1{%MainUnit gtk3int.pas} 2 3function TGtk3WidgetSet.Arc(DC: HDC; Left, top, right, bottom, angle1, 4 angle2: Integer): Boolean; 5begin 6 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 7 DebugLn('WARNING: TGtk3WidgetSet.Arc not implemented ...'); 8 {$ENDIF} 9 Result:=inherited Arc(DC, Left, top, right, bottom, angle1, angle2); 10end; 11 12function TGtk3WidgetSet.AngleChord(DC: HDC; x1, y1, x2, y2, angle1, 13 angle2: Integer): Boolean; 14begin 15 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 16 DebugLn('WARNING: TGtk3WidgetSet.AngleChord not implemented ...'); 17 {$ENDIF} 18 Result:=inherited AngleChord(DC, x1, y1, x2, y2, angle1, angle2); 19end; 20 21function TGtk3WidgetSet.BeginPaint(Handle: hWnd; var PS: TPaintStruct): hdc; 22var 23 Widget: TGtk3Widget; 24 GtkWidget: PGtkWidget; 25 DC: TGtk3DeviceContext; 26begin 27 Widget := TGtk3Widget(Handle); 28 if Widget <> nil then 29 begin 30 GtkWidget := Widget.GetContainerWidget; 31 if Widget.CairoContext <> nil then 32 DC := TGtk3DeviceContext.CreateFromCairo(GtkWidget, Widget.CairoContext) 33 else 34 DC := TGtk3DeviceContext.Create(GtkWidget, True); 35 end 36 else 37 DC := TGtk3DeviceContext.Create(PGtkWidget(nil), True); 38 39 PS.hdc := HDC(DC); 40 41 if Handle<>0 then 42 begin 43 DC.vClipRect := Widget.PaintData.ClipRect^; 44 (* 45 // if current handle has paintdata information, 46 // setup hdc with it 47 //DC.DebugClipRect('BeginPaint: Before'); 48 if Widget.PaintData.ClipRegion <> nil then 49 begin 50 //Write('>>> Setting Paint ClipRegion: '); 51 //DebugRegion('PaintData.ClipRegion: ', Widget.PaintData.ClipRegion); 52 DC.setClipRegion(Widget.PaintData.ClipRegion); 53 DC.setClipping(True); 54 end; 55 if Widget.PaintData.ClipRect <> nil then 56 begin 57 New(DC.vClipRect); 58 DC.vClipRect^ := Widget.PaintData.ClipRect^; 59 end; 60 *) 61 end; 62 63 Result := PS.hdc; 64end; 65 66function TGtk3WidgetSet.BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; 67 SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean; 68begin 69 {$ifdef VerboseGtk3DeviceContext} 70 WriteLn('Trace:> [TGtk3WidgetSet.BitBlt]'); 71 {$endif} 72 Result := StretchBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Width, 73 Height, ROP); 74 75 {$ifdef VerboseGtk3DeviceContext} 76 WriteLn('Trace:< [TGtk3WidgetSet.BitBlt]'); 77 {$endif} 78end; 79 80function TGtk3WidgetSet.CallNextHookEx(hHk: HHOOK; ncode: Integer; 81 wParam: WParam; lParam: LParam): Integer; 82begin 83 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 84 DebugLn('WARNING: TGtk3WidgetSet.CallNextHookEx not implemented ...'); 85 {$ENDIF} 86 Result:=inherited CallNextHookEx(hHk, ncode, wParam, lParam); 87end; 88 89function TGtk3WidgetSet.CallWindowProc(lpPrevWndFunc: TFarProc; Handle: HWND; 90 Msg: UINT; wParam: WParam; lParam: lParam): Integer; 91begin 92 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 93 DebugLn('WARNING: TGtk3WidgetSet.CallWindowProc not implemented ...'); 94 {$ENDIF} 95 Result:=inherited CallWindowProc(lpPrevWndFunc, Handle, Msg, wParam, lParam); 96end; 97 98function TGtk3WidgetSet.ClientToScreen(Handle: HWND; var P: TPoint): Boolean; 99var 100 AWidget: TGtk3Widget; 101 TempAlloc: TGtkAllocation; 102 Pt: TPoint; 103begin 104 {$ifdef VerboseGtk3WinApi} 105 DebugLn('Trace:> [TGtk3WidgetSet.ClientToScreen] ',dbgs(P)); 106 {$endif} 107 // Result:=inherited ClientToScreen(Handle, P); 108 Result := False; 109 Pt := Point(0, 0); 110 if IsValidHandle(Handle) then 111 begin 112 AWidget := TGtk3Widget(Handle); 113 if not AWidget.IsWidgetOk then 114 begin 115 DebugLn('TGtk3WidgetSet.ClientToScreen invalid widget ...'); 116 exit; 117 end; 118 if Gtk3IsGdkWindow(AWidget.Widget^.window) then 119 gdk_window_get_origin(AWidget.Widget^.window, @Pt.X, @Pt.Y) 120 else 121 begin 122 gtk_widget_get_allocation(AWidget.Widget, @TempAlloc); 123 Pt.X := TempAlloc.x; 124 Pt.Y := TempAlloc.y; 125 end; 126 Result := True; 127 inc(P.X, Pt.X); 128 inc(P.Y, Pt.Y); 129 end; 130 {$ifdef VerboseGtk3WinApi} 131 DebugLn('Trace:< [TGtk3WidgetSet.ClientToScreen] ',dbgs(P),' result=',dbgs(Result)); 132 {$endif} 133end; 134 135function TGtk3WidgetSet.ClipboardFormatToMimeType(FormatID: TClipboardFormat 136 ): string; 137begin 138 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 139 DebugLn('WARNING: TGtk3WidgetSet.ClipboardFormatToMimeType not implemented ...'); 140 {$ENDIF} 141 Result:=inherited ClipboardFormatToMimeType(FormatID); 142end; 143 144function TGtk3WidgetSet.ClipboardGetData(ClipboardType: TClipboardType; 145 FormatID: TClipboardFormat; Stream: TStream): boolean; 146begin 147 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 148 DebugLn('WARNING: TGtk3WidgetSet.ClipboardGetData not implemented ...'); 149 {$ENDIF} 150 Result:=inherited ClipboardGetData(ClipboardType, FormatID, Stream); 151end; 152 153function TGtk3WidgetSet.ClipboardGetFormats(ClipboardType: TClipboardType; 154 var Count: integer; var List: PClipboardFormat): boolean; 155begin 156 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 157 DebugLn('WARNING: TGtk3WidgetSet.ClipboardGetFormats not implemented ...'); 158 {$ENDIF} 159 Result:=inherited ClipboardGetFormats(ClipboardType, Count, List); 160end; 161 162function TGtk3WidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType; 163 OnRequestProc: TClipboardRequestEvent; FormatCount: integer; 164 Formats: PClipboardFormat): boolean; 165begin 166 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 167 DebugLn('WARNING: TGtk3WidgetSet.ClipboardGetOwnerShip not implemented ...'); 168 {$ENDIF} 169 Result:=inherited ClipboardGetOwnerShip(ClipboardType, OnRequestProc, 170 FormatCount, Formats); 171end; 172 173function TGtk3WidgetSet.ClipboardRegisterFormat(const AMimeType: string 174 ): TClipboardFormat; 175begin 176 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 177 DebugLn('WARNING: TGtk3WidgetSet.ClipboardRegisterFormat not implemented ...'); 178 {$ENDIF} 179 Result:=inherited ClipboardRegisterFormat(AMimeType); 180end; 181 182function TGtk3WidgetSet.CombineRgn(Dest, Src1, Src2: HRGN; 183 fnCombineMode: Longint): Longint; 184var 185 RDest,RSrc1,RSrc2: Pcairo_region_t; 186 AStatus: cairo_status_t; 187 ACairoRect: Tcairo_rectangle_int_t; 188begin 189 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 190 // DebugLn('WARNING: TGtk3WidgetSet.CombineRgn not implemented ...'); 191 {$ENDIF} 192 Result := ERROR; 193 if not IsValidGDIObject(Dest) or not IsValidGDIObject(Src1) then 194 exit; 195 RDest := TGtk3Region(Dest).Handle; 196 RSrc1 := TGtk3Region(Src1).Handle; 197 if (fnCombineMode<>RGN_COPY) and not IsValidGDIObject(Src2) then 198 exit 199 else 200 RSrc2 := TGtk3Region(Src2).Handle; 201 AStatus := CAIRO_STATUS_READ_ERROR; 202 case fnCombineMode of 203 RGN_AND: 204 begin 205 AStatus := cairo_region_intersect(RSrc1, RSrc2); 206 // cairo cannot intersect empty region 207 if cairo_region_is_empty(RDest) then 208 begin 209 cairo_region_destroy(TGtk3Region(Dest).Handle); 210 cairo_region_get_extents(RSrc1, @ACairoRect); 211 TGtk3Region(Dest).Handle := cairo_region_create_rectangle(@ACairoRect); 212 RDest := TGtk3Region(Dest).Handle; 213 //cairo_region_translate(RDest, -ACairoRect.x, -ACairoRect.y); 214 end else 215 AStatus := cairo_region_intersect(RDest, RSrc1); 216 end; 217 RGN_COPY: 218 begin 219 AStatus := cairo_region_intersect(RDest, RSrc1); 220 // writeln('CombineRgn RGN_COPY ',AStatus); 221 end; 222 RGN_DIFF: 223 begin 224 AStatus := cairo_region_subtract(RSrc1, RSrc2); 225 if cairo_region_is_empty(RDest) then 226 begin 227 cairo_region_destroy(TGtk3Region(Dest).Handle); 228 cairo_region_get_extents(RSrc1, @ACairoRect); 229 TGtk3Region(Dest).Handle := cairo_region_create_rectangle(@ACairoRect); 230 RDest := TGtk3Region(Dest).Handle; 231 cairo_region_translate(RDest, -ACairoRect.x, -ACairoRect.y); 232 end else 233 AStatus := cairo_region_subtract(RDest, RSrc1); 234 end; 235 RGN_OR: 236 begin 237 AStatus := cairo_region_union(RSrc1, RSrc2); 238 AStatus := cairo_region_union(RDest, RSrc1); 239 end; 240 RGN_XOR: 241 begin 242 AStatus := cairo_region_xor(RSrc1, RSrc2); 243 AStatus := cairo_region_xor(RDest, RSrc1); 244 end; 245 end; 246 if (AStatus <> CAIRO_STATUS_SUCCESS) or cairo_region_is_empty(RDest) then 247 Result := NullRegion 248 else 249 begin 250 if cairo_region_num_rectangles(RDest) > 1 then 251 Result := ComplexRegion 252 else 253 Result := SimpleRegion; 254 end; 255end; 256 257function TGtk3WidgetSet.CreateBitmap(Width, Height: Integer; Planes, 258 BitCount: Longint; BitmapBits: Pointer): HBITMAP; 259var 260 Format: cairo_format_t; 261 NewBits: PByte; 262 NewBitsSize: PtrUInt; 263 ARowStride, RSS: Integer; 264begin 265 {$IFDEF VerboseGtk3WinAPI} 266 DebugLn('Trace:> [Gtk3WinAPI CreateBitmap]', 267 ' Width:', dbgs(Width), 268 ' Height:', dbgs(Height), 269 ' Planes:', dbgs(Planes), 270 ' BitCount:', dbgs(BitCount), 271 ' BitmapBits: ', dbgs(BitmapBits)); 272 {$ENDIF} 273 case BitCount of 274 1: Format := CAIRO_FORMAT_A1; 275 8: Format := CAIRO_FORMAT_A8; 276 24: Format := CAIRO_FORMAT_RGB24; 277 else 278 Format := CAIRO_FORMAT_ARGB32; 279 end; 280 281 RSS := GetBytesPerLine(Width, BitCount, rileWordBoundary); 282 if BitmapBits <> nil then 283 begin 284 ARowStride := GetBytesPerLine(Width, BitCount, rileDWordBoundary); 285 if not CopyImageData(Width, Height, RSS, BitCount, BitmapBits, Rect(0, 0, Width, Height), 286 riloBottomToTop, riloBottomToTop, rileDWordBoundary, NewBits, NewBitsSize) then 287 begin 288 // this was never tested 289 ARowStride := RSS; 290 NewBits := AllocMem(RSS * Height); 291 Move(BitmapBits^, NewBits^, RSS * Height); 292 end; 293 Result := HBitmap(TGtk3Image.Create(NewBits, Width, Height, ARowStride, Format, True)); 294 end 295 else 296 Result := HBitmap(TGtk3Image.Create(nil, Width, Height, Format)); 297 298 {$IFDEF VerboseGtk3WinAPI} 299 DebugLn('Trace:< [Gtk3WinAPI CreateBitmap] Bitmap:', dbghex(Result)); 300 {$ENDIF} 301end; 302 303function TGtk3WidgetSet.CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; 304var 305 ABrush: TGtk3Brush; 306 Color: TColor; 307begin 308 Result := 0; 309 // DebugLn('TGtk3WidgetSet.CreateBrushIndirect color=',dbgs(logBrush.lbColor),' style=',dbgs(logBrush.lbStyle)); 310 ABrush := TGtk3Brush.Create; 311 try 312 // todo: hatch 313 ABrush.Style := LogBrush.lbStyle; 314 ABrush.Color := ColorToRGB(TColor(logBrush.lbColor)); 315 ABrush.LogBrush := LogBrush; 316 // ABrush.LogBrush.lbColor := ABrush.Color; 317 Result := HBRUSH(ABrush); 318 except 319 Result := 0; 320 DebugLn('TGtk3WidgetSet.CreateBrushIndirect: Failed'); 321 end; 322 323 {$IFDEF VerboseGtk3DeviceContext} 324 DebugLn('Trace:< [Gtk3WinAPI CreateBrushIndirect] Result: ', dbghex(Result)); 325 {$ENDIF} 326end; 327 328function TGtk3WidgetSet.CreateCaret(Handle: HWND; Bitmap: hBitmap; width, 329 Height: Integer): Boolean; 330begin 331 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 332 DebugLn('WARNING: TGtk3WidgetSet.CreateCaret not implemented ...'); 333 {$ENDIF} 334 Result := inherited CreateCaret(Handle, Bitmap, width, Height); 335end; 336 337function TGtk3WidgetSet.CreateCompatibleBitmap(DC: HDC; Width, Height: Integer 338 ): HBITMAP; 339var 340 Gtk3DC: TGtk3DeviceContext; 341 Format: cairo_format_t = CAIRO_FORMAT_ARGB32; 342 ADepth: Integer; 343 AVisual: PGdkVisual; 344 ABpp: gint; 345 ARowStride: PtrUInt; 346begin 347 {$IFDEF VerboseGtk3WinAPI} 348 DebugLn('Trace:> [WinAPI CreateCompatibleBitmap]', 349 ' DC:', dbghex(DC), 350 ' Width:', dbgs(Width), 351 ' Height:', dbgs(Height)); 352 {$ENDIF} 353 Result := 0; 354 if IsValidDC(DC) then 355 begin 356 Gtk3DC := TGtk3DeviceContext(DC); 357 ADepth := Gtk3DC.getDepth; 358 ABpp := Gtk3DC.getBpp; 359 end else 360 begin 361 AVisual := gdk_window_get_visual(gdk_get_default_root_window); 362 ADepth := gdk_visual_get_depth(AVisual); 363 ABpp := AVisual^.get_bits_per_rgb; 364 g_object_unref(AVisual); 365 end; 366 case ADepth of 367 1: Format := CAIRO_FORMAT_A1; 368 2: Format := CAIRO_FORMAT_A8; 369 24: Format := CAIRO_FORMAT_RGB24; 370 else 371 Format := CAIRO_FORMAT_ARGB32; 372 end; 373 ARowStride := GetBytesPerLine(Width, ABpp, rileDWordBoundary); 374 Result := HBitmap(TGtk3Image.Create(nil, Width, Height, ARowStride, Format)); 375 {$IFDEF VerboseGtk3WinAPI} 376 DebugLn('Trace:< [Gtk3WinAPI CreateCompatibleBitmap] Bitmap:', dbghex(Result)); 377 {$ENDIF} 378end; 379 380function TGtk3WidgetSet.CreateCompatibleDC(DC: HDC): HDC; 381begin 382 Result := HDC(TGtk3DeviceContext.Create(PGtkWidget(nil), False)); 383end; 384 385function TGtk3WidgetSet.CreateEllipticRgn(X1, Y1, X2, Y2: Integer): HRGN; 386begin 387 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 388 DebugLn('WARNING: TGtk3WidgetSet.CreateEllipticRgn not implemented ...'); 389 {$ENDIF} 390 Result := inherited CreateEllipticRgn(X1, Y1, X2, Y2); 391end; 392 393function TGtk3WidgetSet.CreateFontIndirect(const LogFont: TLogFont): HFONT; 394begin 395 Result := CreateFontIndirectEx(LogFont, ''); 396end; 397 398function TGtk3WidgetSet.CreateFontIndirectEx(const LogFont: TLogFont; 399 const LongFontName: string): HFONT; 400var 401 ALogFontName: String; 402begin 403 Result := HFONT(TGtk3Font.Create(LogFont, LongFontName)); 404end; 405 406function TGtk3WidgetSet.CreateIconIndirect(IconInfo: PIconInfo): HICON; 407var 408 PixBuf: PGdkPixBuf; 409 W: gint; 410 H: gint; 411begin 412 Result := 0; 413 if IsValidGDIObject(IconInfo^.hbmColor) then 414 begin 415 if IconInfo^.fIcon then 416 begin 417 Result := HICON(TGtk3Image.Create(TGtk3Image(IconInfo^.hbmColor).Handle)); 418 end else 419 begin 420 // create cursor from pixbuf 421 W := gdk_pixbuf_get_width(TGtk3Image(IconInfo^.hbmColor).Handle); 422 H := gdk_pixbuf_get_height(TGtk3Image(IconInfo^.hbmColor).Handle); 423 DebugLn('TGtk3WidgetSet.CreateIconIndirect W=',dbgs(W),' H=',dbgs(H)); 424 PixBuf := gdk_pixbuf_new_subpixbuf(TGtk3Image(IconInfo^.hbmColor).Handle, 0, 0, W, H); 425 Result := HCURSOR({%H-}PtrUInt(gdk_cursor_new_from_pixbuf(gdk_display_get_default, 426 pixbuf, IconInfo^.xHotSpot, IconInfo^.yHotSpot))); 427 if pixbuf <> nil then 428 g_object_unref(PixBuf); 429 end; 430 end; 431end; 432 433function TGtk3WidgetSet.CreatePalette(const LogPalette: TLogPalette): HPALETTE; 434begin 435 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 436 DebugLn('WARNING: TGtk3WidgetSet.CreatePalette not implemented ...'); 437 {$ENDIF} 438 Result := 0; 439end; 440 441function TGtk3WidgetSet.CreatePenIndirect(const LogPen: TLogPen): HPEN; 442var 443 APen: TGtk3Pen; 444begin 445 Result := 0; 446 APen := TGtk3Pen.Create; 447 with LogPen do 448 begin 449 case lopnStyle and PS_STYLE_MASK of 450 PS_SOLID: APen.Style := psSolid; 451 PS_DASH: APen.Style := psDash; 452 PS_DOT: APen.Style := psDot; 453 PS_DASHDOT: APen.Style := psDashDot; 454 PS_DASHDOTDOT: APen.Style := psDashDotDot; 455 PS_NULL: APen.Style := psClear; 456 else 457 APen.Style := psSolid; 458 end; 459 APen.Color := TColor(lopnColor); 460 APen.Cosmetic := lopnWidth.X <= 0 ; 461 if not APen.Cosmetic then 462 APen.Width := lopnWidth.X; 463 end; 464 APen.LogPen := LogPen; 465 466 Result := HPEN(APen); 467end; 468 469function TGtk3WidgetSet.CreatePolygonRgn(Points: PPoint; NumPts: Integer; 470 FillMode: integer): HRGN; 471begin 472 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 473 DebugLn('WARNING: TGtk3WidgetSet.CreatePolygonRgn not implemented ...'); 474 {$ENDIF} 475 Result:=inherited CreatePolygonRgn(Points, NumPts, FillMode); 476end; 477 478function TGtk3WidgetSet.CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; 479begin 480 Result := HRGN(TGtk3Region.Create(True, X1, Y1, X2, Y2)); 481end; 482 483procedure TGtk3WidgetSet.DeleteCriticalSection(var CritSection: TCriticalSection 484 ); 485var 486 ACritSec: System.PRTLCriticalSection; 487begin 488 ACritSec:=System.PRTLCriticalSection(CritSection); 489 System.DoneCriticalsection(ACritSec^); 490 Dispose(ACritSec); 491 CritSection:=0; 492end; 493 494function TGtk3WidgetSet.DeleteDC(hDC: HDC): Boolean; 495begin 496 {$ifdef VerboseGtk3DeviceContext} 497 DebugLn('TGtk3WidgetSet.DeleteDC Handle: ', dbghex(hDC)); 498 {$endif} 499 500 if not IsValidDC(hDC) then 501 exit(False); 502 503 TGtk3DeviceContext(hDC).Free; 504 Result := True; 505end; 506 507function TGtk3WidgetSet.DeleteObject(GDIObject: HGDIOBJ): Boolean; 508begin 509 Result := False; 510 511 if GDIObject = 0 then 512 Exit(True); 513 514 if not IsValidGDIObject(GDIObject) then 515 Exit; 516 {$ifdef VerboseGtk3DeviceContext} 517 DebugLn('TGtk3WidgetSet.DeleteObject GDIObject: ', dbghex(GdiObject),' name ',dbgsName(TObject(GdiObject))); 518 {$endif} 519 if TObject(GDIObject) is TGtk3ContextObject then 520 begin 521 if TGtk3ContextObject(GDIOBJECT).Shared then 522 // DebugLn('ERROR: TGtk3WidgetSet.DeleteObject trial to delete shared object ',dbgsName(TGtk3ContextObject(GdiObject))) 523 else 524 TGtk3ContextObject(GDIObject).Free; 525 end else 526 TObject(GDIObject).Free; 527end; 528 529function TGtk3WidgetSet.DestroyCaret(Handle: HWND): Boolean; 530begin 531 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 532 DebugLn('WARNING: TGtk3WidgetSet.DestroyCaret not implemented ...'); 533 {$ENDIF} 534 Result:=inherited DestroyCaret(Handle); 535end; 536 537function TGtk3WidgetSet.DestroyCursor(Handle: HCURSOR): Boolean; 538begin 539 Result := Handle <> 0; 540 if Result then 541 g_object_unref(PGdkCursor(Handle)); 542 // gdk_cursor_destroy({%H-}PGdkCursor(Handle)); 543end; 544 545function TGtk3WidgetSet.DestroyIcon(Handle: HICON): Boolean; 546begin 547 Result := False; 548 if IsValidGDIObject(Handle) then 549 begin 550 TGtk3Image(Handle).Free; 551 Result := True; 552 end; 553end; 554 555function TGtk3WidgetSet.DPtoLP(DC: HDC; var Points; Count: Integer): BOOL; 556begin 557 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 558 DebugLn('WARNING: TGtk3WidgetSet.DPToLP not implemented ...'); 559 {$ENDIF} 560 Result:=inherited DPtoLP(DC, Points, Count); 561end; 562 563function TGtk3WidgetSet.DrawFrameControl(DC: HDC; const aRect: TRect; uType, 564 uState: Cardinal): Boolean; 565begin 566 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 567 DebugLn('WARNING: TGtk3WidgetSet.DrawFrameControl not implemented ...'); 568 {$ENDIF} 569 Result := False; 570 // inherited DrawFrameControl(DC, aRect, uType, uState); 571end; 572 573function TGtk3WidgetSet.DrawFocusRect(DC: HDC; const aRect: TRect): boolean; 574var 575 Context: PGtkStyleContext; 576 AValue: TGValue; 577begin 578 Result := False; 579 if IsValidDC(DC) then 580 begin 581 if TGtk3DeviceContext(DC).Parent <> nil then 582 Context := TGtk3DeviceContext(DC).Parent^.get_style_context 583 else 584 if gtk_widget_get_default_style^.has_context then 585 begin 586 // Context := gtk_widget_get_default_style^.has_context 587 AValue.g_type := G_TYPE_POINTER; 588 AValue.set_pointer(nil); 589 g_object_get_property(gtk_widget_get_default_style,'context',@AValue); 590 Context := AValue.get_pointer; 591 AValue.unset; 592 end else 593 Context := nil; 594 if Context = nil then 595 begin 596 DebugLn('WARNING: TGtk3WidgetSet.DrawFocusRect drawing focus on non widget context isn''t implemented.'); 597 exit; 598 end; 599 with aRect do 600 gtk_render_focus(Context ,TGtk3DeviceContext(DC).Widget, Left, Top, Right - Left, Bottom - Top); 601 602 Result := True; 603 end; 604end; 605 606function TGtk3WidgetSet.DrawEdge(DC: HDC; var ARect: TRect; Edge: Cardinal; 607 grfFlags: Cardinal): Boolean; 608begin 609 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 610 DebugLn('WARNING: TGtk3WidgetSet.DrawEdge not implemented ...'); 611 {$ENDIF} 612 Result := False; // inherited DrawEdge(DC, ARect, Edge, grfFlags); 613end; 614 615function TGtk3WidgetSet.DrawText(DC: HDC; Str: PChar; Count: Integer; 616 var Rect: TRect; Flags: Cardinal): Integer; 617const 618 TabString = ' '; 619var 620 pIndex: Longint; 621 AStr: String; 622 623 TM: TTextmetric; 624 theRect: TRect; 625 Lines: PPChar; 626 I, NumLines: Longint; 627 TempDC: HDC; 628 TempPen: HPEN; 629 TempBrush: HBRUSH; 630 l: LongInt; 631 Pt: TPoint; 632 SavedRect: TRect; // if font orientation <> 0 633 634 function LeftOffset: Longint; 635 begin 636 if (Flags and DT_RIGHT) = DT_RIGHT then 637 Result := DT_RIGHT 638 else 639 if (Flags and DT_CENTER) = DT_CENTER then 640 Result := DT_CENTER 641 else 642 Result := DT_LEFT; 643 end; 644 645 function TopOffset: Longint; 646 begin 647 if (Flags and DT_BOTTOM) = DT_BOTTOM then 648 Result := DT_BOTTOM 649 else 650 if (Flags and DT_VCENTER) = DT_VCENTER then 651 Result := DT_VCENTER 652 else 653 Result := DT_TOP; 654 end; 655 656 function CalcRect: Boolean; 657 begin 658 Result := (Flags and DT_CALCRECT) = DT_CALCRECT; 659 end; 660 661 function TextExtentPoint(Str: PChar; Count: Integer; var Sz: TSize): Boolean; 662 var 663 NewStr: String; 664 begin 665 if (Flags and DT_EXPANDTABS) <> 0 then 666 begin 667 NewStr := StringReplace(Str, #9, TabString, [rfReplaceAll]); 668 Result := GetTextExtentPoint(DC, PChar(NewStr), Length(NewStr), Sz); 669 end 670 else 671 Result := GetTextExtentPoint(Dc, Str, Count, Sz); 672 end; 673 674 procedure DoCalcRect; 675 var 676 AP: TSize; 677 J, MaxWidth, 678 LineWidth: Integer; 679 PR1, PR2: TPangoRectangle; 680 Alignment: Integer; 681 ADevOffset: TPoint; 682 begin 683 684 685 theRect := Rect; 686 687 MaxWidth := theRect.Right - theRect.Left; 688 689 (* 690 if Flags and DT_CENTER <> 0then 691 Alignment := DT_CENTER 692 else 693 if Flags and DT_RIGHT <> 0 then 694 Alignment := DT_RIGHT 695 else 696 Alignment := DT_LEFT; 697 698 TGtk3DeviceContext(DC).CurrentFont.Layout^.set_alignment(Alignment); 699 if Flags and DT_WORDBREAK <> 0 then 700 TGtk3DeviceContext(DC).CurrentFont.Layout^.set_wrap(PANGO_WRAP_WORD); 701 702 // ADevOffset := TGtk3DeviceContext(DC).Offset; 703 // TGtk3DeviceContext(DC).CurrentFont.Layout^.set_width(Rect.Right - Rect.Left); 704 // TGtk3DeviceContext(DC).CurrentFont.Layout^.set_height(Rect.Bottom - Rect.Top); 705 706 TGtk3DeviceContext(DC).CurrentFont.Layout^.set_text(Str, Count); 707 708 709 // TGtk3DeviceContext(DC).CurrentFont.Layout^.get_iter^.get_line_extents(@PR1, @PR2); 710 // DebugLn('DoCalcRect LINE EXTENTS Rect=',dbgs(Rect),' PR1 ',dbgs(RectFromGdkRect(TGdkRectangle(PR1))),' PR2 ',dbgs(RectFromGdkRect(TGdkRectangle(PR2)))); 711 TGtk3DeviceContext(DC).CurrentFont.Layout^.get_extents(@PR1, @PR2); 712 // get_extents(@PR1, @PR2); 713 714 DebugLn('DoCalcRect Rect=',dbgs(Rect),' PR1 ',dbgs(RectFromPangoRect(PR1)),' PR2 ',dbgs(RectFromPangoRect(PR2)),' ALIGNMENT ',dbgs(Alignment)); 715 716 // DebugLn('DoCalcRect Rect=',dbgs(Rect),' PR1 ',Format('x %d y %d width %d height %d' 717 *) 718 719 if (Flags and DT_SINGLELINE) > 0 then 720 begin 721 // ignore word and line breaks 722 TextExtentPoint(PChar(AStr), length(AStr), AP{%H-}); 723 theRect.Bottom := theRect.Top + TM.tmHeight; 724 if (Flags and DT_CALCRECT)<>0 then 725 theRect.Right := theRect.Left + AP.cX 726 else 727 begin 728 theRect.Right := theRect.Left + Min(MaxWidth, AP.cX); 729 if (Flags and DT_VCENTER) > 0 then 730 begin 731 OffsetRect(theRect, 0, ((Rect.Bottom - Rect.Top) - (theRect.Bottom - theRect.Top)) div 2); 732 end 733 else 734 if (Flags and DT_BOTTOM) > 0 then 735 begin 736 OffsetRect(theRect, 0, (Rect.Bottom - Rect.Top) - (theRect.Bottom - theRect.Top)); 737 end; 738 end; 739 end 740 else 741 begin 742 // consider line breaks 743 if (Flags and DT_WORDBREAK) = 0 then 744 begin 745 // do not break at word boundaries 746 TextExtentPoint(PChar(AStr), length(AStr), AP); 747 MaxWidth := AP.cX; 748 end; 749 750 Gtk3WordWrap(DC, PChar(AStr), MaxWidth, Lines, NumLines); 751 // writeln('WORD WRAP RESULTED IN ',NumLines,' lines for ',AStr,' MAX=',MaxWidth); 752 if (Flags and DT_CALCRECT)<>0 then 753 begin 754 LineWidth := 0; 755 if (Lines <> nil) then 756 begin 757 for J := 0 to NumLines - 1 do 758 begin 759 TextExtentPoint(Lines[J], StrLen(Lines[J]), AP); 760 LineWidth := Max(LineWidth, AP.cX); 761 end; 762 end; 763 LineWidth := Min(MaxWidth, LineWidth); 764 end else 765 LineWidth := MaxWidth; 766 767 theRect.Right := theRect.Left + LineWidth; 768 theRect.Bottom := theRect.Top + NumLines*TM.tmHeight; 769 if NumLines>1 then 770 Inc(theRect.Bottom, (NumLines-1)*TM.tmDescent);// space between lines 771 772 // debugln('TGtk3WidgetSet.DrawText A ',dbgs(theRect),' TM.tmHeight=',dbgs(TM.tmHeight),' LineWidth=',dbgs(LineWidth),' NumLines=',dbgs(NumLines)); 773 end; 774 775 if not CalcRect then 776 case LeftOffset of 777 DT_CENTER: 778 OffsetRect(theRect, (Rect.Right - theRect.Right) div 2, 0); 779 DT_RIGHT: 780 OffsetRect(theRect, Rect.Right - theRect.Right, 0); 781 end; 782 end; 783 784 // if our Font.Orientation <> 0 we must recalculate X,Y offset 785 // also it works only with DT_TOP DT_LEFT. Gtk2 can handle multiline 786 // text in this case too. 787 procedure CalculateOffsetWithAngle(const AFontAngle: Integer; 788 var TextLeft,TextTop: Integer); 789 var 790 OffsX, OffsY: integer; 791 Angle: Integer; 792 Size: TSize; 793 R: TRect; 794 begin 795 R := SavedRect; 796 OffsX := R.Right - R.Left; 797 OffsY := R.Bottom - R.Top; 798 Size.cX := OffsX; 799 Size.cy := OffsY; 800 Angle := AFontAngle div 10; 801 if Angle < 0 then 802 Angle := 360 + Angle; 803 804 if Angle <= 90 then 805 begin 806 OffsX := 0; 807 OffsY := Trunc(Size.cx * sin(Angle * Pi / 180)); 808 end else 809 if Angle <= 180 then 810 begin 811 OffsX := Trunc(Size.cx * -cos(Angle * Pi / 180)); 812 OffsY := Trunc(Size.cx * sin(Angle * Pi / 180) + 813 Size.cy * cos((180 - Angle) * Pi / 180)); 814 end else 815 if Angle <= 270 then 816 begin 817 OffsX := Trunc(Size.cx * -cos(Angle * Pi / 180) + 818 Size.cy * sin((Angle - 180) * Pi / 180)); 819 OffsY := Trunc(Size.cy * sin((270 - Angle) * Pi / 180)); 820 end else 821 if Angle <= 360 then 822 begin 823 OffsX := Trunc(Size.cy * sin((360 - Angle) * Pi / 180)); 824 OffsY := 0; 825 end; 826 TextTop := OffsY; 827 TextLeft := OffsX; 828 end; 829 830 function NeedOffsetCalc: Boolean; 831 begin 832 833 Result := (TGtk3DeviceContext(DC).CurrentFont.LogFont.lfOrientation <> 0) and 834 (Flags and DT_SINGLELINE <> 0) and 835 (Flags and DT_VCENTER = 0) and (Flags and DT_CENTER = 0) and 836 (Flags and DT_RIGHT = 0) and (Flags and DT_BOTTOM = 0) and 837 (Flags and DT_CALCRECT = 0) and not IsRectEmpty(SavedRect); 838 end; 839 840 841 procedure DrawLineRaw(theLine: PChar; LineLength, TopPos: Longint); 842 var 843 Points: array[0..1] of TSize; 844 LeftPos: Longint; 845 begin 846 if LeftOffset <> DT_LEFT then 847 GetTextExtentPoint(DC, theLine, LineLength, {%H-}Points[0]); 848 849 if TempBrush = HBRUSH(-1) then 850 TempBrush := SelectObject(DC, GetStockObject(NULL_BRUSH)); 851 case LeftOffset of 852 DT_LEFT: 853 LeftPos := theRect.Left; 854 DT_CENTER: 855 LeftPos := theRect.Left + (theRect.Right - theRect.Left) div 2 856 - Points[0].cX div 2; 857 DT_RIGHT: 858 LeftPos := theRect.Right - Points[0].cX; 859 end; 860 861 Pt := Point(0, 0); 862 // Draw line of Text 863 if NeedOffsetCalc then 864 begin 865 Pt.X := SavedRect.Left; 866 Pt.Y := SavedRect.Top; 867 CalculateOffsetWithAngle(TGtk3DeviceContext(DC).CurrentFont.LogFont.lfOrientation, Pt.X, Pt.Y); 868 end; 869 TextUtf8Out(DC, LeftPos + Pt.X, TopPos + Pt.Y, theLine, lineLength); 870 end; 871 872 procedure DrawLine(theLine: PChar; LineLength, TopPos: Longint); 873 var 874 Points: array[0..1] of TSize; 875 LogP: TLogPen; 876 LeftPos: Longint; 877 begin 878 if TempBrush = HBRUSH(-1) then 879 TempBrush := SelectObject(DC, GetStockObject(NULL_BRUSH)); 880 881 FillByte({%H-}Points[0],SizeOf(Points[0])*2,0); 882 if LeftOffset <> DT_Left then 883 GetTextExtentPoint(DC, theLine, LineLength, Points[0]); 884 885 case LeftOffset of 886 DT_LEFT: 887 LeftPos := theRect.Left; 888 DT_CENTER: 889 LeftPos := theRect.Left + (theRect.Right - theRect.Left) div 2 890 - Points[0].cX div 2; 891 DT_RIGHT: 892 LeftPos := theRect.Right - Points[0].cX; 893 end; 894 895 Pt := Point(0, 0); 896 if NeedOffsetCalc then 897 begin 898 Pt.X := SavedRect.Left; 899 Pt.Y := SavedRect.Top; 900 CalculateOffsetWithAngle(TGtk3DeviceContext(DC).CurrentFont.LogFont.lfOrientation, Pt.X, Pt.Y); 901 end; 902 // Draw line of Text 903 TextUtf8Out(DC, LeftPos + Pt.X, TopPos + Pt.Y, theLine, LineLength); 904 905 // Draw Prefix 906 if (pIndex > 0) and (pIndex<=LineLength) then 907 begin 908 // Create & select pen of font color 909 if TempPen = HPEN(-1) then 910 begin 911 LogP.lopnStyle := PS_SOLID; 912 LogP.lopnWidth.X := 1; 913 LogP.lopnColor := GetTextColor(DC); 914 TempPen := SelectObject(DC, CreatePenIndirect(LogP)); 915 end; 916 917 {Get prefix line position} 918 GetTextExtentPoint(DC, theLine, pIndex - 1, Points[0]); 919 Points[0].cX := LeftPos + Points[0].cX; 920 Points[0].cY := TopPos + tm.tmHeight - TM.tmDescent + 1; 921 922 GetTextExtentPoint(DC, @aStr[pIndex], UTF8CodepointSize(@aStr[pIndex]), Points[1]); 923 Points[1].cX := Points[0].cX + Points[1].cX; 924 Points[1].cY := Points[0].cY; 925 926 {Draw prefix line} 927 Polyline(DC, PPoint(@Points[0]), 2); 928 end; 929 end; 930begin 931 Result := 0; 932 if (Str=nil) or (Str[0]=#0) or not IsValidDC(DC) then 933 begin 934 // DebugLn('TGtk3DeviceContext.DrawText params error Str Valid ? ',dbgs(Str<>nil),' DC Valid ? ',dbgs(IsValidDC(DC)),' Str#0 ',dbgs(Str[0] = #0)); 935 exit; 936 end; 937 938 if (Count < -1) or (IsRectEmpty(Rect) and 939 ((Flags and DT_CALCRECT = 0) and (Flags and DT_NOCLIP = 0))) then Exit; 940 941 // Don't try to use StrLen(Str) in cases count >= 0 942 // In those cases str is NOT required to have a null terminator ! 943 if Count = -1 then 944 Count := StrLen(Str); 945 946 Lines := nil; 947 NumLines := 0; 948 TempDC := HDC(-1); 949 TempPen := HPEN(-1); 950 TempBrush := HBRUSH(-1); 951 // DebugLn('TGtk3DeviceContext.DrawText ',Str,' count=',dbgs(Count),' DT_CALCRECT ',dbgs(Flags and DT_CALCRECT <> 0),' ARect=',dbgs(Rect)); 952 try 953 if (Flags and (DT_SINGLELINE or DT_CALCRECT or DT_NOPREFIX or DT_NOCLIP or DT_EXPANDTABS)) = 954 (DT_SINGLELINE or DT_NOPREFIX or DT_NOCLIP) then 955 begin 956 System.Move(Rect, TheRect, SizeOf(TRect)); 957 SavedRect := Rect; 958 DrawLineRaw(Str, Count, Rect.Top); 959 Result := Rect.Bottom - Rect.Top; 960 Exit; 961 end; 962 963 SetLength(AStr,Count); 964 if Count>0 then 965 System.Move(Str^,AStr[1],Count); 966 967 if (Flags and DT_EXPANDTABS) <> 0 then 968 AStr := StringReplace(AStr, #9, TabString, [rfReplaceAll]); 969 970 if (Flags and DT_NOPREFIX) <> DT_NOPREFIX then 971 begin 972 pIndex := DeleteAmpersands(AStr); 973 if pIndex > Length(AStr) then 974 pIndex := -1; // String ended in '&', which was deleted 975 end 976 else 977 pIndex := -1; 978 979 GetTextMetrics(DC, TM{%H-}); 980 DoCalcRect; 981 Result := theRect.Bottom - theRect.Top; 982 if (Flags and DT_CALCRECT) = DT_CALCRECT then 983 begin 984 // DebugLn('TGtk3WidgetSet.DrawText DT_CALCRECT Rect ',dbgs(Rect),' TheRect ',dbgs(theRect),' Result ',dbgs(Result)); 985 System.Move(TheRect, Rect, SizeOf(TRect)); 986 exit; 987 end; 988 989 TempDC := SaveDC(DC); 990 991 if (Flags and DT_NOCLIP) <> DT_NOCLIP then 992 begin 993 if theRect.Right > Rect.Right then 994 theRect.Right := Rect.Right; 995 if theRect.Bottom > Rect.Bottom then 996 theRect.Bottom := Rect.Bottom; 997 // DebugLn('******* CALLING NOT IMPLEMENTED INTERSECTCLIP RECT '); 998 IntersectClipRect(DC, theRect.Left, theRect.Top, 999 theRect.Right, theRect.Bottom); 1000 end; 1001 1002 if (Flags and DT_SINGLELINE) = DT_SINGLELINE 1003 then begin 1004 // DebugLn(['TGtk2WidgetSet.DrawText Draw single line']); 1005 SavedRect := TheRect; 1006 DrawLine(PChar(AStr), length(AStr), theRect.Top); 1007 Exit; //we're ready 1008 end; 1009 1010 // multiple lines 1011 if Lines = nil then Exit; // nothing to do 1012 if NumLines = 0 then Exit; // 1013 1014 1015 //DebugLn(['TGtk2WidgetSet.DrawText Draw multiline']); 1016 SavedRect := Classes.Rect(0, 0, 0, 0); // no font orientation change if multilined text 1017 for i := 0 to NumLines - 1 do 1018 begin 1019 if theRect.Top > theRect.Bottom then Break; 1020 1021 if ((Flags and DT_EDITCONTROL) = DT_EDITCONTROL) 1022 and (tm.tmHeight > (theRect.Bottom - theRect.Top)) 1023 then Break; 1024 1025 if Lines[i] <> nil then begin 1026 l:=StrLen(Lines[i]); 1027 DrawLine(Lines[i], l, theRect.Top); 1028 dec(pIndex,l+length(LineEnding)); 1029 end; 1030 Inc(theRect.Top, TM.tmDescent + TM.tmHeight);// space between lines 1031 end; 1032 1033 finally 1034 Reallocmem(Lines, 0); 1035 if TempBrush <> HBRUSH(-1) then 1036 SelectObject(DC, TempBrush);// DeleteObject not needed here, because it was a default Brush 1037 if TempPen <> HPEN(-1) then 1038 DeleteObject(SelectObject(DC, TempPen)); 1039 if TempDC <> HDC(-1) then 1040 RestoreDC(DC, TempDC); 1041 end; 1042end; 1043 1044function TGtk3WidgetSet.Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean; 1045begin 1046 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1047 DebugLn('WARNING: TGtk3WidgetSet.Ellipse not implemented ...'); 1048 {$ENDIF} 1049 Result:=inherited Ellipse(DC, x1, y1, x2, y2); 1050end; 1051 1052function TGtk3WidgetSet.EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal 1053 ): Boolean; 1054begin 1055 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1056 DebugLn('WARNING: TGtk3WidgetSet.EnableScrollBar not implemented ...'); 1057 {$ENDIF} 1058 Result := inherited EnableScrollBar(Wnd, wSBflags, wArrows); 1059end; 1060 1061function TGtk3WidgetSet.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; 1062begin 1063 Result := False; 1064 if hWnd <> 0 then 1065 begin 1066 Result := TGtk3Widget(HWND).Enabled; 1067 TGtk3Widget(HWND).Enabled := bEnable; 1068 end; 1069end; 1070 1071function TGtk3WidgetSet.EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer; 1072begin 1073 Result := 0; 1074 if IsValidDC(PS.HDC) then 1075 begin 1076 TGtk3DeviceContext(PS.HDC).Free; 1077 PS.HDC := 0; 1078 Result := 1; 1079 end; 1080end; 1081 1082procedure TGtk3WidgetSet.EnterCriticalSection(var CritSection: TCriticalSection 1083 ); 1084var 1085 ACritSec: System.PRTLCriticalSection; 1086begin 1087 ACritSec:=System.PRTLCriticalSection(CritSection); 1088 System.EnterCriticalsection(ACritSec^); 1089end; 1090 1091function TGtk3WidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; 1092 lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool; 1093var 1094 i: integer; 1095begin 1096 Result := True; 1097 for i := 0 to gdk_screen_get_n_monitors(gdk_screen_get_default) - 1 do 1098 begin 1099 Result := Result and lpfnEnum(i + 1, 0, nil, dwData); 1100 if not Result then break; 1101 end; 1102end; 1103 1104function TGtk3WidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; 1105 Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint; 1106type 1107 TPangoFontFaces = packed record 1108 FamilyName: String; 1109 Faces: Array of String; 1110 end; 1111 PPangoFontFaces = Array of TPangoFontFaces; 1112 1113var 1114 i: Integer; 1115 FontType: Integer; 1116 EnumLogFont: TEnumLogFontEx; 1117 Metric: TNewTextMetricEx; 1118 FontList: TStringList; 1119 Faces: PPangoFontFaces; 1120 1121 AStyle: String; 1122 StylesCount: Integer; 1123 StylesList: TStringList; 1124 y: Integer; 1125 CharsetList: TByteList; 1126 CS: Byte; 1127 1128 function Gtk3GetFontFamiliesDefault(var AList: TStringList): Integer; 1129 var 1130 i, j: Integer; 1131 AFamilies: PPPangoFontFamily; 1132 AFaces: PPPangoFontFace; 1133 ANumFaces: Integer; 1134 begin 1135 AList.Clear; 1136 SetLength(Faces, 0); 1137 Result := -1; 1138 AFamilies := nil; 1139 1140 pango_context_list_families(gdk_pango_context_get, @AFamilies, @Result); 1141 SetLength(Faces, Result); 1142 for i := 0 to Result - 1 do 1143 begin 1144 j := AList.Add(StrPas(pango_font_family_get_name(AFamilies[i]))); 1145 AList.Objects[j] := TObject(PtrUInt(pango_font_family_is_monospace(AFamilies[i]))); 1146 Faces[i].FamilyName := AList[j]; 1147 AFaces := nil; 1148 pango_font_family_list_faces(AFamilies[i], @AFaces, @ANumFaces); 1149 SetLength(Faces[i].Faces, ANumFaces); 1150 for j := 0 to ANumFaces - 1 do 1151 Faces[i].Faces[j] := StrPas(pango_font_face_get_face_name(AFaces[j])); 1152 g_free(AFaces); 1153 end; 1154 g_free(AFamilies); 1155 end; 1156 1157 function Gtk3GetFontFamilies(var List: TStringList; 1158 const APitch: Byte; 1159 const AFamilyName: String; 1160 const {%H-}AWritingSystem: Byte): Integer; 1161 var 1162 StrLst: TStringList; 1163 NewList: TStringList; 1164 S: String; 1165 j: integer; 1166 begin 1167 Result := -1; 1168 StrLst := TStringList.Create; 1169 NewList := TStringList.Create; 1170 1171 try 1172 Gtk3GetFontFamiliesDefault(StrLst); 1173 for j := 0 to StrLst.Count - 1 do 1174 begin 1175 S := StrLst[j]; 1176 if APitch <> DEFAULT_PITCH then 1177 begin 1178 case APitch of 1179 FIXED_PITCH, MONO_FONT: 1180 begin 1181 if StrLst.Objects[j] <> nil then 1182 NewList.Add(S); 1183 end; 1184 VARIABLE_PITCH: 1185 begin 1186 if StrLst.Objects[j] = nil then 1187 NewList.Add(S); 1188 end; 1189 end; 1190 end else 1191 NewList.Add(S); 1192 end; 1193 1194 if AFamilyName <> '' then 1195 begin 1196 for j := NewList.Count - 1 downto 0 do 1197 begin 1198 S := NewList[j];; 1199 if S <> AFamilyName then 1200 NewList.Delete(J); 1201 end; 1202 end; 1203 for j := 0 to NewList.Count - 1 do 1204 begin 1205 S := NewList[j]; 1206 List.Add(S); 1207 end; 1208 Result := List.Count; 1209 finally 1210 StrLst.Free; 1211 NewList.Free; 1212 end; 1213 end; 1214 1215 function GetStyleAt(AIndex: Integer): String; 1216 var 1217 S: String; 1218 begin 1219 Result := ''; 1220 if (AIndex >= 0) and (AIndex < StylesList.Count) then 1221 begin 1222 S := StylesList[AIndex]; 1223 Result := S; 1224 end; 1225 end; 1226 1227 function FillLogFontA(const AIndex: Integer; var ALogFontA: TLogFontA; 1228 var {%H-}AMetric: TNewTextMetricEx; var {%H-}AFontType: Integer; 1229 out AStyle: String): Integer; 1230 var 1231 Font: PPangoFontDescription; 1232 FontStyle: TPangoStyle; 1233 FontWeight: TPangoWeight; 1234 S: String; 1235 i: Integer; 1236 begin 1237 S := FontList[AIndex]; 1238 Font := pango_font_description_from_string(PChar(S)); 1239 1240 FontStyle := pango_font_description_get_style(Font); 1241 FontWeight := pango_font_description_get_weight(Font); 1242 1243 ALogFontA.lfItalic := Byte(FontStyle = PANGO_STYLE_ITALIC); 1244 1245 // keep newer pango compat to LCL 1246 if FontWeight = 380 {PANGO_WEIGHT_BOOK as of pango 1.24} then 1247 FontWeight := PANGO_WEIGHT_NORMAL 1248 else 1249 if FontWeight = 1000 {PANGO_WEIGHT_ULTRAHEAVY as of pango 1.24} then 1250 FontWeight := PANGO_WEIGHT_HEAVY; 1251 1252 ALogFontA.lfWeight := FontWeight; 1253 1254 ALogFontA.lfHeight := pango_font_description_get_size(Font); 1255 if not pango_font_description_get_size_is_absolute(Font) then 1256 ALogFontA.lfHeight := ALogFontA.lfHeight div PANGO_SCALE; 1257 1258 // pango does not have underline and strikeout params for font 1259 // ALogFontA.lfUnderline := ; 1260 // ALogFontA.lfStrikeOut := ; 1261 1262 StylesList.Clear; 1263 for i := High(Faces[AIndex].Faces) downto 0 do 1264 StylesList.Add(Faces[AIndex].Faces[i]); 1265 1266 AStyle := ''; 1267 Result := StylesList.Count; 1268 1269 if StylesList.Count > 0 then 1270 AStyle := GetStyleAt(0); 1271 1272 // current pango support in fpc is really poor, we cannot 1273 // get PangoScript since it's in pango >= 1.4 1274 // FillCharsetListForFont() 1275 end; 1276 1277begin 1278 Result := 0; 1279 {$ifdef VerboseEnumFonts} 1280 WriteLn('[TGtk3WidgetSet.EnumFontFamiliesEx] Charset=',lpLogFont^.lfCharSet, 1281 ' face ',lpLogFont^.lfFaceName,' pitchAndFamily=',lpLogFont^.lfPitchAndFamily); 1282 {$endif} 1283 Result := 0; 1284 Metric.ntmentm.ntmAvgWidth := 0; // just to shutup compiler 1285 if (lpLogFont^.lfCharSet = DEFAULT_CHARSET) and 1286 (lpLogFont^.lfFaceName= '') and 1287 (lpLogFont^.lfPitchAndFamily = 0) then 1288 begin 1289 FontType := 0; 1290 FontList := TStringList.create; 1291 try 1292 if Gtk3GetFontFamiliesDefault(FontList) > 0 then 1293 begin 1294 for i := 0 to FontList.Count - 1 do 1295 begin 1296 EnumLogFont.elfLogFont.lfFaceName := FontList[i]; 1297 Result := Callback(EnumLogFont, Metric, FontType, LParam); 1298 end; 1299 end; 1300 finally 1301 FontList.free; 1302 end; 1303 end else 1304 begin 1305 Result := 0; 1306 FontType := TRUETYPE_FONTTYPE; 1307 FontList := TStringList.Create; 1308 StylesList := TStringList.Create; 1309 CharsetList := TByteList.Create; 1310 for i := 0 to CharsetEncodingList.Count - 1 do 1311 begin 1312 CS := TCharSetEncodingRec(CharsetEncodingList.Items[i]^).CharSet; 1313 if CharsetList.IndexOf(CS) = -1 then 1314 CharsetList.Add(CS); 1315 end; 1316 try 1317 if Gtk3GetFontFamilies(FontList, lpLogFont^.lfPitchAndFamily, 1318 lpLogFont^.lfFaceName, lpLogFont^.lfCharSet) > 0 then 1319 begin 1320 for i := 0 to FontList.Count - 1 do 1321 begin 1322 EnumLogFont.elfLogFont.lfFaceName := FontList[i]; 1323 EnumLogFont.elfLogFont.lfPitchAndFamily := lpLogFont^.lfPitchAndFamily; 1324 EnumLogFont.elfFullName := FontList[i]; 1325 1326 StylesCount := FillLogFontA(i, EnumLogFont.elfLogFont, Metric, FontType, AStyle); 1327 EnumLogFont.elfStyle := AStyle; 1328 1329 if CharSetList.Count > 0 then 1330 EnumLogFont.elfLogFont.lfCharSet := CharsetList.Items[0]; 1331 1332 Result := Callback(EnumLogFont, Metric, FontType, LParam); 1333 for y := 1 to StylesCount - 1 do 1334 begin 1335 AStyle := GetStyleAt(y); 1336 EnumLogFont.elfStyle := AStyle; 1337 Result := Callback(EnumLogFont, Metric, FontType, LParam); 1338 end; 1339 for y := 1 to CharSetList.Count - 1 do 1340 begin 1341 EnumLogFont.elfLogFont.lfCharSet := CharsetList.Items[y]; 1342 Result := Callback(EnumLogFont, Metric, FontType, LParam); 1343 end; 1344 end; 1345 end; 1346 finally 1347 CharSetList.Free; 1348 StylesList.Free; 1349 FontList.Free; 1350 end; 1351 end; 1352end; 1353 1354function TGtk3WidgetSet.EqualRgn(Rgn1: HRGN; Rgn2: HRGN): Boolean; 1355begin 1356 Result := Rgn1 = Rgn2; 1357 if Result then 1358 exit; 1359 if not IsValidGDIObject(Rgn1) or not IsValidGDIObject(Rgn2) then 1360 exit; 1361 Result := cairo_region_equal(TGtk3Region(Rgn1).Handle,TGtk3Region(Rgn2).Handle); 1362end; 1363 1364function TGtk3WidgetSet.IntersectClipRect(dc: hdc; Left, Top, Right,Bottom: Integer): Integer; 1365var 1366 ncorg,dcOrigin:TPoint; 1367 rgn,clip:HRGN; 1368begin 1369 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1370 DebugLn('WARNING: TGtk3WidgetSet.ExcludeClipRect not implemented ...'); 1371 {$ENDIF} 1372 rgn:=Self.CreateRectRgn(Left,Top,Right,Bottom); 1373 //Self.SelectClipRGN(dc,rgn); 1374 clip:=Self.CreateEmptyRegion; 1375 Self.GetClipRGN(dc,clip); 1376 Self.CombineRgn(clip,rgn,clip,RGN_AND); 1377 Self.SelectClipRGN(dc,clip); 1378 DeleteObject(clip); 1379 DeleteObject(rgn); 1380 // fail Self.ExtSelectClipRGN(dc,rgn,RGN_AND); 1381 { ncorg:=Tgtk3DeviceContext(dc).fncOrigin; 1382 GetWindowOrgEx(DC, @DCOrigin); 1383 Result:=inherited IntersectClipRect(dc, Left, Top, Right, Bottom);} 1384end; 1385 1386 1387function TGtk3WidgetSet.ExcludeClipRect(dc: hdc; Left, Top, Right, 1388 Bottom: Integer): Integer; 1389begin 1390 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1391 DebugLn('WARNING: TGtk3WidgetSet.ExcludeClipRect not implemented ...'); 1392 {$ENDIF} 1393 Result:=inherited ExcludeClipRect(dc, Left, Top, Right, Bottom); 1394end; 1395 1396function TGtk3WidgetSet.ExtCreatePen(dwPenStyle, dwWidth: DWord; 1397 const lplb: TLogBrush; dwStyleCount: DWord; lpStyle: PDWord): HPEN; 1398var 1399 APen: TGtk3Pen; 1400begin 1401 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1402 // DebugLn('WARNING: TGtk3WidgetSet.ExtCreatePen not implemented ...'); 1403 {$ENDIF} 1404 APen := TGtk3Pen.Create; 1405 APen.IsExtPen := True; 1406 case dwPenStyle and PS_STYLE_MASK of 1407 PS_SOLID: APen.Style := psSolid; 1408 PS_DASH: APen.Style := psDash; 1409 PS_DOT: APen.Style := psDot; 1410 PS_DASHDOT: APen.Style := psDashDot; 1411 PS_DASHDOTDOT: APen.Style := psDashDotDot; 1412 PS_NULL: APen.Style := psClear; 1413 else 1414 APen.Style := psSolid; 1415 end; 1416 1417 APen.Cosmetic := (dwPenStyle and PS_TYPE_MASK) = PS_COSMETIC; 1418 1419 if (dwPenStyle and PS_TYPE_MASK) = PS_GEOMETRIC then 1420 begin 1421 APen.Width := dwWidth; 1422 case dwPenStyle and PS_JOIN_MASK of 1423 PS_JOIN_ROUND: APen.JoinStyle := pjsRound; 1424 PS_JOIN_BEVEL: APen.JoinStyle := pjsBevel; 1425 PS_JOIN_MITER: APen.JoinStyle := pjsMiter; 1426 end; 1427 case dwPenStyle and PS_ENDCAP_MASK of 1428 PS_ENDCAP_ROUND: APen.EndCap := pecRound; 1429 PS_ENDCAP_SQUARE: APen.EndCap := pecSquare; 1430 PS_ENDCAP_FLAT: APen.EndCap := pecFlat; 1431 end; 1432 end; 1433 1434 if (dwPenStyle and PS_STYLE_MASK) = PS_USERSTYLE then 1435 begin 1436 //TODO: APen.setDashPattern 1437 end; 1438 1439 APen.Color := lplb.lbColor; 1440 APen.LogPen.lopnColor := lplb.lbColor; 1441 APen.LogPen.lopnStyle := (dwPenStyle and PS_STYLE_MASK) or (dwPenStyle and PS_JOIN_MASK) or (dwPenStyle and PS_ENDCAP_MASK); 1442 APen.LogPen.lopnWidth.X := dwWidth; 1443 APen.LogPen.lopnWidth.Y := dwWidth; 1444 1445 Result := HPen(APen); 1446end; 1447 1448function TGtk3WidgetSet.ExtSelectClipRGN(dc: hdc; rgn: hrgn; Mode: Longint 1449 ): Integer; 1450var 1451 GtkDC: TGtk3DeviceContext absolute DC; 1452 ARect: TGdkRectangle; 1453 DCOrigin: TPoint; 1454 R: Classes.TRect; 1455 Clip: HRGN; 1456 Tmp: HRGN; 1457begin 1458 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1459 // DebugLn('WARNING: TGtk3WidgetSet.ExtSelectClipRGN not implemented ...'); 1460 {$ENDIF} 1461 if not IsValidDC(DC) then 1462 begin 1463 Result := ERROR; 1464 exit; 1465 end else 1466 Result := SIMPLEREGION; 1467 // DebugLn('WARNING: TGtk3WidgetSet.ExtSelectClipRGN not implemented ...Mode=',dbgs(Mode)); 1468 case Mode of 1469 RGN_COPY: Result := SelectClipRGN(DC, RGN); 1470 RGN_OR, 1471 RGN_XOR, 1472 RGN_AND: 1473 begin 1474 // as MSDN says only RGN_COPY allows NULL RGN param. 1475 if not IsValidGDIObject(RGN) then 1476 begin 1477 Result := ERROR; 1478 exit; 1479 end; 1480 // get existing clip 1481 gdk_cairo_get_clip_rectangle(GtkDC.Widget, @ARect); 1482 R := RectFromGdkRect(ARect); 1483 if IsRectEmpty(R) then 1484 begin 1485 // no clip, just select RGN 1486 Result := SelectClipRGN(DC, RGN); 1487 exit; 1488 end; 1489 1490 // get transformation 1491 GetWindowOrgEx(DC, @DCOrigin); 1492 // writeln('ExtSelectClipRgn DCOrigin=',dbgs(DCOrigin),' R=',dbgs(R)); 1493 // OffsetRect(R, -DCOrigin.X, -DCOrigin.Y); 1494 // writeln('ExtSelectClipRgn after DCOrigin=',dbgs(DCOrigin),' R=',dbgs(R)); 1495 Clip := CreateRectRGN(0, 0, R.Right - R.Left, R.Bottom - R.Top); 1496 1497 cairo_region_translate(TGtk3Region(Clip).Handle, -DCOrigin.X, -DCOrigin.Y); 1498 1499 // create target clip 1500 Tmp := CreateEmptyRegion; 1501 // CreateEmptyRegion; 1502 // combine 1503 Result := CombineRGN(Tmp, Clip, RGN, Mode); 1504 // commit 1505 SelectClipRGN(DC, Tmp); 1506 // clean up 1507 DeleteObject(Clip); 1508 DeleteObject(Tmp); 1509 end; 1510 RGN_DIFF: 1511 begin 1512 //DebugLn('WARNING: TGtk3DeviceContext.ExtSelectClipRgn RGN_DIFF not implemented .'); 1513 //exit; 1514 // when substracting we must have active clipregion 1515 // with all of its rects. 1516 gdk_cairo_get_clip_rectangle(GtkDC.Widget, @ARect); 1517 R := RectFromGdkRect(ARect); 1518 if IsRectEmpty(R) then 1519 begin 1520 // no clip, just select RGN 1521 Result := SelectClipRGN(DC, RGN); 1522 exit; 1523 end; 1524 1525 Clip := CreateRectRGN(R.Left, R.Top, R.Right, R.Bottom); 1526 1527 Tmp := CreateEmptyRegion; 1528 Result := CombineRGN(Tmp, HRGN(Clip), RGN, MODE); 1529 1530 // X11 paintEngine comment only ! 1531 // we'll NOT reset num of rects here (performance problem) like we do 1532 // in ExcludeClipRect, because this function must be correct, 1533 // if someone want accurate ExcludeClipRect with X11 then 1534 // use code from intfbasewinapi.inc TWidgetSet.ExcludeClipRect() 1535 // which calls this function and then combineRgn. 1536 SelectClipRGN(DC, Tmp); 1537 DeleteObject(Clip); 1538 DeleteObject(Tmp); 1539 end; 1540 end; 1541end; 1542 1543function TGtk3WidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; 1544 Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; 1545begin 1546 Result := False; 1547 // {$IFDEF VerboseGtk3DeviceContext} 1548 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1549 DebugLn('TGtk3WidgetSet.ExtTextOut x=',dbgs(x),' y=',dbgs(y),' Text ',dbgs(Str),' count ',dbgs(Count)); 1550 {$ENDIF} 1551 // inherited ExtTextOut(DC, X, Y, Options, Rect, Str, Count, Dx); 1552 if IsValidDC(DC) then 1553 begin 1554 Result := True; 1555 TGtk3DeviceContext(DC).drawText(X, Y , Str); 1556 end; 1557end; 1558 1559function TGtk3WidgetSet.FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH 1560 ): Boolean; 1561begin 1562 Result := False; 1563 if IsValidDC(DC) then 1564 begin 1565 with Rect do 1566 TGtk3DeviceContext(DC).fillRect(Left, Top, Right - Left, Bottom - Top, Brush); 1567 Result := True; 1568 end; 1569end; 1570 1571function TGtk3WidgetSet.FillRgn(DC: HDC; RegionHnd: HRGN; hbr: HBRUSH): Bool; 1572var 1573 R: TRect; 1574begin 1575 Result := False; 1576 if IsValidDC(DC) and IsValidGDIObject(RegionHnd) then 1577 begin 1578 R := TGtk3Region(RegionHnd).GetExtents; 1579 TGtk3DeviceContext(DC).fillRect(R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top); 1580 Result := True; 1581 end; 1582end; 1583 1584function TGtk3WidgetSet.Frame3d(DC: HDC; var ARect: TRect; 1585 const FrameWidth: integer; const Style: TBevelCut): Boolean; 1586var 1587 AStyleWidget: PGtkWidget; 1588 c1: TGdkRGBA; 1589 c2: TGdkRGBA; 1590 AWidth: Integer; 1591 i: Integer; 1592 cr: Pcairo_t; 1593begin 1594 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1595 // DebugLn('WARNING: TGtk3WidgetSet.Frame3D not implemented ...'); 1596 {$ENDIF} 1597 Result := False; // inherited Frame3d(DC, ARect, FrameWidth, Style); 1598 // need style widgets. Must implement them first and/or create them on demand 1599 // AStyle := gtk_widget_get_default_style; 1600 // PGtkWidget(nil)^.get_style^.light; 1601 if not IsValidDC(DC) then 1602 exit; 1603 cr := TGtk3DeviceContext(DC).Widget; 1604 AStyleWidget := GetStyleWidget(lgsButton); 1605 if Gtk3IsWidget(AStyleWidget) then 1606 begin 1607 AStyleWidget^.get_style_context^.get_background_color(GTK_STATE_NORMAL, @c1); 1608 AStyleWidget^.get_style_context^.get_border_color(GTK_STATE_NORMAL, @c2); 1609 // writeln('Frame3d style ',Style,' border ',FrameWidth); 1610 // DebugLn('Button bg R ',dbgs(c1.red * 255),' G ',dbgs(c1.green * 255),' B ',dbgs(c1.blue * 255), 1611 // ' fg R ',dbgs(c2.red),' G ',dbgs(c2.green),' B ',dbgs(c2.blue)); 1612 AWidth := FrameWidth; 1613 case Style of 1614 bvNone: 1615 begin 1616 InflateRect(ARect, -AWidth, -AWidth); 1617 Exit; 1618 end; 1619 bvLowered: 1620 begin 1621 // AStyleWidget^.get_style_context^.get_color(GTK_STATE_NORMAL, @c2); 1622 AStyleWidget^.get_style_context^.get_background_color(GTK_STATE_NORMAL, @c2); 1623 AStyleWidget^.get_style_context^.get_border_color(GTK_STATE_NORMAL, @c1); 1624 // AStyleWidget^.get_style_context^.lookup_color('red', @c1); 1625 // AStyleWidget^.get_style_context^.get_color(GTK_STATE_NORMAL, @c1); 1626 1627 // gc1 := TheStyle^.dark_gc[GTK_STATE_NORMAL]; 1628 // gc2 := TheStyle^.light_gc[GTK_STATE_NORMAL]; 1629 end; 1630 bvRaised: 1631 begin 1632 // AStyleWidget^.get_style_context^.get_color(GTK_STATE_NORMAL, @c1); 1633 AStyleWidget^.get_style_context^.get_background_color(GTK_STATE_NORMAL, @c1); 1634 AStyleWidget^.get_style_context^.get_border_color(GTK_STATE_NORMAL, @c2); 1635 // AStyleWidget^.get_style_context^.lookup_color('red', @c2); 1636 // AStyleWidget^.get_style_context^.get_color(GTK_STATE_NORMAL, @c2); 1637 // gc1 := TheStyle^.light_gc[GTK_STATE_NORMAL]; 1638 // gc2 := TheStyle^.dark_gc[GTK_STATE_NORMAL]; 1639 end; 1640 bvSpace: 1641 begin 1642 InflateRect(ARect, -AWidth, -AWidth); 1643 Exit; 1644 end; 1645 end; 1646 1647 cairo_save(cr); 1648 for i := 1 to AWidth do 1649 begin 1650 cairo_set_antialias(cr, CAIRO_ANTIALIAS_NONE); 1651 cairo_set_line_width(cr, 1); 1652 cairo_set_line_cap(cr, cairo_line_cap_t.CAIRO_LINE_CAP_ROUND); 1653 cairo_set_line_join(cr, cairo_line_join_t.CAIRO_LINE_JOIN_ROUND); 1654 cairo_set_source_rgb(cr, c1.red, c1.green, c1.blue); 1655 cairo_move_to(cr,ARect.Left, ARect.Top); 1656 cairo_line_to(cr,ARect.Right {- 2}, ARect.Top); 1657 cairo_move_to(cr,ARect.Left, ARect.Top); 1658 cairo_line_to(cr,ARect.Left, ARect.Bottom {- 2}); 1659 cairo_stroke(cr); 1660 cairo_set_source_rgb(cr, c2.red, c2.green, c2.blue); 1661 cairo_move_to(cr,ARect.Left, ARect.Bottom {- 1}); 1662 cairo_line_to(cr,ARect.Right {- 1}, ARect.Bottom {- 1}); 1663 cairo_move_to(cr,ARect.Right {- 1}, ARect.Top); 1664 cairo_line_to(cr,ARect.Right {- 1}, ARect.Bottom {- 1}); 1665 cairo_stroke(cr); 1666 (* 1667 gdk_draw_line(Drawable, gc1, ARect.Left + Offset.x, ARect.Top + Offset.y, 1668 ARect.Right + Offset.x - 2, ARect.Top + Offset.y); 1669 gdk_draw_line(Drawable, gc1, ARect.Left + Offset.x, ARect.Top + Offset.y, 1670 ARect.Left + Offset.x, ARect.Bottom + Offset.y - 2); 1671 1672 gdk_draw_line(Drawable, gc2, ARect.Left + Offset.x, ARect.Bottom + Offset.y - 1, 1673 ARect.Right + Offset.x - 1, ARect.Bottom + Offset.y - 1); 1674 gdk_draw_line(Drawable, gc2, ARect.Right + Offset.x - 1, ARect.Top + Offset.y, 1675 ARect.Right + Offset.x - 1, ARect.Bottom + Offset.y - 1); 1676 *) 1677 // inflate the rectangle (! ARect will be returned to the user with this) 1678 InflateRect(ARect, -1, -1); 1679 end; 1680 cairo_restore(cr); 1681 1682 end else 1683 DebugLn('TGtk3WidgetSet.Frame3d failed to get style widget lgsButton'); 1684 1685 1686 1687end; 1688 1689function TGtk3WidgetSet.FrameRect(DC: HDC; const ARect: TRect; hBr: HBRUSH 1690 ): Integer; 1691var 1692 cr: Pcairo_t; 1693begin 1694 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1695 DebugLn('TGtk3WidgetSet.FrameRect ARect=',dbgs(ARect)); 1696 {$ENDIF} 1697 Result := 0; 1698 if not IsValidDC(DC) then 1699 exit; 1700 cr := TGtk3DeviceContext(DC).Widget; 1701 cairo_rectangle(cr, ARect.Left, ARect.Top, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top); 1702 if IsValidGDIObject(hBr) then 1703 TGtk3DeviceContext(DC).SetSourceColor(TGtk3Brush(HBR).Color); 1704 cairo_set_line_width(cr, 1); 1705 cairo_stroke(cr); //Don't touch 1706end; 1707 1708function TGtk3WidgetSet.HideCaret(hWnd: HWND): Boolean; 1709begin 1710 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1711 DebugLn('WARNING: TGtk3WidgetSet.HideCaret not implemented ...'); 1712 {$ENDIF} 1713 Result:=inherited HideCaret(hWnd); 1714end; 1715 1716function TGtk3WidgetSet.GetActiveWindow: HWND; 1717var 1718 AWindow: PGdkWindow; 1719 AData: gpointer; 1720 AWidget: PGtkWidget; 1721 i: Integer; 1722begin 1723 Result := 0; 1724 AWindow := gdk_screen_get_active_window(gdk_screen_get_default); 1725 if AWindow <> nil then 1726 begin 1727 AData := g_object_get_data(AWindow, 'lclwidget'); 1728 if AData <> nil then 1729 begin 1730 // DebugLn('TGtk3WidgetSet.GetActiveWindow found window from data ...',dbgsName(TGtk3Widget(AData).LCLObject)); 1731 Result := HWND(AData); 1732 exit; 1733 end; 1734 for i := 0 to Screen.FormCount - 1 do 1735 begin 1736 if Screen.Forms[i].HandleAllocated then 1737 begin 1738 if PGtkWindow(TGtk3Window(Screen.Forms[i].Handle).Widget)^.get_window = AWindow then 1739 begin 1740 AWidget := PGtkWindow(TGtk3Window(Screen.Forms[i].Handle).Widget)^.get_focus; 1741 Result := HWND(Screen.Forms[i].Handle); 1742 end; 1743 end; 1744 end; 1745 end; 1746end; 1747 1748function TGtk3WidgetSet.GetBitmapBits(Bitmap: HBITMAP; Count: Longint; 1749 Bits: Pointer): Longint; 1750begin 1751 Result:=inherited GetBitmapBits(Bitmap, Count, Bits); 1752end; 1753 1754function TGtk3WidgetSet.GetBkColor(DC: HDC): TColorRef; 1755begin 1756 Result := 0; 1757 if IsValidDC(DC) then 1758 Result := TGtk3DeviceContext(DC).CurrentBrush.Color; 1759end; 1760 1761function TGtk3WidgetSet.GetCapture: HWND; 1762begin 1763 Result := HwndFromGtkWidget(gtk_grab_get_current); 1764 {$IFDEF VerboseGtk3WinApi} 1765 DebugLn('TGtk3WidgetSet.GetCapture ',dbgHex(Result)); 1766 {$ENDIF} 1767end; 1768 1769function TGtk3WidgetSet.GetCaretPos(var lpPoint: TPoint): Boolean; 1770begin 1771 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1772 DebugLn('WARNING: TGtk3WidgetSet.GetCaretPos not implemented ...'); 1773 {$ENDIF} 1774 Result:=inherited GetCaretPos(lpPoint); 1775end; 1776 1777function TGtk3WidgetSet.GetCaretRespondToFocus(handle: HWND; 1778 var ShowHideOnFocus: boolean): Boolean; 1779begin 1780 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1781 DebugLn('WARNING: TGtk3WidgetSet.GetCaretPosRespondToFocus not implemented ...'); 1782 {$ENDIF} 1783 Result:=inherited GetCaretRespondToFocus(handle, ShowHideOnFocus); 1784end; 1785 1786function TGtk3WidgetSet.GetCharABCWidths(DC: HDC; p2, p3: UINT; const ABCStructs 1787 ): Boolean; 1788begin 1789 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1790 DebugLn('WARNING: TGtk3WidgetSet.GetCharABCWidths not implemented ...'); 1791 {$ENDIF} 1792 Result:=inherited GetCharABCWidths(DC, p2, p3, ABCStructs); 1793end; 1794 1795function TGtk3WidgetSet.GetClientBounds(handle: HWND; var ARect: TRect 1796 ): Boolean; 1797begin 1798 {$IF DEFINED(VerboseGtk3WinAPI) OR DEFINED(GTK3DEBUGSIZE)} 1799 DebugLn('[Gtk3WinAPI GetClientBounds]'); 1800 {$ENDIF} 1801 if Handle = 0 then 1802 Exit(False); 1803 ARect := TGtk3Widget(handle).getClientBounds; 1804 Result := True; 1805end; 1806 1807function TGtk3WidgetSet.GetClientRect(handle: HWND; var ARect: TRect): Boolean; 1808begin 1809 {$IF DEFINED(VerboseGtk3WinAPI) OR DEFINED(GTK3DEBUGSIZE)} 1810 DebugLn('[Gtk3WinAPI GetClientRect]'); 1811 {$ENDIF} 1812 if Handle = 0 then 1813 Exit(False); 1814 ARect := TGtk3Widget(handle).getClientRect; 1815 Result := True; 1816end; 1817 1818function TGtk3WidgetSet.GetClipBox(DC: hDC; lpRect: PRect): Longint; 1819var 1820 GtkDC: TGtk3DeviceContext absolute DC; 1821 cr: Pcairo_t; 1822 Pt: TPoint; 1823 ARect: TGdkRectangle; 1824begin 1825 //{$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1826 //DebugLn('WARNING: TGtk3WidgetSet.GetClipBox not implemented ...'); 1827 //{$ENDIF} 1828 Result := NULLREGION; 1829 if lpRect <> nil then 1830 lpRect^ := Rect(0,0,0,0); 1831 1832 if not IsValidDC(DC) then 1833 Result := ERROR; 1834 1835 if Result <> ERROR then 1836 begin 1837 cr := GtkDC.Widget; 1838 if gdk_cairo_get_clip_rectangle(cr, @ARect) then 1839 begin 1840 lpRect^ := RectFromGdkRect(ARect); 1841 Result := SimpleRegion; 1842 end; 1843 end; 1844end; 1845 1846function TGtk3WidgetSet.GetClipRGN(DC: hDC; RGN: hRGN): Longint; 1847var 1848 ARect: TGdkRectangle; 1849begin 1850 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1851 // DebugLn('WARNING: TGtk3WidgetSet.GetClipRgn not implemented ...'); 1852 {$ENDIF} 1853 Result := -1; 1854 if not IsValidDC(DC) or (RGN = 0) then 1855 exit; 1856 gdk_cairo_get_clip_rectangle(TGtk3DeviceContext(DC).Widget, @ARect); 1857 // DebugLn('GetClipRgn ',dbgs(TGtk3Region(RGN).GetExtents),' clipRect ',dbgs(RectFromGdkRect(ARect))); 1858 if IsRectEmpty(RectFromGdkRect(ARect)) then 1859 exit(0) 1860 else 1861 begin 1862 cairo_region_destroy(TGtk3Region(RGN).Handle); 1863 TGtk3Region(RGN).Handle := cairo_region_create_rectangle(@ARect); 1864 Result := 1; 1865 end; 1866end; 1867 1868function TGtk3WidgetSet.GetCmdLineParamDescForInterface: string; 1869begin 1870 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1871 DebugLn('WARNING: TGtk3WidgetSet.GetCmdLineParamDescForInterface not implemented ...'); 1872 {$ENDIF} 1873 Result:=inherited GetCmdLineParamDescForInterface; 1874end; 1875 1876function TGtk3WidgetSet.GetCurrentObject(DC: HDC; uObjectType: UINT): HGDIOBJ; 1877var 1878 GtkDC: TGtk3DeviceContext absolute DC; 1879begin 1880 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1881 // DebugLn('WARNING: TGtk3WidgetSet.GetCurrentObject not implemented ...'); 1882 {$ENDIF} 1883 // Result:=inherited GetCurrentObject(DC, uObjectType); 1884 Result := 0; 1885 if not IsValidDC(DC) then 1886 Exit; 1887 case uObjectType of 1888 OBJ_BITMAP: Result := HGDIOBJ(GtkDC.CurrentImage); 1889 OBJ_BRUSH: Result := HGDIOBJ(GtkDC.CurrentBrush); 1890 OBJ_FONT: Result := HGDIOBJ(GtkDC.CurrentFont); 1891 OBJ_PEN: Result := HGDIOBJ(GtkDC.CurrentPen); 1892 OBJ_REGION: Result := HGDIOBJ(GtkDC.CurrentRegion); 1893 end; 1894end; 1895 1896function TGtk3WidgetSet.GetCursorPos(var lpPoint: TPoint): Boolean; 1897var 1898 ADeviceManager: PGdkDeviceManager; 1899 APointer: PGdkDevice; 1900 AScreen: PGdkScreen; 1901begin 1902 ADeviceManager := gdk_display_get_device_manager(gdk_display_get_default); 1903 APointer := gdk_device_manager_get_client_pointer(ADeviceManager); 1904 AScreen := gdk_screen_get_default; 1905 gdk_device_get_position(APointer, @AScreen, @lpPoint.X, @lpPoint.Y); 1906 Result := True; 1907end; 1908 1909function TGtk3WidgetSet.GetDC(hWnd: HWND): HDC; 1910var 1911 Widget: TGtk3Widget; 1912begin 1913 if Gtk3WidgetSet.IsValidHandle(hWnd) then 1914 begin 1915 Widget := TGtk3Widget(hWnd); 1916 Result := Widget.Context; 1917 if Result = 0 then 1918 Result := HDC(Gtk3DefaultContext); 1919 end else 1920 Result := HDC(Gtk3ScreenContext); 1921end; 1922 1923function TGtk3WidgetSet.GetDCOriginRelativeToWindow(PaintDC: HDC; 1924 WindowHandle: HWND; var OriginDiff: TPoint): boolean; 1925begin 1926 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1927 DebugLn('WARNING: TGtk3WidgetSet.GetDCOriginRelativeToWindow not implemented ...'); 1928 {$ENDIF} 1929 Result:=inherited GetDCOriginRelativeToWindow(PaintDC, WindowHandle, 1930 OriginDiff); 1931end; 1932 1933function TGtk3WidgetSet.GetDesignerDC(WindowHandle: HWND): HDC; 1934begin 1935 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1936 DebugLn('WARNING: TGtk3WidgetSet.GetDesignerDC not implemented ...'); 1937 {$ENDIF} 1938 Result:=inherited GetDesignerDC(WindowHandle); 1939end; 1940 1941function TGtk3WidgetSet.GetDeviceCaps(DC: HDC; Index: Integer): Integer; 1942begin 1943 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1944 if (Index <> BITSPIXEL) and (Index <> LOGPIXELSX) and (Index <> LOGPIXELSY) then 1945 DebugLn('WARNING: TGtk3WidgetSet.GetDeviceCaps not implemented ...Index=',dbgs(Index),' DC=',dbgs(DC)); 1946 {$ENDIF} 1947 Result := 0; // inherited GetDeviceCaps(DC, Index); 1948 case Index of 1949 1950 HORZRES : { Horizontal width in pixels } 1951 begin 1952 if IsValidDC(DC) then 1953 begin 1954 Result := TGtk3DeviceContext(DC).getDeviceSize.X; 1955 end else 1956 Result := GetSystemMetrics(SM_CXSCREEN); 1957 end; 1958 1959 VERTRES : { Vertical height in pixels } 1960 begin 1961 if IsValidDC(DC) then 1962 begin 1963 Result := TGtk3DeviceContext(DC).getDeviceSize.Y; 1964 end else 1965 Result := GetSystemMetrics(SM_CYSCREEN); 1966 end; 1967 1968 HORZSIZE : { Horizontal size in millimeters } 1969 Result := RoundToInt((GetDeviceCaps(DC, HORZRES) * 100) / 1970 (GetDeviceCaps(DC, LOGPIXELSX) * 25.4)); 1971 1972 VERTSIZE : { Vertical size in millimeters } 1973 Result := RoundToInt((GetDeviceCaps(DC, VERTRES) * 100) / 1974 (GetDeviceCaps(DC, LOGPIXELSY) * 25.4)); 1975 1976 BITSPIXEL: 1977 begin 1978 if IsValidDC(DC) then 1979 Result := TGtk3DeviceContext(DC).getDepth 1980 else 1981 Result := gdk_window_get_visual(gdk_get_default_root_window)^.get_depth; 1982 end; 1983 PLANES: Result := 1; 1984 SIZEPALETTE: Result := gdk_window_get_visual(gdk_get_default_root_window)^.get_colormap_size; 1985 LOGPIXELSX : { Logical pixels per inch in X } 1986 begin 1987 Result := RoundToInt(gdk_screen_width / (gdk_screen_width_mm / 25.4)); 1988 end; 1989 1990 LOGPIXELSY : { Logical pixels per inch in Y } 1991 begin 1992 Result := RoundToInt(gdk_screen_height / (gdk_screen_height_mm / 25.4)); 1993 end; 1994 end; 1995 1996end; 1997 1998function TGtk3WidgetSet.GetDeviceSize(DC: HDC; var p: TPoint): boolean; 1999var 2000 ARect: TGdkRectangle; 2001begin 2002 Result := False; 2003 if not IsValidDC(DC) then 2004 exit; 2005 if TGtk3DeviceContext(DC).Parent <> nil then 2006 begin 2007 if Gtk3IsGdkWindow(TGtk3DeviceContext(DC).Parent^.window) then 2008 begin 2009 p.X := gdk_window_get_width(TGtk3DeviceContext(DC).Parent^.window); 2010 p.Y := gdk_window_get_height(TGtk3DeviceContext(DC).Parent^.window); 2011 Result := True; 2012 end; 2013 end else 2014 if (TGtk3DeviceContext(DC).ParentPixmap <> nil) and 2015 Gtk3IsGdkPixbuf(TGtk3DeviceContext(DC).ParentPixmap) then 2016 begin 2017 p.X := TGtk3DeviceContext(DC).ParentPixmap^.get_width; 2018 p.Y := TGtk3DeviceContext(DC).ParentPixmap^.get_height; 2019 Result := True; 2020 end else 2021 if TGtk3DeviceContext(DC).Widget <> nil then 2022 begin 2023 gdk_cairo_get_clip_rectangle(TGtk3DeviceContext(DC).Widget, @ARect); 2024 p.X := ARect.Width; 2025 p.Y := ARect.Height; 2026 Result := True; 2027 end; 2028end; 2029 2030function TGtk3WidgetSet.GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, 2031 NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; 2032begin 2033 Result:=inherited GetDIBits(DC, Bitmap, StartScan, NumScans, Bits, BitInfo, 2034 Usage); 2035end; 2036 2037function TGtk3WidgetSet.GetFocus: HWND; 2038var 2039 i: Integer; 2040 AWidget: PGtkWidget; 2041 AList: PGList; 2042 AHandle: TGtk3Window; 2043 AWindow: PGtkWindow; 2044 AActiveWindow: HWND; 2045begin 2046 AWidget := nil; 2047 2048 AActiveWindow := GetActiveWindow; 2049 if AActiveWindow <> 0 then 2050 begin 2051 AWidget := PGtkWindow(TGtk3Widget(AActiveWindow).Widget)^.get_focus; 2052 end else 2053 begin 2054 // worst case scenario is to search for widget or when application 2055 // isn't active anymore 2056 AList := gtk_window_list_toplevels; 2057 for i := 0 to g_list_length(AList) - 1 do 2058 begin 2059 if Gtk3IsGtkWindow(PGObject(g_list_nth(AList, i)^.data)) then 2060 begin 2061 // gtk3 this is really ugly, it returns .is_active for non active 2062 // windows, while docs says that is_active is window with kbd focus 2063 AWindow := PGtkWindow(g_list_nth(AList, i)^.data); 2064 AHandle := TGtk3Window(HwndFromGtkWidget(AWindow)); 2065 if Assigned(AHandle) and (Screen.FocusedForm = AHandle.LCLObject) and 2066 (AWindow^.is_active) then 2067 begin 2068 AWidget := PGtkWindow(g_list_nth(AList, i)^.data)^.get_focus; 2069 if AWidget <> nil then 2070 break; 2071 end; 2072 end; 2073 end; 2074 g_list_free(AList); 2075 end; 2076 2077 Result := HwndFromGtkWidget(AWidget); 2078 {$IFDEF GTK3DEBUGFOCUS} 2079 DebugLn('TGtk3WidgetSet.GetFocus current focus ',dbgHex(Result)); 2080 if IsValidHandle(Result) then 2081 DebugLn('TGtk3WidgetSet.GetFocus current focus ',dbgsName(TGtk3Widget(Result).LCLObject)); 2082 {$ENDIF} 2083end; 2084 2085function TGtk3WidgetSet.GetFontLanguageInfo(DC: HDC): DWord; 2086begin 2087 Result:=inherited GetFontLanguageInfo(DC); 2088end; 2089 2090function TGtk3WidgetSet.GetForegroundWindow: HWND; 2091var 2092 i: Integer; 2093 AWidget: PGtkWindow; 2094 AWindow: PGtkWindow; 2095 AList: PGList; 2096begin 2097 Result := 0; 2098 AWidget := nil; 2099 AWindow := nil; 2100 AList := gtk_window_list_toplevels; 2101 for i := 0 to g_list_length(AList) - 1 do 2102 begin 2103 if Gtk3IsGtkWindow(PGObject(g_list_nth(AList, i)^.data)) then 2104 begin 2105 AWidget := g_list_nth(AList, i)^.data; 2106 if AWidget^.get_visible and AWidget^.is_toplevel and AWidget^.is_active then 2107 begin 2108 AWindow := AWidget; 2109 break; 2110 end; 2111 end; 2112 end; 2113 g_list_free(AList); 2114 Result := HwndFromGtkWidget(AWindow); 2115end; 2116 2117function TGtk3WidgetSet.GetKeyState(nVirtKey: Integer): Smallint; 2118const 2119 StateDown = SmallInt($FF80); 2120var 2121 AKeyMap: PGdkKeymap; 2122 AModifiers: guint; 2123begin 2124 Result := 0; 2125 2126 Result := 0; 2127 2128 case nVirtKey of 2129 VK_LSHIFT: nVirtKey := VK_SHIFT; 2130 VK_LCONTROL: nVirtKey := VK_CONTROL; 2131 VK_LMENU: nVirtKey := VK_MENU; 2132 end; 2133 2134 (* 2135 // GdkModifierType 2136 GDK_SHIFT_MASK: TGdkModifierType = 1; 2137 GDK_LOCK_MASK: TGdkModifierType = 2; 2138 GDK_CONTROL_MASK: TGdkModifierType = 4; 2139 GDK_MOD1_MASK: TGdkModifierType = 8; 2140 GDK_MOD2_MASK: TGdkModifierType = 16; 2141 GDK_MOD3_MASK: TGdkModifierType = 32; 2142 GDK_MOD4_MASK: TGdkModifierType = 64; 2143 GDK_MOD5_MASK: TGdkModifierType = 128; 2144 GDK_BUTTON1_MASK: TGdkModifierType = 256; 2145 GDK_BUTTON2_MASK: TGdkModifierType = 512; 2146 GDK_BUTTON3_MASK: TGdkModifierType = 1024; 2147 GDK_BUTTON4_MASK: TGdkModifierType = 2048; 2148 GDK_BUTTON5_MASK: TGdkModifierType = 4096; 2149 GDK_MODIFIER_RESERVED_13_MASK: TGdkModifierType = 8192; 2150 GDK_MODIFIER_RESERVED_14_MASK: TGdkModifierType = 16384; 2151 GDK_MODIFIER_RESERVED_15_MASK: TGdkModifierType = 32768; 2152 GDK_MODIFIER_RESERVED_16_MASK: TGdkModifierType = 65536; 2153 GDK_MODIFIER_RESERVED_17_MASK: TGdkModifierType = 131072; 2154 GDK_MODIFIER_RESERVED_18_MASK: TGdkModifierType = 262144; 2155 GDK_MODIFIER_RESERVED_19_MASK: TGdkModifierType = 524288; 2156 GDK_MODIFIER_RESERVED_20_MASK: TGdkModifierType = 1048576; 2157 GDK_MODIFIER_RESERVED_21_MASK: TGdkModifierType = 2097152; 2158 GDK_MODIFIER_RESERVED_22_MASK: TGdkModifierType = 4194304; 2159 GDK_MODIFIER_RESERVED_23_MASK: TGdkModifierType = 8388608; 2160 GDK_MODIFIER_RESERVED_24_MASK: TGdkModifierType = 16777216; 2161 GDK_MODIFIER_RESERVED_25_MASK: TGdkModifierType = 33554432; 2162 GDK_SUPER_MASK: TGdkModifierType = 67108864; 2163 GDK_HYPER_MASK: TGdkModifierType = 134217728; 2164 GDK_META_MASK: TGdkModifierType = 268435456; 2165 GDK_MODIFIER_RESERVED_29_MASK: TGdkModifierType = 536870912; 2166 GDK_RELEASE_MASK: TGdkModifierType = 1073741824; 2167 GDK_MODIFIER_MASK: TGdkModifierType = 1543512063; 2168 *) 2169 // AModifierMask := gdk_keymap_get_modifier_mask(AKeyMap, 0); 2170 2171 AKeyMap := gdk_keymap_get_default; 2172 AModifiers := gdk_keymap_get_modifier_state(AKeyMap); 2173 case nVirtKey of 2174 VK_LBUTTON: 2175 if AModifiers and GDK_BUTTON1_MASK <> 0 then 2176 Result := Result or StateDown; 2177 VK_RBUTTON: 2178 if AModifiers and GDK_BUTTON2_MASK <> 0 then 2179 Result := Result or StateDown; 2180 VK_MBUTTON: 2181 if AModifiers and GDK_BUTTON3_MASK <> 0 then 2182 Result := Result or StateDown; 2183 VK_XBUTTON1: 2184 if AModifiers and GDK_BUTTON4_MASK <> 0 then 2185 Result := Result or StateDown; 2186 VK_XBUTTON2: 2187 if AModifiers and GDK_BUTTON5_MASK <> 0 then 2188 Result := Result or StateDown; 2189 VK_MENU: 2190 if AModifiers and GDK_MOD1_MASK <> 0 then 2191 Result := Result or StateDown; 2192 VK_SHIFT: 2193 if AModifiers and GDK_SHIFT_MASK <> 0 then 2194 Result := Result or StateDown; 2195 VK_CONTROL: 2196 if AModifiers and GDK_CONTROL_MASK <> 0 then 2197 Result := Result or StateDown; 2198 VK_LWIN, VK_RWIN: 2199 if AModifiers and GDK_META_MASK <> 0 then 2200 Result := Result or StateDown; 2201 {$ifdef VerboseGtk3WinAPI} 2202 else 2203 DebugLn('TGtk3WidgetSet.GetKeyState TODO ', DbgSVKCode(Word(nVirtkey))); 2204 {$endif} 2205 end; 2206end; 2207 2208function TGtk3WidgetSet.GetMapMode(DC: HDC): Integer; 2209begin 2210 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2211 DebugLn('WARNING: TGtk3WidgetSet.GetMapMode not implemented ...'); 2212 {$ENDIF} 2213 Result:=inherited GetMapMode(DC); 2214end; 2215 2216function TGtk3WidgetSet.GetMonitorInfo(Monitor: HMONITOR; lpmi: PMonitorInfo 2217 ): Boolean; 2218var 2219 MonitorRect, MonitorWorkArea: TGdkRectangle; 2220begin 2221 Result := (lpmi <> nil) and (lpmi^.cbSize >= SizeOf(TMonitorInfo)) or (Monitor = 0); 2222 if not Result then Exit; 2223 Dec(Monitor); 2224 gdk_screen_get_monitor_geometry(gdk_screen_get_default, Monitor, @MonitorRect); 2225 2226 with MonitorRect do 2227 lpmi^.rcMonitor := Bounds(x, y, width, height); 2228 // there is no way to determine workarea in gtk 2229 gdk_screen_get_monitor_workarea(gdk_screen_get_default, Monitor, @MonitorWorkArea); 2230 with MonitorWorkArea do 2231 lpmi^.rcWork := Bounds(x, y, width, height); 2232 lpmi^.rcWork := lpmi^.rcMonitor; 2233 if Monitor = gdk_screen_get_primary_monitor(gdk_screen_get_default) then 2234 lpmi^.dwFlags := MONITORINFOF_PRIMARY 2235 else 2236 lpmi^.dwFlags := 0; 2237end; 2238 2239function TGtk3WidgetSet.GetObject(GDIObj: HGDIOBJ; BufSize: Integer; 2240 Buf: Pointer): Integer; 2241var 2242 aObject: TObject; 2243 ALogFont: PLogFont absolute Buf; 2244 ALogPen: PLogPen absolute Buf; 2245 AExtLogPen: PExtLogPen absolute Buf; 2246 ALogBrush: PLogBrush absolute Buf; 2247begin 2248 Result := 0; 2249 if not IsValidGDIObject(GDIObj) then 2250 begin 2251 {$ifdef VerboseGtk3WinAPI} 2252 WriteLn('Trace:< TGtk3WidgetSet.GetObject Invalid GDI Object'); 2253 {$endif} 2254 Exit; 2255 end; 2256 aObject := TObject(GdiObj); 2257 DebugLn('TGtk3WidgetSet.GetObject ',dbgsName(aObject)); 2258 if aObject is TGtk3Pen then 2259 begin 2260 if Buf = nil then 2261 Result := SizeOf(TLogPen) 2262 else 2263 begin 2264 Result := SizeOf(TLogPen); 2265 ALogPen^ := TGtk3Pen(aObject).LogPen; 2266 end; 2267 end else 2268 if aObject is TGtk3Brush then 2269 begin 2270 if Buf = nil then 2271 begin 2272 // DebugLn('TGtk3WidgetSet.GetObject ',dbgsName(aObject),' Buffer is empty ',dbgHex(PtrUInt(ALogBrush))); 2273 Result := SizeOf(TLogBrush); 2274 end else 2275 if BufSize >= SizeOf(TLogBrush) then 2276 begin 2277 Result := SizeOf(TLogBrush); 2278 // ALogBrush^ := TGtk3Brush(aObject).Color; 2279 ALogBrush^ := TGtk3Brush(AObject).LogBrush; 2280 // DebugLn('TGtk3WidgetSet.GetObject ',dbgsName(aObject),' ALogBrush ',dbgHex(PtrUInt(ALogBrush))); 2281 end; 2282 end 2283end; 2284 2285function TGtk3WidgetSet.GetParent(Handle: HWND): HWND; 2286begin 2287 if Handle <> 0 then 2288 Result := HWND(TGtk3Widget(Handle).getParent) 2289 else 2290 Result := 0; 2291end; 2292 2293function TGtk3WidgetSet.GetProp(Handle: hwnd; Str: PChar): Pointer; 2294begin 2295 Result := nil; 2296 if not IsValidHandle(Handle) then 2297 exit; 2298 Result := g_object_get_data(TGtk3Widget(Handle).Widget, PgChar(Str)); 2299end; 2300 2301function TGtk3WidgetSet.GetRgnBox(RGN: HRGN; lpRect: PRect): Longint; 2302begin 2303 Result := SIMPLEREGION; 2304 if IsValidGDIObject(RGN) then 2305 begin 2306 lpRect^ := TGtk3Region(RGN).GetExtents; 2307 end; 2308end; 2309 2310function TGtk3WidgetSet.GetROP2(DC: HDC): Integer; 2311begin 2312 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2313 DebugLn('WARNING: TGtk3WidgetSet.GetROP2 not implemented ...'); 2314 {$ENDIF} 2315 Result := inherited GetROP2(DC); 2316end; 2317 2318function TGtk3WidgetSet.GetScrollBarSize(Handle: HWND; BarKind: Integer 2319 ): integer; 2320var 2321 BarWidget: PGtkWidget; 2322 Scrolled: PGtkScrolledWindow; 2323begin 2324 Result := 0; 2325 if not IsValidHandle(Handle) then 2326 exit; 2327 BarWidget := nil; 2328 if wtScrollbar in TGtk3Widget(Handle).WidgetType then 2329 BarWidget := TGtk3Widget(Handle).Widget 2330 else 2331 if wtScrollingWin in TGtk3Widget(Handle).WidgetType then 2332 begin 2333 Scrolled := TGtk3ScrollableWin(Handle).GetScrolledWindow; 2334 if Scrolled <> nil then 2335 begin 2336 if BarKind = SM_CYVSCROLL then 2337 BarWidget := Scrolled^.get_vscrollbar 2338 else 2339 BarWidget := Scrolled^.get_hscrollbar; 2340 end; 2341 end; 2342 if BarWidget <> nil then 2343 begin 2344 if BarKind = SM_CYVSCROLL then 2345 Result := BarWidget^.get_allocated_width 2346 else 2347 Result := BarWidget^.get_allocated_height; 2348 end; 2349end; 2350 2351function TGtk3WidgetSet.GetScrollbarVisible(Handle: HWND; SBStyle: Integer 2352 ): boolean; 2353var 2354 AWidget: TGtk3Widget; 2355begin 2356 Result := False; 2357 if not IsValidHandle(Handle) then 2358 exit; 2359 AWidget := TGtk3Widget(Handle); 2360 2361 if wtScrollBar in AWidget.WidgetType then 2362 Result := AWidget.Visible 2363 else 2364 begin 2365 if wtScrollingWin in AWidget.WidgetType then 2366 begin 2367 if SBStyle = SB_Horz then 2368 Result := TGtk3ScrollableWin(Handle).getHorizontalScrollbar^.get_visible 2369 else 2370 if SBStyle = SB_Vert then 2371 Result := TGtk3ScrollableWin(Handle).getVerticalScrollbar^.get_visible 2372 end; 2373 end; 2374end; 2375 2376function TGtk3WidgetSet.GetScrollInfo(Handle: HWND; SBStyle: Integer; 2377 var ScrollInfo: TScrollInfo): Boolean; 2378var 2379 Adjustment: PGtkAdjustment; 2380 AWidget: TGtk3Widget; 2381 AScrollWin: PGtkScrolledWindow; 2382begin 2383 Result := False; 2384 if not IsValidHandle(Handle) then 2385 exit; 2386 AWidget := TGtk3Widget(Handle); 2387 Adjustment := nil; 2388 AScrollWin := nil; 2389 if wtScrollBar in AWidget.WidgetType then 2390 Adjustment := PGtkScrollBar(AWidget.Widget)^.adjustment 2391 else 2392 if wtScrollingWin in AWidget.WidgetType then 2393 AScrollWin := TGtk3ScrollableWin(Handle).GetScrolledWindow; 2394 2395 case SBStyle of 2396 SB_Horz: 2397 begin 2398 if not Assigned(Adjustment) and Assigned(AScrollWin) then 2399 Adjustment := AScrollWin^.get_hadjustment; 2400 end; 2401 SB_Vert: 2402 begin 2403 if not Assigned(Adjustment) and Assigned(AScrollWin) then 2404 Adjustment := AScrollWin^.get_vadjustment; 2405 end; 2406 SB_CTL: 2407 begin 2408 2409 end; 2410 SB_BOTH: 2411 begin 2412 2413 end; 2414 end; 2415 2416 if Adjustment = nil then 2417 begin 2418 DebugLn('TGtk3WidgetSet.GetScrollInfo error: cannot get PGtkAdjustment from ',dbgsName(AWidget.LCLObject)); 2419 exit; 2420 end; 2421 2422 // POS 2423 if (ScrollInfo.fMask and SIF_POS) <> 0 then 2424 ScrollInfo.nPos := Round(Adjustment^.Value); 2425 2426 // RANGE 2427 if (ScrollInfo.fMask and SIF_RANGE) <> 0 then 2428 begin 2429 ScrollInfo.nMin:= Round(Adjustment^.Lower); 2430 ScrollInfo.nMax:= Round(Adjustment^.Upper); 2431 end; 2432 // PAGE 2433 if (ScrollInfo.fMask and SIF_PAGE) <> 0 then 2434 begin 2435 ScrollInfo.nPage := Round(Adjustment^.Page_Size); 2436 end; 2437 // TRACKPOS 2438 if (ScrollInfo.fMask and SIF_TRACKPOS) <> 0 then 2439 begin 2440 ScrollInfo.nTrackPos := Round(Adjustment^.Value); 2441 end; 2442 2443 Result := True; 2444end; 2445 2446function TGtk3WidgetSet.GetStockObject(Value: Integer): THandle; 2447begin 2448 Result := 0; 2449 2450 case Value of 2451 BLACK_BRUSH: // Black brush. 2452 Result := FStockBlackBrush; 2453 DKGRAY_BRUSH: // Dark gray brush. 2454 Result := FStockDKGrayBrush; 2455 GRAY_BRUSH: // Gray brush. 2456 Result := FStockGrayBrush; 2457 LTGRAY_BRUSH: // Light gray brush. 2458 Result := FStockLtGrayBrush; 2459 NULL_BRUSH: // Null brush (equivalent to HOLLOW_BRUSH). 2460 Result := FStockNullBrush; 2461 WHITE_BRUSH: // White brush. 2462 Result := FStockWhiteBrush; 2463 2464 BLACK_PEN: // Black pen. 2465 Result := FStockBlackPen; 2466 NULL_PEN: // Null pen. 2467 Result := FStockNullPen; 2468 WHITE_PEN: // White pen. 2469 Result := FStockWhitePen; 2470 2471 {System font. By default, Windows uses the system font to draw menus, 2472 dialog box controls, and text. In Windows versions 3.0 and later, 2473 the system font is a proportionally spaced font; earlier versions of 2474 Windows used a monospace system font.} 2475 DEFAULT_GUI_FONT, SYSTEM_FONT: 2476 begin 2477 2478 If FStockSystemFont <> 0 then 2479 begin 2480 DeleteObject(FStockSystemFont); 2481 FStockSystemFont := 0; 2482 end; 2483 2484 If FStockSystemFont = 0 then 2485 FStockSystemFont := CreateDefaultFont; 2486 Result := FStockSystemFont; 2487 end; 2488 end; 2489end; 2490 2491function TGtk3WidgetSet.GetSysColor(nIndex: Integer): DWORD; 2492begin 2493 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2494 writeln('TGtk3WidgetSet.GetSysColor WARNING: SOME SYSCOLORS ARE STILL HARDCODED nIndex=',nIndex); 2495 {$ENDIF} 2496 if (nIndex = COLOR_WINDOW) or (nIndex = COLOR_WINDOWTEXT) or 2497 (nIndex = COLOR_HIGHLIGHT) or (nIndex = COLOR_HIGHLIGHTTEXT) then 2498 GetStyleWidget(lgsMemo) 2499 else 2500 if (nIndex = COLOR_MENU) or (nIndex = COLOR_MENUHILIGHT) or 2501 (nIndex = COLOR_MENUTEXT) then 2502 begin 2503 GetStyleWidget(lgsMenu); 2504 GetStyleWidget(lgsMenuitem); 2505 end else 2506 if (nIndex = COLOR_MENUBAR) then 2507 GetStyleWidget(lgsMenuBar) 2508 else 2509 if (nIndex = COLOR_SCROLLBAR) then 2510 GetStyleWidget(lgsVerticalScrollbar) 2511 else 2512 if (nIndex = COLOR_BTNFACE) or (nIndex = COLOR_BTNTEXT) or 2513 (nIndex = COLOR_BTNSHADOW) or (nIndex = COLOR_BTNHIGHLIGHT) then 2514 GetStyleWidget(lgsButton) 2515 else 2516 if (nIndex = COLOR_BACKGROUND) or (nIndex = COLOR_FORM) then 2517 GetStyleWidget(lgsWindow); 2518 Result := SysColorMap[nIndex]; 2519end; 2520 2521function TGtk3WidgetSet.GetSysColorBrush(nIndex: Integer): HBrush; 2522begin 2523 if (nIndex < 0) or (nIndex > MAX_SYS_COLORS) then 2524 begin 2525 Result := 0; 2526 DebugLn(Format('ERROR: [TGtk3WidgetSet.GetSysColorBrush] Bad Value: %d. Valid Range between 0 and %d', [nIndex, MAX_SYS_COLORS])); 2527 end else 2528 begin 2529 Result := FSysColorBrushes[nIndex]; 2530 if Result = HBRUSH(-1) then 2531 begin 2532 InitSysColorBrushes; 2533 Result := FSysColorBrushes[nIndex]; 2534 if Result = HBRUSH(-1) then 2535 DebugLn('WARNING: GetSysColorBrush SysColorBrushes arent''t initialized properly....'); 2536 end; 2537 end; 2538end; 2539 2540function TGtk3WidgetSet.GetSystemMetrics(nIndex: Integer): Integer; 2541var 2542 auw: guint; 2543 auh: guint; 2544 ascreen: PGdkScreen; 2545 ARect: TGdkRectangle; 2546begin 2547 Result := 0; 2548 case nIndex of 2549 SM_CXCURSOR, 2550 SM_CYCURSOR: 2551 begin 2552 // Width and height of a cursor, in pixels. For win32 system cannot create cursors of other sizes. 2553 // For gtk this should be maximal cursor sizes 2554 gdk_display_get_maximal_cursor_size(gdk_display_get_default, @auw, @auh); 2555 if nIndex = SM_CXCURSOR then 2556 Result := auw // return width 2557 else 2558 Result := auh; // return height 2559 end; 2560 SM_CXDRAG: 2561 begin 2562 Result := 2; 2563 end; 2564 SM_CYDRAG: 2565 begin 2566 Result := 2; 2567 end; 2568 SM_CXEDGE: 2569 begin 2570 Result := 2; 2571 end; 2572 SM_CYEDGE: 2573 begin 2574 Result := 2; 2575 end; 2576 2577 SM_CXICON, 2578 SM_CYICON: 2579 // big icon size 2580 // gtk recommends sizes 16,32,48. optional: 64 and 128 2581 Result := 128; 2582 2583 SM_CXMAXIMIZED: 2584 begin 2585 ascreen := gdk_screen_get_default(); 2586 gdk_screen_get_monitor_workarea(ascreen, 0, @ARect); 2587 Result := ARect.width; 2588 end; 2589 SM_CYMAXIMIZED: 2590 begin 2591 ascreen := gdk_screen_get_default(); 2592 gdk_screen_get_monitor_workarea(ascreen, 0, @ARect); 2593 Result := ARect.height; 2594 end; 2595 2596 SM_CXFULLSCREEN, 2597 SM_CXSCREEN: 2598 begin 2599 ascreen := gdk_screen_get_default(); 2600 gdk_screen_get_monitor_geometry(ascreen, 0, @ARect); 2601 Result := ARect.width; 2602 end; 2603 SM_CXVIRTUALSCREEN: 2604 begin 2605 Result := gdk_Screen_Width; 2606 end; 2607 SM_CYFULLSCREEN, 2608 SM_CYSCREEN: 2609 begin 2610 ascreen := gdk_screen_get_default(); 2611 gdk_screen_get_monitor_geometry(ascreen, 0, @ARect); 2612 Result := ARect.height; 2613 end; 2614 SM_CYVIRTUALSCREEN: 2615 begin 2616 result := gdk_Screen_Height; 2617 end; 2618 SM_LCLHasFormAlphaBlend: 2619 Result := 1; 2620 end; 2621end; 2622 2623function TGtk3WidgetSet.GetTextColor(DC: HDC): TColorRef; 2624begin 2625 Result := CLR_INVALID; 2626 if IsValidDC(DC) then 2627 Result := TColorRef(TGtk3DeviceContext(DC).CurrentTextColor); 2628end; 2629 2630function TGtk3WidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; 2631 var Size: TSize): Boolean; 2632begin 2633 Result := False; 2634 if not IsValidDC(DC) then 2635 exit; 2636 if (Count <= 0) or (Str = nil) or (StrPas(Str) = '') then 2637 begin 2638 FillChar(Size, SizeOf(Size), 0); 2639 Exit; 2640 end; 2641 TGtk3DeviceContext(DC).CurrentFont.Layout^.set_text(Str, Count); 2642 TGtk3DeviceContext(DC).CurrentFont.Layout^.get_pixel_size(@Size.Cx, @Size.CY); 2643 // DebugLn('TGtk3WidgetSet.GetTextExtentPoint pixel size is ',dbgs(Size), 2644 // ' avgcharwidth ',dbgs(ACharWidth div PANGO_SCALE),' avgdigitwidth ',dbgs(ADigitWidth div PANGO_SCALE)); 2645 Result := True; 2646end; 2647 2648function TGtk3WidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; 2649const 2650 TestString: array[boolean] of string = ( 2651 // single byte char font 2652 '{ABCDEFGHIJKLMNOPQRSTUVWXYZXYZabcdefghijklmnopqrstuvwxyz|_}', 2653 // double byte char font 2654 #0'{'#0'A'#0'B'#0'C'#0'D'#0'E'#0'F'#0'G'#0'H'#0'I'#0'J'#0'K'#0'L'#0'M'#0'N' 2655 +#0'O'#0'P'#0'Q'#0'R'#0'S'#0'T'#0'U'#0'V'#0'W'#0'X'#0'Y'#0'Z'#0'X'#0'Y'#0'Z' 2656 +#0'a'#0'b'#0'c'#0'd'#0'e'#0'f'#0'g'#0'h'#0'i'#0'j'#0'k'#0'l'#0'm'#0'n'#0'o' 2657 +#0'p'#0'q'#0'r'#0's'#0't'#0'u'#0'v'#0'w'#0'x'#0'y'#0'z'#0'|'#0'_'#0'}' 2658 ); 2659var 2660 AFont: TGtk3Font; 2661 APangoMetrics: PPangoFontMetrics; 2662 aRect: TPangoRectangle; 2663 APangoWeight: TPangoWeight; 2664 AList: PPangoAttrList; 2665begin 2666 Result := False; 2667 if IsValidDC(DC) then 2668 begin 2669 //TODO add metrics to cache of font, so if we have valid metrics just return. 2670 //or create metrics when font is created (like qt uses) 2671 AFont := TGtk3DeviceContext(DC).CurrentFont; 2672 2673 APangoMetrics := pango_context_get_metrics(AFont.Layout^.get_context, 2674 AFont.Handle, AFont.Layout^.get_context^.get_language); 2675 if APangoMetrics = nil then 2676 begin 2677 DebugLn(['TGtk3WidgetSet.UpdateDCTextMetric WARNING: no pango metrics']); 2678 exit; 2679 end; 2680 FillChar(TM, SizeOf(TM), #0); 2681 2682 TM.tmAveCharWidth := Max(1, 2683 pango_font_metrics_get_approximate_char_width(APangoMetrics) 2684 div PANGO_SCALE); 2685 TM.tmAscent := APangoMetrics^.get_ascent div PANGO_SCALE; 2686 TM.tmDescent := APangoMetrics^.get_descent div PANGO_SCALE; 2687 2688 TM.tmHeight := TM.tmAscent + TM.tmDescent; 2689 2690 pango_layout_set_text(AFont.Layout, PChar(TestString[True]), 2691 length(PChar(TestString[True]))); 2692 pango_layout_get_extents(AFont.Layout, nil, @aRect); 2693 2694 // lBearing := 0; // PANGO_LBEARING(aRect) div PANGO_SCALE; 2695 // rBearing := 0; // PANGO_RBEARING(aRect) div PANGO_SCALE; 2696 2697 pango_layout_set_text(AFont.Layout, 'M', 1); 2698 pango_layout_get_pixel_size(AFont.Layout, @aRect.width, @aRect.height); 2699 TM.tmMaxCharWidth := Max(1,aRect.width); 2700 pango_layout_set_text(AFont.Layout, 'W', 1); 2701 pango_layout_get_pixel_size(AFont.Layout, @aRect.width, @aRect.height); 2702 TM.tmMaxCharWidth := Max(TM.tmMaxCharWidth,aRect.width); 2703 2704 APangoWeight := AFont.Handle^.get_weight; 2705 2706 if APangoWeight < PANGO_WEIGHT_THIN then 2707 APangoWeight := PANGO_WEIGHT_THIN; 2708 if APangoWeight > PANGO_WEIGHT_HEAVY then 2709 APangoWeight := PANGO_WEIGHT_HEAVY; 2710 2711 TM.tmWeight := APangoWeight; 2712 2713 TM.tmFirstChar := 'a'; 2714 TM.tmLastChar := 'z'; 2715 TM.tmDefaultChar := 'x'; 2716 TM.tmBreakChar := '?'; 2717 2718 TM.tmItalic := Ord(AFont.Handle^.get_style = PANGO_STYLE_ITALIC); 2719 AList := AFont.Layout^.get_attributes; 2720 if AList <> nil then 2721 begin 2722 AList^.unref; 2723 end; 2724 // APangoMetrics^.get_underline_position; 2725 // TM.tmUnderlined := 2726 // TM.tmStruckOut := 2727 2728 2729 pango_font_metrics_unref(APangoMetrics); 2730 Result := True; 2731 end; 2732end; 2733 2734function TGtk3WidgetSet.GetViewPortExtEx(DC: HDC; Size: PSize): Integer; 2735begin 2736 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2737 DebugLn('WARNING: TGtk3WidgetSet.GetViewportExtEx not implemented ...'); 2738 {$ENDIF} 2739 Result:=inherited GetViewPortExtEx(DC, Size); 2740end; 2741 2742function TGtk3WidgetSet.GetViewPortOrgEx(DC: HDC; P: PPoint): Integer; 2743begin 2744 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2745 DebugLn('WARNING: TGtk3WidgetSet.GetViewportOrgEx not implemented ...'); 2746 {$ENDIF} 2747 Result:=inherited GetViewPortOrgEx(DC, P); 2748end; 2749 2750function TGtk3WidgetSet.GetWindowExtEx(DC: HDC; Size: PSize): Integer; 2751begin 2752 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2753 DebugLn('WARNING: TGtk3WidgetSet.GetWindowExtEx not implemented ...'); 2754 {$ENDIF} 2755 Result:=inherited GetWindowExtEx(DC, Size); 2756end; 2757 2758function TGtk3WidgetSet.GetWindowLong(Handle: HWND; int: Integer): PtrInt; 2759begin 2760 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2761 DebugLn('WARNING: TGtk3WidgetSet.GetWindowLong not implemented ...'); 2762 {$ENDIF} 2763 Result:=inherited GetWindowLong(Handle, int); 2764end; 2765 2766function TGtk3WidgetSet.GetWindowOrgEx(dc: hdc; P: PPoint): Integer; 2767var 2768 Matrix: cairo_matrix_t; 2769 dx: Double; 2770 dy: Double; 2771begin 2772 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2773 // DebugLn('WARNING: TGtk3WidgetSet.GetWindowOrgEx not implemented ...'); 2774 {$ENDIF} 2775 Result := 0; 2776 if not IsValidDC(DC) and (P <> nil) then 2777 begin 2778 {$ifdef VerboseGtk3WinAPI} 2779 WriteLn('Trace: < [WinAPI GetWindowOrgEx] No valid DC or P is nil'); 2780 {$endif} 2781 exit; 2782 end; 2783 cairo_get_matrix(TGtk3DeviceContext(DC).Widget, @Matrix); 2784 dx := 0; 2785 dy := 0; 2786 cairo_matrix_transform_point(@Matrix, @dx, @dy); 2787 // DebugLn('GetWindowOrgEx POINT ',Format('dx %d dy %d',[-Trunc(Dx), -Trunc(Dy)])); 2788 if P <> nil then 2789 begin 2790 P^.X := -Trunc(DX)+TGtk3DeviceContext(DC).fncOrigin.X; 2791 P^.Y := -Trunc(DY)+TGtk3DeviceContext(DC).fncOrigin.Y; 2792 end; 2793 Result := 1; 2794end; 2795 2796function TGtk3WidgetSet.GetWindowRect(Handle: hwnd; var ARect: TRect): Integer; 2797var 2798 AWindow: PGdkWindow; 2799 x, y, w, h: gint; 2800 GRect: TGdkRectangle; 2801 Allocation: TGtkAllocation; 2802begin 2803 Result := 0; 2804 if Handle <> 0 then 2805 begin 2806 AWindow := TGtk3Widget(Handle).GetWindow; 2807 if AWindow <> nil then 2808 begin 2809 AWindow^.get_origin(@x, @y); 2810 w := AWindow^.get_width; 2811 h := AWindow^.get_height; 2812 AWindow^.get_frame_extents(@GRect); 2813 // R := RectFromGdkRect(GRect); 2814 ARect := Bounds(0, 0, GRect.width, GRect.Height); 2815 Result := 1; 2816 end else 2817 begin 2818 TGtk3Widget(Handle).Widget^.get_allocation(@Allocation); 2819 ARect := Bounds(Allocation.x, Allocation.y, Allocation.width, Allocation.height); 2820 end; 2821 end; 2822end; 2823 2824function TGtk3WidgetSet.GetWindowRelativePosition(Handle: hwnd; var Left, 2825 Top: integer): boolean; 2826var 2827 AWidget: TGtk3Widget; 2828 APos: TPoint; 2829begin 2830 if Handle = 0 then 2831 exit(False); 2832 AWidget := TGtk3Widget(Handle); 2833 Result := AWidget.GetPosition(APos); 2834end; 2835 2836function TGtk3WidgetSet.GetWindowSize(Handle: hwnd; var Width, Height: integer 2837 ): boolean; 2838begin 2839 Result := False; 2840 if Handle <> 0 then 2841 begin 2842 Width := TGtk3Widget(Handle).Widget^.get_allocated_width; 2843 Height := TGtk3Widget(Handle).Widget^.get_allocated_Height; 2844 Result := True; 2845 end; 2846end; 2847 2848procedure TGtk3WidgetSet.InitializeCriticalSection( 2849 var CritSection: TCriticalSection); 2850var 2851 ACritSec: System.PRTLCriticalSection; 2852begin 2853 New(ACritSec); 2854 System.InitCriticalSection(ACritSec^); 2855 CritSection:=TCriticalSection(ACritSec); 2856end; 2857 2858function TGtk3WidgetSet.InvalidateRect(aHandle: HWND; Rect: pRect; 2859 bErase: Boolean): Boolean; 2860begin 2861 Result := False; 2862 if AHandle <> 0 then 2863 begin 2864 TGtk3Widget(AHandle).Update(Rect); 2865 Result := True; 2866 end; 2867end; 2868 2869function TGtk3WidgetSet.InvalidateRgn(Handle: HWND; Rgn: HRGN; Erase: Boolean 2870 ): Boolean; 2871var 2872 R: TRect; 2873begin 2874 Result := False; // inherited InvalidateRgn(Handle, Rgn, Erase); 2875 if IsValidHandle(Handle) then 2876 begin 2877 if IsValidGDIObject(RGN) then 2878 begin 2879 gtk_widget_queue_draw_region(TGtk3Widget(Handle).GetContainerWidget, 2880 TGtk3Region(RGN).Handle) 2881 end else 2882 TGtk3Widget(Handle).Update(nil); 2883 //TODO: TGtk3Region must be implemented as Pcairo_region_t 2884 // GetRgnBox(Rgn, @R); 2885 // InvalidateRect(Handle, @R, True); 2886 Result := True; 2887 // gtk_widget_queue_draw_region(); 2888 end; 2889end; 2890 2891function TGtk3WidgetSet.IsIconic(handle: HWND): boolean; 2892begin 2893 Result := (handle <> 0) and TGtk3Widget(Handle).IsIconic; 2894end; 2895 2896function TGtk3WidgetSet.IsWindow(handle: HWND): boolean; 2897begin 2898 Result := (handle <> 0) and 2899 Gtk3IsWidget(TGtk3Widget(Handle).Widget); 2900end; 2901 2902function TGtk3WidgetSet.IsWindowEnabled(handle: HWND): boolean; 2903begin 2904 Result := (handle <> 0) and TGtk3Widget(Handle).Enabled and 2905 TGtk3Widget(Handle).Visible; 2906end; 2907 2908function TGtk3WidgetSet.IsWindowVisible(handle: HWND): boolean; 2909begin 2910 Result := (handle <> 0) and TGtk3Widget(Handle).Visible; 2911end; 2912 2913function TGtk3WidgetSet.IsZoomed(handle: HWND): boolean; 2914begin 2915 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2916 DebugLn('WARNING: TGtk3WidgetSet.IsZoomed not implemented ...'); 2917 {$ENDIF} 2918 Result:=inherited IsZoomed(handle); 2919end; 2920 2921procedure TGtk3WidgetSet.LeaveCriticalSection(var CritSection: TCriticalSection 2922 ); 2923var 2924 ACritSec: System.PRTLCriticalSection; 2925begin 2926 ACritSec:=System.PRTLCriticalSection(CritSection); 2927 System.LeaveCriticalsection(ACritSec^); 2928end; 2929 2930function TGtk3WidgetSet.LineTo(DC: HDC; X, Y: Integer): Boolean; 2931begin 2932 if not IsValidDC(DC) then 2933 exit(False); 2934 Result := TGtk3DeviceContext(DC).LineTo(X, Y); 2935end; 2936 2937function TGtk3WidgetSet.LPtoDP(DC: HDC; var Points; Count: Integer): BOOL; 2938var 2939 Matrix: cairo_matrix_t; 2940 cr: PCairo_t; 2941 P: PPoint; 2942 dx, dy: Double; 2943 Pt: TPoint; 2944begin 2945 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2946 // DebugLn('WARNING: TGtk3WidgetSet.LPtoDP not implemented ...'); 2947 {$ENDIF} 2948 Result := False; 2949 // inherited LPtoDP(DC, Points, Count); 2950 if not IsValidDC(DC) then 2951 exit; 2952 cr := TGtk3DeviceContext(DC).Widget; 2953 2954 P := @Points; 2955 while Count > 0 do 2956 begin 2957 Dec(Count); 2958 DX := P^.X; 2959 DY := P^.Y; 2960 // DebugLn('LPTODP INPUT ',Format('dx %2.2n dy %2.2n',[dx, dy])); 2961 //cairo_matrix_translate(@Matrix, Dx, Dy); 2962 //cairo_matrix_transform_point(@Matrix, @Dx, @Dy); 2963 cairo_user_to_device(cr,@dx,@dy); 2964 // DebugLn('LPTODP Output ',Format('dx %2.2n dy %2.2n',[dx, dy])); 2965 P^.X := Round(DX)-TGtk3DeviceContext(DC).fncOrigin.x; 2966 P^.Y := Round(DY)-TGtk3DeviceContext(DC).fncOrigin.y; 2967 Inc(P); 2968 end; 2969 Result:=true; 2970end; 2971 2972function MessageButtonClicked(Widget : PGtkWidget; data: gPointer) : GBoolean; cdecl; 2973begin 2974 //DebugLn('[MessageButtonClicked] ',dbgs(data),' ',dbgs(g_object_get_data(PGtkObject(Widget), 'modal_result'))); 2975 if PInteger(data)^ = 0 then 2976 PInteger(data)^:={%H-}PtrUInt(g_object_get_data(PGObject(Widget), 'modal_result')); 2977 Result:=false; 2978end; 2979 2980function MessageBoxClosed(Widget : PGtkWidget; {%H-}Event : PGdkEvent; 2981 data: gPointer) : GBoolean; cdecl; 2982var ModalResult : PtrUInt; 2983begin 2984 { We were requested by window manager to close } 2985 if PInteger(data)^ = 0 then begin 2986 ModalResult:= {%H-}PtrUInt(g_object_get_data(PGObject(Widget), 'modal_result')); 2987 { Don't allow to close if we don't have a default return value } 2988 Result:= (ModalResult = 0); 2989 if not Result then PInteger(data)^:= ModalResult 2990 else DebugLn('Do not close !!!'); 2991 end else Result:= false; 2992end; 2993 2994function TGtk3WidgetSet.MessageBox(hWnd: HWND; lpText, lpCaption: PChar; 2995 uType: Cardinal): integer; 2996var 2997 Dialog, ALabel : PGtkWidget; 2998 ButtonCount, DefButton, ADialogResult : Integer; 2999 DialogType : Cardinal; 3000 procedure CreateButton(const ALabel : PChar; const RetValue : integer); 3001 var AButton : PGtkWidget; 3002 begin 3003 AButton:= gtk_button_new_with_label(ALabel); 3004 Inc(ButtonCount); 3005 if ButtonCount = DefButton then begin 3006 gtk_window_set_focus(PGtkWindow(Dialog), AButton); 3007 end; 3008 { If there is the Cancel button, allow the dialog to close } 3009 if RetValue = IDCANCEL then begin 3010 g_object_set_data(PGObject(Dialog), 'modal_result', Pointer(IDCANCEL)); 3011 end; 3012 g_object_set_data(AButton, 'modal_result', 3013 {%H-}Pointer(PtrInt(RetValue))); 3014 g_signal_connect_data(AButton, 'clicked', 3015 TGCallback(@MessageButtonClicked), GPointer(@ADialogResult), nil, 0); 3016 gtk_container_add (PGtkContainer(PGtkDialog(Dialog)^.get_action_area), AButton); 3017 end; 3018 3019begin 3020 ButtonCount:= 0; 3021 { Determine which is the default button } 3022 DefButton:= ((uType and $00000300) shr 8) + 1; 3023 //DebugLn('Trace:Default button is ' + IntToStr(DefButton)); 3024 3025 ADialogResult:= 0; 3026 Dialog:= gtk_dialog_new; 3027 g_signal_connect_data(Dialog, 'delete-event', TGCallback(@MessageBoxClosed), @ADialogResult, nil, 0); 3028 gtk_window_set_default_size(PGtkWindow(Dialog), 100, 100); 3029 ALabel:= gtk_label_new(lpText); 3030 gtk_container_add (PGtkContainer(PGtkDialog(Dialog)^.get_content_area), ALabel); 3031 DialogType:= (uType and $0000000F); 3032 if DialogType = MB_OKCANCEL 3033 then begin 3034 CreateButton(PChar(rsMbOK), IDOK); 3035 CreateButton(PChar(rsMbCancel), IDCANCEL); 3036 end 3037 else begin 3038 if DialogType = MB_ABORTRETRYIGNORE 3039 then begin 3040 CreateButton(PChar(rsMbAbort), IDABORT); 3041 CreateButton(PChar(rsMbRetry), IDRETRY); 3042 CreateButton(PChar(rsMbIgnore), IDIGNORE); 3043 end 3044 else begin 3045 if DialogType = MB_YESNOCANCEL 3046 then begin 3047 CreateButton(PChar(rsMbYes), IDYES); 3048 CreateButton(PChar(rsMbNo), IDNO); 3049 CreateButton(PChar(rsMbCancel), IDCANCEL); 3050 end 3051 else begin 3052 if DialogType = MB_YESNO 3053 then begin 3054 CreateButton(PChar(rsMbYes), IDYES); 3055 CreateButton(PChar(rsMbNo), IDNO); 3056 end 3057 else begin 3058 if DialogType = MB_RETRYCANCEL 3059 then begin 3060 CreateButton(PChar(rsMbRetry), IDRETRY); 3061 CreateButton(PChar(rsMbCancel), IDCANCEL); 3062 end 3063 else begin 3064 { We have no buttons to show. Create the default of OK button } 3065 CreateButton(PChar(rsMbOK), IDOK); 3066 end; 3067 end; 3068 end; 3069 end; 3070 end; 3071 gtk_window_set_title(PGtkWindow(Dialog), lpCaption); 3072 gtk_window_set_position(PGtkWindow(Dialog), GTK_WIN_POS_CENTER); 3073 gtk_window_set_modal(PGtkWindow(Dialog), true); 3074 gtk_widget_show_all(Dialog); 3075 while ADialogResult = 0 do 3076 begin 3077 Application.HandleMessage; 3078 end; 3079 if Gtk3IsWidget(Dialog) then 3080 gtk_widget_destroy(Dialog); 3081 Result:= ADialogResult; 3082end; 3083 3084function TGtk3WidgetSet.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint 3085 ): Boolean; 3086begin 3087 if not IsValidDC(DC) then 3088 exit(False); 3089 Result := TGtk3DeviceContext(DC).MoveTo(X, Y, OldPoint); 3090end; 3091 3092function TGtk3WidgetSet.OffsetRgn(RGN: HRGN; nXOffset, nYOffset: Integer 3093 ): Integer; 3094begin 3095 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3096 DebugLn('WARNING: TGtk3WidgetSet.OffsetRgn not implemented ...'); 3097 {$ENDIF} 3098 Result:=inherited OffsetRgn(RGN, nXOffset, nYOffset); 3099end; 3100 3101function TGtk3WidgetSet.PaintRgn(DC: HDC; RGN: HRGN): Boolean; 3102begin 3103 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3104 DebugLn('WARNING: TGtk3WidgetSet.PaintRgn not implemented ...'); 3105 {$ENDIF} 3106 Result:=inherited PaintRgn(DC, RGN); 3107end; 3108 3109function TGtk3WidgetSet.PeekMessage(var lpMsg: TMsg; Handle: HWND; 3110 wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): Boolean; 3111begin 3112 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3113 DebugLn('WARNING: TGtk3WidgetSet.PeekMessage not implemented ...'); 3114 {$ENDIF} 3115 Result:=inherited PeekMessage(lpMsg, Handle, wMsgFilterMin, wMsgFilterMax, 3116 wRemoveMsg); 3117end; 3118 3119function TGtk3WidgetSet.PolyBezier(DC: HDC; Points: PPoint; NumPts: Integer; 3120 Filled, Continuous: boolean): boolean; 3121begin 3122 if not IsValidDC(DC) then 3123 exit(False); 3124 TGtk3DeviceContext(DC).drawPolyBezier(Points, NumPts, Filled, Continuous); 3125 Result:=True; 3126end; 3127 3128function TGtk3WidgetSet.Polygon(DC: HDC; Points: PPoint; NumPts: Integer; 3129 Winding: boolean): boolean; 3130begin 3131 if not IsValidDC(DC) then 3132 exit(False); 3133 if not Winding then // faster 3134 TGtk3DeviceContext(DC).drawPolygon(Points, NumPts, ord(CAIRO_FILL_RULE_EVEN_ODD)) 3135 else 3136 TGtk3DeviceContext(DC).drawPolygon(Points, NumPts, Ord(CAIRO_FILL_RULE_WINDING)); 3137 Result:= True; 3138end; 3139 3140function TGtk3WidgetSet.Polyline(DC: HDC; Points: PPoint; NumPts: Integer 3141 ): boolean; 3142begin 3143 if not IsValidDC(DC) then 3144 exit(False); 3145 TGtk3DeviceContext(DC).drawPolyLine(Points, NumPts); 3146 Result:=True; 3147end; 3148 3149 3150type 3151 PCustomGtk3Message = ^TCustomGtk3Message; 3152 TCustomGtk3Message = record 3153 Handle: HWND; 3154 Msg: Cardinal; 3155 AwParam: WParam; 3156 AlParam: LParam; 3157 Result: LRESULT; 3158 end; 3159 3160function Gtk3ProcessPostMessage(user_data: gpointer): gboolean; cdecl; 3161var 3162 AMsg: TCustomGtk3Message; 3163 AMessage: TLMessage; 3164begin 3165 Result := False; 3166 if user_data <> nil then 3167 begin 3168 AMsg := TCustomGtk3Message(user_data^); 3169 if AMsg.Handle <> 0 then 3170 begin 3171 FillChar(AMessage, SizeOf(AMessage), #0); 3172 AMessage.Msg := AMsg.Msg; 3173 AMessage.WParam := AMsg.AwParam; 3174 AMessage.LParam := AMsg.AlParam; 3175 TGtk3Widget(AMsg.Handle).DeliverMessage(AMessage); 3176 end; 3177 g_idle_remove_by_data(user_data); 3178 Freemem(user_data); 3179 user_data := nil; 3180 Result := True; 3181 end; 3182end; 3183 3184function TGtk3WidgetSet.PostMessage(Handle: HWND; Msg: Cardinal; 3185 wParam: WParam; lParam: LParam): Boolean; 3186var 3187 AEvent: PCustomGtk3Message; 3188begin 3189 Result := False; 3190 if Handle <> 0 then 3191 begin 3192 AEvent := GetMem(SizeOf(TCustomGtk3Message)); 3193 AEvent^.Handle := Handle; 3194 AEvent^.Msg := Msg; 3195 AEvent^.AwParam := wParam; 3196 AEvent^.AlParam := lParam; 3197 AEvent^.Result := 0; 3198 g_idle_add(@Gtk3ProcessPostMessage, AEvent); 3199 if GetCurrentThreadId <> MainThreadID then 3200 begin 3201 // writeln('TGtk3WidgetSet.PostMessage from different thread !'); 3202 g_main_context_wakeup(g_main_context_default); 3203 end; 3204 Result := True; 3205 end; 3206end; 3207 3208function TGtk3WidgetSet.PtInRegion(RGN: HRGN; X, Y: Integer): Boolean; 3209begin 3210 Result := False; 3211 if IsValidGDIObject(RGN) then 3212 Result := TGtk3Region(RGN).ContainsPoint(Point(X, Y)); 3213end; 3214 3215function TGtk3WidgetSet.RadialArc(DC: HDC; left, top, right, bottom, sx, sy, 3216 ex, ey: Integer): Boolean; 3217begin 3218 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3219 DebugLn('WARNING: TGtk3WidgetSet.RadialArc not implemented ...'); 3220 {$ENDIF} 3221 Result:=inherited RadialArc(DC, left, top, right, bottom, sx, sy, ex, ey); 3222end; 3223 3224function TGtk3WidgetSet.RadialChord(DC: HDC; x1, y1, x2, y2, sx, sy, ex, 3225 ey: Integer): Boolean; 3226begin 3227 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3228 DebugLn('WARNING: TGtk3WidgetSet.RadialChord not implemented ...'); 3229 {$ENDIF} 3230 Result:=inherited RadialChord(DC, x1, y1, x2, y2, sx, sy, ex, ey); 3231end; 3232 3233function TGtk3WidgetSet.RealizePalette(DC: HDC): Cardinal; 3234begin 3235 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3236 DebugLn('WARNING: TGtk3WidgetSet.RealizePalette not implemented ...'); 3237 {$ENDIF} 3238 Result := inherited RealizePalette(DC); 3239end; 3240 3241function TGtk3WidgetSet.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean; 3242var 3243 R: TRect; 3244begin 3245 if not IsValidDC(DC) then 3246 exit(False); 3247 R := NormalizeRect(Rect(X1, Y1, X2, Y2)); 3248 if IsRectEmpty(R) then Exit(True); 3249 with R do 3250 TGtk3DeviceContext(DC).drawRect(Left, Top, Right - Left, Bottom - Top, false); 3251 Result := True; 3252end; 3253 3254function TGtk3WidgetSet.RectInRegion(RGN: HRGN; ARect: TRect): Boolean; 3255begin 3256 Result := False; 3257 if IsValidGDIObject(RGN) then 3258 Result := TGtk3Region(Rgn).ContainsRect(ARect); 3259end; 3260 3261function TGtk3WidgetSet.RectVisible(dc: hdc; const ARect: TRect): Boolean; 3262var 3263 ACairoRegion: Pcairo_region_t; 3264 ACairoRect: Tcairo_rectangle_int_t; 3265begin 3266 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3267 // DebugLn('WARNING: TGtk3WidgetSet.RectVisible not implemented ...'); 3268 {$ENDIF} 3269 Result := False; 3270 if not IsValidDC(DC) then 3271 exit; 3272 if (TGtk3DeviceContext(DC).Parent <> nil) and 3273 Gtk3IsGdkWindow(TGtk3DeviceContext(DC).Parent^.window) then 3274 begin 3275 if not gdk_window_is_visible(TGtk3DeviceContext(DC).Parent^.window) then 3276 exit; 3277 ACairoRegion := gdk_window_get_visible_region(TGtk3DeviceContext(DC).Parent^.window); 3278 end else 3279 ACairoRegion := gdk_window_get_visible_region(gdk_get_default_root_window); 3280 ACairoRect.x := ARect.Left; 3281 ACairoRect.y := ARect.Top; 3282 ACairoRect.width := ARect.Right - ARect.Left; 3283 ACairoRect.height := ARect.Bottom - ARect.Top; 3284 Result := cairo_region_contains_rectangle(ACairoRegion, @ACairoRect) <> CAIRO_REGION_OVERLAP_OUT; 3285end; 3286 3287function TGtk3WidgetSet.RegroupMenuItem(hndMenu: HMENU; GroupIndex: integer 3288 ): Boolean; 3289begin 3290 Result := False; 3291 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3292 DebugLn('WARNING: TGtk3WidgetSet.RegroupMenuItem not implemented ...'); 3293 {$ENDIF} 3294 // inherited RegroupMenuItem(hndMenu, GroupIndex); 3295end; 3296 3297function TGtk3WidgetSet.ReleaseCapture: Boolean; 3298var 3299 AWidget: TGtk3Widget; 3300begin 3301 {$IFDEF VerboseGtk3WinApi} 3302 DebugLn('TGtk3WidgetSet.ReleaseCapture'); 3303 {$ENDIF} 3304 AWidget := TGtk3Widget(GetCapture); 3305 Result := AWidget <> nil; 3306 if Result then 3307 begin 3308 if AWidget.GetContainerWidget^.has_grab then 3309 gtk_grab_remove(AWidget.GetContainerWidget) 3310 else 3311 if AWidget.Widget^.has_grab then 3312 gtk_grab_remove(AWidget.Widget); 3313 end; 3314end; 3315 3316function TGtk3WidgetSet.ReleaseDC(hWnd: HWND; DC: HDC): Integer; 3317begin 3318 Result := 0; 3319 if IsValidDC(DC) then 3320 begin 3321 if TGtk3DeviceContext(DC).CanRelease then 3322 TGtk3DeviceContext(DC).Free; 3323 Result := 1; 3324 end; 3325end; 3326 3327function TGtk3WidgetSet.RemoveProp(Handle: hwnd; Str: PChar): THandle; 3328begin 3329 Result := 0; 3330 if Handle = 0 then 3331 exit; 3332 if Gtk3IsObject(TGtk3Widget(Handle).Widget) then 3333 g_object_set_data(TGtk3Widget(Handle).Widget, Str, nil); 3334 if TGtk3Widget(Handle).GetContainerWidget <> TGtk3Widget(Handle).Widget then 3335 begin 3336 if Gtk3IsObject(TGtk3Widget(Handle).GetContainerWidget) then 3337 g_object_set_data(TGtk3Widget(Handle).GetContainerWidget, Str, nil); 3338 end; 3339 Result := 1; 3340end; 3341 3342function TGtk3WidgetSet.RestoreDC(DC: HDC; SavedDC: Integer): Boolean; 3343begin 3344 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3345 // DebugLn('WARNING: TGtk3WidgetSet.RestoreDC not implemented ...'); 3346 {$ENDIF} 3347 Result := False; 3348 if not IsValidDC(DC) then 3349 exit; 3350 cairo_restore(TGtk3DeviceContext(DC).Widget); 3351 Result := True; 3352end; 3353 3354function TGtk3WidgetSet.RoundRect(DC: hDC; X1, Y1, X2, Y2: Integer; RX, 3355 RY: Integer): Boolean; 3356begin 3357 Result := False; 3358 if not IsValidDC(DC) then 3359 exit; 3360 Result := TGtk3DeviceContext(DC).RoundRect(X1, Y1, X2, Y2, RX, RY); 3361end; 3362 3363function TGtk3WidgetSet.SaveDC(DC: HDC): Integer; 3364begin 3365 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3366 // DebugLn('WARNING: TGtk3WidgetSet.SaveDC not implemented ...'); 3367 {$ENDIF} 3368 Result := 0; 3369 if not IsValidDC(DC) then 3370 exit; 3371 cairo_save(TGtk3DeviceContext(DC).Widget); 3372 Result := 1; 3373end; 3374 3375function TGtk3WidgetSet.ScreenToClient(Handle: HWND; var P: TPoint): Integer; 3376var 3377 AWidget: TGtk3Widget; 3378 AGtkWidget: PGtkWidget; 3379 AWindow: PGdkWindow; 3380 X,Y: Integer; 3381 Allocation: TGtkAllocation; 3382begin 3383 Result := -1; 3384 X := 0; 3385 Y := 0; 3386 {$ifdef VerboseGtk3WinApi} 3387 DebugLn('Trace:> [TGtk3WidgetSet.ScreenToClient] ',dbgs(P)); 3388 {$endif} 3389 if not IsValidHandle(Handle) then 3390 exit; 3391 3392 AWidget := TGtk3Widget(Handle); 3393 AGtkWidget := TGtk3Widget(Handle).GetContainerWidget; 3394 if Assigned(AGtkWidget) and Gtk3IsGdkWindow(AGtkWidget^.window) then 3395 begin 3396 AWindow := AGtkWidget^.window; 3397 PGdkWindow(AWindow)^.get_origin(@X, @Y); 3398 AGtkWidget^.get_allocation(@Allocation); 3399 if not AGtkWidget^.get_has_window and (AGtkWidget^.get_parent <> nil) then 3400 begin 3401 AGtkWidget^.get_allocation(@Allocation); 3402 P.X := P.X - X - Allocation.x; 3403 P.Y := P.Y - Y - Allocation.y; 3404 exit; 3405 end; 3406 end else 3407 if Gtk3IsGdkWindow(AWidget.Widget^.window) then 3408 begin 3409 AWindow := AWidget.Widget^.window; 3410 PGdkWindow(AWindow)^.get_origin(@X, @Y); 3411 end else 3412 begin 3413 AWidget.Widget^.get_allocation(@Allocation); 3414 P.X := P.X - X - Allocation.x; 3415 P.Y := P.Y - Y - Allocation.y; 3416 exit; 3417 end; 3418 dec(P.X, X); 3419 dec(P.Y, Y); 3420end; 3421 3422function TGtk3WidgetSet.ScrollWindowEx(hWnd: HWND; dx, dy: Integer; prcScroll, 3423 prcClip: PRect; hrgnUpdate: HRGN; prcUpdate: PRect; flags: UINT): Boolean; 3424begin 3425 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3426 DebugLn('WARNING: TGtk3WidgetSet.ScrollWindowEx not implemented ...'); 3427 {$ENDIF} 3428 Result:=inherited ScrollWindowEx(hWnd, dx, dy, prcScroll, prcClip, 3429 hrgnUpdate, prcUpdate, flags); 3430end; 3431 3432function TGtk3WidgetSet.SelectClipRGN(DC: hDC; RGN: HRGN): Longint; 3433begin 3434 Result := 0; 3435 if IsValidDC(DC) then 3436 begin 3437 if IsValidGDIObject(RGN) then 3438 Result := TGtk3DeviceContext(DC).setClipRegion(TGtk3Region(RGN)) 3439 else 3440 Result := TGtk3DeviceContext(DC).ResetClip; 3441 end; 3442end; 3443 3444function TGtk3WidgetSet.SelectObject(DC: HDC; GDIObj: HGDIOBJ): HGDIOBJ; 3445begin 3446 Result := 0; 3447 if not IsValidDC(DC) then 3448 exit; 3449 if IsValidGDIObject(GDIObj) then 3450 begin 3451 if TObject(GDIObj) is TGtk3Pen then 3452 begin 3453 // DebugLn('TGtk3WidgetSet.SelectObject PEN '); 3454 Result := HGDIOBJ(TGtk3DeviceContext(DC).CurrentPen); 3455 TGtk3DeviceContext(DC).SetCurrentPen(TGtk3Pen(GDIObj)); 3456 end else 3457 if TObject(GDIObj) is TGtk3Brush then 3458 begin 3459 Result := HGDIOBJ(TGtk3DeviceContext(DC).CurrentBrush); 3460 // DebugLn('TGtk3WidgetSet.SelectObject BRUSH ',dbgHex(Result),' ',TimeToStr(Now())); 3461 TGtk3DeviceContext(DC).SetCurrentBrush(TGtk3Brush(GDIObj)); 3462 end else 3463 if TObject(GDIObj) is TGtk3Font then 3464 begin 3465 Result := HGDIOBJ(TGtk3DeviceContext(DC).CurrentFont); 3466 TGtk3DeviceContext(DC).SetCurrentFont(TGtk3Font(GDIObj)); 3467 // DebugLn('TGtk3WidgetSet.SelectObject Font '); 3468 end else 3469 if TObject(GDIObj) is TGtk3Region then 3470 begin 3471 Debugln('WARNING: TGtk3WidgetSet.SelectObject missing result for TGtk3Region.'); 3472 Result := 0; 3473 SelectClipRGN(DC, GdiObj); 3474 end else 3475 if TObject(GDIObj) is TGtk3Image then 3476 begin 3477 // Debugln('WARNING: TGtk3WidgetSet.SelectObject missing result for TGtk3Image.'); 3478 Result := HGDIOBJ(TGtk3DeviceContext(DC).CurrentImage); 3479 // TGtk3DeviceContext(DC).SetCurrentImage(TGtk3Image(GdiObj)); 3480 TGtk3DeviceContext(DC).SetImage(TGtk3Image(GdiObj)); 3481 end; 3482 end; 3483end; 3484 3485function TGtk3WidgetSet.SelectPalette(DC: HDC; Palette: HPALETTE; 3486 ForceBackground: Boolean): HPALETTE; 3487begin 3488 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3489 DebugLn('WARNING: TGtk3WidgetSet.SelectPalette not implemented ...'); 3490 {$ENDIF} 3491 Result := inherited SelectPalette(DC, Palette, ForceBackground); 3492end; 3493 3494function TGtk3WidgetSet.SendMessage(HandleWnd: HWND; Msg: Cardinal; 3495 wParam: WParam; lParam: LParam): LResult; 3496begin 3497 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3498 DebugLn('WARNING: TGtk3WidgetSet.SendMessage not implemented ...'); 3499 {$ENDIF} 3500 Result := inherited SendMessage(HandleWnd, Msg, wParam, lParam); 3501end; 3502 3503function TGtk3WidgetSet.SetActiveWindow(Handle: HWND): HWND; 3504begin 3505 Result := GetActiveWindow; 3506 if Handle <> 0 then 3507 begin 3508 if wtWindow in TGtk3Widget(Handle).WidgetType then 3509 PGtkWindow(TGtk3Window(Handle).Widget)^.present; 3510 end; 3511end; 3512 3513function TGtk3WidgetSet.SetBkColor(DC: HDC; Color: TColorRef): TColorRef; 3514begin 3515 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3516 // DebugLn('WARNING: TGtk3WidgetSet.SetBkColor not implemented ...'); 3517 {$ENDIF} 3518 Result := clNone; 3519 if not IsValidDC(DC) then 3520 exit; 3521 Result := TGtk3DeviceContext(DC).CurrentBrush.Color; 3522 TGtk3DeviceContext(DC).CurrentBrush.Color := TColor(ColorToRGB(TColor(Color))); 3523end; 3524 3525function TGtk3WidgetSet.SetBkMode(DC: HDC; bkMode: Integer): Integer; 3526begin 3527 {.$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3528 // DebugLn('WARNING: TGtk3WidgetSet.SetBkMode not implemented ...', dbgs(BkMode)); 3529 {.$ENDIF} 3530 Result := 0; 3531 if not IsValidDC(DC) then 3532 exit; 3533 Result := TGtk3DeviceContext(DC).BkMode; 3534 TGtk3DeviceContext(DC).BkMode := bkMode; 3535 // if cairo_pattern_get_type(cairo_get_source(TGtk3DeviceContext(DC).Widget)) = CAIRO_PATTERN_TYPE_SURFACE then 3536 // Result := TRANSPARENT; 3537 // we must use TGtk3Brush.Handle = Pcairo_pattern_t 3538 // cairo_pattern_get_type(nil).CAIRO_PATTERN_TYPE_SOLID; 3539 // cairo_get_source(); 3540end; 3541 3542function TGtk3WidgetSet.SetCapture(AHandle: HWND): HWND; 3543var 3544 Message: TLMessage; 3545begin 3546 {$IFDEF VerboseGtk3WinApi} 3547 DebugLn('TGtk3WidgetSet.SetCapture'); 3548 {$ENDIF} 3549 Result := GetCapture; 3550 if Result <> AHandle then 3551 begin 3552 if Result <> 0 then 3553 ReleaseCapture; 3554 if IsValidHandle(AHandle) then 3555 begin 3556 TGtk3Widget(AHandle).SetCapture; 3557 if (Result <> 0) then 3558 begin 3559 Message.Msg := 0; 3560 FillChar(Message, SizeOf(Message), 0); 3561 Message.msg := LM_CAPTURECHANGED; 3562 Message.wParam := 0; 3563 Message.lParam := PtrInt(Result); 3564 LCLMessageGlue.DeliverMessage(TGtk3Widget(AHandle).LCLObject, Message); 3565 end; 3566 end; 3567 end; 3568end; 3569 3570function TGtk3WidgetSet.SetCaretPos(X, Y: Integer): Boolean; 3571begin 3572 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3573 DebugLn('WARNING: TGtk3WidgetSet.SetCaretPos not implemented ...'); 3574 {$ENDIF} 3575 Result:=inherited SetCaretPos(X, Y); 3576end; 3577 3578function TGtk3WidgetSet.SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean; 3579begin 3580 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3581 DebugLn('WARNING: TGtk3WidgetSet.SetCaretPosEx not implemented ...'); 3582 {$ENDIF} 3583 Result:=inherited SetCaretPosEx(Handle, X, Y); 3584end; 3585 3586function TGtk3WidgetSet.SetCaretRespondToFocus(handle: HWND; 3587 ShowHideOnFocus: boolean): Boolean; 3588begin 3589 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3590 DebugLn('WARNING: TGtk3WidgetSet.SetCaretRespondToFocus not implemented ...'); 3591 {$ENDIF} 3592 Result:=inherited SetCaretRespondToFocus(handle, ShowHideOnFocus); 3593end; 3594 3595function TGtk3WidgetSet.SetCursor(ACursor: HCURSOR): HCURSOR; 3596begin 3597 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3598 // DebugLn('WARNING: TGtk3WidgetSet.SetCursor not implemented ...'); 3599 {$ENDIF} 3600 Result := FGlobalCursor; 3601 if ACursor = FGlobalCursor then Exit; 3602 if ACursor = Screen.Cursors[crDefault] 3603 then SetGlobalCursor(0) 3604 else SetGlobalCursor(ACursor); 3605 FGlobalCursor := ACursor; 3606end; 3607 3608function TGtk3WidgetSet.SetCursorPos(X, Y: Integer): Boolean; 3609var 3610 ADeviceManager: PGdkDeviceManager; 3611 APointer: PGdkDevice; 3612begin 3613 ADeviceManager := gdk_display_get_device_manager(gdk_display_get_default); 3614 APointer := gdk_device_manager_get_client_pointer(ADeviceManager); 3615 // howto get what screen we are querying on ? 3616 // gdk_display_get_screen(gdk_display_get_default, 0); 3617 gdk_device_warp(APointer, gdk_screen_get_default, X, Y); 3618 Result := True; 3619end; 3620 3621function TGtk3WidgetSet.SetFocus(hWnd: HWND): HWND; 3622begin 3623 Result := GetFocus; 3624 if hWnd <> 0 then 3625 begin 3626 {$IFDEF GTK3DEBUGFOCUS} 3627 if Result <> 0 then 3628 DebugLn('TGtk3WidgetSet.SetFocus: ',dbgsName(TGtk3Widget(HWND).LCLObject),' oldFocus ',dbgsName(TGtk3Widget(Result).LCLObject)) 3629 else 3630 DebugLn('TGtk3WidgetSet.SetFocus: ',dbgsName(TGtk3Widget(HWND).LCLObject),' oldFocus 0'); 3631 {$ENDIF} 3632 TGtk3Widget(HWND).setFocus; 3633 end; 3634end; 3635 3636function TGtk3WidgetSet.SetForegroundWindow(hWnd: HWND): boolean; 3637var 3638 AWindow: TGtk3Window; 3639begin 3640 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3641 // DebugLn('WARNING: TGtk3WidgetSet.SetForegroundWindow not implemented ...'); 3642 {$ENDIF} 3643 if not IsValidHandle(HWnd) then 3644 exit(False); 3645 Result := wtWindow in TGtk3Widget(HWND).WidgetType; 3646 if Result then 3647 begin 3648 AWindow := TGtk3Window(HWND); 3649 if not AWindow.Visible then 3650 exit(False); 3651 // DebugLn('TGtk3WidgetSet.SetForegroundWindow ',dbgsName(AWindow.LCLObject)); 3652 AWindow.Activate; 3653 Result := True; 3654 end; 3655end; 3656 3657function TGtk3WidgetSet.SetMapMode(DC: HDC; fnMapMode: Integer): Integer; 3658begin 3659 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3660 DebugLn('WARNING: TGtk3WidgetSet.SetMapMode not implemented ...'); 3661 {$ENDIF} 3662 Result:=inherited SetMapMode(DC, fnMapMode); 3663end; 3664 3665function TGtk3WidgetSet.SetParent(hWndChild: HWND; hWndParent: HWND): HWND; 3666begin 3667 Result := HWND(TGtk3Widget(hWndChild).getParent); 3668 TGtk3Widget(hWndChild).SetParent(TGtk3Widget(hWndParent),0,0) 3669end; 3670 3671function TGtk3WidgetSet.SetProp(Handle: hwnd; Str: PChar; Data: Pointer 3672 ): Boolean; 3673begin 3674 if Handle = 0 then 3675 exit(False); 3676 if Gtk3IsObject(TGtk3Widget(Handle).Widget) then 3677 g_object_set_data(TGtk3Widget(Handle).Widget, Str, Data); 3678 if TGtk3Widget(Handle).GetContainerWidget <> TGtk3Widget(Handle).Widget then 3679 begin 3680 if Gtk3IsObject(TGtk3Widget(Handle).GetContainerWidget) then 3681 g_object_set_data(TGtk3Widget(Handle).GetContainerWidget, Str, Data); 3682 end; 3683 Result := True; 3684end; 3685 3686function TGtk3WidgetSet.SetRectRgn(aRGN: HRGN; X1, Y1, X2, Y2: Integer 3687 ): Boolean; 3688begin 3689 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3690 DebugLn('WARNING: TGtk3WidgetSet.SetRectRgn not implemented ...'); 3691 {$ENDIF} 3692 Result:=inherited SetRectRgn(aRGN, X1, Y1, X2, Y2); 3693end; 3694 3695function TGtk3WidgetSet.SetROP2(DC: HDC; Mode: Integer): Integer; 3696begin 3697 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3698 DebugLn('WARNING: TGtk3WidgetSet.SetROP2 not implemented ...'); 3699 {$ENDIF} 3700 Result:=inherited SetROP2(DC, Mode); 3701end; 3702 3703function TGtk3WidgetSet.SetScrollInfo(Handle: HWND; SBStyle: Integer; 3704 ScrollInfo: TScrollInfo; bRedraw: Boolean): Integer; 3705 3706 (* 3707 3708 procedure SetRangeUpdatePolicy(Range: PGtkRange); 3709 var 3710 UpdPolicy: TGTKUpdateType; 3711 begin 3712 case ScrollInfo.nTrackPos of 3713 SB_POLICY_DISCONTINUOUS: UpdPolicy := GTK_UPDATE_DISCONTINUOUS; 3714 SB_POLICY_DELAYED: UpdPolicy := GTK_UPDATE_DELAYED; 3715 else 3716 UpdPolicy := GTK_UPDATE_CONTINUOUS; 3717 end; 3718 !!! update policy for gtkRange does not exist anymore in gtk3 3719 so we must mimic that by using events. !!! 3720 gtk_range_set_update_policy(Range, UpdPolicy); 3721 end; 3722 procedure SetScrolledWindowUpdatePolicy(ScrolledWindow:PGTKScrolledWindow); 3723 var 3724 Range: PGtkRange; 3725 begin 3726 case SBStyle of 3727 SB_VERT: Range := PGtkRange(ScrolledWindow^.vscrollbar); 3728 SB_HORZ: Range := PGtkRange(ScrolledWindow^.hscrollbar); 3729 else exit; 3730 end; 3731 SetRangeUpdatePolicy(Range); 3732 end; 3733 *) 3734 3735const 3736 POLICY: array[BOOLEAN] of TGTKPolicyType = (2, 0); // GTK_POLICY_NEVER, GTK_POLICY_ALWAYS); 3737 3738var 3739 Adjustment: PGtkAdjustment; 3740 AWidget: TGtk3Widget; 3741 ARange: PGtkRange; 3742 AScrollWin: PGtkScrolledWindow; 3743 IsScrollbarVis: Boolean; 3744begin 3745 Result := 0; 3746 if not IsValidHandle(Handle) then 3747 exit; 3748 3749 AWidget := TGtk3Widget(Handle); 3750 3751 Adjustment := nil; 3752 ARange := nil; 3753 AScrollWin := nil; 3754 3755 if wtScrollBar in AWidget.WidgetType then 3756 begin 3757 ARange := PGtkRange(AWidget.Widget); 3758 Adjustment := ARange^.adjustment; 3759 end else 3760 if wtScrollingWin in AWidget.WidgetType then 3761 begin 3762 AScrollWin := TGtk3ScrollableWin(Handle).GetScrolledWindow; 3763 if AScrollWin = nil then 3764 exit; 3765 if not Gtk3IsScrolledWindow(AScrollWin) then 3766 begin 3767 DebugLn('ERROR: TGtk3WidgetSet.SetScrollInfo: Wrong class extracted for scrollwin ',dbgsName(TGtk3Widget(Handle).LCLObject)); 3768 AScrollWin := nil; 3769 end; 3770 end; 3771 3772 case SBStyle of 3773 SB_Horz: 3774 begin 3775 if not Assigned(Adjustment) and Assigned(AScrollWin) then 3776 Adjustment := AScrollWin^.get_hadjustment; 3777 end; 3778 SB_Vert: 3779 begin 3780 if not Assigned(Adjustment) and Assigned(AScrollWin) then 3781 Adjustment := AScrollWin^.get_vadjustment; 3782 end; 3783 SB_CTL: 3784 begin 3785 DebugLn('TGtk3WidgetSet.SetScrollInfo SB_CTL error: not implemented ', 3786 dbgsName(AWidget.LCLObject)); 3787 end; 3788 SB_BOTH: 3789 begin 3790 DebugLn('TGtk3WidgetSet.SetScrollInfo SB_BOTH error: not implemented ', 3791 dbgsName(AWidget.LCLObject)); 3792 end; 3793 end; 3794 3795 if Adjustment = nil then 3796 begin 3797 DebugLn('TGtk3WidgetSet.SetScrollInfo error: cannot get PGtkAdjustment from ', 3798 dbgsName(AWidget.LCLObject)); 3799 exit; 3800 end; 3801 3802 if (ScrollInfo.fMask and SIF_RANGE) <> 0 then 3803 begin 3804 Adjustment^.lower := ScrollInfo.nMin; 3805 Adjustment^.upper := ScrollInfo.nMax; 3806 end; 3807 if (ScrollInfo.fMask and SIF_PAGE) <> 0 then 3808 begin 3809 // 0 <= nPage <= nMax-nMin+1 3810 Adjustment^.page_size := ScrollInfo.nPage; 3811 Adjustment^.page_size := Min(Max(Adjustment^.page_size,0), 3812 Adjustment^.upper-Adjustment^.lower+1); 3813 Adjustment^.page_increment := (Adjustment^.page_size/6)+1; 3814 end; 3815 if (ScrollInfo.fMask and SIF_POS) <> 0 then 3816 begin 3817 // nMin <= nPos <= nMax - Max(nPage-1,0) 3818 Adjustment^.value := ScrollInfo.nPos; 3819 Adjustment^.value := Max(Adjustment^.value,Adjustment^.lower); 3820 Adjustment^.value := Min(Adjustment^.value, 3821 Adjustment^.upper-Max(Adjustment^.page_size-1,0)); 3822 end; 3823 3824 // check if scrollbar should be hidden 3825 IsScrollbarVis := True; 3826 if ((ScrollInfo.fMask and (SIF_RANGE or SIF_PAGE)) <> 0) and 3827 ((SBStyle=SB_HORZ) or (SBStyle=SB_VERT)) then 3828 begin 3829 if (Adjustment^.lower >= (Adjustment^.upper-Max(adjustment^.page_size-1,0))) 3830 then begin 3831 if (ScrollInfo.fMask and SIF_DISABLENOSCROLL) = 0 then 3832 IsScrollbarVis := False 3833 else 3834 ;// scrollbar should look disabled (no thumbbar and grayed appearance) 3835 // maybe not possible in gtk 3836 end; 3837 end; 3838 if bRedraw then 3839 begin 3840 if (AScrollWin <> nil) then 3841 begin 3842 // DebugLn('Setting scrollstyle of ',dbgsName(AWidget.LCLObject)); 3843 if SBStyle = SB_HORZ then 3844 TGtk3ScrollableWin(AWidget).HScrollBarPolicy := POLICY[IsScrollbarVis] 3845 else 3846 if SBStyle = SB_VERT then 3847 TGtk3ScrollableWin(AWidget).VScrollBarPolicy := POLICY[IsScrollbarVis]; 3848 end else 3849 AWidget.Update(nil); 3850 3851 Adjustment^.changed; 3852 3853 end; 3854 Result := Round(Adjustment^.value); 3855end; 3856 3857function TGtk3WidgetSet.SetSysColors(cElements: Integer; const lpaElements; 3858 const lpaRgbValues): Boolean; 3859begin 3860 Result:=inherited SetSysColors(cElements, lpaElements, lpaRgbValues); 3861end; 3862 3863function TGtk3WidgetSet.SetTextCharacterExtra(DC: hdc; nCharExtra: Integer 3864 ): Integer; 3865begin 3866 Result:=inherited SetTextCharacterExtra(DC, nCharExtra); 3867end; 3868 3869function TGtk3WidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef; 3870begin 3871 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3872 // DebugLn('WARNING: TGtk3WidgetSet.SetTextColor not implemented ...'); 3873 {$ENDIF} 3874 Result := CLR_INVALID; 3875 if IsValidDC(DC) then 3876 begin 3877 Result := TGtk3DeviceContext(DC).CurrentTextColor; 3878 TGtk3DeviceContext(DC).CurrentTextColor := Color; 3879 end; 3880end; 3881 3882function TGtk3WidgetSet.SetViewPortExtEx(DC: HDC; XExtent, YExtent: Integer; 3883 OldSize: PSize): Boolean; 3884begin 3885 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3886 DebugLn('WARNING: TGtk3WidgetSet.SetViewPortExtEx not implemented ...'); 3887 {$ENDIF} 3888 Result:=inherited SetViewPortExtEx(DC, XExtent, YExtent, OldSize); 3889end; 3890 3891function TGtk3WidgetSet.SetViewPortOrgEx(DC: HDC; NewX, NewY: Integer; 3892 OldPoint: PPoint): Boolean; 3893begin 3894 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3895 DebugLn('WARNING: TGtk3WidgetSet.SetViewPortOrgEx not implemented ...'); 3896 {$ENDIF} 3897 Result:=inherited SetViewPortOrgEx(DC, NewX, NewY, OldPoint); 3898end; 3899 3900function TGtk3WidgetSet.SetWindowExtEx(DC: HDC; XExtent, YExtent: Integer; 3901 OldSize: PSize): Boolean; 3902begin 3903 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3904 DebugLn('WARNING: TGtk3WidgetSet.SetWindowExtEx not implemented ...'); 3905 {$ENDIF} 3906 Result:=inherited SetWindowExtEx(DC, XExtent, YExtent, OldSize); 3907end; 3908 3909function TGtk3WidgetSet.SetWindowLong(Handle: HWND; Idx: Integer; 3910 NewLong: PtrInt): PtrInt; 3911begin 3912 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3913 DebugLn('WARNING: TGtk3WidgetSet.SetWindowLong not implemented ...'); 3914 {$ENDIF} 3915 Result:=inherited SetWindowLong(Handle, Idx, NewLong); 3916end; 3917 3918function TGtk3WidgetSet.SetWindowOrgEx(dc: hdc; NewX, NewY: Integer; 3919 OldPoint: PPoint): Boolean; 3920var 3921 Matrix: cairo_matrix_t; 3922 dx: Double; 3923 dy: Double; 3924begin 3925 Result := False; // inherited SetWindowOrgEx(dc, NewX, NewY, OldPoint); 3926 if IsValidDC(DC) then 3927 begin 3928 GetWindowOrgEx(dc, OldPoint); 3929 cairo_get_matrix(TGtk3DeviceContext(DC).Widget, @Matrix); 3930 dx := 0; 3931 dy := 0; 3932 // cairo_matrix_init_translate(Matrix, -NewX, -NewY); 3933 cairo_matrix_translate(@Matrix, 3934 -NewX - TGtk3DeviceContext(DC).fncOrigin.x, 3935 -NewY - TGtk3DeviceContext(DC).fncOrigin.Y); 3936 cairo_transform(TGtk3DeviceContext(DC).Widget, @Matrix); 3937 // cairo_set_matrix(TGtk3DeviceContext(DC).Widget, Matrix); 3938 // DebugLn('TGtk3WidgetSet.SetWindowOrgEx NewX=',dbgs(NewX),' NewY=',dbgs(NewY)); 3939 Result := True; 3940 3941 end; 3942end; 3943 3944function TGtk3WidgetSet.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; X, Y, 3945 cx, cy: Integer; uFlags: UINT): Boolean; 3946begin 3947 Result := False; 3948 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3949 DebugLn('WARNING: TGtk3WidgetSet.SetWindowPos not implemented Handle=',dbgHex(hWnd),' X=',dbgs(X),' Y=',dbgs(Y)); 3950 {$ENDIF} 3951end; 3952 3953function TGtk3WidgetSet.SetWindowRgn(hWnd: HWND; hRgn: HRGN; bRedraw: Boolean 3954 ): longint; 3955begin 3956 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3957 DebugLn('WARNING: TGtk3WidgetSet.SetWindowRgn not implemented ...'); 3958 {$ENDIF} 3959 Result:=inherited SetWindowRgn(hWnd, hRgn, bRedraw); 3960end; 3961 3962function TGtk3WidgetSet.ShowCaret(hWnd: HWND): Boolean; 3963begin 3964 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3965 DebugLn('WARNING: TGtk3WidgetSet.ShowCaret not implemented ...'); 3966 {$ENDIF} 3967 Result:=inherited ShowCaret(hWnd); 3968end; 3969 3970function TGtk3WidgetSet.ShowScrollBar(Handle: HWND; wBar: Integer; 3971 bShow: Boolean): Boolean; 3972var 3973 AWidget: TGtk3Widget; 3974 // AScrolledWin: PGtkScrolledWindow; 3975 NewPolicy, OldPolicy: TGtkPolicyType; 3976begin 3977 Result := IsValidHandle(Handle); 3978 if not Result then 3979 exit; 3980 AWidget := TGtk3Widget(Handle); 3981 if wtScrollBar in AWidget.WidgetType then 3982 begin 3983 AWidget.Visible := bShow; 3984 end else 3985 (* 3986 if wtWindow in AWidget.WidgetType then 3987 begin 3988 DebugLn('WARNING: TGtk3WidgetSet.ShowScrollBar cannot get scrollbar from ',dbgsName(AWidget.LCLObject), 3989 ' bShow ',dbgs(bShow)); 3990 end else 3991 *) 3992 if wtScrollingWin in AWidget.WidgetType then 3993 begin 3994 // AScrolledWin := 3995 if TGtk3ScrollableWin(Handle).GetScrolledWindow = nil then 3996 exit; 3997 if wBar in [SB_BOTH, SB_HORZ] then 3998 begin 3999 if bShow then 4000 NewPolicy := GTK_POLICY_ALWAYS 4001 else 4002 NewPolicy := GTK_POLICY_NEVER; 4003 4004 // bug in gtk3 4005 if (wtWindow in AWidget.WidgetType) and (NewPolicy = GTK_POLICY_NEVER) then 4006 NewPolicy := GTK_POLICY_AUTOMATIC; 4007 4008 TGtk3ScrollableWin(AWidget).HScrollBarPolicy := NewPolicy; 4009 end; 4010 if wBar in [SB_BOTH, SB_VERT] then 4011 begin 4012 if bShow then 4013 NewPolicy := GTK_POLICY_ALWAYS 4014 else 4015 NewPolicy := GTK_POLICY_NEVER; 4016 4017 // bug in gtk3 4018 if (wtWindow in AWidget.WidgetType) and (NewPolicy = GTK_POLICY_NEVER) then 4019 NewPolicy := GTK_POLICY_AUTOMATIC; 4020 4021 TGtk3ScrollableWin(AWidget).VScrollBarPolicy := NewPolicy; 4022 end; 4023 end else 4024 DebugLn('WARNING: TGtk3WidgetSet.ShowScrollBar cannot get scrollbar from ',dbgsName(AWidget.LCLObject)); 4025end; 4026 4027function TGtk3WidgetSet.ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; 4028begin 4029 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 4030 DebugLn('WARNING: TGtk3WidgetSet.ShowWindow not implemented ...'); 4031 {$ENDIF} 4032 Result := False; 4033end; 4034 4035function TGtk3WidgetSet.StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; 4036 SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean; 4037begin 4038 Result := StretchMaskBlt(DestDC,X,Y,Width,Height, 4039 SrcDC,XSrc,YSrc,SrcWidth,SrcHeight, 4040 0,0,0, 4041 ROp); 4042end; 4043 4044function TGtk3WidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width, 4045 Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; 4046 Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; 4047 4048var 4049 DestContext: TGtk3DeviceContext absolute DestDC; 4050 SrcContext: TGtk3DeviceContext absolute SrcDC; 4051 ATargetRect, ASrcRect: TRect; 4052 AImage: PGdkPixbuf; 4053begin 4054 Result := False; 4055 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 4056 DebugLn('WARNING: TGtk3WidgetSet.StretchMaskBlt not implemented ...'); 4057 {$ENDIF} 4058 ATargetRect := Rect(X, Y, Width + X, Height + Y); 4059 ASrcRect := Rect(XSrc, YSrc, SrcWidth + XSrc, SrcHeight + YSrc); 4060 // AImage := gdk_pixbuf_new_subpixbuf(); 4061 // DestContext.drawImage(@ATargetRect, SrcContext.ParentPixmap, @ASrcRect, nil, nil); 4062 // Ask for DestContext type of surface (surface/image) and then draw 4063 DestContext.drawSurface(@ATargetRect, SrcContext.CairoSurface, @ASrcRect, nil, nil); 4064 // DestContext.drawImage(); 4065 // Result := True; 4066end; 4067 4068function TGtk3WidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord; 4069 pvParam: Pointer; fWinIni: DWord): LongBool; 4070begin 4071 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 4072 DebugLn('WARNING: TGtk3WidgetSet.SystemParametersInfo not implemented ...'); 4073 {$ENDIF} 4074 Result:=inherited SystemParametersInfo(uiAction, uiParam, pvParam, fWinIni); 4075end; 4076 4077function TGtk3WidgetSet.TextOut(DC: HDC; X, Y: Integer; Str: Pchar; 4078 Count: Integer): Boolean; 4079var 4080 S: String; 4081begin 4082 // Result:=inherited TextOut(DC, X, Y, Str, Count); 4083 {$IFDEF VerboseGtk3DeviceContext} 4084 DebugLn('TGtk3WidgetSet.TextOut x=',dbgs(x),' y=',dbgs(y),' Text ',dbgs(Str),' count ',dbgs(Count)); 4085 {$ENDIF} 4086 Result := False; 4087 if IsValidDC(DC) then 4088 begin 4089 Result := True; 4090 S := StrPas(Str); 4091 if Count > 0 then 4092 S := UTF8Copy(S, 1, Count); 4093 TGtk3DeviceContext(DC).drawText(X, Y , S); 4094 end; 4095end; 4096 4097function TGtk3WidgetSet.UpdateWindow(Handle: HWND): Boolean; 4098begin 4099 {$ifdef VerboseGtk3WinAPI} 4100 DebugLn('[Gtk3WinAPI UpdateWindow]'); 4101 {$endif} 4102 Result := False; 4103 if IsValidHandle(Handle) then 4104 begin 4105 TGtk3Widget(Handle).Update(nil); 4106 if TGtk3Widget(Handle).GetContainerWidget^.get_has_window then 4107 begin 4108 if Gtk3IsGdkWindow(TGtk3Widget(Handle).GetContainerWidget^.window) then 4109 TGtk3Widget(Handle).GetContainerWidget^.window^.process_updates(True); 4110 end else 4111 if TGtk3Widget(Handle).Widget^.get_has_window then 4112 begin 4113 if Gtk3IsGdkWindow(TGtk3Widget(Handle).Widget^.window) then 4114 TGtk3Widget(Handle).Widget^.window^.process_updates(True); 4115 end; 4116 Result := True; 4117 end; 4118end; 4119 4120function TGtk3WidgetSet.WindowFromPoint(APoint: TPoint): HWND; 4121var 4122 ev: TGdkEvent; 4123 ADeviceManager: PGdkDeviceManager; 4124 APointer: PGdkDevice; 4125 AWindow: PGdkWindow; 4126 AWidget: PGtkWidget; 4127 x: gint; 4128 y: gint; 4129begin 4130 //TODO: create caching mechanism. window_at_position is pretty expensive call. 4131 Result := 0; 4132 ADeviceManager := gdk_display_get_device_manager(gdk_display_get_default); 4133 APointer := gdk_device_manager_get_client_pointer(ADeviceManager); 4134 APointer^.get_position(nil, @x ,@y); 4135 AWindow := gdk_device_get_window_at_position(APointer, @APoint.X, @APoint.Y); 4136 if AWindow <> nil then 4137 begin 4138 FillChar(ev{%H-}, SizeOf(ev), 0); 4139 ev.any.window := AWindow; 4140 AWidget := gtk_get_event_widget(@ev); 4141 Result := HwndFromGtkWidget(AWidget); 4142 (* 4143 if Result <> 0 then 4144 begin 4145 DebugLn('TGtk3WidgetSet.WindowFromPoint ',dbgsName(TGtk3Widget(Result).LCLObject)); 4146 end else 4147 DebugLn('Cannot find window under point ',dbgs(APoint)); 4148 *) 4149 end; 4150end; 4151