{ ***************************************************************************** * Gtk3WSForms.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 Gtk3WSForms; {$mode objfpc}{$H+} {$i gtk3defines.inc} interface //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// // 1) Only class methods allowed // 2) Class methods have to be published and virtual // 3) To get as little as posible circles, the uses // clause should contain only those LCL units // needed for registration. WSxxx units are OK // 4) To improve speed, register only classes in the // initialization section which actually // implement something // 5) To enable your XXX widgetset units, look at // the uses clause of the XXXintf.pp //////////////////////////////////////////////////// uses //////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// Classes, Graphics, Controls, Forms, LCLType, LCLProc, //////////////////////////////////////////////////// WSLCLClasses, WSControls, WSForms, WSProc, LazGtk3, LazGdk3, LazGLib2, gtk3widgets, gtk3int, gtk3objects; type { TWSScrollingWinControl } TGtk3WSScrollingWinControlClass = class of TWSScrollingWinControl; { TGtk3WSScrollingWinControl } TGtk3WSScrollingWinControl = class(TWSScrollingWinControl) published class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLHandle; override; end; { TWSScrollBox } TGtk3WSScrollBox = class(TGtk3WSScrollingWinControl) published end; { TWSCustomFrame } TGtk3WSCustomFrame = class(TGtk3WSScrollingWinControl) published end; { TWSFrame } TGtk3WSFrame = class(TGtk3WSCustomFrame) published end; { TWSCustomForm } { TGtk3WSCustomForm } TGtk3WSCustomForm = class(TWSCustomForm) published class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLHandle; override; class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override; class procedure ShowHide(const AWinControl: TWinControl); override; class procedure CloseModal(const ACustomForm: TCustomForm); override; class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); override; class procedure SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean; const Alpha: Byte); override; class procedure SetBorderIcons(const AForm: TCustomForm; const ABorderIcons: TBorderIcons); override; class procedure SetFormBorderStyle(const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle); override; class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle, AOldFormStyle: TFormStyle); override; class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override; class procedure ShowModal(const ACustomForm: TCustomForm); override; class procedure SetRealPopupParent(const ACustomForm: TCustomForm; const APopupParent: TCustomForm); override; class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override; class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); override; class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; override; {mdi support} class function ActiveMDIChild(const AForm: TCustomForm): TCustomForm; override; class function Cascade(const AForm: TCustomForm): Boolean; override; class function GetClientHandle(const AForm: TCustomForm): HWND; override; class function GetMDIChildren(const AForm: TCustomForm; AIndex: Integer): TCustomForm; override; class function Next(const AForm: TCustomForm): Boolean; override; class function Previous(const AForm: TCustomForm): Boolean; override; class function Tile(const AForm: TCustomForm): Boolean; override; class function MDIChildCount(const AForm: TCustomForm): Integer; override; end; TGtk3WSCustomFormClass = class of TGtk3WSCustomForm; { TWSForm } TGtk3WSForm = class(TGtk3WSCustomForm) published end; { TWSHintWindow } { TGtk3WSHintWindow } TGtk3WSHintWindow = class(TGtk3WSCustomForm) published class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLHandle; override; end; { TWSScreen } TGtk3WSScreen = class(TWSLCLComponent) published end; { TWSApplicationProperties } TGtk3WSApplicationProperties = class(TWSLCLComponent) published end; implementation uses SysUtils, gtk3procs, LazLogger; { TGtk3WSScrollingWinControl } class function TGtk3WSScrollingWinControl.CreateHandle( const AWinControl: TWinControl; const AParams: TCreateParams): TLCLHandle; begin Result := TLCLHandle(TGtk3ScrollingWinControl.Create(AWinControl, AParams)); end; { TGtk3WSCustomForm } class function TGtk3WSCustomForm.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLHandle; var AWindow: TGtk3Window; AGtkWindow: PGtkWindow; ARect: TGdkRectangle; AWidget: PGtkWidget; begin {$IFDEF GTK3DEBUGCORE} DebugLn('TGtk3WSCustomForm.CreateHandle'); {$ENDIF} if IsFormDesign(AWinControl) or (csDesigning in AWinControl.ComponentState) then AWindow := TGtk3DesignWidget.Create(AWinControl, AParams) else AWindow := TGtk3Window.Create(AWinControl, AParams); //debugln(['TGtk3WSCustomForm.CreateHandle AWindow.Widget=',Get3WidgetClassName(AWindow.Widget)]); AWidget:=AWindow.Widget; AGtkWindow:=nil; if Gtk3IsGtkWindow(AWidget) then begin AGtkWindow := PGtkWindow(AWidget); AWindow.Title := AWinControl.Caption; AGtkWindow^.set_resizable(True); AGtkWindow^.set_has_resize_grip(False); end; with ARect do begin x := AWinControl.Left; y := AWinControl.Top; width := AWinControl.Width; height := AWinControl.Height; end; AWidget^.set_allocation(@ARect); if AGtkWindow<>nil then Gtk3WidgetSet.AddWindow(AGtkWindow); Result := TLCLHandle(AWindow); {$IFDEF GTK3DEBUGCORE} DebugLn('TGtk3WSCustomForm.CreateHandle handle ',dbgs(Result)); {$ENDIF} end; class procedure TGtk3WSCustomForm.SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); begin if not WSCheckHandleAllocated(AWinControl, 'SetBounds') then Exit; {$IFDEF GTK3DEBUGCORE} DebugLn('TGtk3WSCustomForm.SetBounds ',dbgsName(AWinControl),Format(' ALeft %d ATop %d AWidth %d AHeight %d InUpdate %s',[ALeft, ATop, AWidth, AHeight, BoolToStr(TGtk3Widget(AWinControl.Handle).InUpdate, True)])); {$ENDIF} TGtk3Widget(AWinControl.Handle).SetBounds(ALeft,ATop,AWidth,AHeight); end; {$IFDEF GTK3DEBUGCORE} procedure ReleaseInputGrab; var Display: PGdkDisplay; Seat: PGdkSeat; begin // Get the default display Display := gdk_display_get_default(); if not Assigned(Display) then begin WriteLn('Error: No default display available.'); Exit; end; // Get the default seat Seat := gdk_display_get_default_seat(Display); if not Assigned(Seat) then begin WriteLn('Error: No default seat available.'); Exit; end; Gtk3WidgetSet.SetCapture(0); gdk_seat_ungrab(Seat); end; {$ENDIF} function GetActiveGtkWindow: PGtkWindow; var Toplevels, Node: PGList; GtkWin: PGtkWidget; begin Result := nil; Toplevels := gtk_window_list_toplevels; Node := Toplevels; while Node <> nil do begin GtkWin := PGtkWidget(Node^.data); if gtk_window_is_active(PGtkWindow(GtkWin)) then begin Result := PGtkWindow(GtkWin); Break; end; Node := Node^.next; end; g_list_free(Toplevels); end; class procedure TGtk3WSCustomForm.ShowHide(const AWinControl: TWinControl); var AMask:TGdkEventMask; AForm, OtherForm: TCustomForm; AWindow, ATransient: PGtkWindow; i: Integer; AGeom: TGdkGeometry; AGeomMask: TGdkWindowHints; ShouldBeVisible: Boolean; AGtk3Widget: TGtk3Widget; OtherGtk3Window: TGtk3Window; procedure CheckAndFixGeometry; const WaitDelay: gulong = 4000; WaitLoops: integer = 4; var x, y, w, h: gint; begin AWindow^.window^.get_geometry(@x, @y, @w, @h); x := 0; // we don't use result of get_geometry y := 0; if Assigned(aTransient) and not AWindow^.get_decorated then begin if Assigned(AForm.PopupParent) or (AForm.PopupMode = pmAuto) then aTransient^.window^.get_origin(@x, @y); end else begin x := 0; y := 0; end; with AWinControl do AWindow^.window^.move_resize(Left + x, Top + y, Width, Height); AWindow^.window^.process_updates(True); //Give a little breath to WM. for x := 0 to WaitLoops - 1 do begin g_usleep(WaitDelay); g_main_context_iteration(nil, false); end; //Note that here may be still wrong geometry under x11, //but LCL should be happy at this point. end; begin {$IFDEF GTK3DEBUGCORE} DebugLn('TGtk3WSCustomForm.ShowHide handleAllocated=',dbgs(AWinControl.HandleAllocated)); {$ENDIF} if not WSCheckHandleAllocated(AWinControl, 'ShowHide') then Exit; AForm := TCustomForm(AWinControl); {$IFDEF GTK3DEBUGCORE} writeln('>==== TGtk3WSCustomForm.ShowHide begin '); DebugLn('TGtk3WSCustomForm.ShowHide visible=',dbgs(AWinControl.HandleObjectShouldBeVisible)); {$ENDIF} AGtk3Widget:=TGtk3Widget(AForm.Handle); if Gtk3IsGtkWindow(AGtk3Widget.Widget) then AWindow := PGtkWindow(AGtk3Widget.Widget) else AWindow := nil; ShouldBeVisible:=AForm.HandleObjectShouldBeVisible; {$IFDEF GTK3DEBUGCORE} //use this if pure SetCapture(0) does not work under wayland. ReleaseInputGrab; {$ENDIF} Gtk3WidgetSet.SetCapture(0); if ShouldBeVisible and not IsFormDesign(AForm) and (AForm.Parent = nil) then begin {note that gtk3 docs says that GDK_WINDOW_TYPE_HINT_UTILITY is for fsStayOnTop, and set_keep_above() is for fsSystemStayOnTop, but it does not work, so we use set_keep_above for both scenarios.} if (AForm.FormStyle in fsAllStayOnTop) then AWindow^.set_keep_above(True); if (fsModal in AForm.FormState) then begin AWindow^.set_modal(True); AWindow^.window^.set_modal_hint(true); end; AWindow^.realize; if (AForm.BorderStyle = bsNone) then begin if AWindow^.transient_for = nil then begin if Assigned(AForm.PopupParent) then ATransient := PGtkWindow(TGtk3Window(AForm.PopupParent.Handle).Widget) else if AForm.PopupMode = pmAuto then ATransient := GetActiveGtkWindow else ATransient := nil; {$IFDEF GTK3DEBUGCORE} if Assigned(ATransient) then begin writeln('TGtk3WSCustomFOrm.ShowHide: ATransient (popupParent form) is ',dbgsName(TGtk3Window(HwndFromGtkWidget(ATransient)).LCLObject)); writeln(dbgsName(AForm),' bounds ',dbgs(Bounds(AForm.Left, AForm.Top, AForm.Width, AForm.Height))); end; {$ENDIF} AWindow^.set_transient_for(ATransient); end; if Assigned(AGtk3Widget.Shape) then begin AWindow^.set_app_paintable(True); AWindow^.set_visual(TGdkScreen.get_default^.get_rgba_visual); AGtk3Widget.SetWindowShape(AGtk3Widget.Shape, AWindow^.window); end; end; end; AGtk3Widget.BeginUpdate; AGtk3Widget.Visible := ShouldBeVisible; if AGtk3Widget.Visible then begin if not IsFormDesign(AForm) and (fsModal in AForm.FormState) and (Application.ModalLevel > 0) then begin // DebugLn('TGtk3WSCustomForm.ShowHide ModalLevel=',dbgs(Application.ModalLevel),' Self=',dbgsName(AForm)); for i := 0 to Screen.CustomFormZOrderCount - 1 do begin OtherForm:=Screen.CustomFormsZOrdered[i]; // DebugLn('CustomFormZOrder[',dbgs(i),'].',dbgsName(OtherForm),' modal=',dbgs(fsModal in OtherForm.FormState)); if (OtherForm <> AForm) and OtherForm.HandleAllocated then begin // DebugLn('TGtk3WSCustomForm.ShowHide setTransient for ',dbgsName(OtherForm)); OtherGtk3Window:=TGtk3Window(OtherForm.Handle); if Gtk3IsGtkWindow(OtherGtk3Window.Widget) then begin AWindow^.set_transient_for(PGtkWindow(OtherGtk3Window.Widget)); break; end; end; end; end; if Assigned(AWinControl.Parent) then begin AGtk3Widget.EndUpdate; exit; end; //See issue #41412 CheckAndFixGeometry; AWindow^.show_all; AMask := AWindow^.window^.get_events; AWindow^.window^.set_events(GDK_ALL_EVENTS_MASK); if not IsFormDesign(AForm) then AWindow^.present; end else begin if not IsFormDesign(AForm) and ((fsModal in AForm.FormState) or (AForm.BorderStyle = bsNone)) then begin if AWindow^.transient_for <> nil then AWindow^.set_transient_for(nil); end; end; AGtk3Widget.EndUpdate; {$IFDEF GTK3DEBUGCORE} writeln('<==== TGtk3WSCustomForm.ShowHide end '); {$ENDIF} end; class procedure TGtk3WSCustomForm.CloseModal(const ACustomForm: TCustomForm); begin {$IFDEF GTK3DEBUGCORE} DebugLn('TGtk3WSCustomForm.CloseModal'); {$ENDIF} end; class procedure TGtk3WSCustomForm.SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); begin {$IFDEF GTK3DEBUGCORE} DebugLn('TGtk3WSCustomForm.SetAllowDropFiles'); {$ENDIF} if AValue then gtk_drag_dest_set(TGtk3Widget(AForm.Handle).Widget, GTK_DEST_DEFAULT_ALL, @FileDragTarget, 1, [GDK_ACTION_COPY, GDK_ACTION_MOVE]) else gtk_drag_dest_unset(TGtk3Widget(AForm.Handle).Widget); end; class procedure TGtk3WSCustomForm.SetBorderIcons(const AForm: TCustomForm; const ABorderIcons: TBorderIcons); begin if not WSCheckHandleAllocated(AForm, 'SetBorderIcons') then Exit; {$IFDEF GTK3DEBUGCORE} DebugLn('TGtk3WSCustomForm.SetBorderIcons'); {$ENDIF} end; class procedure TGtk3WSCustomForm.SetFormBorderStyle(const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle); begin if not WSCheckHandleAllocated(AForm, 'SetFormBorderStyle') then Exit; // will be done in interface override {$IFDEF GTK3DEBUGCORE} DebugLn('TGtk3WSCustomForm.SetFormBorderStyle'); {$ENDIF} RecreateWnd(AForm); end; class procedure TGtk3WSCustomForm.SetFormStyle(const AForm: TCustomform; const AFormStyle, AOldFormStyle: TFormStyle); begin if not WSCheckHandleAllocated(AForm, 'SetFormStyle') then Exit; {$IFDEF GTK3DEBUGCORE} DebugLn('TGtk3WSCustomForm.SetFormStyle'); {$ENDIF} end; class procedure TGtk3WSCustomForm.SetIcon(const AForm: TCustomForm; const Small, Big: HICON); begin if not WSCheckHandleAllocated(AForm, 'SetIcon') then Exit; if Big = 0 then TGtk3Window(AForm.Handle).Icon := Gtk3WidgetSet.AppIcon else TGtk3Window(AForm.Handle).Icon := TGtk3Image(Big).Handle; end; class procedure TGtk3WSCustomForm.SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); var AWindow: TGtk3Window; Enable: boolean; begin if not WSCheckHandleAllocated(AForm, 'SetShowInTaskbar') then Exit; {$IFDEF GTK3DEBUGCORE} DebugLn('TGtk3WSCustomForm.SetShowInTaskbar'); {$ENDIF} if (AForm.Parent <> nil) or (AForm.ParentWindow <> 0) or not (AForm.HandleAllocated) then Exit; AWindow := TGtk3Window(AForm.Handle); if not Gtk3IsGdkWindow(AWindow.Widget^.window) then exit; Enable := AValue <> stNever; if (not Enable) and AWindow.SkipTaskBarHint then AWindow.SkipTaskBarHint := False; AWindow.SkipTaskBarHint := not Enable; end; class procedure TGtk3WSCustomForm.SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); begin if not WSCheckHandleAllocated(AWinControl, 'SetZPosition') then Exit; {$IFDEF GTK3DEBUGCORE} DebugLn('TGtk3WSCustomForm.SetZPosition'); {$ENDIF} end; class function TGtk3WSCustomForm.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; const DefColors: array[TDefaultColorType] of TColor = ( { dctBrush } clForm, { dctFont } clBtnText ); begin Result := DefColors[ADefaultColorType]; end; class procedure TGtk3WSCustomForm.ShowModal(const ACustomForm: TCustomForm); begin if not WSCheckHandleAllocated(ACustomForm, 'ShowModal') then Exit; {$IFDEF GTK3DEBUGCORE} DebugLn('TGtk3WSCustomForm.ShowModal ... we are using ShowHide.'); {$ENDIF} end; class procedure TGtk3WSCustomForm.SetRealPopupParent( const ACustomForm: TCustomForm; const APopupParent: TCustomForm); begin if not WSCheckHandleAllocated(ACustomForm, 'SetRealPopupParent') then Exit; {$IFDEF GTK3DEBUGCORE} DebugLn('TGtk3WSCustomForm.SetRealPopupParent AForm=',dbgsName(ACustomForm),' PopupParent=',dbgsName(APopupParent)); {$ENDIF} if Assigned(APopupParent) and APopupParent.HandleAllocated then PGtkWindow(TGtk3Window(ACustomForm.Handle).Widget)^.set_transient_for(PGtkWindow(TGtk3Window(APopupParent.Handle).Widget)) else PGtkWindow(TGtk3Window(ACustomForm.Handle).Widget)^.set_transient_for(nil); end; class procedure TGtk3WSCustomForm.SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean; const Alpha: Byte); begin if not WSCheckHandleAllocated(ACustomForm, 'SetAlphaBlend') then Exit; {$IFDEF GTK3DEBUGCORE} DebugLn('TGtk3WSCustomForm.SetAlphaBlend'); {$ENDIF} if Gtk3IsGtkWindow(TGtk3Widget(ACustomForm.Handle).Widget) then if AlphaBlend then TGtk3Widget(ACustomForm.Handle).Widget^.set_opacity(Alpha / 255) else TGtk3Widget(ACustomForm.Handle).Widget^.set_opacity(1); end; { mdi support } class function TGtk3WSCustomForm.ActiveMDIChild(const AForm: TCustomForm ): TCustomForm; begin Result := nil; end; class function TGtk3WSCustomForm.Cascade(const AForm: TCustomForm): Boolean; begin Result := False; end; class function TGtk3WSCustomForm.GetClientHandle(const AForm: TCustomForm): HWND; begin Result := 0; end; class function TGtk3WSCustomForm.GetMDIChildren(const AForm: TCustomForm; AIndex: Integer): TCustomForm; begin Result := nil; end; class function TGtk3WSCustomForm.MDIChildCount(const AForm: TCustomForm): Integer; begin Result := 0; end; class function TGtk3WSCustomForm.Next(const AForm: TCustomForm): Boolean; begin Result := False; end; class function TGtk3WSCustomForm.Previous(const AForm: TCustomForm): Boolean; begin Result := False; end; class function TGtk3WSCustomForm.Tile(const AForm: TCustomForm): Boolean; begin Result := False; end; { TGtk3WSHintWindow } class function TGtk3WSHintWindow.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLHandle; begin Result := TLCLHandle(TGtk3HintWindow.Create(AWinControl, AParams)); end; end.