1{%MainUnit gtk2int.pas} 2{ $Id: gtk2lclintf.inc 56872 2017-12-29 20:22:29Z michl $ } 3{****************************************************************************** 4 All GTK2 interface communication implementations. 5 Initial Revision : Sat Jan 17 19:00:00 2004 6 7 8 !! Keep alphabetical !! 9 10 Support routines go to gtk2proc.pp 11 12 ****************************************************************************** 13 Implementation 14 ****************************************************************************** 15 16 ***************************************************************************** 17 This file is part of the Lazarus Component Library (LCL) 18 19 See the file COPYING.modifiedLGPL.txt, included in this distribution, 20 for details about the license. 21 ***************************************************************************** 22} 23 24 25//##apiwiz##sps## // Do not remove 26 27function TGtk2WidgetSet.CreateRubberBand(const ARect: TRect; const ABrush: HBrush): HWND; 28var 29 Widget: PGtkWidget absolute Result; 30 dx, dy: integer; 31 Pixmap: PGdkPixmap; 32 gc: PGdkGC; 33 AColor: TGdkColor; 34begin 35 dx := ARect.Right - ARect.Left; 36 dy := ARect.Bottom - ARect.Top; 37 if dx < 0 then 38 dx := 0; 39 if dy < 0 then 40 dy := 0; 41 42 // rubber band is just a window without a title 43 Result := {%H-}HWND(gtk_window_new(GTK_WINDOW_POPUP)); 44 gtk_window_set_default_size({%H-}PGtkWindow(Result), dx, dy); 45 gtk_widget_set_uposition(Widget, ARect.Left, ARect.Top); 46 gtk_widget_set_app_paintable(Widget, True); 47 gtk_widget_realize(Widget); 48 gdk_window_set_decorations(Widget^.window, 0); 49 gdk_window_set_functions(Widget^.window, GDK_FUNC_RESIZE or GDK_FUNC_CLOSE); 50 gtk_window_set_opacity({%H-}PGtkWindow(Result), 0.25); 51 if ABrush = 0 then 52 SetWidgetColor(Widget, clNone, clGradientActiveCaption, [GTK_STATE_NORMAL]) 53 else 54 if {%H-}PGDIObject(ABrush)^.GDIBrushFill = GDK_SOLID then 55 SetWidgetColor(Widget, clNone, {%H-}PGDIObject(ABrush)^.GDIBrushColor.ColorRef, [GTK_STATE_NORMAL]) 56 else 57 begin 58 Pixmap := gdk_pixmap_new(Widget^.window, dx, dy, -1); 59 gc := gdk_gc_new(Pixmap); 60 AColor := AllocGDKColor(clWhite); 61 gdk_gc_set_foreground(gc, @AColor); 62 gdk_gc_set_fill(gc, {%H-}PGDIObject(ABrush)^.GDIBrushFill); 63 case {%H-}PGDIObject(ABrush)^.GDIBrushFill of 64 GDK_TILED: gdk_gc_set_tile(gc, {%H-}PGDIObject(ABrush)^.GDIBrushPixMap); 65 GDK_STIPPLED: gdk_gc_set_stipple(gc, {%H-}PGDIObject(ABrush)^.GDIBrushPixMap); 66 end; 67 gdk_draw_rectangle(Pixmap, gc, -1, 0, 0, dx, dy); 68 gdk_gc_unref(gc); 69 gdk_window_set_back_pixmap(Widget^.window, Pixmap, False); 70 g_object_unref(Pixmap); 71 end; 72 73 gtk_widget_show(Widget); 74end; 75 76procedure TGtk2WidgetSet.DestroyRubberBand(ARubberBand: HWND); 77begin 78 gtk_widget_destroy({%H-}PGtkWidget(ARubberBand)); 79end; 80 81procedure TGtk2WidgetSet.DrawDefaultDockImage(AOldRect, ANewRect: TRect; 82 AOperation: TDockImageOperation); 83const 84 LineWidth = 2; 85var 86 Mask: PGdkBitmap; 87 gc: PGdkGC; 88 dx, dy: integer; 89 AColor: TGdkColor; 90{$ifdef GTK_2_10} 91 Colormap: PGdkColormap; 92 Screen: PGdkScreen; 93{$endif} 94begin 95 dx := ANewRect.Right - ANewRect.Left; 96 dy := ANewRect.Bottom - ANewRect.Top; 97 if dx < 0 then 98 dx := 0; 99 if dy < 0 then 100 dy := 0; 101 if FDockImage = nil then 102 begin 103 // dock image is just a window without title 104 FDockImage := gtk_window_new(GTK_WINDOW_POPUP); 105 gtk_window_set_default_size(PGtkWindow(FDockImage), 106 dx, dy); 107 gtk_widget_realize(FDockImage); 108 gdk_window_set_decorations(FDockImage^.window, 0); 109 gdk_window_set_functions(FDockImage^.window, GDK_FUNC_RESIZE or GDK_FUNC_CLOSE); 110 SetWidgetColor(FDockImage, clNone, clGradientActiveCaption, [GTK_STATE_NORMAL]); 111 {$ifdef GTK_2_10} 112 // attemp to make window semi-transparent 113 Screen := gtk_widget_get_screen(FDockImage); 114 Colormap := gdk_screen_get_rgba_colormap(Screen); 115 if (Colormap <> nil) and gdk_screen_is_composited(Screen) then 116 gtk_widget_set_colormap(FDockImage, Colormap); 117 {$endif} 118 end; 119 120 gdk_window_move_resize(FDockImage^.window, ANewRect.Left, ANewRect.Top, 121 dx, dy); 122 if (dx > 0) and (dy > 0) then 123 begin 124 // create a hole inside window 125 Mask := gdk_pixmap_new(nil, dx, dy, 1); 126 gc := gdk_gc_new(Mask); 127 AColor.pixel := 1; 128 gdk_gc_set_foreground(gc, @AColor); 129 gdk_draw_rectangle(Mask, gc, 1, 0, 0, dx, dy); 130 AColor.pixel := 0; 131 gdk_gc_set_foreground(gc, @AColor); 132 gdk_draw_rectangle(Mask, gc, 1, LineWidth, LineWidth, 133 dx - LineWidth * 2, dy - LineWidth * 2); 134 gdk_gc_unref(gc); 135 gtk_widget_shape_combine_mask(FDockImage, Mask, 0, 0); 136 gdk_pixmap_unref(Mask); 137 end; 138 case AOperation of 139 disShow: gtk_widget_show(FDockImage); 140 disHide: gtk_widget_hide(FDockImage); 141 end; 142end; 143 144procedure TGtk2WidgetSet.DrawGrid(DC: HDC; const R: TRect; DX, DY: Integer); 145var 146 X, Y: Integer; 147 W, H: Integer; 148 SavedDC: Integer; 149begin 150 SavedDC := SaveDC(DC); 151 try 152 W := (R.Right - R.Left - 1) div DX; 153 H := (R.Bottom - R.Top - 1) div DY; 154 155 // remove rows from clip rect 156 for Y := 0 to H do 157 begin 158 ExcludeClipRect(DC, R.Left, R.Top + Y * DY + 1, R.Right + 1, R.Top + (Y + 1) * DY); 159 end; 160 161 // draw vertical lines cross excluded rows -> only grid cross points painted 162 for X := 0 to W do 163 begin 164 if MoveToEx(DC, R.Left + X * DX, R.Top, nil) then 165 LineTo(DC, R.Left + X * DX, R.Bottom + 1); 166 end; 167 finally 168 RestoreDC(DC, SavedDC); 169 end; 170end; 171 172 173{------------------------------------------------------------------------------ 174 function TGtk2WidgetSet.ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; 175 Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; 176 177 As ExtTextOut except that Str is treated as UTF8 178 ------------------------------------------------------------------------------} 179function TGtk2WidgetSet.ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; 180 Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; 181begin 182 // all fonts are UTF-8 under gtk2 => no mapping needed 183 Result:=ExtTextOut(DC,X,Y,Options,Rect,Str,Count,Dx); 184end; 185 186function TGtk2WidgetSet.TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint): Boolean; 187begin 188 // all fonts are UTF-8 under gtk2 => no mapping needed 189 Result := TextOut(DC, X, Y, Str, Count); 190end; 191 192{------------------------------------------------------------------------------ 193 function TGtk2WidgetSet.FontCanUTF8(Font: HFont): boolean; 194 195 True if font recognizes Unicode UTF8 encoding. 196 ------------------------------------------------------------------------------} 197function TGtk2WidgetSet.FontCanUTF8(Font: HFont): boolean; 198begin 199 Result:=IsValidGDIObject(Font); 200end; 201 202{------------------------------------------------------------------------------ 203 function TGtk2WidgetSet.FontIsMonoSpace(Font: HFont): boolean; 204 205 True if font characters have all the same width. 206 ------------------------------------------------------------------------------} 207function TGtk2WidgetSet.FontIsMonoSpace(Font: HFont): boolean; 208begin 209 Result:=IsValidGDIObject(Font) 210 and FontIsMonoSpaceFont({%H-}PGdiObject(Font)^.GDIFontObject); 211end; 212 213{------------------------------------------------------------------------------ 214 Function: GetAcceleratorString 215 Params: AVKey: 216 AShiftState: 217 Returns: 218 219 ------------------------------------------------------------------------------} 220function TGtk2WidgetSet.GetAcceleratorString(const AVKey: Byte; 221 const AShiftState: TShiftState): String; 222begin 223 Result:=inherited GetAcceleratorString(AVKey,AShiftState); 224end; 225 226{------------------------------------------------------------------------------ 227 Function: RawImage_CreateBitmap 228 Params: ARawImage: 229 ABitmap: 230 AMask: 231 ASkipMask: When set, no mask is created 232 Returns: 233 234 ------------------------------------------------------------------------------} 235function TGtk2WidgetSet.RawImage_CreateBitmaps(const ARawImage: TRawImage; out 236 ABitmap, AMask: HBitmap; ASkipMask: boolean): boolean; 237var 238 GdiObject: PGDIObject absolute ABitmap; 239 GdiMaskObject: PGDIObject absolute AMask; 240 Desc: TRawImageDescription absolute ARawImage.Description; 241 ImgData: Pointer absolute ARawImage.Data; 242 ImgMask: Pointer absolute ARawImage.Mask; 243 ImgWidth: Cardinal absolute ARawImage.Description.Width; 244 ImgHeight: Cardinal absolute ARawImage.Description.Height; 245 ImgDepth: Byte absolute ARawImage.Description.Depth; 246 ImgDataSize: PtrUInt absolute ARawImage.DataSize; 247 Drawable: PGdkDrawable; 248 Pixbuf, TmpPixBuf: PGdkPixbuf; 249 GC: PGdkGC; 250 Visual: PGdkVisual; 251 GdkImage: PGdkImage; 252 RowStride: Cardinal; 253 Ridx, Gidx, Bidx, Aidx: Byte; 254 Data: Pointer; 255 Src, Dst, SrcRowPtr, DstRowPtr: PByte; 256 x, y: Cardinal; 257 CreateWithAlpha: boolean; 258 ADivResult, ARemainder: DWord; 259begin 260 Result := False; 261 ABitmap := 0; 262 AMask := 0; 263 264 if ImgWidth = 0 then Exit; 265 if ImgHeight = 0 then Exit; 266 267 CreateWithAlpha := True; 268 try 269 {$IFDEF VerboseRawImage} 270 DebugLn('TGtk2WidgetSet.CreateBitmapFromRawImage A ', 271 ' ASkipMask='+dbgs(ASkipMask), 272 ' Depth='+dbgs(Desc.Depth), 273 ' Width='+dbgs(Desc.Width), 274 ' Height='+dbgs(Desc.Height), 275 ' Data='+DbgS(ARawImage.Data), 276 ' DataSize='+dbgs(ARawImage.DataSize)+ 277 ' Mask='+DbgS(ARawImage.Mask)+ 278 ' MaskSize='+dbgs(ARawImage.MaskSize)+ 279 ' Palette='+DbgS(ARawImage.Palette)+ 280 ' PaletteSize='+dbgs(ARawImage.PaletteSize)+ 281 ' BitsPerPixel='+dbgs(Desc.BitsPerPixel)+ 282 ''); 283 {$ENDIF} 284 285 // ToDo: check description 286 287 GdiObject := NewGDIObject(gdiBitmap); 288 GdiObject^.GDIBitmapType := gbPixmap; 289 GdiObject^.Depth := ImgDepth; 290 291 // create Pixmap from data 292 if ImgDepth = 1 then 293 begin 294 // create a GdkBitmap 295 if ImgData <> nil then 296 begin 297 Drawable := gdk_bitmap_create_from_data(nil, ImgData, ImgWidth, ImgHeight); 298 //gtk2 crashes if we create mask on gdkbitmap.issue #21673 299 ASkipMask := True; 300 end else 301 Drawable := gdk_pixmap_new(nil, ImgWidth, ImgHeight, 1); 302 303 GdiObject^.GDIBitmapObject := Drawable; 304 GdiObject^.GDIBitmapType := gbBitmap; 305 end else 306 begin 307 if (ImgData <> nil) and (ImgDepth = 32) 308 then begin 309 case Desc.LineEnd of 310 rileQWordBoundary: begin 311 RowStride := ImgWidth; 312 if ImgWidth and 1 <> 0 then Inc(RowStride); 313 RowStride := RowStride shl 2; 314 end; 315 rileDQWordBoundary: begin 316 RowStride := ImgWidth shr 1; 317 if ImgWidth and 3 <> 0 then Inc(RowStride); 318 RowStride := RowStride shl 3; 319 end; 320 else 321 RowStride := ImgWidth shl 2; 322 end; 323 324 // check if the pixels are in order, pixbuf expects them in R-G-B-A 325 Desc.GetRGBIndices(Ridx, Gidx, Bidx, AIdx); 326 327 if (Ridx <> 0) or (Gidx <> 1) or (Bidx <> 2) or (AIdx <> 3) then 328 begin 329 // put components in right order 330 GetMem(Data, ImgDataSize); 331 DstRowPtr := Data; 332 SrcRowPtr := ImgData; 333 y := ImgHeight; 334 while y > 0 do 335 begin 336 Src := SrcRowPtr; 337 Dst := DstRowPtr; 338 x := ImgWidth; 339 while x > 0 do 340 begin 341 Dst[0] := Src[Ridx]; 342 Dst[1] := Src[Gidx]; 343 Dst[2] := Src[Bidx]; 344 Dst[3] := Src[Aidx]; 345 346 Inc(Src, 4); 347 Inc(Dst, 4); 348 Dec(x); 349 end; 350 Inc(SrcRowPtr, Rowstride); 351 Inc(DstRowPtr, Rowstride); 352 Dec(y); 353 end; 354 end 355 else begin 356 // components are in place 357 358 // gtkPixbuf doesn't like invalid dataSize/MaskSize < 32. issue #8553. 359 if (ARawImage.MaskSize > 0) and (ImgDepth = 32) then 360 begin 361 // seem that gdkPixbuf does not like many of our masks 362 ADivResult := 0; 363 ARemainder := 0; 364 DivMod(ARawImage.DataSize, ARawImage.MaskSize, ADivResult, ARemainder); 365 CreateWithAlpha := ARemainder = 0; 366 {$IFDEF VerboseRawImage} 367 if not CreateWithAlpha then 368 DebugLn('TGtk2WidgetSet.CreateBitmapFromRawImage B WARNING: This image have invalid DataSize / MaskSize.'); 369 {$ENDIF} 370 end; 371 Data := ImgData; 372 end; 373 374 TmpPixBuf := gdk_pixbuf_new_from_data(Data, GDK_COLORSPACE_RGB, CreateWithAlpha, 375 8, ImgWidth, ImgHeight, RowStride, nil, nil); 376 377 // we need to copy our pixbuf into a new one to allow data deallocation 378 Pixbuf := gdk_pixbuf_copy(TmpPixBuf); 379 gdk_pixbuf_unref(TmpPixBuf); 380 GdiObject^.GDIBitmapType := gbPixbuf; 381 GdiObject^.GDIPixbufObject := Pixbuf; 382 if Data <> ImgData 383 then FreeMem(Data); 384 GdiObject^.visual := gdk_visual_get_system(); 385 gdk_visual_ref(GdiObject^.visual); 386 //DbgDumpPixbuf(Pixbuf, 'CreateBitmaps (32)'); 387 end 388 else begin 389 // check if the depth is supported 390 Visual := gdk_visual_get_best_with_depth(Min(ImgDepth, 24)); 391 // try some alternative (I'm not sure if we should fail here instead) 392 // if we don't have a visual we cannot draw anyway 393 //if Visual = nil 394 //then Visual := gdk_visual_get_best; 395 if Visual = nil 396 then Exit; // this depth is not supported 397 398 Drawable := gdk_pixmap_new(nil, ImgWidth, ImgHeight, Visual^.depth); 399 400 // create a GdkPixmap 401 if ImgData <> nil 402 then begin 403 { The gdk_pixmap_create_from_data creates only a two-color pixmap so we can not use it } 404 405 GdkImage := gdk_image_new(GDK_IMAGE_FASTEST, Visual, ImgWidth, ImgHeight); 406 407 {$ifdef VerboseRawImage} 408 //DebugLn('TGtk2WidgetSet.CreateBitmapFromRawImage GdkImage: ', 409 // ' BytesPerLine=',dbgs(GdkImage^.bpl), 410 // ' BitsPerPixel=',dbgs(GetPGdkImageBitsPerPixel(GdkImage)), 411 // ' ByteOrder=',dbgs(ord(GdkImage^.byte_order)), 412 // ''); 413 {$endif} 414 415 if ARawImage.Description.BitsPerPixel <> GetGdkImageBitsPerPixel(GdkImage) 416 then begin 417 RaiseGDBException('TGtk2WidgetSet.CreateBitmapFromRawImage Incompatible BitsPerPixel'); 418 end; 419 if ImgDataSize <> GdkImage^.bpl * ImgHeight 420 then begin 421 RaiseGDBException('TGtk2WidgetSet.CreateBitmapFromRawImage Incompatible DataSize'); 422 end; 423 424 System.Move(ImgData^, GdkImage^.mem^, ImgDataSize); 425 if ImgDepth = 1 426 then CheckGdkImageBitOrder(GdkImage, GdkImage^.mem, ImgDataSize); 427 GC := gdk_gc_new(Drawable); 428 gdk_draw_image(Drawable, GC, GdkImage, 0, 0, 0, 0, ImgWidth, ImgHeight); 429 gdk_gc_unref(GC); 430 gdk_image_destroy(GdkImage); 431 432 //DbgDumpPixmap(Drawable, 'CreateBitmaps'); 433 end; 434 435 GdiObject^.GDIPixmapObject.Image := Drawable; 436 GdiObject^.Visual := gdk_window_get_visual(Drawable); 437 gdk_visual_ref(GdiObject^.Visual); 438 end; 439 end; 440 441 if ASkipMask 442 then begin 443 Result := True; 444 Exit; 445 end; 446 447 // create mask 448 449 {$IFDEF VerboseRawImage} 450 DebugLn('TGtk2WidgetSet.CreateBitmapFromRawImage creating mask .. '); 451 {$ENDIF} 452 453 if ARawImage.IsMasked(False) 454 then Drawable := gdk_bitmap_create_from_data(nil, ImgMask, ImgWidth, ImgHeight) 455 else begin 456 Drawable := gdk_pixmap_new(nil, ImgWidth, ImgHeight, 1); 457 // clear drawable, the contents of a new pixmap are indefined 458 GC := gdk_gc_new(Drawable); 459 gdk_draw_rectangle(Drawable, GC, 1, 0, 0, ImgWidth, ImgHeight); 460 gdk_gc_unref(GC); 461 end; 462 463 GdiMaskObject := NewGDIObject(gdiBitmap); 464 GdiMaskObject^.Depth := 1; 465 GdiMaskObject^.GDIBitmapType := gbBitmap; 466 GdiMaskObject^.GDIBitmapObject := Drawable; 467 468 //DbgDumpBitmap(Drawable, 'CreateBitmaps - Mask'); 469 470 Result := True; 471 except 472 DeleteObject(ABitmap); 473 ABitmap := 0; 474 DeleteObject(AMask); 475 AMask := 0; 476 end; 477end; 478 479{------------------------------------------------------------------------------ 480 Function: RawImage_DescriptionFromBitmap 481 Params: Bitmap: HBITMAP; 482 Desc: PRawImageDescription 483 Returns: boolean; 484 485 ------------------------------------------------------------------------------} 486function TGtk2WidgetSet.RawImage_DescriptionFromBitmap(ABitmap: HBITMAP; out ADesc: TRawImageDescription): boolean; 487var 488 GDIObject: PGDIObject absolute ABitmap; 489begin 490 Result := False; 491 if not IsValidGDIObject(ABitmap) 492 then begin 493 DebugLn('WARNING: [TGtk2WidgetSet.GetBitmapRawImageDescription] invalid Bitmap!'); 494 exit; 495 end; 496 497 case GDIObject^.GDIBitmapType of 498 gbBitmap: 499 Result := RawImage_DescriptionFromDrawable(ADesc, 500 GdiObject^.GDIBitmapObject, False); 501 gbPixmap: 502 Result := RawImage_DescriptionFromDrawable(ADesc, 503 GdiObject^.GDIPixmapObject.Image, GdiObject^.GDIPixmapObject.Mask <> nil); 504 gbPixbuf: 505 Result := RawImage_DescriptionFromPixbuf(ADesc, GdiObject^.GDIPixbufObject); 506 else 507 DebugLn('WARNING: [TGtk2WidgetSet.RawImage_DescriptionFromBitmap] Unknown GDIBitmapType'); 508 Exit; 509 end; 510end; 511 512{------------------------------------------------------------------------------ 513 function RawImage_DescriptionFromDevice 514 Params: DC: HDC; 515 Desc: PRawImageDescription 516 Returns: boolean; 517 518 Retrieves the information about the structure of the supported image data. 519 ------------------------------------------------------------------------------} 520function TGtk2WidgetSet.RawImage_DescriptionFromDevice(ADC: HDC; out 521 ADesc: TRawImageDescription): Boolean; 522var 523 DevCon: TGtkDeviceContext absolute ADC; 524 525 Drawable: PGdkDrawable; 526 UseAlpha: Boolean; 527begin 528 UseAlpha := False; 529 if IsValidDC(ADC) 530 then begin 531 Drawable := DevCon.Drawable; 532 if DevCon.CurrentBitmap <> nil 533 then begin 534 case DevCon.CurrentBitmap^.GDIBitmapType of 535 gbBitmap: Drawable := DevCon.CurrentBitmap^.GDIBitmapObject; 536 gbPixmap: begin 537 Drawable := DevCon.CurrentBitmap^.GDIPixmapObject.Image; 538 UseAlpha := DevCon.CurrentBitmap^.GDIPixmapObject.Mask <> nil; 539 end; 540 gbPixbuf: begin 541 Result := RawImage_DescriptionFromPixbuf(ADesc, DevCon.CurrentBitmap^.GDIPixbufObject); 542 Exit; 543 end; 544 end; 545 end; 546 end 547 else 548 Drawable := nil; 549 550 Result := RawImage_DescriptionFromDrawable(ADesc, Drawable, UseAlpha); 551end; 552 553{------------------------------------------------------------------------------ 554 Function: RawImage_QueryDescription 555 Params: AFlags: 556 ADesc: 557 Returns: 558 559 ------------------------------------------------------------------------------} 560function TGtk2WidgetSet.RawImage_QueryDescription(AFlags: TRawImageQueryFlags; var ADesc: TRawImageDescription): Boolean; 561var 562 Desc: TRawImageDescription; 563begin 564 Desc.Init; 565 Result := RawImage_DescriptionFromDrawable(Desc, nil, riqfAlpha in AFlags); 566 if not Result then Exit; 567 568 if not (riqfUpdate in AFlags) then 569 ADesc.Init; 570 571 // if there's mask gtk2 assumes it's rgba (not XBM format).issue #12362 572 if (riqfUpdate in AFlags) and (riqfMono in AFlags) and (riqfMask in AFlags) then 573 AFlags := AFlags - [riqfMono] + [riqfRgb]; 574 575 if riqfMono in AFlags then 576 begin 577 ADesc.Format := ricfGray; 578 ADesc.Depth := 1; 579 ADesc.BitOrder := Desc.MaskBitOrder; 580 ADesc.ByteOrder := riboLSBFirst; 581 ADesc.LineOrder := Desc.LineOrder; 582 ADesc.LineEnd := Desc.MaskLineEnd; 583 ADesc.BitsPerPixel := Desc.MaskBitsPerPixel; 584 ADesc.RedPrec := 1; 585 ADesc.RedShift := Desc.MaskShift; 586 // in theory only redshift is used, but if someone reads it as color thsi works too. 587 ADesc.GreenPrec := 1; 588 ADesc.GreenShift := Desc.MaskShift; 589 ADesc.BluePrec := 1; 590 ADesc.BlueShift := Desc.MaskShift; 591 end 592 else if riqfGrey in AFlags 593 then begin 594 ADesc.Format := ricfGray; 595 ADesc.Depth := 8; 596 ADesc.BitOrder := Desc.BitOrder; 597 ADesc.ByteOrder := Desc.ByteOrder; 598 ADesc.LineOrder := Desc.LineOrder; 599 ADesc.LineEnd := Desc.LineEnd; 600 ADesc.BitsPerPixel := 8; 601 ADesc.RedPrec := 8; 602 ADesc.RedShift := 0; 603 end 604 else 605 if riqfRGB in AFlags then 606 begin 607 ADesc.Format := ricfRGBA; 608 ADesc.Depth := Desc.Depth; 609 ADesc.BitOrder := Desc.BitOrder; 610 ADesc.ByteOrder := Desc.ByteOrder; 611 ADesc.LineOrder := Desc.LineOrder; 612 ADesc.LineEnd := Desc.LineEnd; 613 ADesc.BitsPerPixel := Desc.BitsPerPixel; 614 ADesc.RedPrec := Desc.RedPrec; 615 ADesc.RedShift := Desc.RedShift; 616 ADesc.GreenPrec := Desc.GreenPrec; 617 ADesc.GreenShift := Desc.GreenShift; 618 ADesc.BluePrec := Desc.BluePrec; 619 ADesc.BlueShift := Desc.BlueShift; 620 end; 621 622 if riqfAlpha in AFlags then 623 begin 624 ADesc.AlphaPrec := Desc.AlphaPrec; 625 ADesc.AlphaShift := Desc.AlphaShift; 626 end; 627 628 if riqfMask in AFlags then 629 begin 630 ADesc.MaskBitsPerPixel := Desc.MaskBitsPerPixel; 631 ADesc.MaskShift := Desc.MaskShift; 632 ADesc.MaskLineEnd := Desc.MaskLineEnd; 633 ADesc.MaskBitOrder := Desc.MaskBitOrder; 634 end; 635 636(* 637 //TODO 638 if riqfPalette in AFlags 639 then begin 640 ADesc.PaletteColorCount := Desc.PaletteColorCount; 641 ADesc.PaletteBitsPerIndex := Desc.PaletteBitsPerIndex; 642 ADesc.PaletteShift := Desc.PaletteShift; 643 ADesc.PaletteLineEnd := Desc.PaletteLineEnd; 644 ADesc.PaletteBitOrder := Desc.PaletteBitOrder; 645 ADesc.PaletteByteOrder := Desc.PaletteByteOrder; 646 end; 647*) 648end; 649 650{------------------------------------------------------------------------------ 651 function TGtk2WidgetSet.GetRawImageFromBitmap(SrcBitmap, SrcMaskBitmap: HBITMAP; 652 const SrcRect: TRect; var NewRawImage: TRawImage): boolean; override; 653 ------------------------------------------------------------------------------} 654function TGtk2WidgetSet.RawImage_FromBitmap(out ARawImage: TRawImage; ABitmap, AMask: HBITMAP; ARect: PRect): Boolean; 655var 656 GdiBitmap: PGDIObject absolute ABitmap; 657 GdiMask: PGDIObject absolute AMask; 658 Drawable: PGdkDrawable; 659 Bitmap: PGdkBitmap; 660begin 661 Result := false; 662 {$IFDEF VerboseRawImage} 663 DebugLn('TGtk2WidgetSet.GetRawImageFromBitmap A'); 664 {$ENDIF} 665 ARawImage.Init; 666 667 if not IsValidGDIObject(ABitmap) 668 then begin 669 DebugLn('WARNING: [TGtk2WidgetSet.RawImage_FromBitmap] invalid Bitmap!'); 670 exit; 671 end; 672 if (AMask <> 0) and not IsValidGDIObject(AMask) 673 then begin 674 DebugLn('WARNING: [TGtk2WidgetSet.RawImage_FromBitmap] invalid Mask'); 675 exit; 676 end; 677 678 try 679 // get rawimage for Bitmap 680 case GdiBitmap^.GDIBitmapType of 681 gbBitmap: begin 682 Drawable := GdiBitmap^.GDIBitmapObject; 683 Bitmap := nil; 684 end; 685 gbPixmap: begin 686 Drawable := GdiBitmap^.GDIPixmapObject.Image; 687 Bitmap := GdiBitmap^.GDIPixmapObject.Mask; 688 end; 689 gbPixbuf: begin 690 Result := RawImage_FromPixbuf(ARawImage, GdiBitmap^.GDIPixbufObject, ARect); 691 Exit; 692 end; 693 else 694 DebugLn('WARNING: [TGtk2WidgetSet.RawImage_FromBitmap] Unknown GDIBitmapType'); 695 Exit; 696 end; 697 {$IFDEF VerboseRawImage} 698 DebugLn('TGtk2WidgetSet.RawImage_FromBitmap A GdkPixmap=',DbgS(Drawable),' SrcMaskBitmap=',DbgS(Bitmap)); 699 {$ENDIF} 700 701 //DbgDumpPixmap(Drawable, 'RawImage_FromBitmap - drawable'); 702 //DbgDumpBitmap(Bitmap, 'RawImage_FromBitmap - alpha'); 703 704 Result := RawImage_FromDrawable(ARawImage, Drawable, Bitmap, ARect); 705 if Result and (AMask <> 0) 706 then begin 707 if GdiMask^.GDIBitmapType <> gbBitmap 708 then begin 709 DebugLn('WARNING: [TGtk2WidgetSet.RawImage_FromBitmap] Unsupported GDIBitmapType for mask'); 710 Exit; 711 end; 712 713 Bitmap := GdiMask^.GDIBitmapObject; 714 RawImage_AddMask(ARawImage, Bitmap, ARect); 715 //DbgDumpBitmap(Bitmap, 'RawImage_FromBitmap - mask'); 716 end 717 else 718 ARawImage.Description.MaskBitsPerPixel := 0; 719 720 if not Result 721 then DebugLn('WARNING: [TGtk2WidgetSet.RawImage_FromBitmap] unable to GetRawImageFromGdkWindow Image'); 722 723 except 724 ARawImage.FreeData; 725 end; 726end; 727 728{------------------------------------------------------------------------------ 729 function TGtk2WidgetSet.GetRawImageFromDevice(SrcDC: HDC; const SrcRect: TRect; 730 var NewRawImage: TRawImage): boolean; 731 732 ------------------------------------------------------------------------------} 733function TGtk2WidgetSet.RawImage_FromDevice(out ARawImage: TRawImage; ADC: HDC; 734 const ARect: TRect): Boolean; 735var 736 DevCtx: TGtkDeviceContext absolute ADC; 737 DCOrigin: TPoint; 738 R: TRect; 739 Drawable: PGdkDrawable; 740begin 741 Result := False; 742 if not IsValidDC(ADC) 743 then begin 744 DebugLn('WARNING: TGtk2WidgetSet.GetRawImageFromDevice invalid SrcDC'); 745 Exit(False); 746 end; 747 748 DCOrigin := DevCtx.Offset; 749 {$IFDEF VerboseRawImage} 750 DebugLn('TGtk2WidgetSet.GetRawImageFromDevice A DCOrigin=',dbgs(DCOrigin.X),',',dbgs(DCOrigin.Y),' SrcRect=',dbgs(ARect.Left),',',dbgs(ARect.Top),',',dbgs(ARect.Right),',',dbgs(ARect.Bottom)); 751 {$ENDIF} 752 R := ARect; 753 LPtoDP(ADC, R, 2); 754 OffSetRect(R, DCOrigin.x, DCOrigin.y); 755 756 Drawable := DevCtx.Drawable; 757 if Drawable = nil then 758 // get screen shot 759 Drawable := gdk_screen_get_root_window(gdk_screen_get_default); 760 Result := RawImage_FromDrawable(ARawImage, Drawable, nil, @R); 761end; 762 763{------------------------------------------------------------------------------ 764 Function: GetControlConstraints 765 Params: Constraints: TObject 766 Returns: true on success 767 768 Updates the constraints object (e.g. TSizeConstraints) with interface specific 769 bounds. 770 ------------------------------------------------------------------------------} 771function TGtk2WidgetSet.GetControlConstraints(Constraints: TObject): boolean; 772var 773 SizeConstraints: TSizeConstraints absolute Constraints; 774 Widget: PGtkWidget; 775 MinWidth: Integer; 776 MinHeight: Integer; 777 MaxWidth: Integer; 778 MaxHeight: Integer; 779begin 780 Result := True; 781 782 if Constraints is TSizeConstraints then 783 begin 784 MinWidth := 1; 785 MinHeight := 1; 786 MaxWidth := 0; 787 MaxHeight := 0; 788 789 if (SizeConstraints.Control=nil) then exit; 790 791 if SizeConstraints.Control is TScrollBar then begin 792 // TScrollBar 793 if TScrollBar(SizeConstraints.Control).Kind=sbHorizontal then begin 794 Widget:=GetStyleWidget(lgsHorizontalScrollbar); 795 MinHeight:=Widget^.requisition.Height; 796 MaxHeight:=MinHeight; 797 end else begin 798 Widget:=GetStyleWidget(lgsVerticalScrollbar); 799 MinWidth:=Widget^.requisition.Width; 800 MaxWidth:=MinWidth; 801 end; 802 //DebugLn('TGtk2WidgetSet.GetControlConstraints A '+dbgs(MinWidth)+','+dbgs(MinHeight),' ',dbgs(TScrollBar(SizeConstraints.Control).Kind=sbHorizontal),' ',TScrollBar(SizeConstraints.Control).Name); 803 end 804 else if SizeConstraints.Control is TCustomSplitter then begin 805 // TCustomSplitter 806 if TCustomSplitter(SizeConstraints.Control).ResizeAnchor in [akTop,akBottom] then 807 begin 808 Widget:=GetStyleWidget(lgsHorizontalPaned); 809 MinHeight:=Widget^.requisition.Height; 810 MaxHeight:=MinHeight; 811 end else begin 812 Widget:=GetStyleWidget(lgsVerticalPaned); 813 MinWidth:=Widget^.requisition.Width; 814 MaxWidth:=MinWidth; 815 end; 816 end 817 else if SizeConstraints.Control is TCustomMemo then begin 818 // TCustomMemo 819 Widget:=GetStyleWidget(lgsHorizontalScrollbar); 820 MinHeight:=Widget^.requisition.Height+20; 821 Widget:=GetStyleWidget(lgsVerticalScrollbar); 822 MinWidth:=Widget^.requisition.Width+20; 823 end 824 else if SizeConstraints.Control is TCustomTrackBar then begin 825 // TCustomTrackBar 826 if TCustomTrackBar(SizeConstraints.Control).Orientation=trHorizontal then 827 begin 828 Widget:=GetStyleWidget(lgsHScale); 829 MinHeight:=Widget^.requisition.height; 830 end else begin 831 Widget:=GetStyleWidget(lgsVScale); 832 MinWidth:=Widget^.requisition.width; 833 end; 834 //DebugLn(['TGtk2WidgetSet.GetControlConstraints ',DbgSName(SizeConstraints.Control),' ',MinWidth,',',MinHeight]); 835 end; 836 837 SizeConstraints.SetInterfaceConstraints(MinWidth,MinHeight, 838 MaxWidth,MaxHeight); 839 end; 840end; 841 842{------------------------------------------------------------------------------ 843 function TGtk2WidgetSet.GetLCLOwnerObject(Handle: HWnd): TObject; 844 845 ------------------------------------------------------------------------------} 846function TGtk2WidgetSet.GetLCLOwnerObject(Handle: HWnd): TObject; 847begin 848 if Handle<>0 then 849 Result:=GetNearestLCLObject({%H-}PGtkWidget(Handle)) 850 else 851 Result:=nil; 852end; 853 854function PromptUserBoxClosed(Widget : PGtkWidget; {%H-}Event : PGdkEvent; 855 data: gPointer) : GBoolean; cdecl; 856var 857 ModalResult : PtrUInt; 858begin 859 { We were requested by window manager to close so return EscapeResult} 860 if PInteger(data)^ = 0 then 861 begin 862 ModalResult:= {%H-}PtrUInt(g_object_get_data(PGObject(Widget), 'modal_result')); 863 { Don't allow to close if we don't have a default return value } 864 Result:= (ModalResult = 0); 865 if not Result then PInteger(data)^:= ModalResult 866 else DebugLn('Do not close !!!'); 867 end else Result:= false; 868end; 869 870function PromptUserButtonClicked(Widget : PGtkWidget; data: gPointer) : GBoolean; cdecl; 871begin 872 PInteger(data)^ := {%H-}PtrUInt(g_object_get_data(PGObject(Widget), 'modal_result')); 873 Result := False; 874end; 875 876function TGtk2WidgetSet.AskUser(const DialogCaption, DialogMessage: string; DialogType: 877 LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt; 878 879const 880 ButtonResults : array[mrNone..mrYesToAll] of Longint = ( 881 -1, idButtonOK, idButtonCancel, idButtonAbort, idButtonRetry, 882 idButtonIgnore, idButtonYes, idButtonNo, idButtonAll, idButtonNoToAll, 883 idButtonYesToAll); 884 885var 886 Dialog: PGtkWidget; 887 888 function ResponseID(const AnID: Integer): Integer; 889 begin 890 case AnID of 891 idButtonOK : Result := GTK_RESPONSE_OK; 892 idButtonCancel : Result := GTK_RESPONSE_CANCEL; 893 idButtonHelp : Result := GTK_RESPONSE_HELP; 894 idButtonYes : Result := GTK_RESPONSE_YES; 895 idButtonNo : Result := GTK_RESPONSE_NO; 896 idButtonClose : Result := GTK_RESPONSE_CLOSE; 897 idButtonAbort : Result := GTK_RESPONSE_REJECT; 898 idButtonRetry : Result := GTK_RESPONSE_LCL_RETRY; 899 idButtonIgnore : Result := GTK_RESPONSE_LCL_IGNORE; 900 idButtonAll : Result := GTK_RESPONSE_LCL_ALL; 901 idButtonNoToAll : Result := GTK_RESPONSE_LCL_NOTOALL; 902 idButtonYesToAll : Result := GTK_RESPONSE_LCL_YESTOALL; 903 end; 904 end; 905 906 procedure CreateButton(const ALabel : String; const AResponse: Integer; 907 const AImageHint: Integer = -1); 908 var 909 NewButton: PGtkWidget; 910 BitmapHandle, MaskHandle: HBitmap; 911 GDIObject: PGDIObject; 912 Pixbuf: PGdkPixbuf; 913 Mask: PGdkBitmap; 914 Img: PGtkWidget; 915 begin 916 NewButton := gtk_dialog_add_button(PGtkDialog(Dialog), 917 PgChar(Ampersands2Underscore(ALabel)), AResponse); 918 gtk_button_set_use_underline(PGtkButton(NewButton), True); 919 if AImageHint >= 0 then 920 begin 921 if ThemeServices.GetStockImage(AImageHint, BitmapHandle, MaskHandle) then 922 begin 923 GDIObject := {%H-}PGDIObject(BitmapHandle); 924 Mask := nil; 925 Pixbuf := nil; 926 if GDIObject^.GDIBitmapType = gbPixbuf then 927 Pixbuf := GDIObject^.GDIPixbufObject 928 else 929 Mask := CreateGdkMaskBitmap(BitmapHandle, MaskHandle); 930 931 Img := gtk_image_new; 932 933 if Pixbuf <> nil then 934 gtk_image_set_from_pixbuf(PGtkImage(Img), Pixbuf) 935 else 936 gtk_image_set_from_pixmap(PGtkImage(Img), GDIObject^.GDIPixmapObject.Image, Mask); 937 gtk_button_set_image(PGtkButton(NewButton), Img); 938 if Mask <> nil then 939 g_object_unref(Mask); 940 DeleteObject(BitmapHandle); 941 DeleteObject(MaskHandle); 942 end; 943 end; 944 end; 945 946var 947 Btn: PGtkButton; 948 BtnId: Longint; 949 GtkDialogType: TGtkMessageType; 950 BtnIdx: Integer; 951 DefaultID, CancelID: Integer; 952 X: Integer; 953 MainList,ChildList: PGList; 954 Title: String; 955 ActiveWindow: HWND; 956 BtnResult: LongInt; 957 DlgBtn: TDialogButton; 958 ADialogResult: Integer; 959 Btns: TGtkButtonsType; 960begin 961 Result := mrNone; 962 ReleaseCapture; 963 964 if (Length(DialogMessage)>1000) then 965 begin 966 Result:=inherited; 967 exit; 968 end; 969 970 ADialogResult := mrCancel; 971 case DialogType of 972 idDialogWarning: GtkDialogType := GTK_MESSAGE_WARNING; 973 idDialogError: GtkDialogType := GTK_MESSAGE_ERROR; 974 idDialogInfo : GtkDialogType := GTK_MESSAGE_INFO; 975 idDialogConfirm : GtkDialogType := GTK_MESSAGE_QUESTION; 976 else 977 GtkDialogType := GTK_MESSAGE_INFO; 978 end; 979 980 Btns := GTK_BUTTONS_NONE; 981 DefaultId := 0; 982 CancelId := -1; 983 for X := 0 to Buttons.Count - 1 do 984 begin 985 DlgBtn:=Buttons[X]; 986 if (Buttons.DefaultButton=DlgBtn) 987 or ((Buttons.DefaultButton=nil) and DlgBtn.Default) then 988 DefaultID := X; 989 if (Buttons.CancelButton=DlgBtn) 990 or ((Buttons.CancelButton=nil) and DlgBtn.Cancel) 991 then begin 992 CancelID := X; 993 ADialogResult := DlgBtn.ModalResult; 994 end; 995 end; 996 997 998 Dialog := gtk_message_dialog_new({$IFDEF HASX}PGtkWindow(GetDesktopWidget){$ELSE}nil{$ENDIF}, 999 GTK_DIALOG_MODAL, GtkDialogType, Btns, 1000 nil); 1001 1002 gtk_message_dialog_set_markup(PGtkMessageDialog(Dialog), PGChar(DialogMessage)); 1003 1004 g_signal_connect(PGtkObject(Dialog), 'delete-event', 1005 TGtkSignalFunc(@PromptUserBoxClosed), 1006 @ADialogResult); 1007 1008 if Btns = GTK_BUTTONS_NONE then 1009 begin 1010 // gtk2 have reverted buttons eg. No, Yes 1011 for BtnIdx := Buttons.Count - 1 downto 0 do 1012 begin 1013 with Buttons[BtnIdx] do 1014 if (ModalResult >= Low(ButtonResults)) and (ModalResult <= High(ButtonResults)) then 1015 begin 1016 BtnID := ButtonResults[ModalResult]; 1017 case BtnID of 1018 idButtonOK : CreateButton(Caption, GTK_RESPONSE_OK, BtnID); 1019 idButtonCancel : CreateButton(Caption, GTK_RESPONSE_CANCEL, BtnID); 1020 idButtonHelp : CreateButton(Caption, GTK_RESPONSE_HELP, BtnID); 1021 idButtonYes : CreateButton(Caption, GTK_RESPONSE_YES, BtnID); 1022 idButtonNo : CreateButton(Caption, GTK_RESPONSE_NO, BtnID); 1023 idButtonClose : CreateButton(Caption, GTK_RESPONSE_CLOSE, BtnID); 1024 idButtonAbort : CreateButton(Caption, GTK_RESPONSE_REJECT, BtnID); 1025 idButtonRetry : CreateButton(Caption, GTK_RESPONSE_LCL_RETRY, BtnID); 1026 idButtonIgnore : CreateButton(Caption, GTK_RESPONSE_LCL_IGNORE, BtnID); 1027 idButtonAll : CreateButton(Caption, GTK_RESPONSE_LCL_ALL, BtnID); 1028 idButtonNoToAll : CreateButton(Caption, GTK_RESPONSE_LCL_NOTOALL, BtnID); 1029 idButtonYesToAll : CreateButton(Caption, GTK_RESPONSE_LCL_YESTOALL, BtnID); 1030 end; 1031 end else 1032 CreateButton(Caption, GTK_RESPONSE_NONE, BtnID); // user defined buttons 1033 end; 1034 end; 1035 1036 MainList := gtk_container_children(PGtkContainer(PGtkDialog(Dialog)^.action_area)); 1037 ChildList := MainList; 1038 BtnIdx := 0; 1039 while ChildList <> nil do 1040 begin 1041 if (ChildList^.Data <> nil) then 1042 begin 1043 if GTK_IS_BUTTON(ChildList^.Data) then 1044 begin 1045 Btn := PGtkButton(ChildList^.Data); 1046 DlgBtn := Buttons[BtnIdx]; 1047 1048 BtnID := -1; 1049 BtnResult:=DlgBtn.ModalResult; 1050 if (BtnResult>=Low(ButtonResults)) and (BtnResult<=High(ButtonResults)) then 1051 BtnID := ButtonResults[DlgBtn.ModalResult]; 1052 if (BtnIdx=CancelID) then 1053 g_object_set_data(PGObject(Dialog), 'modal_result', {%H-}Pointer(PtrInt(DlgBtn.ModalResult))); 1054 1055 X := DlgBtn.ModalResult; 1056 g_object_set_data(PGObject(Btn), 'modal_result', 1057 {%H-}Pointer(PtrInt(X))); 1058 1059 g_signal_connect(PGtkObject(Btn), 'clicked', 1060 TGtkSignalFunc(@PromptUserButtonClicked), @ADialogResult); 1061 1062 if DefaultID = BtnIdx then 1063 begin 1064 gtk_dialog_set_default_response(PGtkDialog(Dialog), ResponseID(BtnID)); 1065 X := DlgBtn.ModalResult; 1066 if CancelID<0 then 1067 g_object_set_data(PGObject(Dialog), 'modal_result', 1068 {%H-}Pointer(PtrInt(X))); 1069 end; 1070 1071 inc(BtnIdx); 1072 end; 1073 end; 1074 ChildList := g_list_next(ChildList); 1075 end; 1076 if MainList <> nil then 1077 g_list_free(MainList); 1078 1079 if DialogCaption <> '' then 1080 gtk_window_set_title(PGtkWindow(Dialog), PGChar(DialogCaption)) 1081 else 1082 begin 1083 Title := ''; 1084 case DialogType of 1085 idDialogWarning: Title := rsMtWarning; 1086 idDialogError: Title := rsMtError; 1087 idDialogInfo : Title := rsMtInformation; 1088 idDialogConfirm : Title := rsMtConfirmation; 1089 end; 1090 gtk_window_set_title(PGtkWindow(Dialog), PGChar(Title)); 1091 end; 1092 1093 if (gtk_major_version = 2) and (gtk_minor_version <= 12) then 1094 begin 1095 ActiveWindow := GetActiveWindow; 1096 if ActiveWindow <> 0 then 1097 gtk_window_set_transient_for(PGtkWindow(Dialog), {%H-}PGtkWindow(ActiveWindow)); 1098 end; 1099 gtk_dialog_run(PGtkDialog(Dialog)); 1100 gtk_widget_destroy(Dialog); 1101 Result := ADialogResult; 1102end; 1103 1104function TGtk2WidgetSet.PromptUser(const DialogCaption: string; 1105 const DialogMessage: string; DialogType: LongInt; Buttons: PLongInt; 1106 ButtonCount: LongInt; DefaultIndex: LongInt; EscapeResult: LongInt): LongInt; 1107var 1108 Btn: PGtkButton; 1109 Dialog: PGtkWidget; 1110 ADialogResult: Integer; 1111 GtkDialogType: TGtkMessageType; 1112 Btns: TGtkButtonsType; 1113 BtnIdx: Integer; 1114 DefaultID: Integer; 1115 X: Integer; 1116 MainList,ChildList: PGList; 1117 Title: String; 1118 ActiveWindow: HWND; 1119 QuotedMessage: Pgchar; 1120 1121 procedure CreateButton(const ALabel : String; const AResponse: Integer); 1122 var 1123 NewButton: PGtkButton; 1124 begin 1125 NewButton := PGtkButton(gtk_dialog_add_button(PGtkDialog(Dialog), 1126 PgChar(Ampersands2Underscore(ALabel)), AResponse)); 1127 gtk_button_set_use_underline(NewButton, True); 1128 end; 1129 1130 function tr(UseWidgetStr: boolean; const TranslatedStr, WidgetStr: String): string; 1131 begin 1132 if UseWidgetStr then 1133 Result:=WidgetStr 1134 else 1135 Result:=TranslatedStr; 1136 end; 1137 1138 function ResponseID(const AnID: Integer): Integer; 1139 begin 1140 case AnID of 1141 idButtonOK : Result := GTK_RESPONSE_OK; 1142 idButtonCancel : Result := GTK_RESPONSE_CANCEL; 1143 idButtonHelp : Result := GTK_RESPONSE_HELP; 1144 idButtonYes : Result := GTK_RESPONSE_YES; 1145 idButtonNo : Result := GTK_RESPONSE_NO; 1146 idButtonClose : Result := GTK_RESPONSE_CLOSE; 1147 idButtonAbort : Result := GTK_RESPONSE_REJECT; 1148 idButtonRetry : Result := GTK_RESPONSE_LCL_RETRY; 1149 idButtonIgnore : Result := GTK_RESPONSE_LCL_IGNORE; 1150 idButtonAll : Result := GTK_RESPONSE_LCL_ALL; 1151 idButtonNoToAll : Result := GTK_RESPONSE_LCL_NOTOALL; 1152 idButtonYesToAll : Result := GTK_RESPONSE_LCL_YESTOALL; 1153 end; 1154 end; 1155 1156begin 1157 Result := -1; 1158 ReleaseCapture; 1159 ADialogResult := EscapeResult; 1160 case DialogType of 1161 idDialogWarning: GtkDialogType := GTK_MESSAGE_WARNING; 1162 idDialogError: GtkDialogType := GTK_MESSAGE_ERROR; 1163 idDialogInfo : GtkDialogType := GTK_MESSAGE_INFO; 1164 idDialogConfirm : GtkDialogType := GTK_MESSAGE_QUESTION; 1165 else 1166 GtkDialogType := GTK_MESSAGE_INFO; 1167 end; 1168 1169 Btns := GTK_BUTTONS_NONE; 1170 DefaultId := 0; 1171 for X := 0 to ButtonCount - 1 do 1172 begin 1173 if X = DefaultIndex then 1174 DefaultID := Buttons[X]; 1175 end; 1176 1177 Dialog := gtk_message_dialog_new({$IFDEF HASX}PGtkWindow(GetDesktopWidget){$ELSE}nil{$ENDIF}, 1178 GTK_DIALOG_MODAL, GtkDialogType, Btns, 1179 nil); 1180 1181 // Can't pass message string to gtk_message_dialog_new, as % chars are interpreted 1182 // gtk_message_dialog_set_markup interpets HTML, so we need to quote that 1183 QuotedMessage := g_markup_escape_text(PGChar(DialogMessage), Length(DialogMessage)); 1184 gtk_message_dialog_set_markup(PGtkMessageDialog(Dialog), QuotedMessage); 1185 g_free(QuotedMessage); 1186 g_signal_connect(PGtkObject(Dialog), 'delete-event', 1187 TGtkSignalFunc(@PromptUserBoxClosed), 1188 @ADialogResult); 1189 1190 if Btns = GTK_BUTTONS_NONE then 1191 begin 1192 // gtk2 have reverted buttons eg. No, Yes 1193 for BtnIdx := ButtonCount-1 downto 0 do 1194 begin 1195 case Buttons[BtnIdx] of 1196 idButtonOK : CreateButton(tr(rsmbOK='&OK',rsmbOK, 'gtk-ok'), GTK_RESPONSE_OK); 1197 idButtonCancel : CreateButton(tr(rsmbCancel='Cancel',rsmbCancel,'gtk-cancel'), GTK_RESPONSE_CANCEL); 1198 idButtonHelp : CreateButton(tr(rsmbHelp='&Help',rsmbHelp,'gtk-help'), GTK_RESPONSE_HELP); 1199 idButtonYes : CreateButton(tr(rsmbYes='&Yes',rsmbYes,'gtk-yes'), GTK_RESPONSE_YES); 1200 idButtonNo : CreateButton(tr(rsmbNo='&No',rsmbNo,'gtk-no'), GTK_RESPONSE_NO); 1201 idButtonClose : CreateButton(tr(rsmbClose='&Close',rsmbClose,'gtk-close'), GTK_RESPONSE_CLOSE); 1202 idButtonAbort : CreateButton(rsMBAbort, GTK_RESPONSE_REJECT); 1203 idButtonRetry : CreateButton(rsMBRetry, GTK_RESPONSE_LCL_RETRY); 1204 idButtonIgnore : CreateButton(rsMBIgnore, GTK_RESPONSE_LCL_IGNORE); 1205 idButtonAll : CreateButton(rsMbAll, GTK_RESPONSE_LCL_ALL); 1206 idButtonNoToAll : CreateButton(rsMBNoToAll, GTK_RESPONSE_LCL_NOTOALL); 1207 idButtonYesToAll : CreateButton(rsMBYesToAll, GTK_RESPONSE_LCL_YESTOALL); 1208 end; 1209 end; 1210 end; 1211 1212 MainList := gtk_container_children(PGtkContainer(PGtkDialog(Dialog)^.action_area)); 1213 ChildList := MainList; 1214 BtnIdx := 0; 1215 1216 while ChildList <> nil do 1217 begin 1218 if (ChildList^.Data <> nil) then 1219 begin 1220 if GTK_IS_BUTTON(ChildList^.Data) then 1221 begin 1222 Btn := PGtkButton(ChildList^.Data); 1223 1224 if Buttons[BtnIdx] = idButtonCancel then 1225 g_object_set_data(PGObject(Dialog), 'modal_result', Pointer(idButtonCancel)); 1226 1227 X := Buttons[BtnIdx]; 1228 g_object_set_data(PGObject(Btn), 'modal_result', 1229 {%H-}Pointer(PtrInt(X))); 1230 1231 g_signal_connect(PGtkObject(Btn), 'clicked', 1232 TGtkSignalFunc(@PromptUserButtonClicked), @ADialogResult); 1233 1234 if DefaultID = Buttons[BtnIdx] then 1235 begin 1236 gtk_dialog_set_default_response(PGtkDialog(Dialog), ResponseID(Buttons[BtnIdx])); 1237 X := Buttons[BtnIdx]; 1238 g_object_set_data(PGObject(Dialog), 'modal_result', 1239 {%H-}Pointer(PtrInt(X))); 1240 end; 1241 1242 inc(BtnIdx); 1243 end; 1244 end; 1245 ChildList := g_list_next(ChildList); 1246 end; 1247 if MainList <> nil then 1248 g_list_free(MainList); 1249 1250 if DialogCaption <> '' then 1251 gtk_window_set_title(PGtkWindow(Dialog), PGChar(DialogCaption)) 1252 else 1253 begin 1254 Title := ''; 1255 case DialogType of 1256 idDialogWarning: Title := rsMtWarning; 1257 idDialogError: Title := rsMtError; 1258 idDialogInfo : Title := rsMtInformation; 1259 idDialogConfirm : Title := rsMtConfirmation; 1260 end; 1261 gtk_window_set_title(PGtkWindow(Dialog), PGChar(Title)); 1262 end; 1263 1264 ActiveWindow := GetActiveWindow; 1265 if ActiveWindow <> 0 then 1266 gtk_window_set_transient_for(PGtkWindow(Dialog), {%H-}PGtkWindow(ActiveWindow)); 1267 // the following line keeps the old behaviour making the dialog appear 1268 // at screen center instead of at ActiveWindow center 1269 gtk_window_set_position(PGtkWindow(Dialog), GTK_WIN_POS_CENTER); 1270 1271 gtk_dialog_run(PGtkDialog(Dialog)); 1272 gtk_widget_destroy(Dialog); 1273 Result := ADialogResult; 1274end; 1275 1276function TGtk2WidgetSet.SetComboMinDropDownSize(Handle: HWND; MinItemsWidth, 1277 MinItemsHeight, MinItemCount: integer): boolean; 1278var 1279 p: PGtkWidget; 1280 Menu: PGtkWidget; 1281 Requisition: TGtkRequisition; 1282begin 1283 Result:=True; 1284 p := GetWidgetInfo({%H-}Pointer(Handle), False)^.CoreWidget; 1285 1286 Menu := PGtkWidget(g_object_get_data(G_OBJECT(p), 'Menu')); 1287 if Menu<>nil then begin 1288 Requisition.width := MinItemsWidth; 1289 Requisition.height := MinItemsHeight * MinItemCount; 1290 gtk_widget_size_request(Menu, @Requisition); 1291 end; 1292end; 1293 1294 1295//##apiwiz##eps## // Do not remove, no wizard declaration after this line 1296 1297 1298function waithandle_iocallback({%H-}source: PGIOChannel; condition: TGIOCondition; 1299 data: gpointer): gboolean; cdecl; 1300var 1301 lEventHandler: PWaitHandleEventHandler absolute data; 1302begin 1303 //debugln('waithandle_iocallback lEventHandler=',HexStr(Cardinal(lEventHandler),8)); 1304 lEventHandler^.OnEvent(lEventHandler^.UserData, condition); 1305 Result := true; 1306end; 1307 1308function TGtk2WidgetSet.AddEventHandler(AHandle: THandle; AFlags: dword; 1309 AEventHandler: TWaitHandleEvent; AData: PtrInt): PEventHandler; 1310var 1311 giochannel: pgiochannel; 1312 lEventHandler: PWaitHandleEventHandler; 1313begin 1314 if AEventHandler = nil then exit; 1315 New(lEventHandler); 1316 giochannel := g_io_channel_unix_new(AHandle); 1317 lEventHandler^.Handle := AHandle; 1318 lEventHandler^.UserData := AData; 1319 lEventHandler^.GIOChannel := giochannel; 1320 lEventHandler^.OnEvent := AEventHandler; 1321 lEventHandler^.GSourceID := g_io_add_watch(giochannel, 1322 AFlags, @waithandle_iocallback, lEventHandler); 1323 //debugln('TGtk2WidgetSet.AddEventHandler lEventHandler=',HexStr(Cardinal(lEventHandler),8),' AHandle=',dbgs(lEventHandler^.Handle)); 1324 lEventHandler^.PrevHandler := nil; 1325 lEventHandler^.NextHandler := FWaitHandles; 1326 if FWaitHandles <> nil then 1327 FWaitHandles^.PrevHandler := lEventHandler; 1328 FWaitHandles := lEventHandler; 1329 Result := lEventHandler; 1330end; 1331 1332 1333procedure TGtk2WidgetSet.RemoveEventHandler(var AHandler: PEventHandler); 1334var 1335 lEventHandler: PWaitHandleEventHandler absolute AHandler; 1336begin 1337 if AHandler = nil then exit; 1338 g_source_remove(lEventHandler^.GSourceID); 1339 { channel will be freed with ref count drops to 0 } 1340 g_io_channel_unref(lEventHandler^.GIOChannel); 1341 if lEventHandler^.PrevHandler = nil then 1342 FWaitHandles := lEventHandler^.NextHandler 1343 else 1344 lEventHandler^.PrevHandler^.NextHandler := lEventHandler^.NextHandler; 1345 if lEventHandler^.NextHandler <> nil then 1346 lEventHandler^.NextHandler^.PrevHandler := lEventHandler^.PrevHandler; 1347 //debugln('TGtk2WidgetSet.RemoveEventHandler lEventHandler=',HexStr(Cardinal(lEventHandler),8),' AHandle=',dbgs(lEventHandler^.Handle)); 1348 Dispose(lEventHandler); 1349 AHandler := nil; 1350end; 1351 1352procedure TGtk2WidgetSet.SetEventHandlerFlags(AHandler: PEventHandler; NewFlags: dword); 1353var 1354 lEventHandler: PWaitHandleEventHandler absolute AHandler; 1355begin 1356 if AHandler = nil then exit; 1357 g_source_remove(lEventHandler^.GSourceID); 1358 lEventHandler^.GSourceID := g_io_add_watch(lEventHandler^.GIOChannel, 1359 NewFlags, @waithandle_iocallback, lEventHandler); 1360 //debugln('TGtk2WidgetSet.SetEventHandlerFlags lEventHandler=',HexStr(Cardinal(lEventHandler),8),' AHandle=',dbgs(lEventHandler^.Handle)); 1361end; 1362 1363procedure TGtk2WidgetSet.SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect); 1364begin 1365 if ARubberBand = 0 then 1366 exit; 1367 with ARect do 1368 gdk_window_move_resize({%H-}PGtkWidget(ARubberBand)^.window, Left, 1369 Top, Right - Left, Bottom - Top); 1370end; 1371 1372type 1373 PPipeEventInfo = ^TPipeEventInfo; 1374 TPipeEventInfo = record 1375 Handler: PEventHandler; 1376 UserData: PtrInt; 1377 OnEvent: TPipeEvent; 1378 end; 1379 1380function TGtk2WidgetSet.AddPipeEventHandler(AHandle: THandle; 1381 AEventHandler: TPipeEvent; AData: PtrInt): PPipeEventHandler; 1382var 1383 lPipeEventInfo: PPipeEventInfo; 1384begin 1385 if AEventHandler = nil then exit; 1386 New(lPipeEventInfo); 1387 lPipeEventInfo^.UserData := AData; 1388 lPipeEventInfo^.OnEvent := AEventHandler; 1389 lPipeEventInfo^.Handler := AddEventHandler(AHandle, G_IO_IN or G_IO_HUP or G_IO_OUT, 1390 @HandlePipeEvent, {%H-}PtrUInt(lPipeEventInfo)); 1391 Result := lPipeEventInfo; 1392end; 1393 1394procedure TGtk2WidgetSet.HandlePipeEvent(AData: PtrInt; AFlags: dword); 1395var 1396 lPipeEventInfo: PPipeEventInfo absolute AData; 1397 lReasons: TPipeReasons; 1398begin 1399 lReasons := []; 1400 if AFlags and G_IO_IN = G_IO_IN then 1401 Include(lReasons, prDataAvailable); 1402 if AFlags and G_IO_OUT = G_IO_OUT then 1403 Include(lReasons, prCanWrite); 1404 if AFlags and G_IO_HUP = G_IO_HUP then 1405 Include(lReasons, prBroken); 1406 1407 lPipeEventInfo^.OnEvent(lPipeEventInfo^.UserData, lReasons); 1408end; 1409 1410procedure TGtk2WidgetSet.RemovePipeEventHandler(var AHandler: PPipeEventHandler); 1411var 1412 lPipeEventInfo: PPipeEventInfo absolute AHandler; 1413begin 1414 if AHandler = nil then exit; 1415 RemoveEventHandler(lPipeEventInfo^.Handler); 1416 Dispose(lPipeEventInfo); 1417 AHandler := nil; 1418end; 1419 1420{$ifdef UNIX} 1421function TGtk2WidgetSet.AddProcessEventHandler(AHandle: THandle; 1422 AEventHandler: TChildExitEvent; AData: PtrInt): PProcessEventHandler; 1423var 1424 lHandler: PChildSignalEventHandler; 1425begin 1426 if AEventHandler = nil then exit(nil); 1427 New(lHandler); 1428 lHandler^.PID := TPid(AHandle); 1429 lHandler^.UserData := AData; 1430 lHandler^.OnEvent := AEventHandler; 1431 lHandler^.PrevHandler := nil; 1432 lHandler^.NextHandler := FChildSignalHandlers; 1433 if FChildSignalHandlers <> nil then 1434 FChildSignalHandlers^.PrevHandler := lHandler; 1435 FChildSignalHandlers := lHandler; 1436 Result := lHandler; 1437end; 1438 1439procedure TGtk2WidgetSet.RemoveProcessEventHandler(var AHandler: PProcessEventHandler); 1440var 1441 lHandler: PChildSignalEventHandler absolute AHandler; 1442begin 1443 if AHandler = nil then exit; 1444 if lHandler^.PrevHandler = nil then 1445 FChildSignalHandlers := lHandler^.NextHandler 1446 else 1447 lHandler^.PrevHandler^.NextHandler := lHandler^.NextHandler; 1448 if lHandler^.NextHandler <> nil then 1449 lHandler^.NextHandler^.PrevHandler := lHandler^.PrevHandler; 1450 Dispose(lHandler); 1451 AHandler := nil; 1452end; 1453{$else} 1454{$IFDEF VerboseGtkToDos}{$warning TGtk2WidgetSet.RemoveProcessEventHandler and TGtk2WidgetSet.AddProcessEventHandler not implemented on this OS}{$ENDIF} 1455//PChildSignalEventHandler is only defined on unix 1456function TGtk2WidgetSet.AddProcessEventHandler(AHandle: THandle; 1457 AEventHandler: TChildExitEvent; AData: PtrInt): PProcessEventHandler; 1458begin 1459 Result := nil; 1460end; 1461 1462procedure TGtk2WidgetSet.RemoveProcessEventHandler(var AHandler: PProcessEventHandler); 1463begin 1464end; 1465{$endif} 1466 1467