File: gtk2wsforms.pp

package info (click to toggle)
lazarus 4.0%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 275,760 kB
  • sloc: pascal: 2,341,904; xml: 509,420; makefile: 348,726; cpp: 93,608; sh: 3,387; java: 609; perl: 297; sql: 222; ansic: 137
file content (1099 lines) | stat: -rw-r--r-- 38,651 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
{
 *****************************************************************************
 *                              Gtk2WSForms.pp                               * 
 *                              --------------                               * 
 *                                                                           *
 *                                                                           *
 *****************************************************************************

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}
unit Gtk2WSForms;

{$mode objfpc}{$H+}
{$I gtk2defines.inc}
interface

uses
  // RTL
  Gtk2, Glib2, Gdk2, Gdk2Pixbuf,
  {$IFDEF HASX}
  Gdk2x, X, XLib,
  {$ENDIF}
  Math, types, Classes,
  // LCL
  LCLType, Controls, LMessages, InterfaceBase, Graphics, Forms,
  Gtk2Int, Gtk2Proc, Gtk2Def, Gtk2Extra, Gtk2Globals, Gtk2WSControls,
  WSForms, WSProc,
  // LazUtils
  LazLoggerBase;

type

  { TGtk2WSScrollingWinControl }

  TGtk2WSScrollingWinControl = class(TWSScrollingWinControl)
  protected
    class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
  published
    class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLHandle; override;
    class procedure SetColor(const AWinControl: TWinControl); override;
  end;

  { TGtk2WSScrollBox }

  TGtk2WSScrollBox = class(TWSScrollBox)
  published
  end;

  { TGtk2WSCustomFrame }

  TGtk2WSCustomFrame = class(TWSCustomFrame)
  published
  end;

  { TGtk2WSFrame }

  TGtk2WSFrame = class(TWSFrame)
  published
  end;

  { TGtk2WSCustomForm }

  TGtk2WSCustomForm = class(TWSCustomForm)
  protected
    class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
  published
    class function CanFocus(const AWinControl: TWinControl): Boolean; override;
    class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLHandle; override;
    class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
    class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
    class procedure SetAlphaBlend(const ACustomForm: TCustomForm;
       const AlphaBlend: Boolean; const Alpha: Byte); override;
    class procedure SetFormBorderStyle(const AForm: TCustomForm;
                             const AFormBorderStyle: TFormBorderStyle); override;
    class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle,
                       {%H-}AOldFormStyle: TFormStyle); override;
    class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); override;
    class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
    class procedure ShowHide(const AWinControl: TWinControl); override;
    class procedure ShowModal(const {%H-}AForm: TCustomForm); override;
    class procedure SetBorderIcons(const AForm: TCustomForm;
                                   const ABorderIcons: TBorderIcons); override;
    class procedure SetColor(const AWinControl: TWinControl); override;
    class procedure SetRealPopupParent(const ACustomForm: TCustomForm;
       const APopupParent: TCustomForm); override;
  end;

  { TGtk2WSForm }

  TGtk2WSForm = class(TWSForm)
  published
  end;

  { TGtk2WSHintWindow }

  TGtk2WSHintWindow = class(TWSHintWindow)
  protected
    class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
  published
    class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLHandle; override;
    class procedure ShowHide(const AWinControl: TWinControl); override;
  end;

  { TGtk2WSScreen }

  TGtk2WSScreen = class(TWSScreen)
  published
  end;

  { TGtk2WSApplicationProperties }

  TGtk2WSApplicationProperties = class(TWSApplicationProperties)
  published
  end;

implementation

{ TGtk2WSCustomForm }

function gtk2WSDelayedWindowStateChange(Data: Pointer): gboolean; cdecl;
var
  AnForm: TCustomForm absolute data;
  AEvent: TGdkEventWindowState;
begin
  Result := False;
  AEvent := GetWidgetInfo({%H-}PGtkWidget(AnForm.Handle))^.FormWindowState;
  GTKWindowStateEventCB({%H-}PGtkWidget(AnForm.Handle), @AEvent, Data);
  // remove idle handler, because in fast switching hide/show there could
  // be dozen of added idle handlers, only one should be here.
  // also reset our internal flag on send_event.
  GetWidgetInfo({%H-}PGtkWidget(AnForm.Handle))^.FormWindowState.send_event := 0;
  g_idle_remove_by_data(Data);
end;

function Gtk2FormEvent(widget: PGtkWidget; event: PGdkEvent; data: GPointer): gboolean; cdecl;
var
  ACtl: TWinControl;
  Mess : TLMessage;
  WInfo: PWidgetInfo;
  X,Y: integer;
  {$IFDEF HASX}
  XDisplay: PDisplay;
  Window: TWindow;
  RevertStatus: Integer;
  winX, winY, winW, winH: gint;
  {$ENDIF}

begin
  Result := CallBackDefaultReturn;
  case event^._type of
    GDK_CONFIGURE:
      begin
        {fixes multiple resize events. See comments on
        http://bugs.freepascal.org/view.php?id=17015}
        ACtl := TWinControl(Data);
        GetWidgetRelativePosition({%H-}PGtkWidget(ACtl.Handle), X, Y);
        Result := (event^.configure.send_event = 1) and
          not ((X <> ACtl.Left) or (Y <> ACtl.Top));

        {$IFDEF HASX}
        // fix for buggy compiz.
        // see http://bugs.freepascal.org/view.php?id=17523
        if Gtk2WidgetSet.compositeManagerRunning then
        begin
          // issue #25473, compositing manager eg. Mutter (Mint 16) makes
          // complete mess with lcl<->gtk2<->x11 when our form is designed.
          if (csDesigning in ACtl.ComponentState) and
          // issue #26349.This patch is related only to Mint window manager !
            (Copy(Gtk2WidgetSet.GetWindowManager,1,6) = 'mutter') then
          begin
            gdk_window_get_geometry(event^.configure.window, @winX, @winY, @winW, @winH, nil);
            if (winW <> event^.configure.width) or (winH <> event^.configure.height) then
            begin
              // goto hell
              {$IF DEFINED(VerboseSizeMsg) OR DEFINED(VerboseGetClientRect)}
              DebugLn('Warning: GDK_CONFIGURE: Designed form is misconfigured because of bad compositing manager (see issue #25473).');
              DebugLn('Warning: GDK_CONFIGURE: Fixing problem by setting current LCL values ',dbgs(ACtl.BoundsRect));
              {$ENDIF}
              Result := True;
              gdk_window_move_resize(event^.configure.window, ACtl.Left, ACtl.Top, ACtl.Width, ACtl.Height);
              exit;
            end;
          end;
          if (X <> ACtl.Left) or (Y <> ACtl.Top) then
            Result := gtkconfigureevent(widget, PGdkEventConfigure(event),
              Data)
          else
            Result := False;
        end;
        {$ENDIF}
      end;
    GDK_WINDOW_STATE:
      begin

        if (GDK_WINDOW_STATE_WITHDRAWN and event^.window_state.changed_mask) = 1 then
          exit;

        {$IFDEF HASX}
        WInfo := GetWidgetInfo(Widget);
        if (event^.window_state.new_window_state = GDK_WINDOW_STATE_ICONIFIED) then
        begin
          if not Gtk2WidgetSet.IsCurrentDesktop(event^.window_state.window) then
          begin
            WInfo := GetWidgetInfo(Widget);
            if (WInfo <> nil) and (WInfo^.LCLObject = Application.MainForm) then
            begin
              g_object_set_data(PGObject(Widget), 'lclhintrestore', Pointer(1));
              GTK2WidgetSet.HideAllHints;
              WInfo^.FormWindowState := Event^.window_state;
              exit;
            end;
          end;
        end;
        if (event^.window_state.new_window_state <> GDK_WINDOW_STATE_ICONIFIED) and
          (WInfo <> nil) and (WInfo^.LCLObject = Application.MainForm) and
          (event^.window_state.changed_mask = GDK_WINDOW_STATE_ICONIFIED) and
          (WInfo^.FormWindowState.new_window_state = GDK_WINDOW_STATE_ICONIFIED) and
          (g_object_get_data(PGObject(Widget), 'lclhintrestore') <> nil) then
        begin
          g_object_set_data(PGObject(Widget), 'lclhintrestore', nil);
          Gtk2WidgetSet.RestoreAllHints;
          WInfo^.FormWindowState := Event^.window_state;
          exit;
        end;
        {$ELSE}
        WInfo := GetWidgetInfo(Widget);
        {$ENDIF}
        if (WInfo <> nil) then
        begin
          if (WInfo^.FormWindowState.new_window_state <> event^.window_state.new_window_state)
           and (WInfo^.FormWindowState.send_event <> 2) then
          begin
            WInfo^.FormWindowState := Event^.window_state;
            // needed to lock recursions, normally send_event can be 0 or 1
            // we add 2 to know if recursion occurred.
            WInfo^.FormWindowState.send_event := 2;
            g_idle_add(@gtk2WSDelayedWindowStateChange, Data);
          end else
          begin
            // our send_event flag is 2, mean recursion occurred
            // so we have to normalize things first.
            while WInfo^.FormWindowState.send_event = 2 do
            begin
             Application.Idle(True);
             Application.ProcessMessages;
            end;
            WInfo^.FormWindowState.send_event := 0;
            Result := GTKWindowStateEventCB(Widget, @event^.window_state, Data);
          end;
        end;
      end;
    GDK_ENTER_NOTIFY:
      begin
        FillChar(Mess{%H-}, SizeOf(Mess), #0);
        Mess.msg := LM_MOUSEENTER;
        DeliverMessage(Data, Mess);
      end;
    GDK_LEAVE_NOTIFY:
      begin
        FillChar(Mess, SizeOf(Mess), #0);
        Mess.msg := LM_MOUSELEAVE;
        DeliverMessage(Data, Mess);
      end;
    GDK_FOCUS_CHANGE:
      begin
        ACtl := TWinControl(Data);
        if PGdkEventFocus(event)^._in = 0 then
        begin
          {$IFDEF HASX}
          XDisplay := gdk_display;
          XGetInputFocus(XDisplay, @Window, @RevertStatus);
          // Window - 1 is our frame  !
          if (RevertStatus = RevertToParent) and
            (GDK_WINDOW_XID(Widget^.Window) = Window - 1) then
            exit(True);
          {$ENDIF}
          with Gtk2WidgetSet do
          begin
            LastFocusOut := {%H-}PGtkWidget(ACtl.Handle);
            if LastFocusOut = LastFocusIn then
              StartFocusTimer;
          end;
        end else
        begin
          with Gtk2WidgetSet do
          begin
            LastFocusIn := {%H-}PGtkWidget(ACtl.Handle);
            if not AppActive then
              AppActive := True;
          end;
        end;
        if GTK_IS_WINDOW(Widget) and
          (g_object_get_data({%H-}PGObject(ACtl.Handle),'lcl_nonmodal_over_modal') <> nil) then
        begin
          if PGdkEventFocus(event)^._in = 0 then
            gtk_window_set_modal({%H-}PGtkWindow(ACtl.Handle), False)
          else
            gtk_window_set_modal({%H-}PGtkWindow(ACtl.Handle), True);
        end;
      end;
  end;
end;

class procedure TGtk2WSCustomForm.SetCallbacks(const AWidget: PGtkWidget;
  const AWidgetInfo: PWidgetInfo);
begin
  TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject));
  if (TWinControl(AWidgetInfo^.LCLObject).Parent = nil) and (TWinControl(AWidgetInfo^.LCLObject).ParentWindow = 0) then
    with TGTK2WidgetSet(Widgetset) do
    begin
      {$IFDEF HASX}
      // fix for buggy compiz.
      // see http://bugs.freepascal.org/view.php?id=17523
      if not compositeManagerRunning then
      {$ENDIF}
         SetCallback(LM_CONFIGUREEVENT, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
      SetCallback(LM_CLOSEQUERY, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
      SetCallBack(LM_ACTIVATE, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
      if (gtk_major_version = 2) and (gtk_minor_version <= 8) then
      begin
        SetCallback(LM_HSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
        SetCallback(LM_VSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
      end;
    end;

  g_signal_connect(PGtkObject(AWidgetInfo^.CoreWidget), 'event',
    gtk_signal_func(@Gtk2FormEvent), AWidgetInfo^.LCLObject);
end;

class function TGtk2WSCustomForm.CanFocus(const AWinControl: TWinControl
  ): Boolean;
var
  Widget: PGtkWidget;
begin
  if AWinControl.HandleAllocated then
  begin
    Widget := {%H-}PGtkWidget(AWinControl.Handle);
    Result := GTK_WIDGET_VISIBLE(Widget) and GTK_WIDGET_SENSITIVE(Widget);
  end else
    Result := False;
end;

class function TGtk2WSCustomForm.CreateHandle(const AWinControl: TWinControl;
  const AParams: TCreateParams): TLCLHandle;
var
  WidgetInfo: PWidgetInfo;
  p: pointer;          // ptr to the newly created GtkWidget
  Box: Pointer;
  ABorderStyle: TFormBorderStyle;
  WindowType: TGtkWindowType;
  ACustomForm: TCustomForm;
  AResizable: gint;
  Allocation: TGtkAllocation;
begin
  // Start of old CreateForm method
  ACustomForm := TCustomForm(AWinControl);

  if (AParams.Style and WS_CHILD) = 0 then
  begin
    if csDesigning in ACustomForm.ComponentState then
      ABorderStyle := bsSizeable
    else
      ABorderStyle := ACustomForm.BorderStyle;
  end
  else
    ABorderStyle := bsNone;

  // Maps the border style
  WindowType := FormStyleMap[ABorderStyle];
  if (csDesigning in ACustomForm.ComponentState) then
    WindowType := GTK_WINDOW_TOPLEVEL;

  if (AParams.Style and WS_CHILD) = 0 then
  begin
    // create a floating form
    P := gtk_window_new(WindowType);

    // This is done with the expectation to avoid the button blinking for forms
    //that hide it, but currently it doesn't seem to make a difference.
    gtk_window_set_skip_taskbar_hint(P, True);

    if (ABorderStyle = bsNone) and (ACustomForm.FormStyle in fsAllStayOnTop) then
      gtk_window_set_decorated(PGtkWindow(P), False);

    // Sets the window as resizable or not
    // Depends on the WM supporting this
    if (csDesigning in ACustomForm.ComponentState) then
      AResizable := 1
    else
      AResizable := FormResizableMap[ABorderStyle];

    // gtk_window_set_policy is deprecated in Gtk2
    gtk_window_set_resizable(GTK_WINDOW(P), gboolean(AResizable));

    // Sets the title
    gtk_window_set_title(PGtkWindow(P), AParams.Caption);

    if (AParams.WndParent <> 0) then
      gtk_window_set_transient_for(PGtkWindow(P), {%H-}PGtkWindow(AParams.WndParent))
    else
    if not (csDesigning in ACustomForm.ComponentState) and
      (ACustomForm.FormStyle in fsAllStayOnTop) then
      gtk_window_set_keep_above(PGtkWindow(P), gboolean(True));

    case ACustomForm.WindowState of
    wsMaximized: gtk_window_maximize(PGtkWindow(P));
    wsMinimized: gtk_window_iconify(PGtkWindow(P));
    wsFullscreen: gtk_window_fullscreen(PGtkWindow(P));
    else
    end;

    // the clipboard needs a widget
    if (ClipboardWidget = nil) then
      Gtk2WidgetSet.SetClipboardWidget(P);
  end
  else
  begin
    // create a form as child control
    P := gtk_hbox_new(false, 0);
  end;

{$IFDEF HASX}
  if (AWinControl = Application.MainForm) and not Gtk2WidgetSet.IsWayland and
    not Application.HasOption('disableaccurateframe') then
      Gtk2WidgetSet.CreateDummyWidgetFrame(-1, -1, -1, -1);
{$ENDIF}

  WidgetInfo := CreateWidgetInfo(P, AWinControl, AParams);
  WidgetInfo^.FormBorderStyle := Ord(ABorderStyle);

  FillChar(WidgetInfo^.FormWindowState, SizeOf(WidgetInfo^.FormWindowState), #0);
  WidgetInfo^.FormWindowState.new_window_state := GDK_WINDOW_STATE_WITHDRAWN;

  Box := CreateFormContents(ACustomForm, P, WidgetInfo);
  gtk_container_add(PGtkContainer(P), Box);

  //so we can double buffer ourselves, eg, the Form Designer
  if csDesigning in AWinControl.ComponentState then
    gtk_widget_set_double_buffered(Box, False);

  gtk_widget_show(Box);

  // main menu
  if (ACustomForm.Menu <> nil) and (ACustomForm.Menu.HandleAllocated) then
    gtk_box_pack_start(Box, {%H-}PGtkWidget(ACustomForm.Menu.Handle), False, False,0);

  // End of the old CreateForm method

  {$IFNDEF NoStyle}
  if (AParams.Style and WS_CHILD) = 0 then
    gtk_widget_set_app_paintable(P, True);
  {$ENDIF}

  if not (csDesigning in AWinControl.ComponentState) then
    WidgetInfo^.UserData := Pointer(1);

  Allocation.X := AParams.X;
  Allocation.Y := AParams.Y;
  Allocation.Width := AParams.Width;
  Allocation.Height := AParams.Height;
  gtk_widget_size_allocate(P, @Allocation);

  {$IFDEF DebugLCLComponents}
  DebugGtkWidgets.MarkCreated(P, dbgsName(AWinControl));
  {$ENDIF}
  Result := TLCLHandle({%H-}PtrUInt(P));
  Set_RC_Name(AWinControl, P);
  SetCallbacks(P, WidgetInfo);
end;

function Gtk2WSDelayRedraw(Data: Pointer): GBoolean; cdecl;
begin
  Result := False;
  gtk_widget_queue_draw(PWidgetInfo(Data)^.ClientWidget);
  g_idle_remove_by_data(Data);
end;

class procedure TGtk2WSCustomForm.ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer);
var
  Layout: PGtkLayout;
  WidgetInfo: PWidgetInfo;
  Adjustment: PGtkAdjustment;
  h, v: Double;
  NewPos: Double;
begin
  if not AWinControl.HandleAllocated then exit;
  WidgetInfo := GetWidgetInfo({%H-}PGtkWidget(AWinControl.Handle));
  Layout := PGtkLayout(WidgetInfo^.ClientWidget);
  Adjustment := gtk_layout_get_hadjustment(Layout);
  if Adjustment <> nil then
  begin
    h := gtk_adjustment_get_value(Adjustment);
    NewPos := Adjustment^.upper - Adjustment^.page_size;
    if h - DeltaX <= NewPos then
      NewPos := h - DeltaX;
    if gtk_adjustment_get_value(Adjustment) <> NewPos then
    begin
      gtk_adjustment_set_value(Adjustment, NewPos);
      //if our adjustment reached end, scrollbar button is disabled
      //so gtk blocks paints for some reason, so we must postpone an update
      if NewPos >= Adjustment^.upper - Adjustment^.page_size then
        g_idle_add(@Gtk2WSDelayRedraw, WidgetInfo);
    end;
  end;
  Adjustment := gtk_layout_get_vadjustment(Layout);
  if Adjustment <> nil then
  begin
    v := gtk_adjustment_get_value(Adjustment);
    NewPos := Adjustment^.upper - Adjustment^.page_size;
    if v - DeltaY <= NewPos then
      NewPos := v - DeltaY;
    if gtk_adjustment_get_value(Adjustment) <> NewPos then
    begin
      gtk_adjustment_set_value(Adjustment, NewPos);
      //if our adjustment reached end, scrollbar button is disabled
      //so gtk blocks paints for some reason, so we must postpone an update
      if NewPos >= Adjustment^.upper - Adjustment^.page_size then
        g_idle_add(@Gtk2WSDelayRedraw, WidgetInfo);
    end;
  end;
end;

class procedure TGtk2WSCustomForm.SetIcon(const AForm: TCustomForm;
  const Small, Big: HICON);

  procedure SetSmallBigIcon;
  var
    List: PGList;
  begin
    List := nil;
    if Small <> 0 then
      List := g_list_append(List, {%H-}PGdkPixbuf(Small));
    if Big <> 0 then
      List := g_list_append(List, {%H-}PGdkPixbuf(Big));
    gtk_window_set_icon_list({%H-}PGtkWindow(AForm.Handle), List);
    if List <> nil
    then  g_list_free(List);
  end;

  {$IFDEF Gtk2SetIconAll}
  procedure SetAllIcons;
  var
    List: PGList;
    Icon: TIcon;
    CurSize: Integer;
    i: Integer;
    LastIndex: Integer;
    OldChange: TNotifyEvent;
    OldCurrent: Integer;
    IconHnd: HICON;
  begin
    List := nil;
    //debugln(['TGtk2WSCustomForm.SetIcon Form=',DbgSName(AForm)]);
    Icon:=AForm.Icon;
    if (Icon=nil) or Icon.Empty then
      Icon:=Application.Icon;
    if Assigned(Icon) and not Icon.Empty then
    begin
      CurSize:=16;
      OldChange:=Icon.OnChange;
      OldCurrent:=Icon.Current;
      Icon.OnChange := nil;
      LastIndex:=-1;
      while CurSize<=256 do begin
        i:=Icon.GetBestIndexForSize(Size(CurSize,CurSize));
        if (i>=0) and (LastIndex<>i) then begin
          Icon.Current := i;
          IconHnd:=Icon.ReleaseHandle;
          if IconHnd <> 0 then
            List := g_list_append(List, {%H-}PGdkPixbuf(IconHnd));
          //debugln(['TGtk2WSCustomForm.SetIcon adding ',CurSize]);
          LastIndex:=i;
        end;
        CurSize:=CurSize*2;
      end;
      Icon.Current:=OldCurrent;
      Icon.OnChange:=OldChange;
    end;
    gtk_window_set_icon_list({%H-}PGtkWindow(AForm.Handle), List);
    if List <> nil
    then  g_list_free(List);
  end;
  {$ENDIF}

  {$IFDEF Gtk2SetIconFile}
  procedure SetIconFromFile;
  var
    Filename: String;
  begin
    Filename:='test128x128.png';
    debugln(['SetIconFromFile filename=',Filename]);
    gtk_window_set_icon_from_file({%H-}PGtkWindow(AForm.Handle),PGChar(Filename),null);
    debugln(['SetIconFromFile prg name="',g_get_prgname,'"']);
  end;
  {$ENDIF}

begin
  if not WSCheckHandleAllocated(AForm, 'SetIcon')
  then Exit;

  if (AForm.Parent <> nil) or (AForm.ParentWindow <> 0) then Exit;

  {$IFDEF Gtk2SetIconAll}
  SetAllIcons;
  {$ELSE}
    {$IFDEF Gtk2SetIconFile}
    SetIconFromFile;
    {$ELSE}
    SetSmallBigIcon;
    {$ENDIF}
  {$ENDIF}
end;

class procedure TGtk2WSCustomForm.SetAlphaBlend(const ACustomForm: TCustomForm;
  const AlphaBlend: Boolean; const Alpha: Byte);
begin
  if not WSCheckHandleAllocated(ACustomForm, 'SetAlphaBlend') then
    Exit;
  if Assigned(gtk_window_set_opacity) and GTK_IS_WINDOW({%H-}PGtkWidget(ACustomForm.Handle)) then
    if AlphaBlend then
      gtk_window_set_opacity({%H-}PGtkWindow(ACustomForm.Handle), Alpha / 255)
    else
      gtk_window_set_opacity({%H-}PGtkWindow(ACustomForm.Handle), 1);
end;

class procedure TGtk2WSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
  const AFormBorderStyle: TFormBorderStyle);
var
  Widget: PGtkWidget;
  WidgetInfo: PWidgetInfo;
  // WindowType: TGtkWindowType;
  Resizable: gint;
begin
  if not WSCheckHandleAllocated(AForm, 'SetFormBorderStyle') then
    exit;
  if (csDesigning in AForm.ComponentState) then
    exit;

  Widget := {%H-}PGtkWidget(AForm.Handle);
  WidgetInfo := GetWidgetInfo(Widget);

  if (WidgetInfo^.FormBorderStyle <> Ord(AFormBorderStyle)) then
  begin
    if (AForm.Parent<>nil) then
    begin
      // a nested form
      // at the moment the gtk interface does not support any border for this
    end else if (AFormBorderStyle <> bsNone) then
    begin
      // the borderstyle can be only set on creation
      RecreateWnd(AForm);
    end else
    begin
      // TODO: set window hint WindowType := FormStyleMap[AFormBorderStyle];
      Resizable := FormResizableMap[AFormBorderStyle];
      if (AFormBorderStyle = bsNone) then
        gtk_window_set_decorated(PGtkWindow(Widget), False);
      gtk_window_set_resizable(GTK_WINDOW(Widget), gboolean(Resizable));
      WidgetInfo^.FormBorderStyle := Ord(AFormBorderStyle);
    end;
  end;
end;

class procedure TGtk2WSCustomForm.SetFormStyle(const AForm: TCustomform;
  const AFormStyle, AOldFormStyle: TFormStyle);
begin
  if not WSCheckHandleAllocated(AForm, 'SetFormStyle') then
    exit;
  if (csDesigning in AForm.ComponentState) then
    exit;
  if GTK_IS_WINDOW({%H-}PGtkWindow(AForm.Handle)) then
    gtk_window_set_keep_above({%H-}PGtkWindow(AForm.Handle),
      GBoolean(AFormStyle in fsAllStayOnTop));
end;

class procedure TGtk2WSCustomForm.SetAllowDropFiles(const AForm: TCustomForm;
  AValue: Boolean);
begin
  if AValue then
    gtk_drag_dest_set({%H-}PGtkWidget(AForm.Handle), GTK_DEST_DEFAULT_ALL,
      @FileDragTarget, 1, GDK_ACTION_COPY or GDK_ACTION_MOVE)
  else
    gtk_drag_dest_unset({%H-}PGtkWidget(AForm.Handle));
end;

class procedure TGtk2WSCustomForm.SetShowInTaskbar(const AForm: TCustomForm;
  const AValue: TShowInTaskbar);
begin
  if not WSCheckHandleAllocated(AForm, 'SetShowInTaskbar')
  then Exit;

  SetFormShowInTaskbar(AForm,AValue);
end;

class procedure TGtk2WSCustomForm.ShowHide(const AWinControl: TWinControl);
var
  {$IFDEF HASX}
  TempGdkWindow: PGdkWindow;
  {$ENDIF}
  AForm, APopupParent: TCustomForm;
  GtkWindow: PGtkWindow;
  Geometry: TGdkGeometry;
  clientRectFix: TRect;

  function ShowNonModalOverModal: Boolean;
  var
    AForm: TCustomForm;
    AWindow: PGtkWindow;
  begin
    Result := False;
    AForm := TCustomForm(AWinControl);
    if AWinControl.HandleObjectShouldBeVisible and
      not (csDesigning in AForm.ComponentState) and
      not (fsModal in AForm.FormState) and
      (AForm.Parent = nil) and
      (AForm.FormStyle <> fsMDIChild) and
      (ModalWindows <> nil) and (ModalWindows.Count > 0) and
      not (AForm.FormStyle in fsAllStayOnTop) and
      (AForm.BorderStyle in [bsDialog, bsSingle, bsSizeable]) and
      (AForm.PopupParent = nil) and (AForm.PopupMode = pmNone) then
    begin
      AWindow := {%H-}PGtkWindow(AForm.Handle);
      gtk_window_set_modal(AWindow, True);
      // lcl_nonmodal_over_modal is needed to track nonmodal form
      // created and shown when we have active modal forms
      g_object_set_data(PGObject(AWindow),'lcl_nonmodal_over_modal', AForm);
      Result := True;
    end;
  end;
begin
  AForm := TCustomForm(AWinControl);
  if GTK_IS_WINDOW({%H-}PGtkWindow(AForm.Handle)) and not (csDesigning in AForm.ComponentState) then
  begin
    if AForm.HandleObjectShouldBeVisible then
      begin
        gtk_window_set_keep_above({%H-}PGtkWindow(AForm.Handle),
          GBoolean(AForm.FormStyle in fsAllStayOnTop))
      end
    else
    if (AForm.FormStyle in fsAllStayOnTop) and
      not (csDestroying in AWinControl.ComponentState) then
        gtk_window_set_keep_above({%H-}PGtkWindow(AForm.Handle), GBoolean(False));
  end;

  GtkWindow := {%H-}PGtkWindow(AForm.Handle);

  if (fsModal in AForm.FormState) and AForm.HandleObjectShouldBeVisible then
  begin
    gtk_window_set_default_size(GtkWindow, Max(1,AForm.Width), Max(1,AForm.Height));
    gtk_widget_set_uposition(PGtkWidget(GtkWindow), AForm.Left, AForm.Top);
    gtk_window_set_type_hint({%H-}PGtkWindow(AForm.Handle),
       GtkWindowTypeHints[AForm.BorderStyle]);
    GtkWindowShowModal(AForm, GtkWindow);
  end else
  begin
    if ShowNonModalOverModal then begin
      // issue #21459
    end
    else if not GTK_IS_WINDOW(GtkWindow) then begin
      //
    end
    else if (AForm.FormStyle <> fsMDIChild) and AForm.HandleObjectShouldBeVisible
      and (ModalWindows <> nil) and (ModalWindows.Count > 0)
      and (AForm.PopupParent = nil) and (AForm.BorderStyle = bsNone)
    then begin
      // showing a non modal form with bsNone above a modal form
      gtk_window_set_transient_for(GtkWindow, nil);
      gtk_window_set_modal(GtkWindow, True);
    end else begin
      // hiding/showing normal form
      // clear former mods, e.g. when a modal form becomes a normal form, see bug 23876
      {$IFDEF HASX}
      gtk_window_set_modal(GtkWindow, False);
      gtk_window_set_transient_for(GtkWindow, nil); //untransient
      {$ELSE}
      gtk_window_set_transient_for(GtkWindow, nil); //untransient
      gtk_window_set_modal(GtkWindow, False);
      {$ENDIF}
    end;

    {$IFDEF HASX}
    // issue #26018
    if AWinControl.HandleObjectShouldBeVisible and
      not (csDesigning in AForm.ComponentState) and
      not (AForm.FormStyle in fsAllStayOnTop) and
      not (fsModal in AForm.FormState) and
      (AForm.PopupMode = pmAuto) and
      (AForm.BorderStyle = bsNone) and
      (AForm.PopupParent = nil) then
    begin
      TempGdkWindow := {%H-}PGdkWindow(Gtk2WidgetSet.GetForegroundWindow);
      if (TempGdkWindow <> nil) and GDK_IS_WINDOW(TempGdkWindow) and (GdkWindowObject_modal_hint(GDK_WINDOW_OBJECT(TempGdkWindow)^) = 0) then
      begin
        if ((gdk_window_get_state(TempGdkWindow) and GDK_WINDOW_STATE_ABOVE) = GDK_WINDOW_STATE_ABOVE) or
          GTK2WidgetSet.GetAlwaysOnTopX11(TempGdkWindow) then
            gtk_window_set_keep_above(GtkWindow, True);
      end;
    end;

    if AWinControl.HandleObjectShouldBeVisible and
      not (csDesigning in AForm.ComponentState) and
      not (AForm.FormStyle in fsAllStayOnTop) and
      not (fsModal in AForm.FormState) then
    begin
      APopupParent := AForm.GetRealPopupParent;
      if (APopupParent <> nil) then
        SetRealPopupParent(AForm, APopupParent);
    end;
    {$ENDIF}

    Gtk2WidgetSet.SetVisible(AWinControl, AForm.HandleObjectShouldBeVisible);
  end;

  if not (csDesigning in AForm.ComponentState) and
    AForm.HandleObjectShouldBeVisible and
    (AForm.BorderStyle in [bsDialog, bsSingle]) then
  begin
    clientRectFix:= GetWidgetInfo(PGtkWidget(AForm.Handle))^.FormClientRectFix;
    // we must set fixed size, gtk_window_set_resizable does not work
    // as expected for some reason.issue #20741
    with Geometry do
    begin
      min_width := AForm.Width + clientRectFix.Width;
      max_width := AForm.Width + clientRectFix.Width;
      min_height := AForm.Height + clientRectFix.Height;
      max_height := AForm.Height + clientRectFix.Height;

      base_width := AForm.Width + clientRectFix.Width;
      base_height := AForm.Height + clientRectFix.Height;
      width_inc := 1;
      height_inc := 1;
      min_aspect := 0;
      max_aspect := 1;
      win_gravity := gtk_window_get_gravity(GtkWindow);
    end;
    //debugln('TGtk2WSWinControl.ConstraintsChange A ',GetWidgetDebugReport(Widget),' max=',dbgs(Geometry.max_width),'x',dbgs(Geometry.max_height));
    gtk_window_set_geometry_hints(GtkWindow, nil, @Geometry,
      GDK_HINT_POS or GDK_HINT_MIN_SIZE or GDK_HINT_MAX_SIZE);
  end;

  if not (csDesigning in AForm.ComponentState) and
    AForm.HandleObjectShouldBeVisible and (AForm.WindowState = wsFullScreen) then
      gtk_window_fullscreen(GtkWindow);


  InvalidateLastWFPResult(AWinControl, AWinControl.BoundsRect);
end;

class procedure TGtk2WSCustomForm.ShowModal(const AForm: TCustomForm);
begin
  // modal is started in ShowHide
end;

class procedure TGtk2WSCustomForm.SetBorderIcons(const AForm: TCustomForm;
  const ABorderIcons: TBorderIcons);
begin
  if not WSCheckHandleAllocated(AForm, 'SetBorderIcons')
  then Exit;

  inherited SetBorderIcons(AForm, ABorderIcons);
end;

class procedure TGtk2WSCustomForm.SetColor(const AWinControl: TWinControl);
var
  AScrolled: PGtkWidget;
  AColor: TColor;
begin
  TGtk2WSWinControl.SetColor(AWinControl);

  // Forms: GtkWindow->GtkVBox->gtkScrolledWindow->GtkLayout
  // we need to set the color of the GtkLayout so that the whole viewport
  // will be filled (issue #16183)
  AScrolled := g_object_get_data({%H-}PGObject(AWinControl.Handle), odnScrollArea);
  if GTK_IS_SCROLLED_WINDOW(AScrolled) and
    GTK_IS_LAYOUT({%H-}PGtkBin(AScrolled)^.child) then
  begin
    AColor := AWinControl.Color;
    if AColor = clDefault then
      AColor := GetDefaultColor(AWinControl, dctBrush);
    Gtk2WidgetSet.SetWidgetColor({%H-}PGtkBin(AScrolled)^.child,
                                 clNone, AColor,
                                 [GTK_STATE_NORMAL, GTK_STATE_ACTIVE,
                                  GTK_STATE_PRELIGHT, GTK_STATE_SELECTED]);
  end;
end;

class procedure TGtk2WSCustomForm.SetRealPopupParent(
  const ACustomForm: TCustomForm; const APopupParent: TCustomForm);
begin
  if not WSCheckHandleAllocated(ACustomForm, 'SetRealPopupParent') then Exit;

  if APopupParent <> nil then
    gtk_window_set_transient_for({%H-}PGtkWindow(ACustomForm.Handle), {%H-}PGtkWindow(APopupParent.Handle))
  else
    gtk_window_set_transient_for({%H-}PGtkWindow(ACustomForm.Handle), nil);
end;


{ TGtk2WSScrollingWinControl }

class procedure TGtk2WSScrollingWinControl.SetCallbacks(
  const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
var
  UseScrollCallback: Boolean;
begin
  TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject));
  with TGTK2WidgetSet(Widgetset) do
  begin
    UseScrollCallBack := (gtk_major_version = 2) and (gtk_minor_version <= 8);
    if UseScrollCallBack then
    begin
      SetCallback(LM_HSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
      SetCallback(LM_VSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
    end;
  end;
end;

class function TGtk2WSScrollingWinControl.CreateHandle(
  const AWinControl: TWinControl; const AParams: TCreateParams): TLCLHandle;
var
  Scrolled: PGtkScrolledWindow;
  Layout: PGtkWidget;
  WidgetInfo: PWidgetInfo;
  Adjustment: PGtkAdjustment;
begin
  // create a gtk_scrolled_window for the scrollbars
  Scrolled := PGtkScrolledWindow(gtk_scrolled_window_new(nil, nil));
  gtk_scrolled_window_set_shadow_type(Scrolled,
    BorderStyleShadowMap[TScrollingWinControl(AWinControl).BorderStyle]);

  GTK_WIDGET_UNSET_FLAGS(Scrolled^.hscrollbar, GTK_CAN_FOCUS);
  GTK_WIDGET_UNSET_FLAGS(Scrolled^.vscrollbar, GTK_CAN_FOCUS);
  gtk_scrolled_window_set_policy(Scrolled, GTK_POLICY_NEVER, GTK_POLICY_NEVER);
  g_object_set_data(PGObject(Scrolled), odnScrollArea, Scrolled);

  {$IFDEF DebugLCLComponents}
  DebugGtkWidgets.MarkCreated(Scrolled, dbgsName(AWinControl));
  {$ENDIF}

  WidgetInfo := CreateWidgetInfo(Scrolled, AWinControl, AParams);

  Adjustment := gtk_scrolled_window_get_vadjustment(Scrolled);
  if Adjustment <> nil then
    g_object_set_data(PGObject(Adjustment), odnScrollBar, Scrolled^.vscrollbar);

  Adjustment := gtk_scrolled_window_get_hadjustment(Scrolled);
  if Adjustment <> nil then
    g_object_set_data(PGObject(Adjustment), odnScrollBar, Scrolled^.hscrollbar);

  // create a gtk_layout for the client area, so children can be added at
  // free x,y positions and the scrollbars automatically scrolls the children

  Layout := gtk_layout_new(nil, nil);
  gtk_container_add(PGTKContainer(Scrolled), Layout);
  gtk_widget_show(Layout);
  SetFixedWidget(Scrolled, Layout);
  SetMainWidget(Scrolled, Layout);

  Result := TLCLHandle({%H-}PtrUInt(Scrolled));

  Set_RC_Name(AWinControl, PGtkWidget(Scrolled));
  SetCallBacks(PGtkWidget(Scrolled), WidgetInfo);
  if (gtk_major_version >= 2) and (gtk_minor_version > 8) then
  begin
    g_signal_connect(Scrolled^.hscrollbar, 'change-value',
                     TGCallback(@Gtk2RangeScrollCB), WidgetInfo);
    g_signal_connect(Scrolled^.vscrollbar, 'change-value',
                     TGCallback(@Gtk2RangeScrollCB), WidgetInfo);

    g_signal_connect(Scrolled^.hscrollbar, 'value-changed',
      TGCallback(@Gtk2RangeValueChanged), WidgetInfo);
    g_signal_connect(Scrolled^.vscrollbar, 'value-changed',
      TGCallback(@Gtk2RangeValueChanged), WidgetInfo);

    g_signal_connect(Scrolled^.hscrollbar, 'button-press-event',
                     TGCallback(@Gtk2RangeScrollPressCB), WidgetInfo);
    g_signal_connect(Scrolled^.hscrollbar, 'button-release-event',
                     TGCallback(@Gtk2RangeScrollReleaseCB), WidgetInfo);
    g_signal_connect(Scrolled^.vscrollbar, 'button-press-event',
                     TGCallback(@Gtk2RangeScrollPressCB), WidgetInfo);
    g_signal_connect(Scrolled^.vscrollbar, 'button-release-event',
                     TGCallback(@Gtk2RangeScrollReleaseCB), WidgetInfo);
    if (AWinControl is TScrollBox) then
      g_signal_connect(Scrolled, 'scroll-event',
                       TGCallback(@Gtk2ScrolledWindowScrollCB), WidgetInfo);
  end;
end;

class procedure TGtk2WSScrollingWinControl.SetColor(const AWinControl: TWinControl);
var
  AColor: TColor;
begin
  if not WSCheckHandleAllocated(AWinControl, 'SetColor')
  then Exit;

  // ScrollingWinControl: GtkScrolledWindow->GtkLayout
  // we need to set the color of the GtkLayout so that the whole viewport
  // will be filled (issue #16183)
  AColor := AWinControl.Color;
  if AColor = clDefault then
    AColor := GetDefaultColor(AWinControl, dctBrush);
  Gtk2WidgetSet.SetWidgetColor({%H-}PGtkBin(AWinControl.Handle)^.child,
                               clNone, AColor,
                               [GTK_STATE_NORMAL, GTK_STATE_ACTIVE,
                                GTK_STATE_PRELIGHT, GTK_STATE_SELECTED]);
end;

{ TGtk2WSHintWindow }

class procedure TGtk2WSHintWindow.SetCallbacks(const AWidget: PGtkWidget;
  const AWidgetInfo: PWidgetInfo);
begin
  TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject));
  if (TControl(AWidgetInfo^.LCLObject).Parent = nil) then
    with TGTK2WidgetSet(Widgetset) do
    begin
      {$note test with smaller minor versions and check where LM_CONFIGUREEVENT is needed.}
      {$IFDEF HASX}
      // fix for buggy compiz.
      // see http://bugs.freepascal.org/view.php?id=17523
      if not compositeManagerRunning then
      {$ENDIF}
        SetCallback(LM_CONFIGUREEVENT, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
    end;
end;

class function TGtk2WSHintWindow.CreateHandle(const AWinControl: TWinControl;
  const AParams: TCreateParams): TLCLHandle;
var
  TempWidget : PGTKWidget;       // pointer to gtk-widget (local use when neccessary)
  p          : pointer;          // ptr to the newly created GtkWidget
  ACustomForm: TCustomForm;
  AWindow: PGdkWindow;
  WidgetInfo: PWidgetInfo;
begin
  ACustomForm := TCustomForm(AWinControl);

  p := gtk_window_new(GTK_WINDOW_POPUP);
  WidgetInfo := CreateWidgetInfo(p, AWinControl, AParams);
  gtk_window_set_policy(GTK_WINDOW(p), 0, 0, 0);
  gtk_window_set_focus_on_map(P, False);

  // issue #24363
  g_object_set_data(P,'lclhintwindow',AWinControl);

  // Create the form client area
  TempWidget := CreateFixedClientWidget;
  gtk_container_add(p, TempWidget);
  GTK_WIDGET_UNSET_FLAGS(TempWidget, GTK_CAN_FOCUS);
  gtk_widget_show(TempWidget);
  SetFixedWidget(p, TempWidget);
  SetMainWidget(p, TempWidget);

  ACustomForm.FormStyle := fsStayOnTop;
  ACustomForm.BorderStyle := bsNone;
  gtk_widget_realize(p);
  AWindow := GetControlWindow(P);
  {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}

  gdk_window_set_decorations(AWindow, GetWindowDecorations(ACustomForm));

  gdk_window_set_functions(AWindow, GetWindowFunction(ACustomForm));

  {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
  gtk_widget_show_all(TempWidget);// Important: do not show the window yet, only make its content visible

  {$IFNDEF NoStyle}
  if (ACustomForm.Parent = nil) then
    gtk_widget_set_app_paintable(P, True);
  {$ENDIF}

  {$IFDEF DebugLCLComponents}
  DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl));
  {$ENDIF}
  Result := TLCLHandle({%H-}PtrUInt(P));
  Set_RC_Name(AWinControl, P);
  SetCallbacks(P, WidgetInfo);
end;

class procedure TGtk2WSHintWindow.ShowHide(const AWinControl: TWinControl);
var
  bVisible: boolean;
begin
  if not WSCheckHandleAllocated(AWinControl, 'SetColor') then
    exit;

  bVisible := AWinControl.HandleObjectShouldBeVisible;
  if bVisible then
    gtk_window_set_type_hint({%H-}PGtkWindow(AWinControl.Handle), GDK_WINDOW_TYPE_HINT_TOOLTIP);
  Gtk2WidgetSet.SetVisible(AWinControl, bVisible);
  InvalidateLastWFPResult(AWinControl, AWinControl.BoundsRect);
end;

end.