1{
2 *****************************************************************************
3 *                              Gtk2WSForms.pp                               *
4 *                              --------------                               *
5 *                                                                           *
6 *                                                                           *
7 *****************************************************************************
8
9 *****************************************************************************
10  This file is part of the Lazarus Component Library (LCL)
11
12  See the file COPYING.modifiedLGPL.txt, included in this distribution,
13  for details about the license.
14 *****************************************************************************
15}
16unit Gtk2WSForms;
17
18{$mode objfpc}{$H+}
19{$I gtk2defines.inc}
20interface
21
22uses
23  // RTL
24  Gtk2, Glib2, Gdk2, Gdk2Pixbuf,
25  {$IFDEF HASX}
26  Gdk2x, X, XLib,
27  {$ENDIF}
28  Math, types, Classes,
29  // LCL
30  LCLType, Controls, LMessages, InterfaceBase, Graphics, Forms,
31  Gtk2Int, Gtk2Proc, Gtk2Def, Gtk2Extra, Gtk2Globals, Gtk2WSControls,
32  WSForms, WSProc,
33  // LazUtils
34  LazLoggerBase;
35
36type
37
38  { TGtk2WSScrollingWinControl }
39
40  TGtk2WSScrollingWinControl = class(TWSScrollingWinControl)
41  protected
42    class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
43  published
44    class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
45    class procedure SetColor(const AWinControl: TWinControl); override;
46  end;
47
48  { TGtk2WSScrollBox }
49
50  TGtk2WSScrollBox = class(TWSScrollBox)
51  published
52  end;
53
54  { TGtk2WSCustomFrame }
55
56  TGtk2WSCustomFrame = class(TWSCustomFrame)
57  published
58  end;
59
60  { TGtk2WSFrame }
61
62  TGtk2WSFrame = class(TWSFrame)
63  published
64  end;
65
66  { TGtk2WSCustomForm }
67
68  TGtk2WSCustomForm = class(TWSCustomForm)
69  protected
70    class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
71  published
72    class function CanFocus(const AWinControl: TWinControl): Boolean; override;
73    class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
74    class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
75    class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
76    class procedure SetAlphaBlend(const ACustomForm: TCustomForm;
77       const AlphaBlend: Boolean; const Alpha: Byte); override;
78    class procedure SetFormBorderStyle(const AForm: TCustomForm;
79                             const AFormBorderStyle: TFormBorderStyle); override;
80    class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle,
81                       {%H-}AOldFormStyle: TFormStyle); override;
82    class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); override;
83    class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
84    class procedure ShowHide(const AWinControl: TWinControl); override;
85    class procedure ShowModal(const {%H-}AForm: TCustomForm); override;
86    class procedure SetBorderIcons(const AForm: TCustomForm;
87                                   const ABorderIcons: TBorderIcons); override;
88    class procedure SetColor(const AWinControl: TWinControl); override;
89    class procedure SetRealPopupParent(const ACustomForm: TCustomForm;
90       const APopupParent: TCustomForm); override;
91  end;
92
93  { TGtk2WSForm }
94
95  TGtk2WSForm = class(TWSForm)
96  published
97  end;
98
99  { TGtk2WSHintWindow }
100
101  TGtk2WSHintWindow = class(TWSHintWindow)
102  protected
103    class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
104  published
105    class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
106    class procedure ShowHide(const AWinControl: TWinControl); override;
107  end;
108
109  { TGtk2WSScreen }
110
111  TGtk2WSScreen = class(TWSScreen)
112  published
113  end;
114
115  { TGtk2WSApplicationProperties }
116
117  TGtk2WSApplicationProperties = class(TWSApplicationProperties)
118  published
119  end;
120
121implementation
122
123{ TGtk2WSCustomForm }
124
125function gtk2WSDelayedWindowStateChange(Data: Pointer): gboolean; cdecl;
126var
127  AnForm: TCustomForm absolute data;
128  AEvent: TGdkEventWindowState;
129begin
130  Result := False;
131  AEvent := GetWidgetInfo({%H-}PGtkWidget(AnForm.Handle))^.FormWindowState;
132  GTKWindowStateEventCB({%H-}PGtkWidget(AnForm.Handle), @AEvent, Data);
133  // remove idle handler, because in fast switching hide/show there could
134  // be dozen of added idle handlers, only one should be here.
135  // also reset our internal flag on send_event.
136  GetWidgetInfo({%H-}PGtkWidget(AnForm.Handle))^.FormWindowState.send_event := 0;
137  g_idle_remove_by_data(Data);
138end;
139
140function Gtk2FormEvent(widget: PGtkWidget; event: PGdkEvent; data: GPointer): gboolean; cdecl;
141var
142  ACtl: TWinControl;
143  Mess : TLMessage;
144  WInfo: PWidgetInfo;
145  X,Y: integer;
146  {$IFDEF HASX}
147  XDisplay: PDisplay;
148  Window: TWindow;
149  RevertStatus: Integer;
150  winX, winY, winW, winH: gint;
151  {$ENDIF}
152
153begin
154  Result := CallBackDefaultReturn;
155  case event^._type of
156    GDK_CONFIGURE:
157      begin
158        {fixes multiple resize events. See comments on
159        http://bugs.freepascal.org/view.php?id=17015}
160        ACtl := TWinControl(Data);
161        GetWidgetRelativePosition({%H-}PGtkWidget(ACtl.Handle), X, Y);
162        Result := (event^.configure.send_event = 1) and
163          not ((X <> ACtl.Left) or (Y <> ACtl.Top));
164
165        {$IFDEF HASX}
166        // fix for buggy compiz.
167        // see http://bugs.freepascal.org/view.php?id=17523
168        if Gtk2WidgetSet.compositeManagerRunning then
169        begin
170          // issue #25473, compositing manager eg. Mutter (Mint 16) makes
171          // complete mess with lcl<->gtk2<->x11 when our form is designed.
172          if (csDesigning in ACtl.ComponentState) and
173          // issue #26349.This patch is related only to Mint window manager !
174            (Copy(Gtk2WidgetSet.GetWindowManager,1,6) = 'mutter') then
175          begin
176            gdk_window_get_geometry(event^.configure.window, @winX, @winY, @winW, @winH, nil);
177            if (winW <> event^.configure.width) or (winH <> event^.configure.height) then
178            begin
179              // goto hell
180              {$IF DEFINED(VerboseSizeMsg) OR DEFINED(VerboseGetClientRect)}
181              DebugLn('Warning: GDK_CONFIGURE: Designed form is misconfigured because of bad compositing manager (see issue #25473).');
182              DebugLn('Warning: GDK_CONFIGURE: Fixing problem by setting current LCL values ',dbgs(ACtl.BoundsRect));
183              {$ENDIF}
184              Result := True;
185              gdk_window_move_resize(event^.configure.window, ACtl.Left, ACtl.Top, ACtl.Width, ACtl.Height);
186              exit;
187            end;
188          end;
189          if (X <> ACtl.Left) or (Y <> ACtl.Top) then
190            Result := gtkconfigureevent(widget, PGdkEventConfigure(event),
191              Data)
192          else
193            Result := False;
194        end;
195        {$ENDIF}
196      end;
197    GDK_WINDOW_STATE:
198      begin
199
200        if (GDK_WINDOW_STATE_WITHDRAWN and event^.window_state.changed_mask) = 1 then
201          exit;
202
203        {$IFDEF HASX}
204        WInfo := GetWidgetInfo(Widget);
205        if (event^.window_state.new_window_state = GDK_WINDOW_STATE_ICONIFIED) then
206        begin
207          if not Gtk2WidgetSet.IsCurrentDesktop(event^.window_state.window) then
208          begin
209            WInfo := GetWidgetInfo(Widget);
210            if (WInfo <> nil) and (WInfo^.LCLObject = Application.MainForm) then
211            begin
212              g_object_set_data(PGObject(Widget), 'lclhintrestore', Pointer(1));
213              GTK2WidgetSet.HideAllHints;
214              WInfo^.FormWindowState := Event^.window_state;
215              exit;
216            end;
217          end;
218        end;
219        if (event^.window_state.new_window_state <> GDK_WINDOW_STATE_ICONIFIED) and
220          (WInfo <> nil) and (WInfo^.LCLObject = Application.MainForm) and
221          (event^.window_state.changed_mask = GDK_WINDOW_STATE_ICONIFIED) and
222          (WInfo^.FormWindowState.new_window_state = GDK_WINDOW_STATE_ICONIFIED) and
223          (g_object_get_data(PGObject(Widget), 'lclhintrestore') <> nil) then
224        begin
225          g_object_set_data(PGObject(Widget), 'lclhintrestore', nil);
226          Gtk2WidgetSet.RestoreAllHints;
227          WInfo^.FormWindowState := Event^.window_state;
228          exit;
229        end;
230        {$ELSE}
231        WInfo := GetWidgetInfo(Widget);
232        {$ENDIF}
233        if (WInfo <> nil) then
234        begin
235          if (WInfo^.FormWindowState.new_window_state <> event^.window_state.new_window_state)
236           and (WInfo^.FormWindowState.send_event <> 2) then
237          begin
238            WInfo^.FormWindowState := Event^.window_state;
239            // needed to lock recursions, normally send_event can be 0 or 1
240            // we add 2 to know if recursion occurred.
241            WInfo^.FormWindowState.send_event := 2;
242            g_idle_add(@gtk2WSDelayedWindowStateChange, Data);
243          end else
244          begin
245            // our send_event flag is 2, mean recursion occurred
246            // so we have to normalize things first.
247            while WInfo^.FormWindowState.send_event = 2 do
248            begin
249             Application.Idle(True);
250             Application.ProcessMessages;
251            end;
252            WInfo^.FormWindowState.send_event := 0;
253            Result := GTKWindowStateEventCB(Widget, @event^.window_state, Data);
254          end;
255        end;
256      end;
257    GDK_ENTER_NOTIFY:
258      begin
259        FillChar(Mess{%H-}, SizeOf(Mess), #0);
260        Mess.msg := LM_MOUSEENTER;
261        DeliverMessage(Data, Mess);
262      end;
263    GDK_LEAVE_NOTIFY:
264      begin
265        FillChar(Mess, SizeOf(Mess), #0);
266        Mess.msg := LM_MOUSELEAVE;
267        DeliverMessage(Data, Mess);
268      end;
269    GDK_FOCUS_CHANGE:
270      begin
271        ACtl := TWinControl(Data);
272        if PGdkEventFocus(event)^._in = 0 then
273        begin
274          {$IFDEF HASX}
275          XDisplay := gdk_display;
276          XGetInputFocus(XDisplay, @Window, @RevertStatus);
277          // Window - 1 is our frame  !
278          if (RevertStatus = RevertToParent) and
279            (GDK_WINDOW_XID(Widget^.Window) = Window - 1) then
280            exit(True);
281          {$ENDIF}
282          with Gtk2WidgetSet do
283          begin
284            LastFocusOut := {%H-}PGtkWidget(ACtl.Handle);
285            if LastFocusOut = LastFocusIn then
286              StartFocusTimer;
287          end;
288        end else
289        begin
290          with Gtk2WidgetSet do
291          begin
292            LastFocusIn := {%H-}PGtkWidget(ACtl.Handle);
293            if not AppActive then
294              AppActive := True;
295          end;
296        end;
297        if GTK_IS_WINDOW(Widget) and
298          (g_object_get_data({%H-}PGObject(ACtl.Handle),'lcl_nonmodal_over_modal') <> nil) then
299        begin
300          if PGdkEventFocus(event)^._in = 0 then
301            gtk_window_set_modal({%H-}PGtkWindow(ACtl.Handle), False)
302          else
303            gtk_window_set_modal({%H-}PGtkWindow(ACtl.Handle), True);
304        end;
305      end;
306  end;
307end;
308
309class procedure TGtk2WSCustomForm.SetCallbacks(const AWidget: PGtkWidget;
310  const AWidgetInfo: PWidgetInfo);
311begin
312  TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject));
313  if (TWinControl(AWidgetInfo^.LCLObject).Parent = nil) and (TWinControl(AWidgetInfo^.LCLObject).ParentWindow = 0) then
314    with TGTK2WidgetSet(Widgetset) do
315    begin
316      {$IFDEF HASX}
317      // fix for buggy compiz.
318      // see http://bugs.freepascal.org/view.php?id=17523
319      if not compositeManagerRunning then
320      {$ENDIF}
321         SetCallback(LM_CONFIGUREEVENT, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
322      SetCallback(LM_CLOSEQUERY, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
323      SetCallBack(LM_ACTIVATE, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
324      if (gtk_major_version = 2) and (gtk_minor_version <= 8) then
325      begin
326        SetCallback(LM_HSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
327        SetCallback(LM_VSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
328      end;
329    end;
330
331  g_signal_connect(PGtkObject(AWidgetInfo^.CoreWidget), 'event',
332    gtk_signal_func(@Gtk2FormEvent), AWidgetInfo^.LCLObject);
333end;
334
335class function TGtk2WSCustomForm.CanFocus(const AWinControl: TWinControl
336  ): Boolean;
337var
338  Widget: PGtkWidget;
339begin
340  if AWinControl.HandleAllocated then
341  begin
342    Widget := {%H-}PGtkWidget(AWinControl.Handle);
343    Result := GTK_WIDGET_VISIBLE(Widget) and GTK_WIDGET_SENSITIVE(Widget);
344  end else
345    Result := False;
346end;
347
348class function TGtk2WSCustomForm.CreateHandle(const AWinControl: TWinControl;
349  const AParams: TCreateParams): TLCLIntfHandle;
350var
351  WidgetInfo: PWidgetInfo;
352  p: pointer;          // ptr to the newly created GtkWidget
353  Box: Pointer;
354  ABorderStyle: TFormBorderStyle;
355  WindowType: TGtkWindowType;
356  ACustomForm: TCustomForm;
357  AResizable: gint;
358  Allocation: TGtkAllocation;
359begin
360  // Start of old CreateForm method
361  ACustomForm := TCustomForm(AWinControl);
362
363  if (AParams.Style and WS_CHILD) = 0 then
364  begin
365    if csDesigning in ACustomForm.ComponentState then
366      ABorderStyle := bsSizeable
367    else
368      ABorderStyle := ACustomForm.BorderStyle;
369  end
370  else
371    ABorderStyle := bsNone;
372
373  // Maps the border style
374  WindowType := FormStyleMap[ABorderStyle];
375  if (csDesigning in ACustomForm.ComponentState) then
376    WindowType := GTK_WINDOW_TOPLEVEL;
377
378  if (AParams.Style and WS_CHILD) = 0 then
379  begin
380    // create a floating form
381    P := gtk_window_new(WindowType);
382
383    // This is done with the expectation to avoid the button blinking for forms
384    //that hide it, but currently it doesn't seem to make a difference.
385    gtk_window_set_skip_taskbar_hint(P, True);
386
387    if (ABorderStyle = bsNone) and (ACustomForm.FormStyle in fsAllStayOnTop) then
388      gtk_window_set_decorated(PGtkWindow(P), False);
389
390    // Sets the window as resizable or not
391    // Depends on the WM supporting this
392    if (csDesigning in ACustomForm.ComponentState) then
393      AResizable := 1
394    else
395      AResizable := FormResizableMap[ABorderStyle];
396
397    // gtk_window_set_policy is deprecated in Gtk2
398    gtk_window_set_resizable(GTK_WINDOW(P), gboolean(AResizable));
399
400    // Sets the title
401    gtk_window_set_title(PGtkWindow(P), AParams.Caption);
402
403    if (AParams.WndParent <> 0) then
404      gtk_window_set_transient_for(PGtkWindow(P), {%H-}PGtkWindow(AParams.WndParent))
405    else
406    if not (csDesigning in ACustomForm.ComponentState) and
407      (ACustomForm.FormStyle in fsAllStayOnTop) then
408      gtk_window_set_keep_above(PGtkWindow(P), gboolean(True));
409
410    // the clipboard needs a widget
411    if (ClipboardWidget = nil) then
412      Gtk2WidgetSet.SetClipboardWidget(P);
413  end
414  else
415  begin
416    // create a form as child control
417    P := gtk_hbox_new(false, 0);
418  end;
419
420{$IFDEF HASX}
421  if (AWinControl = Application.MainForm) and
422    not Application.HasOption('disableaccurateframe') then
423      Gtk2WidgetSet.CreateDummyWidgetFrame(-1, -1, -1, -1);
424{$ENDIF}
425
426  WidgetInfo := CreateWidgetInfo(P, AWinControl, AParams);
427  WidgetInfo^.FormBorderStyle := Ord(ABorderStyle);
428
429  FillChar(WidgetInfo^.FormWindowState, SizeOf(WidgetInfo^.FormWindowState), #0);
430  WidgetInfo^.FormWindowState.new_window_state := GDK_WINDOW_STATE_WITHDRAWN;
431
432  Box := CreateFormContents(ACustomForm, P, WidgetInfo);
433  gtk_container_add(PGtkContainer(P), Box);
434
435  //so we can double buffer ourselves, eg, the Form Designer
436  if csDesigning in AWinControl.ComponentState then
437    gtk_widget_set_double_buffered(Box, False);
438
439  gtk_widget_show(Box);
440
441  // main menu
442  if (ACustomForm.Menu <> nil) and (ACustomForm.Menu.HandleAllocated) then
443    gtk_box_pack_start(Box, {%H-}PGtkWidget(ACustomForm.Menu.Handle), False, False,0);
444
445  // End of the old CreateForm method
446
447  {$IFNDEF NoStyle}
448  if (AParams.Style and WS_CHILD) = 0 then
449    gtk_widget_set_app_paintable(P, True);
450  {$ENDIF}
451
452  if not (csDesigning in AWinControl.ComponentState) then
453    WidgetInfo^.UserData := Pointer(1);
454
455  Allocation.X := AParams.X;
456  Allocation.Y := AParams.Y;
457  Allocation.Width := AParams.Width;
458  Allocation.Height := AParams.Height;
459  gtk_widget_size_allocate(P, @Allocation);
460
461  {$IFDEF DebugLCLComponents}
462  DebugGtkWidgets.MarkCreated(P, dbgsName(AWinControl));
463  {$ENDIF}
464  Result := TLCLIntfHandle({%H-}PtrUInt(P));
465  Set_RC_Name(AWinControl, P);
466  SetCallbacks(P, WidgetInfo);
467end;
468
469function Gtk2WSDelayRedraw(Data: Pointer): GBoolean; cdecl;
470begin
471  Result := False;
472  gtk_widget_queue_draw(PWidgetInfo(Data)^.ClientWidget);
473  g_idle_remove_by_data(Data);
474end;
475
476class procedure TGtk2WSCustomForm.ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer);
477var
478  Layout: PGtkLayout;
479  WidgetInfo: PWidgetInfo;
480  Adjustment: PGtkAdjustment;
481  h, v: Double;
482  NewPos: Double;
483begin
484  if not AWinControl.HandleAllocated then exit;
485  WidgetInfo := GetWidgetInfo({%H-}PGtkWidget(AWinControl.Handle));
486  Layout := PGtkLayout(WidgetInfo^.ClientWidget);
487  Adjustment := gtk_layout_get_hadjustment(Layout);
488  if Adjustment <> nil then
489  begin
490    h := gtk_adjustment_get_value(Adjustment);
491    NewPos := Adjustment^.upper - Adjustment^.page_size;
492    if h - DeltaX <= NewPos then
493      NewPos := h - DeltaX;
494    if gtk_adjustment_get_value(Adjustment) <> NewPos then
495    begin
496      gtk_adjustment_set_value(Adjustment, NewPos);
497      //if our adjustment reached end, scrollbar button is disabled
498      //so gtk blocks paints for some reason, so we must postpone an update
499      if NewPos >= Adjustment^.upper - Adjustment^.page_size then
500        g_idle_add(@Gtk2WSDelayRedraw, WidgetInfo);
501    end;
502  end;
503  Adjustment := gtk_layout_get_vadjustment(Layout);
504  if Adjustment <> nil then
505  begin
506    v := gtk_adjustment_get_value(Adjustment);
507    NewPos := Adjustment^.upper - Adjustment^.page_size;
508    if v - DeltaY <= NewPos then
509      NewPos := v - DeltaY;
510    if gtk_adjustment_get_value(Adjustment) <> NewPos then
511    begin
512      gtk_adjustment_set_value(Adjustment, NewPos);
513      //if our adjustment reached end, scrollbar button is disabled
514      //so gtk blocks paints for some reason, so we must postpone an update
515      if NewPos >= Adjustment^.upper - Adjustment^.page_size then
516        g_idle_add(@Gtk2WSDelayRedraw, WidgetInfo);
517    end;
518  end;
519end;
520
521class procedure TGtk2WSCustomForm.SetIcon(const AForm: TCustomForm;
522  const Small, Big: HICON);
523
524  procedure SetSmallBigIcon;
525  var
526    List: PGList;
527  begin
528    List := nil;
529    if Small <> 0 then
530      List := g_list_append(List, {%H-}PGdkPixbuf(Small));
531    if Big <> 0 then
532      List := g_list_append(List, {%H-}PGdkPixbuf(Big));
533    gtk_window_set_icon_list({%H-}PGtkWindow(AForm.Handle), List);
534    if List <> nil
535    then  g_list_free(List);
536  end;
537
538  {$IFDEF Gtk2SetIconAll}
539  procedure SetAllIcons;
540  var
541    List: PGList;
542    Icon: TIcon;
543    CurSize: Integer;
544    i: Integer;
545    LastIndex: Integer;
546    OldChange: TNotifyEvent;
547    OldCurrent: Integer;
548    IconHnd: HICON;
549  begin
550    List := nil;
551    //debugln(['TGtk2WSCustomForm.SetIcon Form=',DbgSName(AForm)]);
552    Icon:=AForm.Icon;
553    if (Icon=nil) or Icon.Empty then
554      Icon:=Application.Icon;
555    if Assigned(Icon) and not Icon.Empty then
556    begin
557      CurSize:=16;
558      OldChange:=Icon.OnChange;
559      OldCurrent:=Icon.Current;
560      Icon.OnChange := nil;
561      LastIndex:=-1;
562      while CurSize<=256 do begin
563        i:=Icon.GetBestIndexForSize(Size(CurSize,CurSize));
564        if (i>=0) and (LastIndex<>i) then begin
565          Icon.Current := i;
566          IconHnd:=Icon.ReleaseHandle;
567          if IconHnd <> 0 then
568            List := g_list_append(List, {%H-}PGdkPixbuf(IconHnd));
569          //debugln(['TGtk2WSCustomForm.SetIcon adding ',CurSize]);
570          LastIndex:=i;
571        end;
572        CurSize:=CurSize*2;
573      end;
574      Icon.Current:=OldCurrent;
575      Icon.OnChange:=OldChange;
576    end;
577    gtk_window_set_icon_list({%H-}PGtkWindow(AForm.Handle), List);
578    if List <> nil
579    then  g_list_free(List);
580  end;
581  {$ENDIF}
582
583  {$IFDEF Gtk2SetIconFile}
584  procedure SetIconFromFile;
585  var
586    Filename: String;
587  begin
588    Filename:='test128x128.png';
589    debugln(['SetIconFromFile filename=',Filename]);
590    gtk_window_set_icon_from_file({%H-}PGtkWindow(AForm.Handle),PGChar(Filename),null);
591    debugln(['SetIconFromFile prg name="',g_get_prgname,'"']);
592  end;
593  {$ENDIF}
594
595begin
596  if not WSCheckHandleAllocated(AForm, 'SetIcon')
597  then Exit;
598
599  if (AForm.Parent <> nil) or (AForm.ParentWindow <> 0) then Exit;
600
601  {$IFDEF Gtk2SetIconAll}
602  SetAllIcons;
603  {$ELSE}
604    {$IFDEF Gtk2SetIconFile}
605    SetIconFromFile;
606    {$ELSE}
607    SetSmallBigIcon;
608    {$ENDIF}
609  {$ENDIF}
610end;
611
612class procedure TGtk2WSCustomForm.SetAlphaBlend(const ACustomForm: TCustomForm;
613  const AlphaBlend: Boolean; const Alpha: Byte);
614begin
615  if not WSCheckHandleAllocated(ACustomForm, 'SetAlphaBlend') then
616    Exit;
617  if Assigned(gtk_window_set_opacity) and GTK_IS_WINDOW({%H-}PGtkWidget(ACustomForm.Handle)) then
618    if AlphaBlend then
619      gtk_window_set_opacity({%H-}PGtkWindow(ACustomForm.Handle), Alpha / 255)
620    else
621      gtk_window_set_opacity({%H-}PGtkWindow(ACustomForm.Handle), 1);
622end;
623
624class procedure TGtk2WSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
625  const AFormBorderStyle: TFormBorderStyle);
626var
627  Widget: PGtkWidget;
628  WidgetInfo: PWidgetInfo;
629  // WindowType: TGtkWindowType;
630  Resizable: gint;
631begin
632  if not WSCheckHandleAllocated(AForm, 'SetFormBorderStyle') then
633    exit;
634  if (csDesigning in AForm.ComponentState) then
635    exit;
636
637  Widget := {%H-}PGtkWidget(AForm.Handle);
638  WidgetInfo := GetWidgetInfo(Widget);
639
640  if (WidgetInfo^.FormBorderStyle <> Ord(AFormBorderStyle)) then
641  begin
642    if (AForm.Parent<>nil) then
643    begin
644      // a nested form
645      // at the moment the gtk interface does not support any border for this
646    end else if (AFormBorderStyle <> bsNone) then
647    begin
648      // the borderstyle can be only set on creation
649      RecreateWnd(AForm);
650    end else
651    begin
652      // TODO: set window hint WindowType := FormStyleMap[AFormBorderStyle];
653      Resizable := FormResizableMap[AFormBorderStyle];
654      if (AFormBorderStyle = bsNone) then
655        gtk_window_set_decorated(PGtkWindow(Widget), False);
656      gtk_window_set_resizable(GTK_WINDOW(Widget), gboolean(Resizable));
657      WidgetInfo^.FormBorderStyle := Ord(AFormBorderStyle);
658    end;
659  end;
660end;
661
662class procedure TGtk2WSCustomForm.SetFormStyle(const AForm: TCustomform;
663  const AFormStyle, AOldFormStyle: TFormStyle);
664begin
665  if not WSCheckHandleAllocated(AForm, 'SetFormStyle') then
666    exit;
667  if (csDesigning in AForm.ComponentState) then
668    exit;
669  if GTK_IS_WINDOW({%H-}PGtkWindow(AForm.Handle)) then
670    gtk_window_set_keep_above({%H-}PGtkWindow(AForm.Handle),
671      GBoolean(AFormStyle in fsAllStayOnTop));
672end;
673
674class procedure TGtk2WSCustomForm.SetAllowDropFiles(const AForm: TCustomForm;
675  AValue: Boolean);
676begin
677  if AValue then
678    gtk_drag_dest_set({%H-}PGtkWidget(AForm.Handle), GTK_DEST_DEFAULT_ALL,
679      @FileDragTarget, 1, GDK_ACTION_COPY or GDK_ACTION_MOVE)
680  else
681    gtk_drag_dest_unset({%H-}PGtkWidget(AForm.Handle));
682end;
683
684class procedure TGtk2WSCustomForm.SetShowInTaskbar(const AForm: TCustomForm;
685  const AValue: TShowInTaskbar);
686begin
687  if not WSCheckHandleAllocated(AForm, 'SetShowInTaskbar')
688  then Exit;
689
690  SetFormShowInTaskbar(AForm,AValue);
691end;
692
693class procedure TGtk2WSCustomForm.ShowHide(const AWinControl: TWinControl);
694var
695  {$IFDEF HASX}
696  TempGdkWindow: PGdkWindow;
697  {$ENDIF}
698  AForm, APopupParent: TCustomForm;
699  GtkWindow: PGtkWindow;
700  Geometry: TGdkGeometry;
701
702  function ShowNonModalOverModal: Boolean;
703  var
704    AForm: TCustomForm;
705    AWindow: PGtkWindow;
706  begin
707    Result := False;
708    AForm := TCustomForm(AWinControl);
709    if AWinControl.HandleObjectShouldBeVisible and
710      not (csDesigning in AForm.ComponentState) and
711      not (fsModal in AForm.FormState) and
712      (AForm.Parent = nil) and
713      (AForm.FormStyle <> fsMDIChild) and
714      (ModalWindows <> nil) and (ModalWindows.Count > 0) and
715      not (AForm.FormStyle in fsAllStayOnTop) and
716      (AForm.BorderStyle in [bsDialog, bsSingle, bsSizeable]) and
717      (AForm.PopupParent = nil) and (AForm.PopupMode = pmNone) then
718    begin
719      AWindow := {%H-}PGtkWindow(AForm.Handle);
720      gtk_window_set_modal(AWindow, True);
721      // lcl_nonmodal_over_modal is needed to track nonmodal form
722      // created and shown when we have active modal forms
723      g_object_set_data(PGObject(AWindow),'lcl_nonmodal_over_modal', AForm);
724      Result := True;
725    end;
726  end;
727begin
728  AForm := TCustomForm(AWinControl);
729  if not (csDesigning in AForm.ComponentState) then
730  begin
731    if AForm.HandleObjectShouldBeVisible and
732      GTK_IS_WINDOW({%H-}PGtkWindow(AForm.Handle)) then
733      begin
734        gtk_window_set_keep_above({%H-}PGtkWindow(AForm.Handle),
735          GBoolean(AForm.FormStyle in fsAllStayOnTop))
736      end
737    else
738    if (AForm.FormStyle in fsAllStayOnTop) and
739      not (csDestroying in AWinControl.ComponentState) then
740        gtk_window_set_keep_above({%H-}PGtkWindow(AForm.Handle), GBoolean(False));
741  end;
742
743  GtkWindow := {%H-}PGtkWindow(AForm.Handle);
744
745  if (fsModal in AForm.FormState) and AForm.HandleObjectShouldBeVisible then
746  begin
747    gtk_window_set_default_size(GtkWindow, Max(1,AForm.Width), Max(1,AForm.Height));
748    gtk_widget_set_uposition(PGtkWidget(GtkWindow), AForm.Left, AForm.Top);
749    gtk_window_set_type_hint({%H-}PGtkWindow(AForm.Handle),
750       GtkWindowTypeHints[AForm.BorderStyle]);
751    GtkWindowShowModal(AForm, GtkWindow);
752  end else
753  begin
754    if ShowNonModalOverModal then begin
755      // issue #21459
756    end
757    else if not GTK_IS_WINDOW(GtkWindow) then begin
758      //
759    end
760    else if (AForm.FormStyle <> fsMDIChild) and AForm.HandleObjectShouldBeVisible
761      and (ModalWindows <> nil) and (ModalWindows.Count > 0)
762      and (AForm.PopupParent = nil) and (AForm.BorderStyle = bsNone)
763    then begin
764      // showing a non modal form with bsNone above a modal form
765      gtk_window_set_transient_for(GtkWindow, nil);
766      gtk_window_set_modal(GtkWindow, True);
767    end else begin
768      // hiding/showing normal form
769      // clear former mods, e.g. when a modal form becomes a normal form, see bug 23876
770      {$IFDEF HASX}
771      gtk_window_set_modal(GtkWindow, False);
772      gtk_window_set_transient_for(GtkWindow, nil); //untransient
773      {$ELSE}
774      gtk_window_set_transient_for(GtkWindow, nil); //untransient
775      gtk_window_set_modal(GtkWindow, False);
776      {$ENDIF}
777    end;
778
779    {$IFDEF HASX}
780    // issue #26018
781    if AWinControl.HandleObjectShouldBeVisible and
782      not (csDesigning in AForm.ComponentState) and
783      not (AForm.FormStyle in fsAllStayOnTop) and
784      not (fsModal in AForm.FormState) and
785      (AForm.PopupMode = pmAuto) and
786      (AForm.BorderStyle = bsNone) and
787      (AForm.PopupParent = nil) then
788    begin
789      TempGdkWindow := {%H-}PGdkWindow(Gtk2WidgetSet.GetForegroundWindow);
790      if (TempGdkWindow <> nil) and (GdkWindowObject_modal_hint(GDK_WINDOW_OBJECT(TempGdkWindow)^) = 0) then
791      begin
792        if ((gdk_window_get_state(TempGdkWindow) and GDK_WINDOW_STATE_ABOVE) = GDK_WINDOW_STATE_ABOVE) or
793          GTK2WidgetSet.GetAlwaysOnTopX11(TempGdkWindow) then
794            gtk_window_set_keep_above(GtkWindow, True);
795      end;
796    end;
797
798    if AWinControl.HandleObjectShouldBeVisible and
799      not (csDesigning in AForm.ComponentState) and
800      not (AForm.FormStyle in fsAllStayOnTop) and
801      not (fsModal in AForm.FormState) then
802    begin
803      APopupParent := AForm.GetRealPopupParent;
804      if (APopupParent <> nil) then
805        SetRealPopupParent(AForm, APopupParent);
806    end;
807    {$ENDIF}
808
809    Gtk2WidgetSet.SetVisible(AWinControl, AForm.HandleObjectShouldBeVisible);
810  end;
811
812  if not (csDesigning in AForm.ComponentState) and
813    AForm.HandleObjectShouldBeVisible and
814    (AForm.BorderStyle in [bsDialog, bsSingle]) then
815  begin
816    // we must set fixed size, gtk_window_set_resizable does not work
817    // as expected for some reason.issue #20741
818    with Geometry do
819    begin
820      min_width := AForm.Width;
821      max_width := AForm.Width;
822      min_height := AForm.Height;
823      max_height := AForm.Height;
824
825      base_width := AForm.Width;
826      base_height := AForm.Height;
827      width_inc := 1;
828      height_inc := 1;
829      min_aspect := 0;
830      max_aspect := 1;
831      win_gravity := gtk_window_get_gravity(GtkWindow);
832    end;
833    //debugln('TGtk2WSWinControl.ConstraintsChange A ',GetWidgetDebugReport(Widget),' max=',dbgs(Geometry.max_width),'x',dbgs(Geometry.max_height));
834    gtk_window_set_geometry_hints(GtkWindow, nil, @Geometry,
835      GDK_HINT_POS or GDK_HINT_MIN_SIZE or GDK_HINT_MAX_SIZE);
836  end;
837
838  if not (csDesigning in AForm.ComponentState) and
839    AForm.HandleObjectShouldBeVisible and (AForm.WindowState = wsFullScreen) then
840      gtk_window_fullscreen(GtkWindow);
841
842
843  InvalidateLastWFPResult(AWinControl, AWinControl.BoundsRect);
844end;
845
846class procedure TGtk2WSCustomForm.ShowModal(const AForm: TCustomForm);
847begin
848  // modal is started in ShowHide
849end;
850
851class procedure TGtk2WSCustomForm.SetBorderIcons(const AForm: TCustomForm;
852  const ABorderIcons: TBorderIcons);
853begin
854  if not WSCheckHandleAllocated(AForm, 'SetBorderIcons')
855  then Exit;
856
857  inherited SetBorderIcons(AForm, ABorderIcons);
858end;
859
860class procedure TGtk2WSCustomForm.SetColor(const AWinControl: TWinControl);
861var
862  AScrolled: PGtkWidget;
863  AColor: TColor;
864begin
865  TGtk2WSWinControl.SetColor(AWinControl);
866
867  // Forms: GtkWindow->GtkVBox->gtkScrolledWindow->GtkLayout
868  // we need to set the color of the GtkLayout so that the whole viewport
869  // will be filled (issue #16183)
870  AScrolled := g_object_get_data({%H-}PGObject(AWinControl.Handle), odnScrollArea);
871  if GTK_IS_SCROLLED_WINDOW(AScrolled) and
872    GTK_IS_LAYOUT({%H-}PGtkBin(AScrolled)^.child) then
873  begin
874    AColor := AWinControl.Color;
875    if AColor = clDefault then
876      AColor := GetDefaultColor(AWinControl, dctBrush);
877    Gtk2WidgetSet.SetWidgetColor({%H-}PGtkBin(AScrolled)^.child,
878                                 clNone, AColor,
879                                 [GTK_STATE_NORMAL, GTK_STATE_ACTIVE,
880                                  GTK_STATE_PRELIGHT, GTK_STATE_SELECTED]);
881  end;
882end;
883
884class procedure TGtk2WSCustomForm.SetRealPopupParent(
885  const ACustomForm: TCustomForm; const APopupParent: TCustomForm);
886begin
887  if not WSCheckHandleAllocated(ACustomForm, 'SetRealPopupParent') then Exit;
888
889  if APopupParent <> nil then
890    gtk_window_set_transient_for({%H-}PGtkWindow(ACustomForm.Handle), {%H-}PGtkWindow(APopupParent.Handle))
891  else
892    gtk_window_set_transient_for({%H-}PGtkWindow(ACustomForm.Handle), nil);
893end;
894
895
896{ TGtk2WSScrollingWinControl }
897
898class procedure TGtk2WSScrollingWinControl.SetCallbacks(
899  const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
900var
901  UseScrollCallback: Boolean;
902begin
903  TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject));
904  with TGTK2WidgetSet(Widgetset) do
905  begin
906    UseScrollCallBack := (gtk_major_version = 2) and (gtk_minor_version <= 8);
907    if UseScrollCallBack then
908    begin
909      SetCallback(LM_HSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
910      SetCallback(LM_VSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
911    end;
912  end;
913end;
914
915class function TGtk2WSScrollingWinControl.CreateHandle(
916  const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle;
917var
918  Scrolled: PGtkScrolledWindow;
919  Layout: PGtkWidget;
920  WidgetInfo: PWidgetInfo;
921  Adjustment: PGtkAdjustment;
922begin
923  // create a gtk_scrolled_window for the scrollbars
924  Scrolled := PGtkScrolledWindow(gtk_scrolled_window_new(nil, nil));
925  gtk_scrolled_window_set_shadow_type(Scrolled,
926    BorderStyleShadowMap[TScrollingWinControl(AWinControl).BorderStyle]);
927
928  GTK_WIDGET_UNSET_FLAGS(Scrolled^.hscrollbar, GTK_CAN_FOCUS);
929  GTK_WIDGET_UNSET_FLAGS(Scrolled^.vscrollbar, GTK_CAN_FOCUS);
930  gtk_scrolled_window_set_policy(Scrolled, GTK_POLICY_NEVER, GTK_POLICY_NEVER);
931  g_object_set_data(PGObject(Scrolled), odnScrollArea, Scrolled);
932
933  {$IFDEF DebugLCLComponents}
934  DebugGtkWidgets.MarkCreated(Scrolled, dbgsName(AWinControl));
935  {$ENDIF}
936
937  WidgetInfo := CreateWidgetInfo(Scrolled, AWinControl, AParams);
938
939  Adjustment := gtk_scrolled_window_get_vadjustment(Scrolled);
940  if Adjustment <> nil then
941    g_object_set_data(PGObject(Adjustment), odnScrollBar, Scrolled^.vscrollbar);
942
943  Adjustment := gtk_scrolled_window_get_hadjustment(Scrolled);
944  if Adjustment <> nil then
945    g_object_set_data(PGObject(Adjustment), odnScrollBar, Scrolled^.hscrollbar);
946
947  // create a gtk_layout for the client area, so children can be added at
948  // free x,y positions and the scrollbars automatically scrolls the children
949
950  Layout := gtk_layout_new(nil, nil);
951  gtk_container_add(PGTKContainer(Scrolled), Layout);
952  gtk_widget_show(Layout);
953  SetFixedWidget(Scrolled, Layout);
954  SetMainWidget(Scrolled, Layout);
955
956  Result := TLCLIntfHandle({%H-}PtrUInt(Scrolled));
957
958  Set_RC_Name(AWinControl, PGtkWidget(Scrolled));
959  SetCallBacks(PGtkWidget(Scrolled), WidgetInfo);
960  if (gtk_major_version >= 2) and (gtk_minor_version > 8) then
961  begin
962    g_signal_connect(Scrolled^.hscrollbar, 'change-value',
963                     TGCallback(@Gtk2RangeScrollCB), WidgetInfo);
964    g_signal_connect(Scrolled^.vscrollbar, 'change-value',
965                     TGCallback(@Gtk2RangeScrollCB), WidgetInfo);
966
967    g_signal_connect(Scrolled^.hscrollbar, 'value-changed',
968      TGCallback(@Gtk2RangeValueChanged), WidgetInfo);
969    g_signal_connect(Scrolled^.vscrollbar, 'value-changed',
970      TGCallback(@Gtk2RangeValueChanged), WidgetInfo);
971
972    g_signal_connect(Scrolled^.hscrollbar, 'button-press-event',
973                     TGCallback(@Gtk2RangeScrollPressCB), WidgetInfo);
974    g_signal_connect(Scrolled^.hscrollbar, 'button-release-event',
975                     TGCallback(@Gtk2RangeScrollReleaseCB), WidgetInfo);
976    g_signal_connect(Scrolled^.vscrollbar, 'button-press-event',
977                     TGCallback(@Gtk2RangeScrollPressCB), WidgetInfo);
978    g_signal_connect(Scrolled^.vscrollbar, 'button-release-event',
979                     TGCallback(@Gtk2RangeScrollReleaseCB), WidgetInfo);
980    if (AWinControl is TScrollBox) then
981      g_signal_connect(Scrolled, 'scroll-event',
982                       TGCallback(@Gtk2ScrolledWindowScrollCB), WidgetInfo);
983  end;
984end;
985
986class procedure TGtk2WSScrollingWinControl.SetColor(const AWinControl: TWinControl);
987var
988  AColor: TColor;
989begin
990  if not WSCheckHandleAllocated(AWinControl, 'SetColor')
991  then Exit;
992
993  // ScrollingWinControl: GtkScrolledWindow->GtkLayout
994  // we need to set the color of the GtkLayout so that the whole viewport
995  // will be filled (issue #16183)
996  AColor := AWinControl.Color;
997  if AColor = clDefault then
998    AColor := GetDefaultColor(AWinControl, dctBrush);
999  Gtk2WidgetSet.SetWidgetColor({%H-}PGtkBin(AWinControl.Handle)^.child,
1000                               clNone, AColor,
1001                               [GTK_STATE_NORMAL, GTK_STATE_ACTIVE,
1002                                GTK_STATE_PRELIGHT, GTK_STATE_SELECTED]);
1003end;
1004
1005{ TGtk2WSHintWindow }
1006
1007class procedure TGtk2WSHintWindow.SetCallbacks(const AWidget: PGtkWidget;
1008  const AWidgetInfo: PWidgetInfo);
1009begin
1010  TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject));
1011  if (TControl(AWidgetInfo^.LCLObject).Parent = nil) then
1012    with TGTK2WidgetSet(Widgetset) do
1013    begin
1014      {$note test with smaller minor versions and check where LM_CONFIGUREEVENT is needed.}
1015      {$IFDEF HASX}
1016      // fix for buggy compiz.
1017      // see http://bugs.freepascal.org/view.php?id=17523
1018      if not compositeManagerRunning then
1019      {$ENDIF}
1020        SetCallback(LM_CONFIGUREEVENT, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
1021    end;
1022end;
1023
1024class function TGtk2WSHintWindow.CreateHandle(const AWinControl: TWinControl;
1025  const AParams: TCreateParams): TLCLIntfHandle;
1026var
1027  TempWidget : PGTKWidget;       // pointer to gtk-widget (local use when neccessary)
1028  p          : pointer;          // ptr to the newly created GtkWidget
1029  ACustomForm: TCustomForm;
1030  AWindow: PGdkWindow;
1031  WidgetInfo: PWidgetInfo;
1032begin
1033  ACustomForm := TCustomForm(AWinControl);
1034
1035  p := gtk_window_new(GTK_WINDOW_POPUP);
1036  WidgetInfo := CreateWidgetInfo(p, AWinControl, AParams);
1037  gtk_window_set_policy(GTK_WINDOW(p), 0, 0, 0);
1038  gtk_window_set_focus_on_map(P, False);
1039
1040  // issue #24363
1041  g_object_set_data(P,'lclhintwindow',AWinControl);
1042
1043  // Create the form client area
1044  TempWidget := CreateFixedClientWidget;
1045  gtk_container_add(p, TempWidget);
1046  GTK_WIDGET_UNSET_FLAGS(TempWidget, GTK_CAN_FOCUS);
1047  gtk_widget_show(TempWidget);
1048  SetFixedWidget(p, TempWidget);
1049  SetMainWidget(p, TempWidget);
1050
1051  ACustomForm.FormStyle := fsStayOnTop;
1052  ACustomForm.BorderStyle := bsNone;
1053  gtk_widget_realize(p);
1054  AWindow := GetControlWindow(P);
1055  {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
1056
1057  gdk_window_set_decorations(AWindow, GetWindowDecorations(ACustomForm));
1058
1059  gdk_window_set_functions(AWindow, GetWindowFunction(ACustomForm));
1060
1061  {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
1062  gtk_widget_show_all(TempWidget);// Important: do not show the window yet, only make its content visible
1063
1064  {$IFNDEF NoStyle}
1065  if (ACustomForm.Parent = nil) then
1066    gtk_widget_set_app_paintable(P, True);
1067  {$ENDIF}
1068
1069  {$IFDEF DebugLCLComponents}
1070  DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl));
1071  {$ENDIF}
1072  Result := TLCLIntfHandle({%H-}PtrUInt(P));
1073  Set_RC_Name(AWinControl, P);
1074  SetCallbacks(P, WidgetInfo);
1075end;
1076
1077class procedure TGtk2WSHintWindow.ShowHide(const AWinControl: TWinControl);
1078var
1079  bVisible: boolean;
1080begin
1081  if not WSCheckHandleAllocated(AWinControl, 'SetColor') then
1082    exit;
1083
1084  bVisible := AWinControl.HandleObjectShouldBeVisible;
1085  if bVisible then
1086    gtk_window_set_type_hint({%H-}PGtkWindow(AWinControl.Handle), GDK_WINDOW_TYPE_HINT_TOOLTIP);
1087  Gtk2WidgetSet.SetVisible(AWinControl, bVisible);
1088  InvalidateLastWFPResult(AWinControl, AWinControl.BoundsRect);
1089end;
1090
1091end.
1092