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