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