{ ***************************************************************************** * gtk3widgets.pas * * ------------- * * * * * ***************************************************************************** ***************************************************************************** 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 Gtk3Widgets; {$mode objfpc}{$H+} {$i gtk3defines.inc} interface uses Classes, SysUtils, types, math, // LCL Controls, StdCtrls, ExtCtrls, Buttons, ComCtrls, Graphics, Dialogs, Forms, Menus, ExtDlgs, Spin, CheckLst, PairSplitter, LCLType, LMessages, LCLMessageGlue, LCLIntf, // LazUtils GraphType, LazUtilities, // GTK3 LazGtk3, LazGdk3, LazGObject2, LazGLib2, LazCairo1, LazPango1, LazGdkPixbuf2, gtk3objects, gtk3procs, gtk3private, Gtk3CellRenderer; type TByteSet = set of byte; // records TPaintData = record PaintWidget: PGtkWidget; ClipRect: PRect; ClipRegion: Pcairo_region_t; end; TDefaultRGBA = record R: Double; G: Double; B: Double; Alpha: Double; end; TGtk3WidgetType = (wtWidget, wtStaticText, wtProgressBar, wtLayout, wtContainer, wtMenuBar, wtMenu, wtMenuItem, wtEntry, wtSpinEdit, wtNotebook, wtTabControl, wtComboBox, wtGroupBox, wtCalendar, wtTrackBar, wtScrollBar, wtScrollingWin, wtListBox, wtListView, wtCheckListBox, wtMemo, wtTreeModel, wtCustomControl, wtScrollingWinControl, wtWindow, wtDialog, wtHintWindow, wtGLArea); TGtk3WidgetTypes = set of TGtk3WidgetType; TGtk3GroupBoxType = (gbtGroupBox, gbtCheckGroup, gbtRadioGroup); { TGtk3Widget } TGtk3Widget = class(TGtk3Object, IUnknown) private FCairoContext: Pcairo_t; FShape: PGdkPixbuf; FContext: HDC; FPaintData: TPaintData; FDrawSignal: GULong; // needed by designer FFont: PPangoFontDescription; class function WidgetEvent(widget: PGtkWidget; event: PGdkEvent; data: GPointer): gboolean; cdecl; static; {main event filter of widget} strict private FCentralWidgetRGBA: array [0{GTK_STATE_NORMAL}..4{GTK_STATE_INSENSITIVE}] of TDefaultRGBA; FEnterLeaveTime: Cardinal; FFocusableByMouse: Boolean; {shell we call SetFocus on mouse down. Default = False} FHasCaret: boolean; FOwner: PGtkWidget; FProps: TStringList; FWidgetMapped: boolean; FWidgetRGBA: array [0{GTK_STATE_NORMAL}..4{GTK_STATE_INSENSITIVE}] of TDefaultRGBA; function CanSendLCLMessage: Boolean; function GetCairoContext: Pcairo_t; function GetEnabled: Boolean; function GetFont: PPangoFontDescription; function GetStyleContext: PGtkStyleContext; function GetVisible: Boolean; procedure SetEnabled(AValue: Boolean); procedure SetFont(AValue: PPangoFontDescription); procedure SetShape(AValue: PGdkPixbuf); procedure SetStyleContext({%H-}AValue: PGtkStyleContext); class procedure DestroyWidgetEvent({%H-}w: PGtkWidget;{%H-}data:gpointer); cdecl; static; class function DrawWidget(AWidget: PGtkWidget; AContext: Pcairo_t; Data: gpointer): gboolean; cdecl; static; class procedure MapWidget(AWidget: PGtkWidget; Data: gPointer); cdecl; static; {GtkWindow never sends this signal !} class function MouseEnterNotify(aWidget: PGtkWidget; aEvent: PGdkEventCrossing; aData: gpointer): gboolean; cdecl; static; class function MouseLeaveNotify(aWidget: PGtkWidget; aEvent: PGdkEventCrossing; aData: gpointer): gboolean; cdecl; static; class function ResizeEvent(AWidget: PGtkWidget; AEvent: PGdkEvent; Data: gpointer): gboolean; cdecl; static; class function ScrollEvent(AWidget: PGtkWidget; AEvent: PGdkEvent; AData: GPointer): GBoolean; cdecl; static; class procedure SizeAllocate(AWidget: PGtkWidget; AGdkRect: PGdkRectangle; Data: gpointer); cdecl; static; class procedure WidgetHide({%H-}AWidget:PGtkWidget; AData:gpointer); cdecl; static; class procedure WidgetShow({%H-}AWidget:PGtkWidget; AData:gpointer); cdecl; static; protected FCentralWidget: PGtkWidget; FHasPaint: Boolean; FKeysToEat: TByteSet; FParams: TCreateParams; fText: string; FOwnWidget: Boolean; FWidget: PGtkWidget; FWidgetType: TGtk3WidgetTypes; // IUnknown implementation function QueryInterface(constref iid: TGuid; out obj): LongInt; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF}; function _AddRef: LongInt; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF}; function _Release: LongInt; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF}; function IsDesigning: boolean; virtual; function EatArrowKeys(const AKey: Word): Boolean; virtual; function getText: String; virtual; procedure setText(const AValue: String); virtual; function GetContext: HDC; virtual; function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; virtual; procedure DestroyWidget; virtual; procedure DoBeforeLCLPaint; virtual; function GetColor: TColor; virtual; procedure SetColor(AValue: TColor); virtual; function GetFontColor: TColor; virtual; procedure SetFontColor(AValue: TColor); virtual; function GetWidget:PGtkWidget; procedure ConnectSizeAllocateSignal(ToWidget: PGtkWidget); virtual; procedure SetVisible(AValue: Boolean); virtual; public LCLObject: TWinControl; LCLWidth: integer; {setted up only TWSControl.SetBounds} LCLHeight: integer; {setted up only TWSControl.SetBounds} public constructor Create(const AWinControl: TWinControl; const AParams: TCreateParams); virtual; overload; constructor CreateFrom(const AWinControl: TWinControl; AWidget: PGtkWidget); virtual; procedure InitializeWidget; virtual; procedure DeInitializeWidget; procedure RecreateWidget; procedure DestroyNotify({%H-}AWidget: PGtkWidget); virtual; destructor Destroy; override; function CanFocus: Boolean; virtual; function GetFocusableByMouse: Boolean; function getClientOffset: TPoint; virtual; function getWidgetPos: TPoint; virtual; procedure OffsetMousePos(APoint: PPoint); virtual; function ClientToScreen(var P:TPoint):boolean; function ScreenToClient(var P: TPoint): Integer; function DeliverMessage(var Msg; const AIsInputEvent: Boolean = False): LRESULT; virtual; function GtkEventKey(Sender: PGtkWidget; Event: PGdkEvent; AKeyPress: Boolean): Boolean; virtual; cdecl; function GtkEventMouse(Sender: PGtkWidget; Event: PGdkEvent): Boolean; virtual; cdecl; function GtkEventMouseMove(Sender: PGtkWidget; Event: PGdkEvent): Boolean; virtual; cdecl; function GtkEventPaint(Sender: PGtkWidget; AContext: Pcairo_t): Boolean; virtual; cdecl; function GtkEventResize(Sender: PGtkWidget; Event: PGdkEvent): Boolean; virtual; cdecl; procedure GtkEventFocus(Sender: PGtkWidget; Event: PGdkEvent); cdecl; procedure GtkEventDestroy; cdecl; function GtkEventMouseWheel(Sender: PGtkWidget; Event: PGdkEvent): Boolean; virtual; cdecl; function IsValidHandle: Boolean; function IsWidgetOk: Boolean; virtual; function IsIconic: Boolean; virtual; function getType: TGType; function getTypeName: PgChar; procedure lowerWidget; virtual; procedure raiseWidget; virtual; procedure stackUnder(AWidget: PGtkWidget); virtual; function GetCapture: TGtk3Widget; virtual; function SetCapture: HWND; virtual; function getClientRect: TRect; virtual; function getClientBounds: TRect; virtual; procedure SetBounds(ALeft,ATop,AWidth,AHeight:integer); virtual; procedure SetLclFont(const AFont:TFont); virtual; procedure SetWindowShape(AShape: PGdkPixBuf; AWindow: PGdkWindow); virtual; function GetContainerWidget: PGtkWidget; virtual; function GetPosition(out APoint: TPoint): Boolean; virtual; procedure Release; override; procedure Hide; virtual; function getParent: TGtk3Widget; function GetWindow: PGdkWindow; virtual; procedure Move(ALeft, ATop: Integer); procedure Activate; virtual; procedure preferredSize(var PreferredWidth, PreferredHeight: integer; {%H-}WithThemeSpace: Boolean); virtual; procedure SetCursor(ACursor: HCURSOR); procedure SetFocus; virtual; procedure SetParent(AParent: TGtk3Widget; const ALeft, ATop: Integer); virtual; procedure Show; virtual; procedure ShowAll; virtual; procedure Update(ARect: PRect); virtual; property CairoContext: Pcairo_t read GetCairoContext; property Color: TColor read GetColor write SetColor; property Context: HDC read GetContext; property Enabled: Boolean read GetEnabled write SetEnabled; property Font: PPangoFontDescription read GetFont write SetFont; property FontColor: TColor read GetFontColor write SetFontColor; property HasCaret: boolean read FHasCaret write FHasCaret; property KeysToEat: TByteSet read FKeysToEat write FKeysToEat; property PaintData: TPaintData read FPaintData write FPaintData; property Shape: PGdkPixbuf read FShape write SetShape; property StyleContext: PGtkStyleContext read GetStyleContext write SetStyleContext; property Text: String read getText write setText; property Visible: Boolean read GetVisible write SetVisible; property Widget: PGtkWidget read GetWidget; property WidgetMapped: boolean read FWidgetMapped write FWidgetMapped; {very important. Gtk3 does not give us reliable informations about this state get_mapped returns true, but actually map event isn't arrived yet.} property WidgetType: TGtk3WidgetTypes read FWidgetType; end; { TGtk3Editable } TGtk3Editable = class(TGtk3Widget) private function GetReadOnly: Boolean; procedure SetReadOnly(AValue: Boolean); protected PrivateCursorPos: Integer; // used only for delayed selStart and selLength PrivateSelection: Integer; function getCaretPos: TPoint; virtual; procedure SetCaretPos(AValue: TPoint); virtual; public function getSelStart: Integer; virtual; function getSelLength: Integer; virtual; procedure setSelStart(AValue: Integer); virtual; procedure setSelLength(AValue: Integer); virtual; property CaretPos: TPoint read GetCaretPos write SetCaretPos; property ReadOnly: Boolean read GetReadOnly write SetReadOnly; end; { TGtk3Entry } TGtk3Entry = class(TGtk3Editable) private function GetAlignment: TAlignment; procedure SetAlignment(AValue: TAlignment); strict private class procedure EntryChanged({%H-}AEntry: PGtkEntryBuffer; AData: GPointer); cdecl; static; class procedure InsertText(editable: PGtkEditable; aNewText: PgChar; anewtextlen: gint; var pos:Pgint; data: gpointer);cdecl; static; class procedure EntrySizeAllocate(AWidget: PGtkWidget; AGdkRect: PGdkRectangle; Data: gpointer); cdecl; static; protected procedure ConnectSizeAllocateSignal(ToWidget: PGtkWidget); override; function EatArrowKeys(const AKey: Word): Boolean; override; function getText: String; override; procedure setText(const AValue: String); override; function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; public procedure preferredSize(var PreferredWidth, PreferredHeight: integer; {%H-}WithThemeSpace: Boolean); override; procedure InitializeWidget; override; procedure SetEchoMode(AVisible: Boolean); procedure SetMaxLength(AMaxLength: Integer); procedure SetPasswordChar(APasswordChar: Char); procedure SetNumbersOnly(ANumbersOnly:boolean); procedure SetTextHint(const AHint:string); procedure SetFrame(const aborder:boolean); function GetTextHint:string; function IsWidgetOk: Boolean; override; property Alignment: TAlignment read GetAlignment write SetAlignment; property TextHint:string read GetTextHint write SetTextHint; end; { TGtk3SpinEdit } TGtk3SpinEdit = class(TGtk3Entry) strict private class procedure SpinValueChanged({%H-}aSpin: PGtkSpinButton; aData: gpointer); cdecl; static; private function GetMaximum: Double; function GetMinimum: Double; function GetNumDigits: Integer; function GetNumeric: Boolean; function GetStep: Double; function GetValue: Double; procedure SetNumDigits(AValue: Integer); procedure SetNumeric(AValue: Boolean); procedure SetStep(AValue: Double); procedure SetValue(AValue: Double); protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; function EatArrowKeys(const {%H-}AKey: Word): Boolean; override; public procedure InitializeWidget; override; function IsWidgetOk: Boolean; override; procedure SetRange(AMin, AMax: Double); property Minimum: Double read GetMinimum; property Maximum: Double read GetMaximum; property Numeric: Boolean read GetNumeric write SetNumeric; property NumDigits: Integer read GetNumDigits write SetNumDigits; property Step: Double read GetStep write SetStep; property Value: Double read GetValue write SetValue; end; { TGtk3Range } TGtk3Range = class(TGtk3Widget) strict private class procedure RangeChanged(ARange:PGtkRange;AData:gPointer); cdecl; static; private function GetPosition: Integer; reintroduce; function GetRange: TPoint; procedure SetPosition(AValue: Integer); procedure SetRange(AValue: TPoint); public procedure InitializeWidget; override; procedure SetStep(AStep: Integer; APageSize: Integer); property Range: TPoint read GetRange write SetRange; property Position: Integer read GetPosition write SetPosition; end; { TGtk3TrackBar } TGtk3TrackBar = class(TGtk3Range) private FOrientation: TTrackBarOrientation; function GetReversed: Boolean; procedure SetReversed(AValue: Boolean); protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; public procedure SetBounds(ALeft,ATop,AWidth,AHeight:integer); override; function GetTrackBarOrientation: TTrackBarOrientation; procedure SetScalePos(AValue: TTrackBarScalePos); procedure SetTickMarks(AValue: TTickMark; ATickStyle: TTickStyle); property Reversed: Boolean read GetReversed write SetReversed; end; { TGtk3ScrollBar } TGtk3ScrollBar = class(TGtk3Range) protected class procedure ScrollBarValueChanged(adjustment: PGtkAdjustment; data:gpointer);cdecl; static; function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; public procedure SetParams; end; { TGtk3ProgressBar } TGtk3ProgressBar = class(TGtk3Widget) private function GetOrientation: TProgressBarOrientation; function GetPosition: Integer; reintroduce; function GetShowText: Boolean; function GetStyle: TProgressBarStyle; procedure SetOrientation(AValue: TProgressBarOrientation); procedure SetPosition(AValue: Integer); procedure SetShowText(AValue: Boolean); procedure SetStyle(AValue: TProgressBarStyle); protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; public procedure InitializeWidget; override; property Orientation: TProgressBarOrientation read GetOrientation write SetOrientation; property Position: Integer read GetPosition write SetPosition; property ShowText: Boolean read GetShowText write SetShowText; property Style: TProgressBarStyle read GetStyle write SetStyle; end; { TGtk3Calendar } TGtk3Calendar = class(TGtk3Widget) protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; public procedure GetDate(out AYear, AMonth, ADay: LongWord); procedure SetDate(const AYear, AMonth, ADay: LongWord); procedure SetDisplayOptions(const ADisplayOptions: TGtkCalendarDisplayOptions); end; { TGtk3StaticText } TGtk3StaticText = class(TGtk3Widget) private function GetAlignment: TAlignment; function GetStaticBorderStyle: TStaticBorderStyle; procedure SetAlignment(AValue: TAlignment); procedure SetStaticBorderStyle(AValue: TStaticBorderStyle); protected function getText: String; override; procedure setText(const AValue: String); override; function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; public property Alignment: TAlignment read GetAlignment write SetAlignment; property StaticBorderStyle: TStaticBorderStyle read GetStaticBorderStyle write SetStaticBorderStyle; end; { TGtk3Container } TGtk3Container = class(TGtk3Widget) protected procedure SetVisible(AValue: Boolean); override; public procedure InitializeWidget; override; procedure AddChild(AWidget: PGtkWidget; const ALeft, ATop: Integer); virtual; end; { TGtk3Page } TGtk3Page = class(TGtk3Container) private FPageLabel: PGtkLabel; protected procedure setText(const AValue: String); override; function CreateWidget(const Params: TCreateParams):PGtkWidget; override; procedure DestroyWidget; override; public function getClientOffset:TPoint; override; function getClientRect: TRect; override; end; { TGtk3NoteBook } TGtk3NoteBook = class (TGtk3Container) private FDefaultClientRect:TRect; protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; public procedure InitializeWidget; override; function GetTabSize(AWinControl: TWinControl): integer; {returns size of tab. Height if orientation is top/bottom, width if orientation is left/right} function getClientRect: TRect; override; function getPagesCount: integer; procedure InsertPage(ACustomPage: TCustomPage; AIndex: Integer); procedure MovePage(ACustomPage: TCustomPage; ANewIndex: Integer); procedure RemovePage(AIndex: Integer); procedure SetPageIndex(AIndex: Integer); procedure SetShowTabs(const AShowTabs: Boolean); procedure SetTabPosition(const ATabPosition: TTabPosition); procedure SetTabLabelText(AChild: TCustomPage; const AText: String); function GetTabLabelText(AChild: TCustomPage): String; property DefaultClientRect: TRect read FDefaultClientRect write FDefaultClientRect; //measured in gtk3wscomctrls.getDefaultClientRect end; { TGtk3Bin } TGtk3Bin = class(TGtk3Container) end; { TGtk3Paned } TGtk3Paned = class(TGtk3Container) protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; end; { TGtk3SplitterSide } TGtk3SplitterSide = class(TGtk3Container) protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; end; { TGtk3MenuShell } TGtk3MenuShell = class(TGtk3Container) public MenuObject: TMenu; constructor Create(const AMenu: TMenu; AMenuBar: PGtkMenuBar); virtual; overload; procedure Insert(AMenuShell: PGtkMenuShell; APosition: Integer); procedure InitializeWidget; override; end; { TGtk3MenuBar } TGtk3MenuBar = class(TGtk3MenuShell) protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; end; { TGtk3Menu } TGtk3Menu = class(TGtk3MenuShell) protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; public PopupPoint: TPoint; constructor CreateFromMenuItem(const AMenuItem: TMenuItem); virtual; overload; end; { TGtk3MenuItem } TGtk3MenuItem = class(TGtk3Bin) private function GetCaption: string; procedure SetCaption(const AValue: string); strict private class procedure MenuItemActivated(AItem:PGtkMenuItem;AData:GPointer); cdecl; static; class function MenuItemEvent(AWidget:PGtkWidget;event:PGdkEvent; data:GPointer):gboolean; cdecl; static; protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; public Lock:integer; MenuItem: TMenuItem; constructor Create(const AMenuItem: TMenuItem); virtual; overload; procedure InitializeWidget; override; procedure SetCheck(ACheck:boolean); property Caption: string read GetCaption write SetCaption; end; { TGtk3ScrollableWin } TGtk3ScrollableWin = class(TGtk3Container) private FBorderStyle: TBorderStyle; FHBarInitialized, FVBarInitialized: boolean; function GetHScrollBarPolicy: TGtkPolicyType; function GetVScrollBarPolicy: TGtkPolicyType; procedure SetBorderStyle(AValue: TBorderStyle); procedure SetHScrollBarPolicy(AValue: TGtkPolicyType); virtual; procedure SetVScrollBarPolicy(AValue: TGtkPolicyType); virtual; protected class function RangeChangeValue(ARange: PGtkRange; AScrollType: TGtkScrollType; AValue: gdouble; AData: TGtk3Widget): gboolean; cdecl; static; public {result = true if scrollbar is pressed by mouse, AMouseOver if mouse is over scrollbar pressed or not.} class function CheckIfScrollbarPressed(scrollbar: PGtkWidget; out AMouseOver: boolean; const ACheckModifier: TGdkModifierTypeIdx): boolean; procedure SetScrollBarsSignalHandlers(const AIsHorizontalScrollBar: boolean); function getClientBounds: TRect; override; function getViewport: PGtkViewport; virtual; function getHorizontalScrollbar: PGtkScrollbar; virtual; abstract; function getVerticalScrollbar: PGtkScrollbar; virtual; abstract; function getScrolledWindow: PGtkScrolledWindow; virtual; abstract; property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle; property HScrollBarPolicy: TGtkPolicyType read GetHScrollBarPolicy write SetHScrollBarPolicy; property VScrollBarPolicy: TGtkPolicyType read GetVScrollBarPolicy write SetVScrollBarPolicy; end; { TGtk3ToolBar } TGtk3ToolBar = class(TGtk3Container) private fBmpList:TList; procedure ButtonClicked(data: gPointer); cdecl; procedure ClearGlyphs; public destructor Destroy; override; function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; end; { TGtk3Memo } TGtk3Memo = class(TGtk3ScrollableWin) private function GetAlignment: TAlignment; function GetReadOnly: Boolean; function GetWantTabs: Boolean; function GetWordWrap: Boolean; procedure SetAlignment(AValue: TAlignment); procedure SetReadOnly(AValue: Boolean); procedure SetWantTabs(AValue: Boolean); procedure SetWordWrap(AValue: Boolean); protected function getText: String; override; procedure setText(const AValue: String); override; function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; function EatArrowKeys(const {%H-}AKey: Word): Boolean; override; public function getHorizontalScrollbar: PGtkScrollbar; override; function getVerticalScrollbar: PGtkScrollbar; override; function GetScrolledWindow: PGtkScrolledWindow; override; public property Alignment: TAlignment read GetAlignment write SetAlignment; property ReadOnly: Boolean read GetReadOnly write SetReadOnly; property WantTabs: Boolean read GetWantTabs write SetWantTabs; property WordWrap: Boolean read GetWordWrap write SetWordWrap; end; { TGtk3ListBox } TGtk3ListBox = class(TGtk3ScrollableWin) private FListBoxStyle: TListBoxStyle; function GetItemIndex: Integer; function GetMultiSelect: Boolean; procedure SetItemIndex(AValue: Integer); procedure SetListBoxStyle(AValue: TListBoxStyle); procedure SetMultiSelect(AValue: Boolean); protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; function EatArrowKeys(const {%H-}AKey: Word): Boolean; override; public procedure InitializeWidget; override; function getHorizontalScrollbar: PGtkScrollbar; override; function getVerticalScrollbar: PGtkScrollbar; override; function GetScrolledWindow: PGtkScrolledWindow; override; public function GetSelCount: Integer; function GetSelection: PGtkTreeSelection; function GetItemRect(const AIndex: integer): TRect; function GetIndexAtXY(const X, Y: integer): integer; function GetItemSelected(const AIndex: Integer): Boolean; function GetScrollWidth: integer; procedure SelectItem(const AIndex: Integer; ASelected: Boolean); procedure SetTopIndex(const AIndex: Integer); property ItemIndex: Integer read GetItemIndex write SetItemIndex; property MultiSelect: Boolean read GetMultiSelect write SetMultiSelect; property ListBoxStyle: TListBoxStyle read FListBoxStyle write SetListBoxStyle; end; { TGtk3CheckListBox } TGtk3CheckListBox = class(TGtk3ListBox) protected function CreateWidget(const {%H-}Params: TCreateParams): PGtkWidget; override; end; { TGtk3ListView } TGtk3ListView = class(TGtk3ScrollableWin) private FPreselectedIndices: TFPList; FImages: TFPList; FIsTreeView: Boolean; protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; function EatArrowKeys(const {%H-}AKey: Word): Boolean; override; procedure SetColor(AValue: TColor); override; class function selection_changed(AIconView: PGtkIconView; aData: gPointer):gboolean; cdecl; static; public destructor Destroy; override; {interface implementation} function getHorizontalScrollbar: PGtkScrollbar; override; function getVerticalScrollbar: PGtkScrollbar; override; function GetScrolledWindow: PGtkScrolledWindow; override; procedure ClearImages; procedure ColumnDelete(AIndex: Integer); function ColumnGetWidth(AIndex: Integer): Integer; procedure ColumnInsert(AIndex: Integer; AColumn: TListColumn); procedure SetAlignment(AIndex: Integer; {%H-}AColumn: TListColumn; AAlignment: TAlignment); procedure SetColumnAutoSize(AIndex: Integer; {%H-}AColumn: TListColumn; AAutoSize: Boolean); procedure SetColumnCaption(AIndex: Integer; {%H-}AColumn: TListColumn; const ACaption: String); procedure SetColumnMaxWidth(AIndex: Integer; {%H-}AColumn: TListColumn; AMaxWidth: Integer); procedure SetColumnMinWidth(AIndex: Integer; {%H-}AColumn: TListColumn; AMinWidth: Integer); procedure SetColumnWidth(AIndex: Integer; {%H-}AColumn: TListColumn; AWidth: Integer); procedure SetColumnVisible(AIndex: Integer; {%H-}AColumn: TListColumn; AVisible: Boolean); procedure ColumnSetSortIndicator(const AIndex: Integer; const {%H-}AColumn: TListColumn; const ASortIndicator: TSortIndicator); procedure UpdateItem(AIndex:integer;AItem: TListItem); procedure ItemDelete(AIndex: Integer); function ItemDisplayRect(AIndex: Integer; ASubItem: integer; ACode: TDisplayCode): TRect; procedure ItemInsert(AIndex: Integer; AItem: TListItem); function ItemPosition(AIndex: integer): TPoint; procedure ItemSetText(AIndex, ASubIndex: Integer; AItem: TListItem; const AText: String); procedure ItemSetImage(AIndex, ASubIndex: Integer; AItem: TListItem); procedure ItemSetState(const AIndex: Integer; const {%H-}AItem: TListItem; const AState: TListItemState; const AIsSet: Boolean); function ItemGetState(const AIndex: Integer; const {%H-}AItem: TListItem; const AState: TListItemState; out AIsSet: Boolean): Boolean; procedure setItemWidth(const AImageListWidth: integer=0); //calculates width of vsIcon item. Param aWidth is imageList.Width procedure ScrollToRow(const ARow: integer); procedure UpdateImageCellsSize; property Images: TFPList read FImages write FImages; property IsTreeView: Boolean read FIsTreeView; end; { TGtk3Box } TGtk3Box = class(TGtk3Container) end; { TGtk3StatusBar } TGtk3StatusBar = class(TGtk3Box) protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; end; { TGtk3Panel } TGtk3Panel = class(TGtk3Bin) private FBorderStyle: TBorderStyle; procedure SetBorderStyle(AValue: TBorderStyle); protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; procedure DoBeforeLCLPaint; override; procedure setText(const AValue: String); override; public property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle; end; { TGtk3GroupBox } TGtk3GroupBox = class(TGtk3Bin) strict private class procedure GroupBoxSizeAllocate(AWidget: PGtkWidget; AGdkRect: PGdkRectangle; Data: gpointer); cdecl; static; private FGroupBoxType:TGtk3GroupBoxType; function GetInnerClientRect(Frame:PGtkWidget):TRect; protected procedure DoBeforeLCLPaint; override; procedure ConnectSizeAllocateSignal(ToWidget: PGtkWidget); override; function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; function getText: String; override; procedure setText(const AValue: String); override; public function getClientRect:TRect; override; property GroupBoxType: TGtk3GroupBoxType read FGroupBoxType write FGroupBoxType; end; { TGtk3ComboBox } TGtk3ComboBox = class(TGtk3Bin) private FCellView: PGtkCellView; function GetItemIndex: Integer; procedure SetDroppedDown(AValue: boolean); procedure SetItemIndex(AValue: Integer); function GetDroppedDown: boolean; strict private class procedure ComboSizeAllocate(AWidget: PGtkWidget; AGdkRect: PGdkRectangle; Data: gpointer); cdecl; static; class procedure ComboBoxChanged({%H-}ACombo: PGtkComboBox; AData: gpointer); cdecl; static; class procedure NotifySignal(AObject: PGObject; pspec: PGParamSpec; AData: GPointer); cdecl; static; protected procedure ConnectSizeAllocateSignal(ToWidget:PGtkWidget);override; function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; function EatArrowKeys(const AKey: Word): Boolean; override; function getText: String; override; procedure setText(const AValue: String); override; public procedure DumpPrivateStructValues(const ADbgEvent: String); public function CanFocus: Boolean; override; procedure SetBounds(ALeft,ATop,AWidth,AHeight:integer); override; procedure SetFocus; override; function GetCellView: PGtkCellView; function GetPopupWidget: PGtkWidget; function GetButtonWidget: PGtkWidget; function GetArrowWidget: PGtkWidget; function getSelStart: integer; function getSelLength: integer; function getMaxLength: integer; procedure SetMaxLength(const AMaxLength: integer); procedure SetSelStart(const ANewStart: integer); procedure SetSelLength(const ANewLength: integer); procedure InitializeWidget; override; property DroppedDown: boolean read GetDroppedDown write SetDroppedDown; property ItemIndex: Integer read GetItemIndex write SetItemIndex; end; { TGtk3Button } TGtk3Button = class(TGtk3Bin) private FMargin: Integer; FLayout: Integer; FSpacing: Integer; FImage: TBitmap; function getLayout: Integer; function getMargin: Integer; procedure SetLayout(AValue: Integer); procedure SetMargin(AValue: Integer); procedure SetSpacing(AValue: Integer); strict private class procedure ButtonClicked({%H-}aButton: PGtkButton; pData:pointer); cdecl; static; protected procedure SetImage(AImage:TBitmap); function getText: String; override; procedure setText(const AValue: String); override; function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; public destructor Destroy; override; function IsWidgetOk: Boolean; override; procedure SetDefault(const ADefault: Boolean); property Layout: Integer read getLayout write SetLayout; property Margin: Integer read getMargin write SetMargin; property Spacing: Integer read FSpacing write SetSpacing; property Image:TBitmap read fImage write SetImage; end; { TGtk3ToggleButton } TGtk3ToggleButton = class(TGtk3Button) protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; public procedure InitializeWidget; override; end; { TGtk3CheckBox } TGtk3CheckBox = class(TGtk3ToggleButton) private function GetState: TCheckBoxState; procedure SetState(AValue: TCheckBoxState); protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; public procedure SetBounds(ALeft,ATop,AWidth,AHeight:integer); override; property State: TCheckBoxState read GetState write SetState; end; { TGtk3RadioButton } TGtk3RadioButton = class(TGtk3CheckBox) protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; public function getClientRect:TRect; override; procedure InitializeWidget; override; end; { TGtk3CustomControl } TGtk3CustomControl = class(TGtk3ScrollableWin) strict private class procedure RangeValueChanged(range: PGtkRange; data: gpointer); cdecl; static; protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; function EatArrowKeys(const {%H-}AKey: Word): Boolean; override; public procedure DoBeforeLCLPaint; override; procedure OffsetMousePos(APoint: PPoint); override; procedure InitializeWidget; override; function getViewport: PGtkViewport; override; procedure preferredSize(var PreferredWidth, PreferredHeight: integer; {%H-}WithThemeSpace: Boolean); override; function getClientRect: TRect; override; function getHorizontalScrollbar: PGtkScrollbar; override; function getVerticalScrollbar: PGtkScrollbar; override; function GetScrolledWindow: PGtkScrolledWindow; override; end; { TGtk3ScrollingWinControl } TGtk3ScrollingWinControl = class(TGtk3CustomControl) protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; end; { TGtk3Splitter } TGtk3Splitter = class(TGtk3Panel) public end; { TGtk3Window } TGtk3Window = class(TGtk3ScrollableWin) {we are TGtk3Bin actually, but it won't hurt since we need scroll} private FIcon: PGdkPixBuf; FScrollWin: PGtkScrolledWindow; FMenuBar: PGtkMenuBar; FBox: PGtkBox; function GetSkipTaskBarHint: Boolean; function GetTitle: String; procedure SetIcon(AValue: PGdkPixBuf); procedure SetSkipTaskBarHint(AValue: Boolean); procedure SetTitle(const AValue: String); strict private class function WindowMapEvent(awidget:PGtkWindow;AEvent: PGdkEventAny; adata: gpointer): gboolean; cdecl; static; //uses lcl-window-first-map data. class procedure WindowSizeAllocate(AWidget: PGtkWidget; AGdkRect: PGdkRectangle; Data: gpointer); cdecl; static; class function WindowStateSignal(AWidget: PGtkWidget; AEvent: PGdkEvent; AData: gPointer): gboolean; cdecl; static; protected FFirstMapRect: TRect; procedure ConnectSizeAllocateSignal(ToWidget: PGtkWidget); override; function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; function EatArrowKeys(const {%H-}AKey: Word): Boolean; override; function getText: String; override; procedure setText(const AValue: String); override; public // function getClientBounds: TRect; override; function getViewport: PGtkViewport; override; function getClientRect: TRect; override; function getHorizontalScrollbar: PGtkScrollbar; override; function getVerticalScrollbar: PGtkScrollbar; override; function GetScrolledWindow: PGtkScrolledWindow; override; function ShowState(nstate:integer):boolean; // winapi ShowWindow procedure UpdateWindowState; // LCL WindowState class function decoration_flags(Aform: TCustomForm): TGdkWMDecoration; public procedure DoBeforeLCLPaint; override; procedure SetBounds(ALeft,ATop,AWidth,AHeight:integer); override; destructor Destroy; override; procedure Activate; override; procedure ActivateWindow(AEvent: PGdkEvent); function CloseQuery: Boolean; function GetWindow: PGdkWindow; override; function GetMenuBar: PGtkMenuBar; function GetBox: PGtkBox; function GetWindowState: TGdkWindowState; property Icon: PGdkPixBuf read FIcon write SetIcon; property SkipTaskBarHint: Boolean read GetSkipTaskBarHint write SetSkipTaskBarHint; property Title: String read GetTitle write SetTitle; end; { TGtk3HintWindow } TGtk3HintWindow = class(TGtk3Window) protected function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; public procedure InitializeWidget; override; end; { TGtk3Dialog } TGtk3Dialog = class(TGtk3Widget) private class function CloseCB(dlg:TGtk3Dialog): GBoolean; cdecl; class function CloseQueryCB(w:PGtkWidget;dlg:TGtk3Dialog): GBoolean; cdecl; class function DestroyCB(dlg:TGtk3Dialog): GBoolean; cdecl; class function ResponseCB(response_id:gint; dlg: TGtk3Dialog): GBoolean; cdecl; class function RealizeCB(dlg:TGtk3Dialog): GBoolean; cdecl; protected function response_handler(response_id:TGtkResponseType):boolean; virtual; function close_handler():boolean; virtual; procedure SetCallbacks; virtual; function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; public CommonDialog: TCommonDialog; procedure InitializeWidget; override; procedure CloseDialog; virtual; end; { TGtk3FileDialog } TGtk3FileDialog = class(TGtk3Dialog) private protected function CreateWidget(const {%H-}Params: TCreateParams): PGtkWidget; override; public constructor Create(const ACommonDialog: TCommonDialog); virtual; overload; end; { TGtk3FontSelectionDialog } TGtk3FontSelectionDialog = class(TGtk3Dialog) protected function response_handler(resp_id:TGtkResponseType):boolean; override; public procedure InitializeWidget; override; constructor Create(const ACommonDialog: TCommonDialog); virtual; overload; end; { TGtk3ColorSelectionDialog } TGtk3ColorSelectionDialog = class(TGtk3Dialog) public procedure InitializeWidget; override; constructor Create(const ACommonDialog: TCommonDialog); virtual; overload; end; { TGtk3newColorSelectionDialog } TGtk3newColorSelectionDialog = class(TGtk3Dialog) protected function response_handler(resp_id:TGtkResponseType):boolean; override; public constructor Create(const ACommonDialog: TCommonDialog); virtual; overload; procedure InitializeWidget; override; class procedure color_to_rgba(clr:TColor;out rgba:TgdkRGBA); class function rgba_to_color(const rgba:TgdkRGBA):TColor; end; { TGtk3GLArea } TGtk3GLArea = class(TGtk3Widget) protected function CreateWidget(const {%H-}Params: TCreateParams): PGtkWidget; override; public procedure Update({%H-}ARect: PRect); override; end; { TGtk3DesignWidget } TGtk3DesignWidget = class(TGtk3Window) protected FDesignContext: HDC; procedure BringDesignerToFront; procedure ResizeDesigner; function CreateWidget(const {%H-}Params: TCreateParams): PGtkWidget; override; function GetContext: HDC; override; public procedure InitializeWidget; override; function GtkEventPaint(Sender: PGtkWidget; AContext: Pcairo_t): Boolean; override; cdecl; procedure lowerWidget; override; procedure raiseWidget; override; property DesignContext: HDC read FDesignContext; end; implementation uses {$IFDEF GTK3DEBUGKEYPRESS}TypInfo,{$ENDIF}gtk3int, gtk3caret, imglist,lclproc, LazLogger; const GDK_DEFAULT_EVENTS_MASK = [ GDK_EXPOSURE_MASK, {2} GDK_POINTER_MOTION_MASK, {4} GDK_POINTER_MOTION_HINT_MASK, {8} GDK_BUTTON_MOTION_MASK, {16} GDK_BUTTON1_MOTION_MASK, {32} GDK_BUTTON2_MOTION_MASK, {64} GDK_BUTTON3_MOTION_MASK, {128} GDK_BUTTON_PRESS_MASK, {256} GDK_BUTTON_RELEASE_MASK, {512} GDK_KEY_PRESS_MASK, {1024} GDK_KEY_RELEASE_MASK, {2048} GDK_ENTER_NOTIFY_MASK, {4096} GDK_LEAVE_NOTIFY_MASK, {8192} GDK_FOCUS_CHANGE_MASK, {16384} GDK_STRUCTURE_MASK, {32768} GDK_PROPERTY_CHANGE_MASK, {65536} GDK_VISIBILITY_NOTIFY_MASK, {131072} GDK_PROXIMITY_IN_MASK, {262144} GDK_PROXIMITY_OUT_MASK, {524288} GDK_SUBSTRUCTURE_MASK, {1048576} GDK_SCROLL_MASK, {2097152} GDK_TOUCH_MASK {4194304} // GDK_SMOOTH_SCROLL_MASK {8388608} //there is a bug in GTK3, see https://stackoverflow.com/questions/11775161/gtk3-get-mouse-scroll-direction ]; function Gtk3EventToStr(AEvent: TGdkEventType): String; begin Result := 'GDK_NOTHING'; case AEvent of GDK_DELETE: Result := 'GDK_DELETE'; GDK_DESTROY: Result := 'GDK_DESTROY'; GDK_EXPOSE: Result := 'GDK_EXPOSE'; GDK_MOTION_NOTIFY: Result := 'GDK_MOTION_NOTIFY'; GDK_BUTTON_PRESS: Result := 'GDK_BUTTON_PRESS'; GDK_2BUTTON_PRESS: Result := 'GDK_2BUTTON_PRESS'; GDK_3BUTTON_PRESS: Result := 'GDK_3BUTTON_PRESS'; GDK_BUTTON_RELEASE: Result := 'GDK_BUTTON_RELEASE'; GDK_KEY_PRESS: Result := 'GDK_KEY_PRESS'; GDK_KEY_RELEASE: Result := 'GDK_KEY_RELEASE'; GDK_ENTER_NOTIFY: Result := 'GDK_ENTER_NOTIFY'; GDK_LEAVE_NOTIFY: Result := 'GDK_LEAVE_NOTIFY'; GDK_FOCUS_CHANGE: Result := 'GDK_FOCUS_CHANGE'; GDK_CONFIGURE: Result := 'GDK_CONFIGURE'; GDK_MAP: Result := 'GDK_MAP'; GDK_UNMAP: Result := 'GDK_UNMAP'; GDK_PROPERTY_NOTIFY: Result := 'GDK_PROPERTY_NOTIFY'; GDK_SELECTION_CLEAR: Result := 'GDK_SELECTION_CLEAR'; GDK_SELECTION_REQUEST: Result := 'GDK_SELECTION_REQUEST'; GDK_SELECTION_NOTIFY: Result := 'GDK_SELECTION_NOTIFY'; GDK_PROXIMITY_IN: Result := 'GDK_PROXIMITY_IN'; GDK_PROXIMITY_OUT: Result := 'GDK_PROXIMITY_OUT'; GDK_DRAG_ENTER: Result := 'GDK_DRAG_ENTER'; GDK_DRAG_LEAVE: Result := 'GDK_DRAG_LEAVE'; GDK_DRAG_MOTION_: Result := 'GDK_DRAG_MOTION_'; GDK_DRAG_STATUS_: Result := 'GDK_DRAG_STATUS_'; GDK_DROP_START: Result := 'GDK_DROP_START'; GDK_DROP_FINISHED: Result := 'GDK_DROP_FINISHED'; GDK_CLIENT_EVENT: Result := 'GDK_CLIENT_EVENT'; GDK_VISIBILITY_NOTIFY: Result := 'GDK_VISIBILITY_NOTIFY'; GDK_SCROLL: Result := 'GDK_SCROLL'; GDK_WINDOW_STATE: Result := 'GDK_WINDOW_STATE'; GDK_SETTING: Result := 'GDK_SETTING'; GDK_OWNER_CHANGE: Result := 'GDK_OWNER_CHANGE'; GDK_GRAB_BROKEN: Result := 'GDK_GRAB_BROKEN'; GDK_DAMAGE: Result := 'GDK_DAMAGE'; GDK_TOUCH_BEGIN: Result := 'GDK_TOUCH_BEGIN'; GDK_TOUCH_UPDATE: Result := 'GDK_TOUCH_UPDATE'; GDK_TOUCH_END: Result := 'GDK_TOUCH_END'; GDK_TOUCH_CANCEL: Result := 'GDK_TOUCH_CANCEL'; GDK_EVENT_LAST: Result := 'GDK_EVENT_LAST'; else Result := 'UNKNOWN GDK EVENT'; end; end; function GtkModifierStateToShiftState(AState: TGdkModifierType; AIsKeyEvent: Boolean): Cardinal; begin Result := 0; if GDK_SHIFT_MASK in AState then Result := Result or MK_SHIFT; if GDK_CONTROL_MASK in AState then Result := Result or MK_CONTROL; if GDK_MOD1_MASK in AState then begin if AIsKeyEvent then Result := Result or KF_ALTDOWN else Result := Result or MK_ALT; end; end; {$i gtk3lclcombobox.inc} {$i gtk3lclentry.inc} {$i gtk3lclbutton.inc} {$i gtk3lclspinbutton.inc} {$i gtk3lclframe.inc} {$i gtk3lclnotebook.inc} class function TGtk3Widget.WidgetEvent(widget: PGtkWidget; event: PGdkEvent; data: GPointer): gboolean; cdecl; begin {$IFDEF GTK3DEBUGCOMBOBOX} if (Data <> nil) and (wtComboBox in TGtk3Widget(Data).WidgetType) and (event^.type_ <> GDK_MOTION_NOTIFY) then begin if (Widget = TGtk3ComboBox(Data).GetPopupWidget) then DebugLn('***** TGtk3Widget.WidgetEvent(MENU triggered ',dbgsName(TGtk3Widget(Data).LCLObject), ' ',Gtk3EventToStr(event^.type_)) else if (Widget = TGtk3ComboBox(Data).GetButtonWidget) then DebugLn('***** TGtk3Widget.WidgetEvent(BUTTON triggered ',dbgsName(TGtk3Widget(Data).LCLObject), ' ',Gtk3EventToStr(event^.type_)) else if (Widget = PGtkWidget(TGtk3ComboBox(Data).GetCellView)) then DebugLn('***** TGtk3Widget.WidgetEvent(CELLVIEW triggered ',dbgsName(TGtk3Widget(Data).LCLObject), ' ',Gtk3EventToStr(event^.type_)) else if (Widget = TGtk3ComboBox(Data).Widget) then DebugLn('***** TGtk3Widget.WidgetEvent(EVENTBOX triggered ',dbgsName(TGtk3Widget(Data).LCLObject), ' ',Gtk3EventToStr(event^.type_)); end; {$ENDIF} {$IFDEF GTK3DEBUGCORE} // if event^.type_ = GDK_EXPOSE then if event^.type_ <> GDK_MOTION_NOTIFY then DebugLn('TGtk3Widget.WidgetEvent triggered ',dbgsName(TGtk3Widget(Data).LCLObject), ' ',Gtk3EventToStr(event^.type_)); {$ENDIF} Result := gtk_false; if Assigned(Application) and Application.Terminated then exit; case event^.type_ of GDK_DELETE: begin // DebugLn('****** GDK_DELETE FOR ',dbgsName(TGtk3Widget(Data).LCLObject),' main_level=',dbgs(gtk_main_level)); if wtWindow in TGtk3Widget(Data).WidgetType then begin TGtk3Window(Data).CloseQuery; // let lcl destroy widget Result := True; end; end; GDK_DESTROY: begin // DebugLn('****** GDK_DESTROY FOR ' + dbgsName(TGtk3Widget(Data).LCLObject)); end; GDK_EXPOSE: begin DebugLn('****** GDK_EXPOSE FOR ' + dbgsName(TGtk3Widget(Data).LCLObject)); // Gtk3DrawWidget is attached to 'draw' signal, Expose event doesn't trigger // under gtk3. // we use 'draw' signal Gtk3DrawEvent() // Result := TGtk3Widget(Data).GtkEventPaint(Widget, Event); end; GDK_MOTION_NOTIFY: begin if wtWindow in TGtk3Widget(Data).WidgetType then begin if Widget = TGtk3Widget(Data).Widget then exit; end; Result := TGtk3Widget(Data).GtkEventMouseMove(Widget, Event); end; GDK_BUTTON_PRESS: begin // set focus before gtk does that, so we have same behaviour as other ws if TGtk3Widget(Data).GetFocusableByMouse and not TGtk3Widget(Data).LCLObject.Focused and TGtk3Widget(Data).LCLObject.CanFocus then begin //FIXME: combobox updates popup-shown property too late // so we dont know yet if its dropped down or not if (wtComboBox in TGtk3Widget(Data).WidgetType) then begin TGtk3ComboBox(Data).DumpPrivateStructValues('GDK_BUTTON_PRESS btn='+IntToStr(Event^.button.button)); end; if (wtWindow in TGtk3Widget(Data).WidgetType) then begin TGtk3Widget(Data).Activate; end else LCLIntf.SetFocus(HWND(TGtk3Widget(Data))); end; if TGtk3Widget(Data).LCLObject is TButtonControl then exit; Result:=TGtk3Widget(Data).GtkEventMouse(Widget , Event); end; GDK_2BUTTON_PRESS: begin // set focus before gtk does that, so we have same behaviour as other ws if TGtk3Widget(Data).GetFocusableByMouse and not TGtk3Widget(Data).LCLObject.Focused and TGtk3Widget(Data).LCLObject.CanFocus then LCLIntf.SetFocus(HWND(TGtk3Widget(Data))); if TGtk3Widget(Data).LCLObject is TButtonControl then exit; Result := TGtk3Widget(Data).GtkEventMouse(Widget , Event); end; GDK_3BUTTON_PRESS: begin // set focus before gtk does that, so we have same behaviour as other ws if TGtk3Widget(Data).GetFocusableByMouse and not TGtk3Widget(Data).LCLObject.Focused and TGtk3Widget(Data).LCLObject.CanFocus then LCLIntf.SetFocus(HWND(TGtk3Widget(Data))); if TGtk3Widget(Data).LCLObject is TButtonControl then exit; Result := TGtk3Widget(Data).GtkEventMouse(Widget , Event); end; GDK_BUTTON_RELEASE: begin {if not ((csClickEvents in TGtk3Widget(Data).LCLObject.ControlStyle) and (csClicked in TGtk3Widget(Data).LCLObject.ControlState)) then } if TGtk3Widget(Data).LCLObject is TButtonControl then exit; Result := TGtk3Widget(Data).GtkEventMouse(Widget , Event); end; GDK_KEY_PRESS: begin if Widget^.has_focus or Widget^.is_toplevel then Result := TGtk3Widget(Data).GtkEventKey(Widget, Event, True); end; GDK_KEY_RELEASE: begin if Widget^.has_focus or Widget^.is_toplevel then // or (Widget = TGtk3Widget(data).GetContainerWidget) then Result := TGtk3Widget(Data).GtkEventKey(Widget, Event, False); end; GDK_ENTER_NOTIFY: begin end; GDK_LEAVE_NOTIFY: begin end; GDK_FOCUS_CHANGE: begin if wtComboBox in TGtk3Widget(Data).WidgetType then begin TGtk3ComboBox(Data).DumpPrivateStructValues('GDK_FOCUS_CHANGE='+IntToStr(Event^.focus_change.in_)); //FIXME: combobox updates popup-shown property too late // so we dont know yet if its dropped down or not if TGtk3ComboBox(Data).DroppedDown then exit; end; if not (csNoFocus in TCustomForm(TGtk3Widget(Data).LCLObject).ControlStyle) then TGtk3Widget(Data).GtkEventFocus(Widget, Event); end; GDK_CONFIGURE: begin (* DOES NOT WORK AS DOCUMENTATION SAYS if Data <> nil then begin if wtWindow in TGtk3Widget(Data).WidgetType then begin TGtk3Window(Data).ActivateWindow(Event); DebugLn('** WindowState event ',dbgsName(TGtk3Widget(Data).LCLObject),' windowState=',dbgs(TGtk3Window(Data).GetWindowState)); end else DebugLn('** WindowState event not wtWindow ',dbgsName(TGtk3Widget(Data).LCLObject)); end; *) Result := TGtk3Widget(Data).GtkEventResize(Widget, Event); end; GDK_MAP: begin //DebugLn('****** GDK_MAP FOR ',dbgsName(TGtk3Widget(Data).LCLObject)); end; GDK_UNMAP: begin // DebugLn('****** GDK_UNMAP FOR ',dbgsName(TGtk3Widget(Data).LCLObject)); end; GDK_PROPERTY_NOTIFY: begin // DebugLn('****** GDK_PROPERTY_NOTIFY FOR ',dbgsName(TGtk3Widget(Data).LCLObject)); end; GDK_CLIENT_EVENT: begin // DebugLn('****** GDK_CLIENT_EVENT FOR ',dbgsName(TGtk3Widget(Data).LCLObject)); end; GDK_VISIBILITY_NOTIFY: begin // ONLY HERE WE CAN CATCH Activate/Deactivate but problem is that // PGtkWindow does not update active property properly // so PGtkWindow(Widget)^.is_active returns TRUE even if window isn't active anymore if wtWindow in TGtk3Widget(Data).WidgetType then TGtk3Window(Data).ActivateWindow(Event); // Result := TGtk3Widget(Data).GtkEventShowHide(Widget, Event); // DebugLn('****** GDK_VISIBILITY_NOTIFY FOR ' + dbgsName(TGtk3Widget(Data).LCLObject)); end; GDK_SCROLL: begin // DebugLn('****** GDK_SCROLL ' + dbgsName(TGtk3Widget(Data).LCLObject)); Result := TGtk3Widget(Data).GtkEventMouseWheel(Widget, Event); end; GDK_WINDOW_STATE: begin // DebugLn('****** GDK_WINDOW_STATE FOR ' + dbgsName(TGtk3Widget(Data).LCLObject)); // this doesn't work as expected ... must use GDK_CONFIGURE to get active status ?!? end; GDK_GRAB_BROKEN: //could be broken eg. because of popupmenu begin DebugLn('****** GDK_GRAB_BROKEN (no problem if popupmenu is activated) ' + dbgsName(TGtk3Widget(Data).LCLObject)); end; otherwise DebugLn('****** GDK unhandled event type ' + dbgsName(TGtk3Widget(Data).LCLObject)); // DebugLn(event^.type_); end; end; class function TGtk3Widget.DrawWidget(AWidget: PGtkWidget; AContext: Pcairo_t; Data: gpointer): gboolean; cdecl; var ARect: TGdkRectangle; begin Result := False; if Data <> nil then begin gdk_cairo_get_clip_rectangle(AContext, @ARect); Result := TGtk3Widget(Data).GtkEventPaint(AWidget, AContext); end; end; class procedure TGtk3Widget.MapWidget(AWidget: PGtkWidget; Data: gPointer); cdecl; var Allocation: TGtkAllocation; ARect: TRect; AWindow: PGdkWindow; xx,yy,w,h: Gint; begin AWidget^.get_allocation(@Allocation); {$IFDEF GTK3DEBUGCORE} DebugLn('**** Gtk3MapWidget ....',dbgsName(TGtk3Widget(Data).LCLObject)); with Allocation do DebugLn(' Allocation ',Format('x %d y %d w %d h %d',[x,y,width,height])); {$ENDIF} TGtk3Widget(Data).WidgetMapped := True; ARect := TGtk3Widget(Data).LCLObject.BoundsRect; {$IFDEF GTK3DEBUGCORE} with ARect do DebugLn(' Rect ',Format('x %d y %d w %d h %d',[Left,Top,Right - Left, Bottom - Top])); {$ENDIF} if ARect.Left nil) and AWidget^.get_has_window then begin // do resize to lcl size when mapping widget gdk_window_set_events(AWindow, GDK_DEFAULT_EVENTS_MASK); { if not (wtWindow in TGtk3Widget(Data).WidgetType) then begin } with TGtk3Widget(Data).LCLObject do begin xx := Left; yy := Top; w := Width; h := Height; end; TGtk3Widget(Data).BeginUpdate; AWindow^.move(xx, yy); AWindow^.resize(w, h); TGtk3Widget(Data).EndUpdate; { end else begin // DebugLn('TGtk3Window is mapped , setting lclwidget property to PGdkWindow ...'); // now we set 'lclwidget' to our window. // g_object_set_data(AWindow,'lclwidget', TGtk3Widget(Data)); end;} end else begin if wtMemo in TGtk3Widget(Data).WidgetType then begin // gdk_window_get_geometry(AWindow, @xx,@yy,@w,@h); // gdk_window_get_position(AWindow, @xx,@yy); // DebugLn(' ***** Window ',Format('x %d y %d w %d h %d',[xx,yy,w,h]),' lclobject ',dbgsName(TGtk3Widget(Data).LCLObject)); end; end; end; function SubtractScroll(AWidget: PGtkWidget; APosition: TPoint): TPoint; begin Result := APosition; if Gtk3IsScrolledWindow(AWidget) then begin with gtk_scrolled_window_get_hadjustment(PGtkScrolledWindow(AWidget))^ do dec(Result.x, Trunc(value - lower)); with gtk_scrolled_window_get_vadjustment(PGtkScrolledWindow(AWidget))^ do dec(Result.y, Trunc(value - lower)); end; end; class function TGtk3Widget.ScrollEvent(AWidget: PGtkWidget; AEvent: PGdkEvent; AData: GPointer): GBoolean; cdecl; var AWinControl: TWinControl; EventXY: TPoint; AState: Cardinal; ShiftState: TShiftState; MappedXY: TPoint; MessE : TLMMouseEvent; begin Result := False; if AWidget=nil then ; AWinControl := TGtk3Widget(AData).LCLObject; if AEvent^.scroll.send_event = NO_PROPAGATION_TO_PARENT then exit; EventXY := Point(LazUtilities.TruncToInt(AEvent^.Scroll.X),LazUtilities.TruncToInt(AEvent^.scroll.Y)); AState := GtkModifierStateToShiftState(AEvent^.scroll.state, False); ShiftState := []; if AState and MK_SHIFT <> 0 then ShiftState := ShiftState + [ssShift]; if AState and MK_CONTROL <> 0 then ShiftState := ShiftState + [ssCtrl]; if AState and MK_ALT <> 0 then ShiftState := ShiftState + [ssAlt]; // MappedXY := TranslateGdkPointToClientArea(AEvent^.scroll.window, EventXY, // {%H-}TGtk3Widget(AWinControl.Handle).GetContainerWidget); MappedXY := EventXY; if TGtk3Widget(AWinControl.Handle) is TGtk3ScrollableWin then MappedXY := SubtractScroll(TGtk3Widget(AWinControl.Handle).Widget, MappedXY) else MappedXY := SubtractScroll(TGtk3Widget(AWinControl.Handle).GetContainerWidget, MappedXY); //DebugLn('gtkMouseWheelCB ',DbgSName(AWinControl),' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y)); // this is a mouse wheel event FillChar(MessE{%H-},SizeOf(MessE),0); MessE.Msg := LM_MOUSEWHEEL; case AEvent^.scroll.direction of GDK_SCROLL_UP {0}: MessE.WheelDelta := 120; GDK_SCROLL_DOWN {1}: MessE.WheelDelta := -120; else exit; end; MessE.X := MappedXY.X; MessE.Y := MappedXY.Y; MessE.State := ShiftState; MessE.UserData := AWinControl; MessE.Button := 0; // send the message directly to the LCL NotifyApplicationUserInput(AWinControl, MessE.Msg); if TGtk3Widget(AData).DeliverMessage(MessE) <> 0 then Result := True // message handled by LCL, stop processing else AEvent^.scroll.send_event := NO_PROPAGATION_TO_PARENT; // DebugLn('Gtk3ScrollEvent for ', dbgsName(TGtk3Widget(AData).LCLObject),' Result ',dbgs(Result)); end; class procedure TGtk3Widget.SizeAllocate(AWidget: PGtkWidget; AGdkRect: PGdkRectangle; Data: gpointer); cdecl; var Msg: TLMSize; NewSize: TSize; ACtl: TGtk3Widget; AState: TGdkWindowState; Alloc: TGtkAllocation; begin if AWidget=nil then ; ACtl := TGtk3Widget(Data); {$IFDEF GTK3DEBUGSIZE} if Assigned(ACtl.LCLObject) then begin with ACtl.LCLObject do writeln(Format('TGtk3Widget.SizeAllocate %s Gdk x %d y %d w %d h %d LCL l %d t %d w %d h %d applied w %d h %d cliRect %s',[dbgsName(ACtl.LCLObject), AGdkRect^.x, AGdkRect^.y, AGdkRect^.width, AGdkRect^.height, Left, Top, Width, Height, ACtl.LCLWidth, ACtl.LCLHeight, dbgs(ACtl.LCLObject.ClientRect)])); end; {$ENDIF} // return size w/o frame NewSize.cx := AGdkRect^.width; NewSize.cy := AGdkRect^.height; //writeln(format('Gkt3SizeAllocate w=%d h=%d',[NewSize.cx,NewSize.cy])); if not Assigned(ACtl.LCLObject) then exit; // do not loop with LCL ! if not (csDesigning in ACtl.LCLObject.ComponentState) then begin if ACtl.InUpdate then exit; if (ACtl.LCLWidth = NewSize.cx) and (ACtl.LCLHeight = NewSize.cy) and (ACtl.LCLWidth > 0) then begin if ACtl.LCLObject.ClientRectNeedsInterfaceUpdate then ACtl.LCLObject.DoAdjustClientRectChange(True); end; end; if ((NewSize.cx <> ACtl.LCLObject.Width) or (NewSize.cy <> ACtl.LCLObject.Height) or ACtl.LCLObject.ClientRectNeedsInterfaceUpdate) then ACtl.LCLObject.DoAdjustClientRectChange; FillChar(Msg{%H-}, SizeOf(Msg), #0); Msg.Msg := LM_SIZE; Msg.SizeType := SIZE_RESTORED; if ACtl is TGtk3Window then begin AState := TGtk3Window(ACtl).getWindowState; if GDK_WINDOW_STATE_ICONIFIED in AState then Msg.SizeType := SIZE_MINIMIZED else if GDK_WINDOW_STATE_MAXIMIZED in AState then Msg.SizeType := SIZE_MAXIMIZED else if GDK_WINDOW_STATE_FULLSCREEN in AState then Msg.SizeType := SIZE_FULLSCREEN; end; Msg.SizeType := Msg.SizeType or Size_SourceIsInterface; if ACtl.WidgetType*[wtScrollBar, wtHintWindow]<>[] then begin Msg.Width := ACtl.LCLObject.Width;//Word(NewSize.cx); Msg.Height := ACtl.LCLObject.Height;//Word(NewSize.cy); end else if {ACtl is TGtk3Window} ACtl.WidgetType*[wtWindow,wtDialog, {wtScrollingWinControl,}wtScrollingWin,wtNotebook,wtContainer]<>[] then begin Msg.Width := Word(NewSize.cx); Msg.Height := Word(NewSize.cy); end else begin Msg.Width := ACtl.LCLObject.Width;//Word(NewSize.cx); Msg.Height := ACtl.LCLObject.Height;//Word(NewSize.cy); end; ACtl.DeliverMessage(Msg); end; class function TGtk3Widget.ResizeEvent(AWidget: PGtkWidget; AEvent: PGdkEvent; Data: gpointer): gboolean; cdecl; var ARect: TGdkRectangle; begin Result := False; ARect.X := AEvent^.configure.x; ARect.Y := AEvent^.configure.y; ARect.width := AEvent^.configure.width; ARect.height := AEvent^.configure.height; // DebugLn('**** Gtk3ResizeEvent(CONFIGURE) **** ....',dbgsName(TGtk3Widget(Data).LCLObject),' ARect ',dbgs(RectFromGdkRect(ARect))); SizeAllocate(AWidget, @ARect, Data); end; class procedure TGtk3Widget.WidgetHide({%H-}AWidget: PGtkWidget; AData: gpointer); cdecl; var Msg: TLMShowWindow; Gtk3Widget: TGtk3Widget; begin Gtk3Widget := TGtk3Widget(AData); {do not pass message to LCL if LCL setted up control visibility} if Gtk3Widget.inUpdate then exit; // DebugLn('SEND LM_HIDE FOR ',dbgsName(Gtk3Widget.LCLObject)); FillChar(Msg{%H-}, SizeOf(Msg), #0); Msg.Msg := LM_SHOWWINDOW; Msg.Show := False; Gtk3Widget.DeliverMessage(Msg); end; class procedure TGtk3Widget.WidgetShow({%H-}AWidget: PGtkWidget; AData: gpointer); cdecl; var Msg: TLMShowWindow; Gtk3Widget: TGtk3Widget; begin Gtk3Widget := TGtk3Widget(AData); {do not pass message to LCL if LCL setted up control visibility} if Gtk3Widget.inUpdate then exit; // DebugLn('SEND LM_SHOW FOR ',dbgsName(Gtk3Widget.LCLObject)); FillChar(Msg{%H-}, SizeOf(Msg), #0); Msg.Msg := LM_SHOWWINDOW; Msg.Show := True; Gtk3Widget.DeliverMessage(Msg); end; function Gtk3ScrolledWindowScrollEvent(AScrollWindow: PGtkScrolledWindow; AEvent: PGdkEvent; AData: gPointer): gboolean; cdecl; var Msg: TLMVScroll; ScrollStep, AValue: Double; Adjustment: PGtkAdjustment; Range: PGtkRange; ACtl: TGtk3Widget absolute AData; IsVerticalScroll: Boolean; begin Result := False; if ACtl = nil then Exit; {$IFDEF GTK3DEBUGSCROLL} DebugLn(['>Gtk3ScrolledWindowScrollEvent triggered InUpdate lock=',dbgs(ACtl.InUpdate)]); {$ENDIF} Msg := Default(TLMVScroll); case AEvent^.scroll.direction of GDK_SCROLL_UP, GDK_SCROLL_DOWN: begin Msg.Msg := LM_VSCROLL; Range := PGtkRange(gtk_scrolled_window_get_vscrollbar(AScrollWindow)); Adjustment := gtk_range_get_adjustment(Range); ScrollStep := power(Adjustment^.page_size, 2 / 3); if AEvent^.scroll.direction = GDK_SCROLL_DOWN then ScrollStep := -ScrollStep; end; GDK_SCROLL_LEFT, GDK_SCROLL_RIGHT: begin Msg.Msg := LM_HSCROLL; Range := PGtkRange(gtk_scrolled_window_get_hscrollbar(AScrollWindow)); Adjustment := gtk_range_get_adjustment(Range); ScrollStep := power(Adjustment^.page_size, 2 / 3); if AEvent^.scroll.direction = GDK_SCROLL_RIGHT then ScrollStep := -ScrollStep; end; GDK_SCROLL_SMOOTH: begin IsVerticalScroll := Abs(AEvent^.scroll.delta_y) > Abs(AEvent^.scroll.delta_x); if IsVerticalScroll then begin Msg.Msg := LM_VSCROLL; Range := PGtkRange(gtk_scrolled_window_get_vscrollbar(AScrollWindow)); Adjustment := gtk_range_get_adjustment(Range); ScrollStep := -AEvent^.scroll.delta_y * Adjustment^.page_size * 0.1; end else begin Msg.Msg := LM_HSCROLL; Range := PGtkRange(gtk_scrolled_window_get_hscrollbar(AScrollWindow)); Adjustment := gtk_range_get_adjustment(Range); ScrollStep := -AEvent^.scroll.delta_x * Adjustment^.page_size * 0.1; end; if Abs(ScrollStep) < 1.0 then begin if ScrollStep > 0 then ScrollStep := 1.0 else ScrollStep := -1.0; end; {$IFDEF GTK3DEBUGSCROLL} DebugLn(Format('Smooth Scroll: delta_x=%.2f, delta_y=%.2f, ScrollStep=%.2f', [AEvent^.scroll.delta_x, AEvent^.scroll.delta_y, ScrollStep])); {$ENDIF} end; else begin {$IFDEF GTK3DEBUGSCROLL} DebugLn('Gtk3ScrolledWindowScrollEvent: Unknown scroll direction: ', dbgs(AEvent^.scroll.direction)); {$ENDIF} Exit; end; end; with Adjustment^ do begin AValue := value + ScrollStep; AValue := Max(AValue, lower); AValue := Min(AValue, upper - page_size); end; with Msg do begin Pos := Round(AValue); ScrollBar := HWND({%H-}TGtk3Widget(AData)); //TODO: Implement TGtk3Scrollbar.CreateFrom ScrollCode := SB_THUMBPOSITION; end; {$IFDEF GTK3DEBUGSCROLL} DebugLn(Format('Scroll Event: Pos=%d, ScrollStep=%.2f, Value=%.2f', [Msg.Pos, ScrollStep, AValue])); {$ENDIF} Result := ACtl.DeliverMessage(Msg) <> 0; {$IFDEF GTK3DEBUGSCROLL} DebugLn([' 0)); {$ENDIF} FillChar(Msg{%H-}, SizeOf(Msg), #0); if Event^.focus_change.in_ <> 0 then Msg.Msg := LM_SETFOCUS else Msg.Msg := LM_KILLFOCUS; if HasCaret then begin ACaret := TGtk3Caret(g_object_get_data(PGObject(getContainerWidget),'gtk3-caret')); if ACaret.RespondToFocus then begin if Msg.Msg = LM_SETFOCUS then ACaret.Show else ACaret.Hide; end; end; DeliverMessage(Msg); end; procedure TGtk3Widget.GtkEventDestroy; cdecl; var Msg: TLMessage; begin FillChar(Msg{%H-}, SizeOf(Msg), #0); Msg.Msg := LM_DESTROY; DeliverMessage(Msg); Release; end; function TGtk3Widget.GtkEventMouseWheel(Sender: PGtkWidget; Event: PGdkEvent ): Boolean; cdecl; var Msg: TLMMouseEvent; MousePos: TPoint; begin // gtk3 have ugly bug with scroll-event // https://bugzilla.gnome.org/show_bug.cgi?id=675959 Result := False; FillChar(Msg{%H-},SizeOf(Msg),0); Msg.Msg := LM_MOUSEWHEEL; //DebugLn('Scroll ',Format('deltaX %2.2n deltaY %2.2n x %2.2n y %2.2n rootx %2.2n rooty %2.2n', // [Event^.scroll.delta_x, Event^.scroll.delta_y, Event^.scroll.x, Event^.scroll.y, // Event^.scroll.x_root, Event^.scroll.y_root])); if Event^.scroll.direction = GDK_SCROLL_UP then Msg.WheelDelta := 120 else if Event^.scroll.direction = GDK_SCROLL_DOWN then Msg.WheelDelta := -120 else exit; if [wtContainer, wtLayout] * WidgetType <> [] then begin MousePos.X := Round(Event^.scroll.x_root); MousePos.Y := Round(Event^.scroll.y_root); ScreenToClient(MousePos) end else begin MousePos.x := Round(Event^.scroll.x); MousePos.y := Round(Event^.scroll.y); end; Msg.X := MousePos.X; Msg.Y := MousePos.Y; Msg.State := GdkModifierStateToShiftState(Event^.scroll.state); Msg.UserData := LCLObject; Msg.Button := 0; NotifyApplicationUserInput(LCLObject, Msg.Msg); if Widget^.get_parent <> nil then Event^.motion.send_event := NO_PROPAGATION_TO_PARENT; if DeliverMessage(Msg, True) <> 0 then Result := True; end; function TGtk3Widget.IsValidHandle: Boolean; begin Result := Assigned(FWidget) and Gtk3IsWidget(FWidget) and not FWidget^.in_destruction; end; function TGtk3Widget.IsWidgetOk: Boolean; begin Result := Gtk3IsWidget(FWidget); end; function TGtk3Widget.IsIconic: Boolean; begin Result := False; if IsWidgetOk then begin if FWidget^.get_window <> nil then Result := GDK_WINDOW_STATE_ICONIFIED in gdk_window_get_state(FWidget^.get_window); end; end; function TGtk3Widget.getType: TGType; begin Result := getContainerWidget^.g_type_instance.g_class^.g_type; end; function TGtk3Widget.getTypeName: PgChar; begin Result := g_type_name(getType); end; procedure TGtk3Widget.lowerWidget; begin if Gtk3IsGdkWindow(FWidget^.window) then FWidget^.window^.lower; end; procedure TGtk3Widget.raiseWidget; begin if Gtk3IsGdkWindow(FWidget^.window) then FWidget^.window^.raise_; end; procedure TGtk3Widget.stackUnder(AWidget: PGtkWidget); begin // FWidget^. end; function TGtk3Widget.GetCapture: TGtk3Widget; var AHandle: HWND; begin AHandle := HwndFromGtkWidget(gtk_grab_get_current); if AHandle <> 0 then Result := TGtk3Widget(AHandle); end; function TGtk3Widget.SetCapture: HWND; begin Result := HWND(GetCapture); gtk_grab_add(GetContainerWidget); end; function TGtk3Widget.GtkEventKey(Sender: PGtkWidget; Event: PGdkEvent; AKeyPress: Boolean): Boolean; cdecl; const CN_KeyDownMsgs: array[Boolean] of UINT = (CN_KEYDOWN, CN_SYSKEYDOWN); CN_KeyUpMsgs: array[Boolean] of UINT = (CN_KEYUP, CN_SYSKEYUP); LM_KeyDownMsgs: array[Boolean] of UINT = (LM_KEYDOWN, LM_SYSKEYDOWN); LM_KeyUpMsgs: array[Boolean] of UINT = (LM_KEYUP, LM_SYSKEYUP); CN_CharMsg: array[Boolean] of UINT = (CN_CHAR, CN_SYSCHAR); LM_CharMsg: array[Boolean] of UINT = (LM_CHAR, LM_SYSCHAR); var AEvent: TGdkEventKey; Msg: TLMKey; CharMsg: TLMChar; AEventString: String; KeyValue, ACharCode: Word; LCLModifiers: Word; IsSysKey: Boolean; UTF8Char: TUTF8Char; AChar: Char; IsArrowKey: Boolean; TempWidget: HWND; {$IFDEF GTK3DEBUGKEYPRESS} Info: PTypeInfo; {$ENDIF} begin //TODO: finish LCL messaging Result := False; AEvent := Event^.key; FillChar(Msg{%H-}, SizeOf(Msg), 0); AEventString := AEvent.string_; TempWidget := HwndFromGtkWidget(Sender); {$IFDEF GTK3DEBUGKEYPRESS} if TempWidget = 0 then writeln('***** warning: no gtk3widget ! *****') else writeln('GtkEventKey: Gtk3Widget ',dbgsName(TGtk3Widget(TempWidget))); {$ENDIF} if gdk_keyval_is_lower(AEvent.keyval) then KeyValue := Word(gdk_keyval_to_upper(AEvent.keyval)) else KeyValue := Word(AEvent.keyval); // state=16 = numlock= on. LCLModifiers := GtkModifierStateToShiftState(AEvent.state, True); if length(AEventString) = 0 then begin if KeyValue = GDK_KEY_Alt_L then LCLModifiers := LCLModifiers or KF_ALTDOWN else if (KeyValue = GDK_KEY_Control_L) or (KeyValue = GDK_KEY_Control_R) then LCLModifiers := LCLModifiers or MK_CONTROL else if (KeyValue = GDK_KEY_Shift_L) or (KeyValue = GDK_KEY_Shift_R) then LCLModifiers := LCLModifiers or MK_SHIFT; // writeln('MODIFIERS BY KEYS ',LCLModifiers); end; IsSysKey := LCLModifiers and KF_ALTDOWN <> 0; if not AKeyPress then LCLModifiers := LCLModifiers or KF_UP; // else // writeln('KeyRelease: ',dbgsName(LCLObject),' Dump state=',AEvent.state,' hwkey=',KeyCode,' keyvalue=',KeyValue,' modifier=',AEvent.Bitfield0.is_modifier); // this is just for testing purposes. ACharCode := GdkKeyToLCLKey(KeyValue); {$IFDEF GTK3DEBUGKEYPRESS} writeln('==== ACharCode=',ACharCode,' KeyValue=',KeyValue); {$ENDIF} if KeyValue > VK_UNDEFINED then KeyValue := ACharCode; // VK_UNKNOWN; if AKeyPress and (ACharCode = VK_TAB) then begin if Sender^.is_focus then Self.LCLObject.SelectNext(Self.LCLObject,true,true); exit; end; IsArrowKey := (AEventString='') and ((ACharCode = VK_UP) or (ACharCode = VK_DOWN) or (ACharCode = VK_LEFT) or (ACharCode = VK_RIGHT)); {$IFDEF GTK3DEBUGKEYPRESS} Info := TypeInfo(TGdkModifierType); if AKeyPress then writeln('EVENT KeyPress: ',dbgsName(LCLObject),' Dump state=',SetToString(Info, LongInt(AEvent.state), True),' keyvalue=',KeyValue,' modifier=',AEvent.Bitfield0.is_modifier, ' KeyValue ',KeyValue,' MODIFIERS ',LCLModifiers,' CharCode ',ACharCode,' EAT ',EatArrowKeys(ACharCode),' Window ? ',Sender^.window = GetWindow) else writeln('EVENT KeyRelease: ',dbgsName(LCLObject),' Dump state=',SetToString(Info, LongInt(AEvent.state), True),' keyvalue=',KeyValue,' modifier=',AEvent.Bitfield0.is_modifier, ' KeyValue ',KeyValue,' MODIFIERS ',LCLModifiers,' CharCode ',ACharCode, ' EAT ',EatArrowKeys(ACharCode)); {$ENDIF} if (ACharCode <> VK_UNKNOWN) then begin if AKeyPress then Msg.Msg := CN_KeyDownMsgs[IsSysKey] else Msg.Msg := CN_KeyUpMsgs[IsSysKey]; Msg.CharCode := ACharCode; Msg.KeyData := PtrInt((KeyValue shl 16) or (LCLModifiers shl 16) or $0001); NotifyApplicationUserInput(LCLObject, Msg.Msg); if not CanSendLCLMessage then exit; if (DeliverMessage(Msg, True) <> 0) or (Msg.CharCode = VK_UNKNOWN) then begin {$IFDEF GTK3DEBUGKEYPRESS} writeln('<==== CN_KeyDownMsgs handled ... exiting'); {$ENDIF} if ([wtEntry,wtMemo] * WidgetType <>[]) then exit(false) else exit(True); end; if not CanSendLCLMessage then exit; if AKeyPress then Msg.Msg := LM_KeyDownMsgs[IsSysKey] else Msg.Msg := LM_KeyUpMsgs[IsSysKey]; Msg.CharCode := ACharCode; Msg.KeyData := PtrInt((KeyValue shl 16) or (LCLModifiers shl 16) or $0001); NotifyApplicationUserInput(LCLObject, Msg.Msg); if not CanSendLCLMessage then exit; {$warning workaround for GtkTreeView key bindings.Must find out what LCL does with this keys.} if {IsArrowKey and} ([wtListBox,wtListView,wtEntry,wtMemo] * WidgetType <> []) then // let gtk3 select cell for now. Must check what LCL does with arrow keys // since gtk3 becomes crazy after delivery of this message else if (DeliverMessage(Msg, True) <> 0) or (Msg.CharCode = 0) then begin Result := (Msg.CharCode = 0) or IsArrowKey; {$IFDEF GTK3DEBUGKEYPRESS} writeln('<=== LM_KeyDownMsgs handled ... exiting ',dbgs(ACharCode),' Result=',dbgs(Result),' AKeyPress=',dbgs(AKeyPress)); {$ENDIF} exit; end; if not CanSendLCLMessage then exit; end; if AKeyPress and (length(AEventString) > 0) then begin UTF8Char := AEventString; // TODO: If not IsControlKey Result := LCLObject.IntfUTF8KeyPress(UTF8Char, 1, IsSysKey); if not CanSendLCLMessage then exit; if Result then begin {$IFDEF GTK3DEBUGKEYPRESS} writeln('LCLObject.IntfUTF8KeyPress handled ... exiting'); {$ENDIF} exit; end; // create the CN_CHAR / CN_SYSCHAR message FillChar(CharMsg{%H-}, SizeOf(CharMsg), 0); CharMsg.Msg := CN_CharMsg[IsSysKey]; CharMsg.KeyData := Msg.KeyData; AChar := AEventString[1]; CharMsg.CharCode := Word(AChar); NotifyApplicationUserInput(LCLObject, CharMsg.Msg); if not CanSendLCLMessage then exit; Result := (DeliverMessage(CharMsg, True) <> 0) or (CharMsg.CharCode = VK_UNKNOWN) or IsArrowKey; if not CanSendLCLMessage then exit; if Result then begin {$IFDEF GTK3DEBUGKEYPRESS} writeln('<=== CN_CharMsg handled ... exiting'); {$ENDIF} exit; end; //Send a LM_(SYS)CHAR CharMsg.Msg := LM_CharMsg[IsSysKey]; NotifyApplicationUserInput(LCLObject, CharMsg.Msg); if not CanSendLCLMessage then exit; DeliverMessage(CharMsg, True); if not CanSendLCLMessage then exit; end; if AKeyPress then begin {$IFDEF GTK3DEBUGKEYPRESS} if (Msg.CharCode in FKeysToEat) then begin writeln('EVENT: ******* KeyPress charcode is in keys to eat (FKeysToEat), charcode=',dbgs(Msg.CharCode),' window ? ',Sender^.window = Self.GetWindow); end else writeln('EVENT: KeyPress Result = False Window ? ', Sender^.window = Self.GetWindow); {$ENDIF} Result := (TempWidget = GetFocus) and (Msg.CharCode in FKeysToEat); end; end; function TGtk3Widget.GtkEventMouse(Sender: PGtkWidget; Event: PGdkEvent): Boolean; cdecl; var Msg: TLMMouse; MsgPopup : TLMMouse; MousePos: TPoint; MButton: guint; SavedHandle: PtrUInt; begin Result := gtk_false; {$IF DEFINED(GTK3DEBUGEVENTS) OR DEFINED(GTK3DEBUGMOUSE)} writeLn('TGtk3Widget.GtkEventMouse ',dbgsName(LCLObject), ' propagate=',dbgs(not (Event^.button.send_event = NO_PROPAGATION_TO_PARENT)),' Exit ? ',Event^.button.send_event = NO_PROPAGATION_TO_PARENT, ' Event.Type=',Event^.type_,' Capture=',LCLintf.GetCapture); {$ENDIF} if Event^.button.send_event = NO_PROPAGATION_TO_PARENT then begin if Event^.type_ <> GDK_BUTTON_RELEASE then LCLIntf.SetCapture(HWND(Self)); exit(gtk_true); end; SavedHandle := PtrUInt(Self); FillChar(Msg{%H-}, SizeOf(Msg), #0); Msg.Keys := GdkModifierStateToLCL(Event^.button.state, False); if [wtContainer, wtLayout] * WidgetType <> [] then begin MousePos.X := Round(Event^.button.x_root); MousePos.Y := Round(Event^.button.y_root); ScreenToClient(MousePos) end else begin MousePos.x := Round(Event^.button.x); MousePos.y := Round(Event^.button.y); end; Msg.XPos := SmallInt(MousePos.X); Msg.YPos := SmallInt(MousePos.Y); MButton := Event^.button.button; case Event^.type_ of GDK_BUTTON_PRESS: begin if MButton = GTK3_LEFT_BUTTON then begin Msg.Msg := LM_LBUTTONDOWN; Msg.Keys := Msg.Keys or MK_LBUTTON; end else if MButton = GTK3_RIGHT_BUTTON then begin Msg.Msg := LM_RBUTTONDOWN; Msg.Keys := Msg.Keys or MK_RBUTTON; end else if MButton = GTK3_MIDDLE_BUTTON then begin Msg.Msg := LM_MBUTTONDOWN; Msg.Keys := Msg.Keys or MK_MBUTTON; end; end; GDK_2BUTTON_PRESS: //-> double click GDK_DOUBLE_BUTTON_PRESS begin if MButton = GTK3_LEFT_BUTTON then begin Msg.Msg := LM_LBUTTONDBLCLK; Msg.Keys := Msg.Keys or MK_LBUTTON; end else if MButton = GTK3_RIGHT_BUTTON then begin Msg.Msg := LM_RBUTTONDBLCLK; Msg.Keys := Msg.Keys or MK_RBUTTON; end else if MButton = GTK3_MIDDLE_BUTTON then begin Msg.Msg := LM_MBUTTONDBLCLK; Msg.Keys := Msg.Keys or MK_MBUTTON; end; end; GDK_BUTTON_RELEASE: begin if MButton = GTK3_LEFT_BUTTON then begin Msg.Msg := LM_LBUTTONUP; Msg.Keys := Msg.Keys or MK_LBUTTON; end else if MButton = GTK3_RIGHT_BUTTON then begin Msg.Msg := LM_RBUTTONUP; Msg.Keys := Msg.Keys or MK_RBUTTON; end else if MButton = GTK3_MIDDLE_BUTTON then begin Msg.Msg := LM_MBUTTONUP; Msg.Keys := Msg.Keys or MK_MBUTTON; end; end; else DebugLn(Format('WARNING: GtkEventMouse() unhandled event type %d.',[Ord(Event^.type_)])) end; {$IF DEFINED(GTK3DEBUGEVENTS) OR DEFINED(GTK3DEBUGMOUSE)} DebugLn('TGtk3Widget.GtkEventMouse ',dbgsName(LCLObject), ' msg=',dbgs(msg.Msg), ' point=',dbgs(Msg.XPos),',',dbgs(Msg.YPos)); {$ENDIF} NotifyApplicationUserInput(LCLObject, Msg.Msg); Event^.button.send_event := NO_PROPAGATION_TO_PARENT; Result := False; if Msg.Msg = LM_RBUTTONDOWN then begin MsgPopup := Msg; MsgPopup.Msg := LM_CONTEXTMENU; MsgPopup.XPos := SmallInt(Round(Event^.button.x_root)); MsgPopup.YPos := SmallInt(Round(Event^.button.y_root)); if (SavedHandle <> PtrUInt(Self)) or (LCLObject = nil) or (FWidget = nil) then exit; DeliverMessage(MsgPopup, True); end; if not Result then begin if (SavedHandle <> PtrUInt(Self)) or (LCLObject = nil) or (FWidget = nil) then exit; Result := DeliverMessage(Msg, True) <> 0; end; end; function TGtk3Widget.GetVisible: Boolean; begin Result := Assigned(FWidget) and FWidget^.visible; end; procedure TGtk3Widget.SetEnabled(AValue: Boolean); begin if IsWidgetOK then FWidget^.set_sensitive(AValue); end; procedure TGtk3Widget.SetFont(AValue: PPangoFontDescription); begin if IsWidgetOk then begin GetContainerWidget^.override_font(AValue); if Assigned(FFont) and (FFont <> AValue) then FFont^.free; FFont := AValue; end; end; procedure TGtk3Widget.SetShape(AValue: PGdkPixbuf); begin if FShape=AValue then Exit; if FShape <> nil then FShape^.unref; FShape := AValue; end; procedure TGtk3Widget.SetFontColor(AValue: TColor); var AColor: TGdkRGBA; i: TGtkStateType; begin if IsWidgetOK then begin AColor := TColortoTGdkRGBA(ColorToRgb(AValue)); if FWidget <> GetContainerWidget then begin with FWidget^ do begin for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do override_color(TGtkStateFlags(1 shl (i - 1)), @AColor); end; end; with GetContainerWidget^ do begin for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do override_color(TGtkStateFlags(1 shl (i - 1)), @AColor); end; end; end; procedure TGtk3Widget.SetColor(AValue: TColor); var AColor: TGdkRGBA; i: TGtkStateType; ARgba: TGdkRGBA; begin // new way (gtk3) but still buggy if IsWidgetOK and (0 > 1) then begin if AValue = clDefault then begin (* with FDefaultRGBA do begin writeln('clDefault ',Format('R %2.2n G %2.2n B %2.2n A %2.2n',[R, G, B , Alpha])); ARgba.red := R; ARgba.green := G; ARgba.blue := B; ARgba.alpha := Alpha; end; *) end else begin ARgba := TColortoTGdkRGBA(ColorToRGB(AValue)); {$info GTK3: set GdkRGBA.alpah to 1.0?} {ColorToCairoRGB(ColorToRGB(AValue), R, G, B); ARgba.red := R; ARgba.green := G; ARgba.blue := B; ARgba.alpha := 1.0;} end; if FWidget <> GetContainerWidget then begin with FWidget^ do begin for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do begin if AValue = clDefault then begin ARgba.red := FWidgetRGBA[i].R; ARgba.green := FWidgetRGBA[i].G; ARgba.blue := FWidgetRGBA[i].B; ARgba.alpha := FWidgetRGBA[i].Alpha; end; FWidget^.override_background_color(TGtkStateFlags(1 shl (i - 1)), @ARgba); end; end; end; with GetContainerWidget^ do begin for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do begin //if AVAlue = clDefault then // GetContainerWidget^.get_style_context^.get_background_color(GTK_STATE_NORMAL, @ARgba); if AValue = clDefault then begin ARgba.red := FCentralWidgetRGBA[i].R; ARgba.green := FCentralWidgetRGBA[i].G; ARgba.blue := FCentralWidgetRGBA[i].B; ARgba.alpha := FCentralWidgetRGBA[i].Alpha; end; GetContainerWidget^.override_background_color(TGtkStateFlags(1 shl (i - 1)), @ARgba); end; end; end; if IsWidgetOK then begin AColor := TColortoTGdkRGBA(ColorToRgb(AValue)); if FWidget <> GetContainerWidget then begin with FWidget^ do begin for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do if AValue = clDefault then override_background_color(TGtkStateFlags(1 shl (i - 1)), nil) else override_background_color(TGtkStateFlags(1 shl (i - 1)), @AColor); end; end; with GetContainerWidget^ do begin for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do begin if AValue = clDefault then override_background_color(TGtkStateFlags(1 shl (i - 1)), nil) else override_background_color(TGtkStateFlags(1 shl (i - 1)), @AColor); end; end; end; end; function TGtk3Widget.GetStyleContext: PGtkStyleContext; begin Result := nil; if IsWidgetOK then Result := GetContainerWidget^.get_style_context; end; function TGtk3Widget.GetFont: PPangoFontDescription; var AContext: PPangoContext; begin Result := nil; if IsWidgetOK then begin AContext := GetContainerWidget^.get_pango_context; Result := pango_context_get_font_description(AContext); end; end; function TGtk3Widget.CanSendLCLMessage: Boolean; begin Result := IsWidgetOk and (LCLObject <> nil); end; function TGtk3Widget.GetCairoContext: Pcairo_t; begin Result := FCairoContext; end; function TGtk3Widget.GetEnabled: Boolean; begin Result := False; if IsWidgetOK then Result := FWidget^.get_sensitive; end; function TGtk3Widget.GetFontColor: TColor; var AStyle: PGtkStyleContext; AGdkRGBA: TGdkRGBA; begin Result := clDefault; if IsWidgetOK then begin AStyle := GetStyleContext; AStyle^.get_background_color(GTK_STATE_FLAG_NORMAL, @AGdkRGBA); Result := TGdkRGBAToTColor(AGdkRGBA); end; end; function TGtk3Widget.GetColor: TColor; var AStyle: PGtkStyleContext; AColor: TGdkRGBA; begin Result := clDefault; if IsWidgetOK then begin AStyle := GetStyleContext; AStyle^.get_background_color(GTK_STATE_FLAG_NORMAL, @AColor); Result := TGdkRGBAToTColor(AColor); end; end; procedure TGtk3Widget.SetStyleContext(AValue: PGtkStyleContext); begin {$NOTE Gtk3: Find a nice way to assign StyleContext} {if IsWidgetOK then GetContainerWidget^.set_style(AValue);} end; class procedure TGtk3Widget.DestroyWidgetEvent(w: PGtkWidget; data: gpointer); cdecl; begin {$IFDEF GTK3DEBUGCORE} writeln('DestroyWidgetEvent entered ',Assigned(w),' Data ? ',Assigned(data)); {$ENDIF} if Assigned(data) then TGtk3Widget(Data).FWidget:=nil; end; function TGtk3Widget.getText: String; begin Result := fText; // default text storage end; procedure TGtk3Widget.setText(const AValue: String); begin fText:=AValue; // DebugLn('WARNING: ',dbgsName(LCLObject),' self=',dbgsName(Self),' does not implement setText !'); end; procedure TGtk3Widget.SetVisible(AValue: Boolean); begin if IsWidgetOK then FWidget^.Visible := AValue; end; function TGtk3Widget.QueryInterface(constref iid: TGuid; out obj): LongInt; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF}; begin if GetInterface(iid, obj) then Result := 0 else Result := E_NOINTERFACE; end; function TGtk3Widget._AddRef: LongInt; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF}; begin Result := -1; // no ref counting end; function TGtk3Widget._Release: LongInt; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF}; begin Result := -1; end; function TGtk3Widget.IsDesigning: boolean; begin Result := Assigned(LCLObject) and (csDesigning in LCLObject.ComponentState) and not (Self is TGtk3DesignWidget); end; function TGtk3Widget.EatArrowKeys(const AKey: Word): Boolean; begin Result := AKey in [VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN]; end; function TGtk3Widget.GetContext: HDC; begin Result := FContext; end; function TGtk3Widget.CreateWidget(const Params: TCreateParams): PGtkWidget; begin Result := PGtkWidget(TGtkWidget.newv(32, 0 ,nil)); end; function TGtk3Widget.GetWidget:PGtkWidget; begin Result := FWidget; end; procedure TGtk3Widget.DestroyWidget; var ATemp: PGtkWidget; begin if HasCaret and IsValidHandle then GTK3WidgetSet.DestroyCaret(HWND(Self)); if IsValidHandle and FOwnWidget then begin FOwnWidget:=false; {$IFDEF GTK3DEBUGCORE} DbgOut(#10'destroying '+Classname+' ... '); {$ENDIF} ATemp := FWidget; FWidget := nil; ATemp^.destroy_; {$IFDEF GTK3DEBUGCORE} DbgOut(Classname+' destroyed.'+#10); {$ENDIF} end; FWidget := nil; if Assigned(FShape) then begin FShape^.unref; FShape := nil; end; end; procedure TGtk3Widget.DoBeforeLCLPaint; begin // end; constructor TGtk3Widget.Create(const AWinControl: TWinControl; const AParams: TCreateParams); begin inherited Create; LCLWidth := 0; LCLHeight := 0; FContext := 0; FWidgetMapped := False; FHasPaint := False; FWidget := nil; FOwner := nil; FCentralWidget := nil; FOwnWidget := True; // Initializes the properties FProps := nil; LCLObject := AWinControl; FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE]; // FHasPaint := False; FParams := AParams; InitializeWidget; end; constructor TGtk3Widget.CreateFrom(const AWinControl: TWinControl; AWidget: PGtkWidget); begin inherited Create; FContext := 0; FWidgetMapped := False; FHasPaint := False; FWidget := nil; FOwner := nil; FCentralWidget := nil; FOwnWidget := False; // Initializes the properties FProps := nil; LCLObject := AWinControl; FWidget := AWidget; // FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE]; // FHasPaint := False; end; class function TGtk3Widget.MouseEnterNotify(aWidget: PGtkWidget; aEvent: PGdkEventCrossing; aData: gpointer): gboolean; cdecl; var Msg: TLMessage; begin Result := gtk_false; Msg.Msg := LM_MOUSEENTER; TGtk3Widget(aData).DeliverMessage(Msg, True); if Assigned(TGtk3Widget(aData).LCLObject) and (csDesigning in TGtk3Widget(aData).LCLObject.ComponentState) then Result := gtk_true; end; class function TGtk3Widget.MouseLeaveNotify(aWidget: PGtkWidget; aEvent: PGdkEventCrossing; aData: gpointer): gboolean; cdecl; var Msg: TLMessage; begin Result := gtk_false; Msg.Msg := LM_MOUSELEAVE; if Gtk3IsLayout(aWidget) and (aWidget^.get_parent = TGtk3Widget(aData).Widget) then exit; TGtk3Widget(aData).DeliverMessage(Msg, True); if Assigned(TGtk3Widget(aData).LCLObject) and (csDesigning in TGtk3Widget(aData).LCLObject.ComponentState) then Result := gtk_true; end; procedure TGtk3Widget.InitializeWidget; var ARect: TGdkRectangle; ARgba: TGdkRGBA; i: TGtkStateType; begin FHasCaret := False; FFocusableByMouse := False; FCentralWidget := nil; FCairoContext := nil; FContext := 0; FEnterLeaveTime := 0; FShape := nil; FWidgetType := [wtWidget]; FWidget := CreateWidget(FParams); if not (wtWindow in FWidgetType) then begin FWidget^.show_all; with ARect do begin x := LCLObject.Left; y := LCLObject.Top; width := LCLObject.Width; height := LCLObject.Height; end; FWidget^.set_allocation(@ARect); end; LCLIntf.SetProp(HWND(Self),'lclwidget',Self); // connect events // move signal connections into attach events if not gtk_widget_get_realized(FWidget) then FWidget^.set_events(GDK_DEFAULT_EVENTS_MASK); g_signal_connect_data(FWidget, 'destroy', TGCallback(@DestroyWidgetEvent), Self, nil, G_CONNECT_DEFAULT); g_signal_connect_data(FWidget, 'event', TGCallback(@WidgetEvent), Self, nil, G_CONNECT_DEFAULT); g_signal_connect_data(GetContainerWidget, 'enter-notify-event', TGCallback(@MouseEnterNotify), Self, nil, G_CONNECT_DEFAULT); g_signal_connect_data(getContainerWidget, 'leave-notify-event', TGCallback(@MouseLeaveNotify), Self, nil, G_CONNECT_DEFAULT); for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do begin FWidget^.get_style_context^.get_background_color(TGtkStateFlags(1 shl (i - 1)), @ARgba); with FWidgetRGBA[i] do begin R := ARgba.red; G := ARgba.green; B := ARgba.blue; Alpha := ARgba.alpha; end; end; if (FCentralWidget <> nil) and (FCentralWidget <> FWidget) then begin FCentralWidget^.set_events(GDK_DEFAULT_EVENTS_MASK); g_signal_connect_data(FCentralWidget, 'event', TGCallback(@WidgetEvent), Self, nil, G_CONNECT_DEFAULT); for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do begin FCentralWidget^.get_style_context^.get_background_color(TGtkStateFlags(1 shl (i - 1)), @ARgba); with FCentralWidgetRGBA[i] do begin R := ARgba.red; G := ARgba.green; B := ARgba.blue; Alpha := ARgba.alpha; end; end; end else begin for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do FCentralWidgetRGBA[i] := FWidgetRGBA[i]; end; FDrawSignal := g_signal_connect_data(GetContainerWidget,'draw', TGCallback(@DrawWidget), Self, nil, G_CONNECT_DEFAULT); g_signal_connect_data(GetContainerWidget,'scroll-event', TGCallback(@ScrollEvent), Self, nil, G_CONNECT_DEFAULT); // must hide all by default ??? //FWidget^.hide; g_signal_connect_data(FWidget,'hide', TGCallback(@WidgetHide), Self, nil, G_CONNECT_DEFAULT); g_signal_connect_data(FWidget,'show', TGCallback(@WidgetShow), Self, nil, G_CONNECT_DEFAULT); g_signal_connect_data(FWidget,'map', TGCallback(@MapWidget), Self, nil, G_CONNECT_DEFAULT); ConnectSizeAllocateSignal(FWidget); if IsDesigning then begin {$IFDEF GTK3DEBUGDESIGNER} writeln('Designer: initializing ',dbgsName(Self),' LCLObj=',dbgsName(LCLobject),' set can focus to false.'); {$ENDIF} gtk_widget_set_can_focus(Widget, False); gtk_widget_set_can_focus(GetContainerWidget, False); end; // g_signal_connect_data(FWidget, 'motion_notify_event', TGCallback(@Gtk3MotionNotifyEvent), LCLObject, nil, 0); end; procedure TGtk3Widget.ConnectSizeAllocateSignal(ToWidget:PGtkWidget); begin g_signal_connect_data(ToWidget,'size-allocate',TGCallback(@SizeAllocate), Self, nil, G_CONNECT_DEFAULT); end; procedure TGtk3Widget.DeInitializeWidget; begin end; procedure TGtk3Widget.RecreateWidget; begin end; procedure TGtk3Widget.DestroyNotify(AWidget: PGtkWidget); begin end; destructor TGtk3Widget.Destroy; begin DestroyWidget; inherited Destroy; end; function TGtk3Widget.CanFocus: Boolean; begin Result := False; if IsWidgetOK then Result := FWidget^.can_focus or GetContainerWidget^.can_focus; end; function TGtk3Widget.GetFocusableByMouse: Boolean; begin Result := FFocusableByMouse; end; function TGtk3Widget.getClientOffset: TPoint; var Allocation: TGtkAllocation; R: TRect; begin {offset between inner and outer rect of widget. It tricky since some widgets have regular offset eg Parent (FWidget) = (120,80) Child (FCentralWidget) = (2,2) but some are Parent (FWidget) = (120,80) Child (FCentralWidget) = (122,82). Such widgets are usually those with FCentralWidget^.get_has_window} Result := Point(0, 0); if Widget <> getContainerWidget then begin GetContainerWidget^.get_allocation(@Allocation); Result.X := Allocation.X; Result.Y := Allocation.Y; end else exit; R := getClientBounds; Result := Point(Result.x + R.Left, Result.y + R.Top); end; function TGtk3Widget.getWidgetPos: TPoint; var Allocation: TGtkAllocation; begin Result := Point(0, 0); if IsWidgetOk then begin FWidget^.get_allocation(@Allocation); Result := Point(Allocation.X, Allocation.Y); end; end; procedure TGtk3Widget.OffsetMousePos(APoint: PPoint); begin with getClientOffset do begin dec(APoint^.x, x); dec(APoint^.y, y); end; end; function TGtk3Widget.ClientToScreen(var P: TPoint): boolean; var TempAlloc: TGtkAllocation; Pt: TPoint; w,tw:PgtkWidget; x,y:integer; gw:PgdkWindow; begin Result := False; Pt := Point(0, 0); if not IsWidgetOk then begin DebugLn('TGtk3Widget.ClientToScreen invalid widget ...'); exit; end; { most usable source https://stackoverflow.com/questions/2088962/how-do-you-find-the-absolute-position-of-a-gtk-widget-in-a-window } w:=fWidget; tw:=w^.get_toplevel; gw:=tw^.window; while Assigned(w) {and (w<>tw)} do begin w^.get_allocation(@TempAlloc); pt.X:=pt.X+TempAlloc.X; pt.Y:=pt.Y+TempAlloc.Y; w:=w^.parent; end; gw^.get_origin(@x,@y); pt.x+=x; pt.y+=y; p:=pt; Result:=true; end; function TGtk3Widget.ScreenToClient(var P: TPoint): Integer; var AGtkWidget: PGtkWidget; AWindow: PGdkWindow; X,Y: Integer; Allocation: TGtkAllocation; begin Result:=-1; AGtkWidget := GetContainerWidget; if Assigned(AGtkWidget) and Gtk3IsGdkWindow(AGtkWidget^.window) then begin AWindow := AGtkWidget^.window; PGdkWindow(AWindow)^.get_origin(@X, @Y); AGtkWidget^.get_allocation(@Allocation); if not AGtkWidget^.get_has_window and (AGtkWidget^.get_parent <> nil) then begin AGtkWidget^.get_allocation(@Allocation); P.X := P.X - X - Allocation.x; P.Y := P.Y - Y - Allocation.y; exit; end; end else if Gtk3IsGdkWindow(fWidget^.window) then begin AWindow := fWidget^.window; PGdkWindow(AWindow)^.get_origin(@X, @Y); end else begin fWidget^.get_allocation(@Allocation); P.X := P.X - X - Allocation.x; P.Y := P.Y - Y - Allocation.y; exit; end; dec(P.X, X); dec(P.Y, Y); end; function TGtk3Widget.DeliverMessage(var Msg; const AIsInputEvent: Boolean ): LRESULT; begin Result := LRESULT(AIsInputEvent); if LCLObject = nil then Exit; try if LCLObject.HandleAllocated then begin LCLObject.WindowProc(TLMessage(Msg)); Result := TLMessage(Msg).Result; end; except Application.HandleException(nil); end; end; function TGtk3Widget.getClientRect: TRect; var AAlloc: TGtkAllocation; begin Result := LCLObject.BoundsRect; if not IsWidgetOK then exit; if GetContainerWidget^.get_realized then begin GetContainerWidget^.get_allocation(@AAlloc); Result := Rect(AAlloc.x, AAlloc.y, AAlloc.width + AAlloc.x,AAlloc.height + AAlloc.y); end else if FWidget^.get_realized then begin FWidget^.get_allocation(@AAlloc); Result := Rect(AAlloc.x, AAlloc.y, AAlloc.width + AAlloc.x,AAlloc.height + AAlloc.y); end; Types.OffsetRect(Result, -Result.Left, -Result.Top); end; function TGtk3Widget.getClientBounds: TRect; var AAlloc: TGtkAllocation; begin Result := Rect(0, 0, 0, 0); if IsWidgetOk then begin if FWidget^.get_realized then begin FWidget^.get_allocation(@AAlloc); Result := Rect(AAlloc.x, AAlloc.y, AAlloc.width + AAlloc.x,AAlloc.height + AAlloc.y); end else if GetContainerWidget^.get_realized then begin GetContainerWidget^.get_allocation(@AAlloc); Result := Rect(AAlloc.x, AAlloc.y, AAlloc.width + AAlloc.x,AAlloc.height + AAlloc.y); end; end; end; procedure TGtk3Widget.SetBounds(ALeft,ATop,AWidth,AHeight:integer); var ARect: TGdkRectangle; Alloc: TGtkAllocation; begin if (Widget=nil) then exit; LCLWidth := AWidth; LCLHeight := AHeight; ARect.x := ALeft; ARect.y := ATop; ARect.width := AWidth; ARect.Height := AHeight; with Alloc do begin x := ALeft; y := ATop; width := AWidth; height := AHeight; end; if Self is TGtk3Button then begin AWidth:=Max(1,AWidth-4); AHeight:=Max(1,AHeight-4); end; BeginUpdate; try {fixes gtk3 assertion} if not Widget^.get_realized then Widget^.realize; //this should be removed in future. Widget^.set_size_request(AWidth,AHeight); if Gtk3IsContainer(Widget) then // according to the gtk3 docs only GtkContainer should call this Widget^.size_allocate(@ARect); if Widget^.get_visible then Widget^.set_allocation(@Alloc); if LCLObject.Parent <> nil then Move(ALeft, ATop); // we must trigger get_preferred_width after changing size Widget^.queue_resize; {if wtProgressBar in WidgetType then getContainerWidget^.set_size_request(AWidth, AHeight);} finally EndUpdate; end; end; procedure TGtk3Widget.SetLclFont(const AFont:TFont); var AGtkFont: PPangoFontDescription; APangoStyle: TPangoStyle; Family: String; Stretch: TPangoStretch; Weight: TPangoWeight; begin if not IsWidgetOk then exit; if IsFontNameDefault(AFont.Name) then begin AGtkFont := Self.Font; Stretch := PANGO_STRETCH_NORMAL; Weight := PANGO_WEIGHT_NORMAL; end else begin Family := AFont.Name; ExtractPangoFontFaceSuffixes(Family, Stretch, Weight); AGtkFont := TPangoFontDescription.new; AGtkFont^.set_family(PgChar(Family)); end; if Stretch <> PANGO_STRETCH_NORMAL then AGtkFont^.set_stretch(Stretch); if AFont.Size <> 0 then AGtkFont^.set_size(Abs(AFont.Size) * PANGO_SCALE); if (fsBold in AFont.Style) and (Weight < PANGO_WEIGHT_SEMIBOLD) then // bold is specified by the fsBold flag only AGtkFont^.set_weight(PANGO_WEIGHT_BOLD) else if (Weight <> PANGO_WEIGHT_NORMAL) then AGtkFont^.set_weight(Weight); if fsItalic in AFont.Style then APangoStyle := PANGO_STYLE_ITALIC else APangoStyle := PANGO_STYLE_NORMAL; AGtkFont^.set_style(APangoStyle); Font := AGtkFont; FontColor := AFont.Color; end; procedure TGtk3Widget.SetWindowShape(AShape: PGdkPixBuf; AWindow: PGdkWindow); var imageSurface: Pcairo_surface_t; ARegion: Pcairo_region_t; ACairoRect: Tcairo_rectangle_int_t; begin if (AWindow = nil) or not Gtk3IsGdkWindow(AWindow) then exit; if AShape = nil then begin ACairoRect.x := 0; ACairoRect.y := 0; ACairoRect.width := AWindow^.get_width; ACairoRect.height := AWindow^.get_height; ARegion := cairo_region_create_rectangle(@ACairoRect); gdk_window_shape_combine_region(AWindow, ARegion, 0, 0); cairo_region_destroy(ARegion); end else begin //TODO: check on scaled displays. imageSurface := gdk_cairo_surface_create_from_pixbuf(AShape, 1, AWindow); ARegion := gdk_cairo_region_create_from_surface(imageSurface); gdk_window_shape_combine_region(AWindow, ARegion, 0, 0); cairo_region_destroy(ARegion); cairo_surface_destroy(imageSurface); end; end; function TGtk3Widget.GetContainerWidget: PGtkWidget; begin if Assigned(FCentralWidget) then Result := FCentralWidget else Result := FWidget; end; function TGtk3Widget.GetPosition(out APoint: TPoint): Boolean; var GdkWindow: PGdkWindow; GtkLeft, GtkTop: GInt; Alloc:TGtkAllocation; prnt:TGtk3Widget; wtype:TGType; begin fWidget^.get_allocation(@Alloc); if (alloc.X=-1) and (alloc.Y=-1) and (alloc.height=1) and (alloc.width=1) then // default allocation else begin APoint.X:=alloc.X; APoint.Y:=alloc.Y; end; prnt:=self.GetParent; // TGtk3Widget if (prnt<>nil) then begin wtype:=prnt.getType; // parent widget type if (wtype<>gtk_fixed_get_type()) and (wtype<>gtk_layout_get_type()) then begin // widget is not on a normal client area. e.g. TPage Apoint.X:=0; APoint.Y:=0; Result:=true; end else if (wtype=gtk_fixed_get_type()) and prnt.Widget^.get_has_window then begin // widget on a fixed, but fixed w/o window prnt.Widget^.get_allocation(@alloc); Dec(Apoint.X, alloc.x); Dec(APoint.Y, alloc.y); Result:=true; end; end; if (self.getType=gtk_window_get_type()) then begin GdkWindow:=Self.Widget^.window; if (GdkWindow<>nil) and (Self.FWidget^.get_mapped) then begin // window is mapped = window manager has put the window somewhere gdk_window_get_root_origin(GdkWindow, @GtkLeft, @GtkTop); APoint.X := GtkLeft; APoint.Y := GtkTop; Result:=true; end else begin // the gtk has not yet put the window to the final position // => the gtk/gdk position is not reliable // => use the LCL coords Apoint.X:=LCLObject.Left; Apoint.Y:=LCLObject.Top; Result:=true; end; //DebugLn(['TGtk3WidgetSet.GetWindowRelativePosition ',GetWidgetDebugReport(aWidget),' Left=',Left,' Top=',Top,' GdkWindow=',GdkWindow<>nil]); end; //DebugLn(['TGtk3WidgetSet.GetWindowRelativePosition ',GetWidgetDebugReport(aWidget),' Left=',Left,' Top=',Top]); end; procedure TGtk3Widget.Release; begin LCLObject := nil; Free; end; procedure TGtk3Widget.Hide; begin if Assigned(FWidget) then FWidget^.hide; end; function TGtk3Widget.getParent: TGtk3Widget; begin Result := Gtk3WidgetFromGtkWidget(Widget^.get_parent); end; function TGtk3Widget.GetWindow: PGdkWindow; begin Result := FWidget^.window; end; procedure TGtk3Widget.Move(ALeft, ATop: Integer); var AParent: TGtk3Widget; begin AParent := getParent; if (AParent <> nil) then begin if (wtContainer in AParent.WidgetType) then PGtkFixed(AParent.GetContainerWidget)^.move(FWidget, ALeft, ATop) else if (wtLayout in AParent.WidgetType) then PGtkLayout(AParent.GetContainerWidget)^.move(FWidget, ALeft, ATop); end; end; procedure TGtk3Widget.Activate; begin if IsWidgetOK then begin if not FWidget^.visible then exit; if Gtk3IsGdkWindow(FWidget^.window) then FWidget^.window^.raise_ else begin FWidget^.get_parent_window^.raise_; end; if FWidget^.can_focus then FWidget^.grab_focus; end; end; procedure TGtk3Widget.preferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); var AMinH: gint; AMinW: gint; AWidget:PGtkWidget; {$IFDEF GTK3DEBUGPREFERREDSIZE} ABorder: TGtkBorder; {$ENDIF} begin if IsWidgetOK then begin if [wtComboBox] * WidgetType <> [] then AWidget := Widget else AWidget := getContainerWidget; {$IFDEF GTK3DEBUGPREFERREDSIZE} AWidget^.get_size_request(@AMinW, @AMinH); DebugLn('>',dbgsName(LCLObject),'.preferredSize W=',dbgs(PreferredWidth),' H=',dbgs(PreferredHeight),' WithThemeSpace ',dbgs(WithThemeSpace),' AMinW=',dbgs(AMinW),' AMinH=',dbgs(AMinH)); {$ENDIF} AWidget^.get_preferred_height(@AMinH, @PreferredHeight); AWidget^.get_preferred_width(@AMinW, @PreferredWidth); {$IFDEF GTK3DEBUGPREFERREDSIZE} if WithThemeSpace then begin AWidget^.get_style_context^.get_margin(GTK_STATE_FLAG_NORMAL, @ABorder); with ABorder do DebugLn('BorderSpaces ',Format('L %d T %d R %d B %d',[Left, Top, Right, Bottom])); AWidget^.get_style_context^.get_padding(GTK_STATE_FLAG_NORMAL, @ABorder); with ABorder do DebugLn('Padding ',Format('L %d T %d R %d B %d',[Left, Top, Right, Bottom])); end; DebugLn('<',dbgsName(LCLObject),'.preferredSize W=',dbgs(PreferredWidth),' H=',dbgs(PreferredHeight),' WithThemeSpace ',dbgs(WithThemeSpace),' AMinH=',dbgs(AMinH),' AMinW=',dbgs(AMinW)); {$ENDIF} if [wtComboBox] * WidgetType <> [] then begin PreferredWidth := 0; end; end; end; procedure TGtk3Widget.SetCursor(ACursor: HCURSOR); begin if IsWidgetOk then begin if GetContainerWidget^.get_has_window and Gtk3IsGdkWindow(GetContainerWidget^.window) then SetWindowCursor(GetContainerWidget^.window, HCURSOR(TGtk3Cursor(ACursor).Handle), False, True) else if Widget^.get_has_window and Gtk3IsGdkWindow(Widget^.window) then SetWindowCursor(Widget^.window, HCURSOR(TGtk3Cursor(ACursor).Handle), False, True) else // fallback for window-less widgets if Assigned(self.getParent) then Self.getParent.SetCursor(ACursor); end; end; procedure TGtk3Widget.SetFocus; begin if GetContainerWidget^.can_focus then GetContainerWidget^.grab_focus else if FWidget^.can_focus then FWidget^.grab_focus; end; procedure TGtk3Widget.SetParent(AParent: TGtk3Widget; const ALeft, ATop: Integer ); begin if FWidget=nil then exit;; if wtLayout in AParent.WidgetType then PGtkLayout(AParent.GetContainerWidget)^.put(FWidget, ALeft, ATop) else if wtContainer in AParent.WidgetType then PGtkFixed(AParent.GetContainerWidget)^.put(FWidget, ALeft, ATop) else if wtNotebook in AParent.WidgetType then // do nothing ! else FWidget^.set_parent(AParent.GetContainerWidget); end; procedure TGtk3Widget.Show; begin if IsValidHandle then begin FWidget^.show; end; end; procedure TGtk3Widget.ShowAll; begin if IsValidHandle then FWidget^.show_all; end; procedure TGtk3Widget.Update(ARect: PRect); begin if IsWidgetOK then begin if (ARect <> nil) then begin if (aRect^.Width > 0) and (ARect^.Height > 0) then begin with ARect^ do FWidget^.queue_draw_area(Left, Top, Right - Left, Bottom - Top); if FWidget <> GetContainerWidget then with ARect^ do GetContainerWidget^.queue_draw_area(Left, Top, Right - Left, Bottom - Top); end; end else begin //FWidget^.queue_draw; if FWidget <> GetContainerWidget then GetContainerWidget^.queue_draw else FWidget^.queue_draw; end; end; end; { TGtk3StatusBar } function TGtk3StatusBar.CreateWidget(const Params: TCreateParams): PGtkWidget; begin Result := TGtkEventBox.new; FCentralWidget := TGtkHBox.new(GTK_ORIENTATION_HORIZONTAL, 1); PGtkBox(FCentralWidget)^.set_homogeneous(True); PGtkEventBox(Result)^.add(FCentralWidget); //TODO: add routines to set panels end; { TGtk3Panel } procedure TGtk3Panel.SetBorderStyle(AValue: TBorderStyle); begin if FBorderStyle = AValue then Exit; FBorderStyle := AValue; PGtkLayout(Widget)^.set_border_width(Ord(AValue)); end; function TGtk3Panel.CreateWidget(const Params: TCreateParams): PGtkWidget; var AGdkRGBA: TGdkRGBA; begin FHasPaint := True; FBorderStyle := bsNone; FWidgetType := [wtWidget, wtLayout]; Result := TGtkLayout.new(nil, nil); Result^.set_has_window(True); // as GtkFixed have no child control here - nobody triggers resizing // GNOME takes care of it, but other WM - not // this is here to make TGtk3Panel shown under Plasma //Result^.set_size_request(LCLObject.Width,LCLObject.Height); PGtkLayout(Result)^.set_size(1, 1); // AColor := Result^.style^.bg[0]; // writeln('BG COLOR R=',AColor.red,' G=',AColor.green,' B=',AColor.blue); // now we make panel completely transparent. // SetColor must usr override_background_color for panel // we must implement cairo_pattern_t since background can be brush AGdkRGBA.alpha := 0; AGdkRGBA.red := 0; // AColor.Red / 65535.00; AGdkRGBA.blue := 0; // AColor.Blue / 65535.00; AGdkRGBA.green := 0; // AColor.green / 65535.00; Result^.override_background_color(GTK_STATE_FLAG_NORMAL, @AGdkRGBA); Result^.override_background_color([GTK_STATE_FLAG_ACTIVE], @AGdkRGBA); Result^.override_background_color([GTK_STATE_FLAG_FOCUSED], @AGdkRGBA); Result^.override_background_color([GTK_STATE_FLAG_PRELIGHT], @AGdkRGBA); Result^.override_background_color([GTK_STATE_FLAG_SELECTED], @AGdkRGBA); Result^.show_all; end; procedure TGtk3Panel.DoBeforeLCLPaint; var DC: TGtk3DeviceContext; NColor: TColor; begin inherited DoBeforeLCLPaint; if not Visible then exit; DC := TGtk3DeviceContext(Context); NColor := LCLObject.Color; if (NColor <> clNone) and (NColor <> clDefault) then begin DC.CurrentBrush.Color := ColorToRGB(NColor); DC.fillRect(0, 0, LCLObject.Width, LCLObject.Height); end; if BorderStyle <> bsNone then begin DC.CurrentPen.Color := ColorToRGB(clBtnShadow); // not sure what color to use here? DC.drawRect(0, 0, LCLObject.Width, LCLObject.Height, False, True); end; end; procedure TGtk3Panel.setText(const AValue: String); begin if FText = AValue then exit; FText := AValue; if Self.Visible then Widget^.queue_draw; end; { TGtk3GroupBox } function TGtk3GroupBox.CreateWidget(const Params: TCreateParams): PGtkWidget; begin FHasPaint := True; FGroupBoxType := gbtGroupBox; FWidgetType := [wtWidget, wtLayout, wtGroupBox]; Result := LCLGtkFrameNew; FCentralWidget := TGtkLayout.new(nil, nil); PGtkBin(Result)^.add(FCentralWidget); FCentralWidget^.set_has_window(True); PGtkFrame(result)^.set_label_align(0.1,0.5); PGtkLayout(FCentralWidget)^.set_size(1, 1); Result^.show_all; end; function TGtk3GroupBox.getText: String; begin Result := ''; if IsWidgetOK then begin if PGtkFrame(Widget)^.get_label_widget = nil then exit; Result := {%H-}ReplaceUnderscoresWithAmpersands(PGtkFrame(Widget)^.get_label); end; end; procedure TGtk3GroupBox.setText(const AValue: String); begin if IsWidgetOK then begin if AValue = '' then PGtkFrame(Widget)^.set_label_widget(nil) else begin if PGtkFrame(Widget)^.get_label_widget = nil then PGtkFrame(Widget)^.set_label_widget(TGtkLabel.new('')); {%H-}PGtkFrame(Widget)^.set_label(PgChar({%H-}ReplaceAmpersandsWithUnderscores(AValue))); end; end; end; {$IF DEFINED(GTK3DEBUGSIZE) OR DEFINED(GTK3DEBUGGROUPBOX)} procedure ContainerChildrenCallback(widget: PGtkWidget; data: gpointer); cdecl; begin // This callback is called for each child of the GtkFixed container WriteLn('TGtk3GroupBox Child widget pointer: ', PtrUInt(widget),' ACtl=',dbgsName(TGtk3WIdget(data))); // Example: Print the widget type name WriteLn('TGtk3GroupBox Widget type: ', gtk_widget_get_name(widget)); end; {$ENDIF} class procedure TGtk3GroupBox.GroupBoxSizeAllocate(AWidget:PGtkWidget;AGdkRect: PGdkRectangle;Data:gpointer);cdecl; var Msg: TLMSize; NewSize: TSize; ACtl: TGtk3GroupBox; AState: TGdkWindowState; Alloc: TGtkAllocation; AList:PGList; AFixed: PGtkFixed; i:Integer; begin if AWidget=nil then ; ACtl := TGtk3GroupBox(Data); {$IF DEFINED(GTK3DEBUGSIZE) OR DEFINED(GTK3DEBUGGROUPBOX)} with AGdkRect^ do DebugLn('**** GroupBoxSizeAllocate **** ....',dbgsName(ACtl.LCLObject), ' ',Format('GTK x %d y %d w %d h %d',[x, y, width, height]), Format(' LCL W=%d H=%d LLW %d LLH %d upd=%s',[ACtl.LCLObject.Width, ACtl.LCLObject.Height, ACtl.LCLWidth, ACtl.LCLHeight, BoolToStr(ACtl.InUpdate, True)])); {$ENDIF} with Alloc do begin x := AGdkRect^.x; y := AGdkRect^.y; Width := AGdkRect^.width; Height := AGdkRect^.height; end; gtk_widget_set_clip(AWidget, @Alloc); if not Assigned(ACtl.LCLObject) then exit; // return size w/o frame NewSize.cx := AGdkRect^.width; NewSize.cy := AGdkRect^.height; if not (csDesigning in ACtl.LCLObject.ComponentState) then begin if ACtl.InUpdate then exit; end; {$IF DEFINED(GTK3DEBUGSIZE) OR DEFINED(GTK3DEBUGGROUPBOX)} if not ACtl.LCLObject.AutoSize and (ACtl.LCLWidth > 0) and (ACtl.LCLHeight > 0) and ACtl.LCLObject.ClientRectNeedsInterfaceUpdate then begin if (AGdkRect^.Width = ACtl.LCLWidth) and (AGdkRect^.Height = ACtl.LCLHeight) then begin //ACtl.LCLObject.DoAdjustClientRectChange; AFixed := PGtkFixed(ACtl.getContainerWidget); if AFixed^.compute_expand(GTK_ORIENTATION_VERTICAL) then AFixed^.resize_children; // PGtkLayout(AFixed)^.set_size(AFixed^.get_allocated_width, AFixed^.get_allocated_height); gtk_container_foreach(AFixed, @ContainerChildrenCallback, ACtl); exit; end; end; {$ENDIF} FillChar(Msg{%H-}, SizeOf(Msg), #0); Msg.Msg := LM_SIZE; Msg.SizeType := SIZE_RESTORED; Msg.SizeType := Msg.SizeType or Size_SourceIsInterface; Msg.Width := Word(NewSize.cx); Msg.Height := Word(NewSize.cy); ACtl.DeliverMessage(Msg); end; {This routine is used as long as gtk3 is beta and getClientRect needs debugging} function TGtk3GroupBox.GetInnerClientRect(Frame: PGtkWidget): TRect; var Allocation: TGdkRectangle; AStyleContext: PGtkStyleContext; Padding, Border: TGtkBorder; LabelWidget: PGtkWidget; FinalRect: TGdkRectangle; minH:gint; natH:gint; begin Result := Rect(0, 0, 0, 0); gtk_widget_get_allocation(Frame, @Allocation); LabelWidget := gtk_frame_get_label_widget(PGtkFrame(Frame)); AStyleContext := gtk_widget_get_style_context(Frame); gtk_style_context_get_padding(AStyleContext, GTK_STATE_FLAG_NORMAL, @Padding); gtk_style_context_get_border(AStyleContext, GTK_STATE_FLAG_NORMAL, @Border); FinalRect.X := Allocation.X + Border.Left + Padding.Left; FinalRect.Y := Allocation.Y + Border.Top + Padding.Top; FinalRect.Width := Allocation.Width - Border.Left - Border.Right - Padding.Left - Padding.Right; FinalRect.Height := Allocation.Height - Border.Top - Border.Bottom - Padding.Top - Padding.Bottom; if PGtkFrame(Frame)^.get_shadow_type > GTK_SHADOW_NONE then begin // this looks like a bug in gtk3, that's why I separated this part of code. Zeljan. if (Border.left = 0) and (Border.Right = 0) then dec(FinalRect.Width, 2); if (Border.Top = 0) and (Border.Bottom = 0) then dec(FinalRect.Height, 2); end; if Assigned(LabelWidget) then begin PGtkLabel(LabelWidget)^.get_preferred_height(@minH, @natH); FinalRect.Y := FinalRect.Y + natH; FinalRect.Height := FinalRect.Height - natH; {$IF DEFINED(GTK3DEBUGSIZE) OR DEFINED(GTK3DEBUGGROUPBOX)} writeln('LabelAllocation LCLObject.Caption=',LCLObject.Caption,' LabelText=',PGtkLabel(LabelWidget)^.get_text,' MinH=',MinH,' NatH=',NatH); {$ENDIF} end; Result := RectFromGdkRect(FinalRect); end; procedure TGtk3GroupBox.DoBeforeLCLPaint; var DC: TGtk3DeviceContext; NColor: TColor; begin inherited DoBeforeLCLPaint; if not Visible then exit; DC := TGtk3DeviceContext(Context); NColor := LCLObject.Color; if (NColor <> clNone) and (NColor <> clDefault) then begin DC.CurrentBrush.Color := ColorToRGB(NColor); DC.fillRect(0, 0, getContainerWidget^.get_allocated_width, getContainerWidget^.get_allocated_height); end; end; procedure TGtk3GroupBox.ConnectSizeAllocateSignal(ToWidget:PGtkWidget); begin g_signal_connect_data(ToWidget,'size-allocate',TGCallback(@GroupBoxSizeAllocate), Self, nil, G_CONNECT_DEFAULT); end; function TGtk3GroupBox.getClientRect:TRect; var Alloc:TGtkAllocation; R: TRect; begin Result := GetInnerClientRect(Widget); Types.OffsetRect(Result, -Result.Left, -Result.Top); end; { TGtk3Editable } function gtk3EditableDelayedSelStart(AData: Pointer): gboolean; cdecl; var AWidget: PGtkEditable; AEditable: TGtk3Editable; begin Result := False; AEditable := TGtk3Editable(AData); AWidget := PGtkEditable(TGtk3Widget(AData).Widget); if (AEditable.PrivateCursorPos <> -1) and (AEditable.PrivateSelection <> -1) then begin gtk_editable_select_region(AWidget,AEditable.PrivateCursorPos, AEditable.PrivateSelection); // gtk_editable_set_position(AWidget, TGtk3Editable(AData).PrivateCursorPos); end; AEditable.PrivateCursorPos := -1; AEditable.PrivateSelection := -1; g_idle_remove_by_data(AData); end; function TGtk3Editable.GetReadOnly: Boolean; begin Result := False; if IsWidgetOK then Result := not PGtkEditable(Widget)^.get_editable; end; procedure TGtk3Editable.SetReadOnly(AValue: Boolean); begin if IsWidgetOK then PGtkEditable(Widget)^.set_editable(not AValue); end; function TGtk3Editable.getCaretPos: TPoint; begin Result := Point(0, 0); if not IsWidgetOk then exit; Result.X := PGtkEditable(Widget)^.get_position; end; procedure TGtk3Editable.SetCaretPos(AValue: TPoint); begin if not IsWidgetOk then exit; PGtkEditable(Widget)^.set_position(AValue.X); end; function TGtk3Editable.getSelStart: Integer; var AStart: gint; AStop: gint; begin Result := 0; if not IsWidgetOk then exit; if PGtkEditable(Widget)^.get_selection_bounds(@AStart, @AStop) then begin Result := AStart; end; end; function TGtk3Editable.getSelLength: Integer; var AStart: gint; AStop: gint; begin Result := 0; if not IsWidgetOk then exit; if PGtkEditable(Widget)^.get_selection_bounds(@AStart, @AStop) then begin Result := AStop - AStart; end; end; procedure TGtk3Editable.setSelStart(AValue: Integer); var ASelStart:gint; ASelStop:gint; begin if not IsWidgetOk then exit; CaretPos := Point(AValue, 0); PGtkEditable(FWidget)^.get_selection_bounds(@ASelStart, @ASelStop); if ASelStop < AValue then ASelStop := AValue; if InUpdate then begin PrivateCursorPos := ASelStart; PrivateSelection := AValue; end; PGtkEditable(FWidget)^.select_region(AValue, ASelStop); end; procedure TGtk3Editable.setSelLength(AValue: Integer); var AStart: gint; AStop: gint; begin if not IsWidgetOk then exit; PGtkEditable(Widget)^.get_selection_bounds(@AStart, @AStop); AStart := CaretPos.X; // DebugLn('TGtk3Editable.SetSelLength ',dbgsName(LCLObject),' value=',dbgs(AValue),' AStart=',dbgs(AStart),' InUpdate ',dbgs(InUpdate)); if InUpdate then begin PrivateCursorPos := AStart; PrivateSelection := AValue; // g_idle_add(@gtk3EditableDelayedSelStart, Self) // setDelayed later PGtkEditable(Widget)^.select_region(AStart, AStart + AValue) end else PGtkEditable(Widget)^.select_region(AStart, AStart + AValue); end; { TGtk3Entry } function TGtk3Entry.GetAlignment: TAlignment; var AFloat: GFloat; begin Result := taLeftJustify; if not IsWidgetOk then exit; AFloat := PGtkEntry(Widget)^.get_alignment; if AFloat = 1 then Result := taRightJustify else if AFloat = 0.5 then Result := taCenter; end; procedure TGtk3Entry.SetAlignment(AValue: TAlignment); var AFloat: GFloat; begin if not IsWidgetOk then exit; case AValue of taCenter: AFloat := 0.5; taRightJustify: AFloat := 1.0; else AFloat := 0;; end; PGtkEntry(Widget)^.set_alignment(AFloat); end; function TGtk3Entry.EatArrowKeys(const AKey: Word): Boolean; begin Result := AKey in [VK_UP, VK_DOWN]; end; class procedure TGtk3Entry.EntryChanged({%H-}AEntry: PGtkEntryBuffer; AData: GPointer); cdecl; var Msg: TLMessage; S:String; I:Integer; ASpin: TGtk3SpinEdit; fl: double; begin FillChar(Msg{%H-}, SizeOf(Msg), 0); Msg.Msg := CM_TEXTCHANGED; if [wtSpinEdit] * TGtk3Widget(AData).WidgetType <> [] then begin ASpin := TGtk3SpinEdit(AData); if not TGtk3Widget(AData).InUpdate then begin S := TGtk3SpinEdit(adata).getText; I := 0; if (ASpin.NumDigits = 0) then begin if TryStrToInt(S, I) then begin if (I >= Round(TGtk3SpinEdit(adata).Minimum)) and (I<= Round(TGtk3SpinEdit(adata).Maximum)) then PGtkSpinButton(TGtk3SpinEdit(adata).Widget)^.set_value(I); end; end else begin fl := 0; if TryStrToFloat(S, fl) then begin if (fl >= TGtk3SpinEdit(adata).Minimum) and (fl<= TGtk3SpinEdit(adata).Maximum) then PGtkSpinButton(TGtk3SpinEdit(adata).Widget)^.set_value(fl); end; end; end; exit; // value-changed should trigger end; if not TGtk3Widget(AData).InUpdate then TGtk3Widget(AData).DeliverMessage(Msg); end; class procedure TGtk3Entry.InsertText(editable: PGtkEditable; aNewText: PgChar; anewtextlen: gint; var pos:Pgint; data: gpointer);cdecl; var i:integer; edt:TGtk3Entry; //s: string; begin if not Assigned(data) then exit; edt := TGtk3Entry(data); if [wtSpinEdit] * TGtk3Widget(data).WidgetType <> [] then begin (* if pos <> nil then s := pos^.ToString else s := 'nil'; writeln('SpinEdit.InsertText text=',edt.getText,' newText="',aNewText,'"',' newLen=',anewTextLen,' pos=',s); *) end else if (edt.LCLObject as TCustomEdit).NumbersOnly then begin for i := 0 to anewtextlen-1 do begin if not (aNewText[i] in ['0'..'9']) then begin g_signal_stop_emission_by_name(PGObject(editable), 'insert-text'); exit; end; end; end; end; class procedure TGtk3Entry.EntrySizeAllocate(AWidget:PGtkWidget;AGdkRect: PGdkRectangle;Data:gpointer);cdecl; var Msg: TLMSize; NewSize: TSize; ACtl: TGtk3Entry; AState: TGdkWindowState; Alloc: TGtkAllocation; begin if AWidget=nil then ; ACtl := TGtk3Entry(Data); {$IF DEFINED(GTK3DEBUGENTRY) OR DEFINED(GTK3DEBUGENTRY)} with AGdkRect^ do DebugLn('**** EntrySizeAllocate **** ....',dbgsName(ACtl.LCLObject), ' ',Format('GTK x %d y %d w %d h %d',[x, y, width, height]), Format(' LCL W=%d H=%d LLW %d LLH %d',[ACtl.LCLObject.Width, ACtl.LCLObject.Height, ACtl.LCLWidth, ACtl.LCLHeight])); {$ENDIF} with Alloc do begin x := AGdkRect^.x; y := AGdkRect^.y; Width := AGdkRect^.width; Height := AGdkRect^.height; end; //fix layout, especially for GtkSpinButton if [wtSpinEdit] * ACtl.WidgetType <> [] then gtk_widget_set_clip(AWidget, @Alloc); if not Assigned(ACtl.LCLObject) then exit; // return size w/o frame NewSize.cx := AGdkRect^.width; NewSize.cy := AGdkRect^.height; if not (csDesigning in ACtl.LCLObject.ComponentState) then begin if ACtl.InUpdate then exit; end; if ((NewSize.cx <> ACtl.LCLObject.Width) or (NewSize.cy <> ACtl.LCLObject.Height) or ACtl.LCLObject.ClientRectNeedsInterfaceUpdate) then begin ACtl.LCLObject.DoAdjustClientRectChange; end; FillChar(Msg{%H-}, SizeOf(Msg), #0); Msg.Msg := LM_SIZE; Msg.SizeType := SIZE_RESTORED; Msg.SizeType := Msg.SizeType or Size_SourceIsInterface; Msg.Width := Word(NewSize.cx); Msg.Height := Word(NewSize.cy); ACtl.DeliverMessage(Msg); end; procedure TGtk3Entry.ConnectSizeAllocateSignal(ToWidget:PGtkWidget); begin g_signal_connect_data(ToWidget,'size-allocate',TGCallback(@EntrySizeAllocate), Self, nil, G_CONNECT_DEFAULT); end; function TGtk3Entry.getText: String; begin if IsValidHandle and IsWidgetOk then Result := StrPas(PGtkEntry(Widget)^.get_text) else Result := ''; end; procedure TGtk3Entry.setText(const AValue: String); begin if IsValidHandle and IsWidgetOK then {%H-}PGtkEntry(Widget)^.set_text(PgChar(AValue)); end; function TGtk3Entry.CreateWidget(const Params: TCreateParams): PGtkWidget; begin Result := LCLGtkEntryNew; FWidgetType := FWidgetType + [wtEntry]; fText:=Params.Caption; PrivateCursorPos := -1; PrivateSelection := -1; end; procedure TGtk3Entry.InitializeWidget; begin inherited InitializeWidget; Widget^.set_size_request(fParams.Width,fParams.Height); PgtkEntry(Widget)^.set_text(PgChar(fParams.Caption)); Self.SetTextHint(TCustomEdit(Self.LCLObject).TextHint); Self.SetNumbersOnly(TCustomEdit(Self.LCLObject).NumbersOnly); g_signal_connect_data(Widget, 'changed', TGCallback(@EntryChanged), Self, nil, G_CONNECT_DEFAULT); g_signal_connect_data(Widget, 'insert-text', TGCallback(@InsertText), Self, nil, G_CONNECT_DEFAULT); end; procedure TGtk3Entry.preferredSize(var PreferredWidth,PreferredHeight:integer; WithThemeSpace:Boolean); begin inherited preferredSize(PreferredWidth,PreferredHeight,WithThemeSpace); PreferredWidth := 0; end; procedure TGtk3Entry.SetPasswordChar(APasswordChar: Char); var PWChar: Integer; begin if IsWidgetOK then begin PWChar := ord(APasswordChar); if (PWChar < 192) or (PWChar = ord('*')) then PWChar := 9679; PGtkEntry(Widget)^.set_invisible_char(PWChar); end; end; procedure TGtk3Entry.SetNumbersOnly(ANumbersOnly:boolean); const ips:array[boolean]of TGtkInputPurpose=(GTK_INPUT_PURPOSE_FREE_FORM,GTK_INPUT_PURPOSE_NUMBER); begin // this is not enough for numeric input - it is just a hint for GUI if IsWidgetOK then PGtkEntry(Widget)^.set_input_purpose(ips[ANumbersOnly]); end; procedure TGtk3Entry.SetTextHint(const AHint: string); begin if IsWidgetOK and (Ahint<>'') then PGtkEntry(Widget)^.set_placeholder_text(PgChar(AHint)); end; procedure TGtk3Entry.SetFrame(const aborder: boolean); begin if IsWidgetOk then PGtkEntry(Widget)^.set_has_frame(aborder); end; function TGtk3Entry.GetTextHint:string; begin if IsWidgetOK then Result:=PGtkEntry(Widget)^.get_placeholder_text() else Result:=''; end; procedure TGtk3Entry.SetEchoMode(AVisible: Boolean); begin if IsWidgetOK then PGtkEntry(Widget)^.set_visibility(AVisible); end; procedure TGtk3Entry.SetMaxLength(AMaxLength: Integer); begin if IsWidgetOK then begin PGtkEntry(Widget)^.set_max_length(AMaxLength); PGtkEntry(Widget)^.set_width_chars(AMaxLength); end; end; function TGtk3Entry.IsWidgetOk: Boolean; begin Result := (Widget <> nil) and Gtk3IsEntry(Widget); end; { TGtk3SpinEdit } function TGtk3SpinEdit.GetMaximum: Double; var AFloat: gdouble; begin Result := 0; if IsWidgetOk then PGtkSpinButton(Widget)^.get_range(@AFloat ,@Result); end; function TGtk3SpinEdit.GetMinimum: Double; var AFloat: gdouble; begin Result := 0; if IsWidgetOk then PGtkSpinButton(Widget)^.get_range(@Result ,@AFloat); end; function TGtk3SpinEdit.GetNumDigits: Integer; begin Result := 0; if IsWidgetOk then Result := Integer(PGtkSpinButton(Widget)^.get_digits); end; function TGtk3SpinEdit.GetNumeric: Boolean; begin Result := False; if IsWidgetOk then Result := PGtkSpinButton(Widget)^.get_numeric; end; function TGtk3SpinEdit.GetStep: Double; var AFloat: Double; begin Result := 0; if IsWidgetOk then PGtkSpinButton(Widget)^.get_increments(@Result, @AFloat); end; function TGtk3SpinEdit.GetValue: Double; begin Result := 0; if IsWidgetOk then Result := PGtkSpinButton(Widget)^.get_value; end; procedure TGtk3SpinEdit.SetNumDigits(AValue: Integer); begin if IsWidgetOk then PGtkSpinButton(Widget)^.set_digits(GUint(AValue)); end; procedure TGtk3SpinEdit.SetNumeric(AValue: Boolean); begin if IsWidgetOk then PGtkSpinButton(Widget)^.set_numeric(AValue); end; procedure TGtk3SpinEdit.SetStep(AValue: Double); var AStep: gdouble; APage: gdouble; begin if IsWidgetOk then begin PGtkSpinButton(Widget)^.get_increments(@AStep, @APage); PGtkSpinButton(Widget)^.set_increments(AValue, APage); end; end; procedure TGtk3SpinEdit.SetValue(AValue: Double); begin if IsWidgetOk then begin PGtkSpinButton(Widget)^.set_value(AValue); end; end; function TGtk3SpinEdit.CreateWidget(const Params: TCreateParams): PGtkWidget; var ASpin: TCustomSpinEdit; begin PrivateCursorPos := -1; PrivateSelection := -1; ASpin := TCustomSpinEdit(LCLObject); FWidgetType := FWidgetType + [wtSpinEdit]; Result := LCLGtkSpinButtonNew; PGtkSpinButton(Result)^.set_range(ASpin.MinValue, ASpin.MaxValue); PGtkSpinButton(Result)^.set_increments(ASpin.Increment, ASpin.Increment * 10); //page param gtk default is 10 * step. end; function TGtk3SpinEdit.EatArrowKeys(const AKey: Word): Boolean; begin Result := False; end; class procedure TGtk3SpinEdit.SpinValueChanged(aSpin:PGtkSpinButton;aData: gpointer);cdecl; var Msg: TLMessage; begin FillChar(Msg{%H-}, SizeOf(Msg), 0); Msg.Msg := CM_TEXTCHANGED; if not TGtk3Widget(AData).InUpdate then TGtk3Widget(AData).DeliverMessage(Msg); end; procedure TGtk3SpinEdit.InitializeWidget; begin inherited InitializeWidget; g_signal_connect_data(Widget, 'value-changed', TGCallback(@SpinValueChanged), Self, nil, G_CONNECT_DEFAULT); end; function TGtk3SpinEdit.IsWidgetOk: Boolean; begin Result := (Widget <> nil) and Gtk3IsSpinButton(Widget); end; procedure TGtk3SpinEdit.SetRange(AMin, AMax: Double); begin if IsWidgetOk then PGtkSpinButton(Widget)^.set_range(AMin, AMax); end; { TGtk3Range } class procedure TGtk3Range.RangeChanged({%H-}ARange: PGtkRange; AData: gPointer); cdecl; var Msg: TLMessage; begin if AData <> nil then begin if TGtk3Widget(AData).InUpdate then Exit; FillChar(Msg{%H-}, SizeOf(Msg), #0); Msg.Msg := LM_CHANGED; TGtk3Widget(AData).DeliverMessage(Msg); end; end; function TGtk3Range.GetPosition: Integer; begin Result := 0; if IsWidgetOK then Result := Round(PGtkRange(Widget)^.get_value); end; function TGtk3Range.GetRange: TPoint; begin Result := Point(0, 0); if IsWidgetOK then PGtkRange(Widget)^.get_slider_range(@Result.X, @Result.Y); end; procedure TGtk3Range.SetPosition(AValue: Integer); begin if IsWidgetOK then PGtkRange(Widget)^.set_value(gDouble(AValue)); end; procedure TGtk3Range.SetRange(AValue: TPoint); var dx,dy: gdouble; begin if IsWidgetOK then begin dx := AValue.X; dy := AValue.Y; PGtkRange(Widget)^.set_range(dx, dy); end; end; procedure TGtk3Range.InitializeWidget; begin inherited InitializeWidget; g_signal_connect_data(GetContainerWidget, 'value-changed', TGCallback(@RangeChanged), Self, nil, G_CONNECT_DEFAULT); end; procedure TGtk3Range.SetStep(AStep: Integer; APageSize: Integer); begin if IsWidgetOk then PGtkRange(Widget)^.set_increments(gDouble(AStep), gDouble(APageSize)); end; { TGtk3TrackBar } function TGtk3TrackBar.GetReversed: Boolean; begin Result := False; if IsWidgetOK then Result := PGtkScale(Widget)^.get_inverted; end; procedure TGtk3TrackBar.SetReversed(AValue: Boolean); begin if IsWidgetOK then PGtkScale(Widget)^.set_inverted(AValue); end; function TGtk3TrackBar.CreateWidget(const Params: TCreateParams): PGtkWidget; var ATrack: TCustomTrackBar; begin ATrack := TCustomTrackBar(LCLObject); FWidgetType := FWidgetType + [wtTrackBar]; { Result := TGtkHBox.new(1,0); fCentralWidget:=PGtkWidget(TGtkScale.new(Ord(ATrack.Orientation), nil)); PgtkBox(Result)^.add(fCentralWidget);} Result :=PGtkWidget(TGtkScale.new(TGtkOrientation(ATrack.Orientation), nil)); FOrientation := ATrack.Orientation; if ATrack.Reversed then PGtkScale(Result)^.set_inverted(True); PGtkScale(Result)^.set_digits(0); end; procedure TGtk3TrackBar.SetBounds(ALeft, ATop, AWidth, AHeight: integer); begin Widget^.set_size_request(AWidth,AHeight); inherited SetBounds(ALeft, ATop, AWidth, AHeight); end; function TGtk3TrackBar.GetTrackBarOrientation: TTrackBarOrientation; begin Result := FOrientation; end; procedure TGtk3TrackBar.SetScalePos(AValue: TTrackBarScalePos); begin if IsWidgetOK then PGtkScale(Widget)^.set_value_pos(TGtkPositionType(AValue)); end; procedure TGtk3TrackBar.SetTickMarks(AValue: TTickMark; ATickStyle: TTickStyle); var i,cnt,fldw: Integer; Track:TCustomTrackbar; const tick_map:array[TTrackBarOrientation,0..1] of TGtkPositionType = ((GTK_POS_TOP,GTK_POS_BOTTOM), // trHorizontal (GTK_POS_LEFT,GTK_POS_RIGHT) // trVertical ); begin if IsWidgetOK then begin PGtkScale(Widget)^.set_draw_value(ATickStyle <> tsNone); if ATickStyle = tsNone then PGtkScale(Widget)^.clear_marks else begin PGtkScale(Widget)^.clear_marks; Track:=TCustomTrackbar(LCLObject); cnt:=round(abs(Track.max-Track.min)/Track.LineSize); // highly-dense marks just enlarge GtkScale automatically // it is up to user concent to do this if Track.Orientation=trHorizontal then fldw:=Track.Width else fldw:=Track.Height; if cnt*Track.LineSize 0) then fraction := (AValue - ABar.Min) / (ABar.Max - ABar.Min) else fraction := 0; PGtkProgressBar(GetContainerWidget)^.set_fraction(fraction); end; procedure TGtk3ProgressBar.SetShowText(AValue: Boolean); begin if IsWidgetOK then PGtkProgressBar(GetContainerWidget)^.set_show_text(AValue); end; function ProgressPulseTimeout(data: gpointer): gboolean; cdecl; begin Result := {%H-}PtrUInt(g_object_get_data(data, 'lclprogressbarstyle')) = 1; if Result then PGtkProgressBar(Data)^.pulse; end; procedure ProgressDestroy(data: gpointer); cdecl; begin g_source_remove({%H-}PtrUInt(data)); end; procedure TGtk3ProgressBar.SetStyle(AValue: TProgressBarStyle); begin if IsWidgetOk then begin g_object_set_data(GetContainerWidget,'lclprogressbarstyle', {%H-}Pointer(PtrUInt(Ord(AValue)))); if AValue = pbstNormal then begin Position := TCustomProgressBar(LCLObject).Position; end else begin g_object_set_data_full(GetContainerWidget, 'timeout', {%H-}Pointer(PtrUInt(g_timeout_add(100, @ProgressPulseTimeout, GetContainerWidget))), @ProgressDestroy); PGtkProgressBar(GetContainerWidget)^.pulse; end; end; end; {we must override preferred width since gtk3 have strange opinion about minimum width of progress bar} procedure get_progress_preferred_width(widget: PGtkWidget; minimum_width: Pgint; natural_width: Pgint); cdecl; var Handle: HWND; begin Handle := HwndFromGtkWidget(Widget); if Handle <> 0 then begin minimum_width^ := TGtk3Widget(Handle).LCLObject.Width; natural_width^ := TGtk3Widget(Handle).LCLObject.Width; end else begin minimum_width^ := 0; natural_width^ := 0; DebugLn('ERROR: get_progress_preferred_width cannot find GtkWidget LCL Handle ....'); end; end; {we must override preferred height since gtk3 have strange opinion about height of progress bar} procedure get_progress_preferred_height(widget: PGtkWidget; minimum_height: Pgint; natural_height: Pgint); cdecl; var Handle: HWND; begin Handle := HwndFromGtkWidget(Widget); if Handle <> 0 then begin minimum_height^ := TGtk3Widget(Handle).LCLObject.Height; natural_height^ := TGtk3Widget(Handle).LCLObject.Height; // TODO: get spacing from style property // Widget^.get_style_context^.get_style_property(); end else begin minimum_height^ := 0; natural_height^ := 0; DebugLn('ERROR: get_progress_preferred_height cannot find GtkWidget LCL Handle ....'); end; end; function TGtk3ProgressBar.CreateWidget(const Params: TCreateParams): PGtkWidget; var AProgress: TCustomProgressBar; begin AProgress := TCustomProgressBar(LCLObject); if AProgress=nil then ; FWidgetType := FWidgetType + [wtProgressBar]; Result := TGtkEventBox.new; FCentralWidget := TGtkProgressBar.new; PGtkEventBox(Result)^.add(FCentralWidget); FCentralWidget^.set_can_focus(True); end; var AProgressClassHookInitialized: Boolean = False; procedure TGtk3ProgressBar.InitializeWidget; var AClass: PGTypeClass; begin inherited InitializeWidget; //TODO: move hook check variable code into Gtk3WidgetSet. if not AProgressClassHookInitialized then begin AProgressClassHookInitialized := True; AClass := g_type_class_ref(gtk_progress_bar_get_type); PGtkWidgetClass(AClass)^.get_preferred_width := @get_progress_preferred_width; PGtkWidgetClass(AClass)^.get_preferred_height := @get_progress_preferred_height; g_type_class_unref(AClass); end; end; { TGtk3Container } function disableMouseButtonEvent(widget: PGtkWidget; event: PGdkEvent; user_data: gpointer): gboolean; cdecl; var AEvent: TGdkEvent; begin Result := TGtk3Widget(user_data).GtkEventMouse(Widget, Event); {TODO: check if we can block button_press also} if event^.type_ = GDK_BUTTON_RELEASE then Result := True; end; function motionNotifyEvent(widget: PGtkWidget; event: PGdkEvent; user_data: gpointer): gboolean; cdecl; begin TGtk3Widget(user_data).GtkEventMouseMove(widget, event); Result := True; end; procedure TGtk3Container.SetVisible(AValue: Boolean); begin if not AValue then begin if [wtNotebook, wtWindow] * WidgetType = [] then begin Widget^.set_no_show_all(True); Widget^.hide; end; end; inherited SetVisible(AValue); end; procedure TGtk3Container.InitializeWidget; begin inherited InitializeWidget; if IsDesigning then begin (* if (Widget <> getContainerWidget) then begin //Widget^.set_events([GDK_BUTTON_PRESS_MASK, GDK_BUTTON_RELEASE_MASK]); g_signal_connect_data(Widget, 'button-press-event', TGCallback(@disableMouseButtonEvent), Self, Nil, G_CONNECT_DEFAULT); g_signal_connect_data(Widget, 'button-release-event', TGCallback(@disableMouseButtonEvent), Self, Nil, G_CONNECT_DEFAULT); g_signal_connect_data(Widget, 'motion-notify-event', TGCallback(@motionNotifyEvent), Self, nil, G_CONNECT_DEFAULT); end; *) g_signal_connect_data(GetContainerWidget, 'button-press-event', TGCallback(@disableMouseButtonEvent), Self, Nil, G_CONNECT_DEFAULT); g_signal_connect_data(GetContainerWidget, 'button-release-event', TGCallback(@disableMouseButtonEvent), Self, Nil, G_CONNECT_DEFAULT); g_signal_connect_data(GetContainerWidget, 'motion-notify-event', TGCallback(@motionNotifyEvent), Self, nil, G_CONNECT_DEFAULT); end; end; procedure TGtk3Container.AddChild(AWidget: PGtkWidget; const ALeft, ATop: Integer); begin if Assigned(FCentralWidget) then PGtkFixed(PGtkScrolledWindow(FCentralWidget)^.get_child)^.put(AWidget, ALeft, ATop) else PGtkContainer(Widget)^.add(AWidget); end; { TGtk3ToolBar } procedure TGtk3ToolBar.ClearGlyphs; var i:integer; begin if Assigned(fBmpList) then for i:=fBmpList.Count-1 downto 0 do TObject(fBmpList[i]).Free; end; destructor TGtk3ToolBar.Destroy; begin ClearGlyphs; fBmpList.Free; inherited Destroy; end; procedure TGtk3ToolBar.ButtonClicked(data: gPointer);cdecl; begin if TObject(data) is TToolButton then TToolButton(data).Click; end; function TGtk3ToolBar.CreateWidget(const Params: TCreateParams): PGtkWidget; var i:integer; AToolBar: TToolBar; btn:TToolButton; gtb:PGtkToolItem; wmenu,wicon:PGtkWidget; pb:PGdkPixBuf; bmp:TBitmap; resolution:TCustomImageListResolution; raw:TRawImage; bs:string; begin AToolBar := TToolBar(LCLObject); FHasPaint := False; FWidgetType := [wtWidget, wtContainer]; Result:=PGtkWidget(TGtkToolbar.new); if not Assigned(fBmpList) then fBmpList:=TList.Create; ClearGlyphs; // allocate appropriate number of tool items for i:=0 to AToolbar.ButtonCount-1 do begin btn:=AToolBar.Buttons[i]; bs:= ReplaceAmpersandsWithUnderscores(btn.Caption); wicon:=nil; if btn is TToolButton then begin if (btn.ImageIndex>=0) and assigned(AToolbar.Images) and not (btn.Style in [tbsSeparator,tbsDivider]) then begin if Assigned(AToolBar.Images) and (btn.ImageIndex>=0) then begin bmp:=TBitmap.Create; { this carries gdk pixmap } resolution:=AToolBar.Images.Resolution[AToolBar.ImagesWidth]; // not AToolBar.Images.Width, issue #36465 resolution.GetRawImage(btn.ImageIndex,raw); { convince the bitmap it has actually another format } bmp.BeginUpdate(); //raw.Description.Init_BPP32_R8G8B8A8_BIO_TTB(resolution.Width,resolution.Height); bmp.LoadFromRawImage(raw,false); bmp.EndUpdate(); pb:=TGtk3Image(bmp.Handle).Handle; wicon := TGtkImage.new_from_pixbuf(pb); fBmpList.Add(bmp); end else wicon := nil; end; case btn.Style of tbsSeparator: gtb:=TGtkSeparatorToolItem.new(); tbsDropDown: begin gtb:=TGtkMenuToolButton.new(wicon,PgChar(bs)); if Assigned(btn.DropdownMenu) then begin wmenu:=TGtk3Menu(btn.DropdownMenu.Handle).Widget; PGtkMenuToolButton(gtb)^.set_menu(wmenu); end; end; tbsCheck: begin gtb:=TGtkToggleToolButton.new(); PGtkToolButton(gtb)^.set_label(PgChar(bs)); PGtkToolButton(gtb)^.set_icon_widget(wicon); end else gtb:=TGtkToolButton.new(wicon,PgChar(bs)); end; if not (btn.Style in [tbsSeparator,tbsDivider]) then begin gtb^.set_tooltip_text(PgChar(btn.Hint)); PgtkToolButton(gtb)^.set_use_underline(true); end; PGtkToolBar(Result)^.add(gtb); if not (btn.Style in [tbsSeparator,tbsDivider]) then g_signal_connect_data(gtb,'clicked', TGCallback(@TGtk3Toolbar.ButtonClicked), btn, nil, G_CONNECT_DEFAULT); end; end; end; { TGtk3Page } procedure TGtk3Page.setText(const AValue: String); var bs:string; begin inherited; if Assigned(FPageLabel) then begin bs:=ReplaceAmpersandsWithUnderscores(Avalue); FPageLabel^.set_markup_with_mnemonic(PChar(bs)); end; end; function TGtk3Page.CreateWidget(const Params: TCreateParams): PGtkWidget; begin FWidgetType := FWidgetType + [wtContainer]; FPageLabel:= TGtkLabel.new(PChar(Params.Caption)); FPageLabel^.set_use_underline(true); Self.FHasPaint:=true; // ref it to save it in case TabVisible is set to false FPageLabel^.ref; Result := TGtkHBox.new(GTK_ORIENTATION_HORIZONTAL, 0); FCentralWidget := TGtkFixed.new; PGtkHBox(Result)^.pack_start(FCentralWidget, True , True, 0); PGtkFixed(FCentralWidget)^.set_has_window(True); // PGtkFixed(FCentralWidget)^.set_can_focus(True); end; procedure TGtk3Page.DestroyWidget; begin // unref it to allow it to be destroyed FPageLabel^.unref; inherited DestroyWidget; end; function TGtk3Page.getClientOffset: TPoint; var Allocation: TGtkAllocation; R: TRect; begin Self.Widget^.get_allocation(@Allocation); Result.X := -Allocation.X; Result.Y := -Allocation.Y; R := getClientBounds; Result := Point(Result.x + R.Left, Result.y + R.Top); end; function TGtk3Page.getClientRect: TRect; var AParent: PGtkWidget; AParentObject: TGtk3Widget; begin Result := Rect(0, 0, 0, 0); if Assigned(LCLObject.Parent) and (LCLObject.Parent.HandleAllocated) then begin if not WidgetMapped then begin Result := TGtk3Widget(LCLObject.Parent.Handle).getClientRect; exit; end; end; if not WidgetMapped then begin AParent := Widget^.get_parent; AParentObject := TGtk3Widget(HwndFromGtkWidget(AParent)); if AParentObject <> nil then Result := AParentObject.getClientRect else Result := inherited getClientRect; end else Result := inherited getClientRect; // DebugLn('TGtk3Page.GetClientRect Result=',dbgs(Result),' Realized ',dbgs(getContainerWidget^.get_realized)); end; { TGtk3NoteBook } function NotebookPageRealToLCLIndex(const ATabControl: TCustomTabControl; AIndex: integer): integer; var I: Integer; begin Result := AIndex; if csDesigning in ATabControl.ComponentState then exit; I := 0; while (I < ATabControl.PageCount) and (I <= Result) do begin if not ATabControl.Page[I].TabVisible then Inc(Result); Inc(I); end; end; // function GtkNotebookAfterSwitchPage(widget: PGtkWidget; pagenum: integer; data: gPointer): GBoolean; cdecl; procedure GtkNotebookAfterSwitchPage(widget: PGtkWidget; {%H-}page: PGtkWidget; pagenum: integer; data: gPointer); cdecl; var Mess: TLMNotify; NMHdr: tagNMHDR; LCLPageIndex: Integer; begin if widget=nil then ; if TGtk3Widget(Data).InUpdate then exit; {page is deleted} { DebugLn('GtkNotebookAfterSwitchPage '); if TGtk3NoteBook(Data).getPagesCount < TCustomTabControl(TGtk3NoteBook(Data).LCLObject).PageCount then begin DebugLn('GtkNotebookAfterSwitchPage PageIsDeleted'); exit; end;} FillChar(Mess{%H-}, SizeOf(Mess), 0); Mess.Msg := LM_NOTIFY; FillChar(NMHdr{%H-}, SizeOf(NMHdr), 0); NMHdr.code := TCN_SELCHANGE; NMHdr.hwndFrom := HWND(TGtk3Widget(Data)); LCLPageIndex := NotebookPageRealToLCLIndex(TCustomTabControl(TGtk3Widget(Data).LCLObject), pagenum); //use this to set pageindex to the correct page. NMHdr.idFrom := LCLPageIndex; Mess.NMHdr := @NMHdr; TGtk3Widget(Data).DeliverMessage(Mess); end; function BackNoteBookSignal(AData: Pointer): gboolean; cdecl; var AWidget: PGtkNotebook; APageNum: PtrInt; ACurrentPage: gint; begin Result := False; AWidget := PGtkNoteBook(AData); if not Gtk3IsWidget(AWidget) then exit; if g_object_get_data(AWidget,'switch-page-signal-stopped') <> nil then begin Result := True; APageNum := {%H-}PtrInt(g_object_get_data(AWidget,'switch-page-signal-stopped')); ACurrentPage := AWidget^.get_current_page; g_object_set_data(AWidget,'switch-page-signal-stopped', nil); {$IFDEF GTK3DEBUGNOTEBOOK} DebugLn('BackNoteBookSignal back notebook switch-page signal currpage=',dbgs(AWidget^.get_current_page),' blockedPage ',dbgs(APageNum)); {$ENDIF} if ACurrentPage<0 then ; // must hook into notebook^.priv to unlock APageNum // AWidget^.set_current_page(AWidget^.get_current_page); // g_object_thaw_notify(AWidget^.get_nth_page(AWidget^.get_current_page)); // PGtkFixed(AWidget^.get_nth_page(AWidget^.get_current_page))^. // g_signal_emit_by_name(AWidget,'switch-page',[AWidget^.get_nth_page(APageNum), APageNum, gPointer(HwndFromGtkWidget(AWidget)), nil{AWidget, True, gPointer(HwndFromGtkWidget(AWidget))}]); // AWidget^.notify('page'); // g_signal_stop_emission_by_name(AWidget, 'switch-page'); // g_signal_emit_by_name(AWidget,'switch-page',[G_TYPE_NONE, AWidget, AWidget^.get_nth_page(AWidget^.get_current_page), AWidget^.get_current_page, gPointer(HwndFromGtkWidget(AWidget))]); end; g_idle_remove_by_data(AData); end; procedure GtkNotebookSwitchPage(widget: PGtkWidget; {%H-}page: PGtkWidget; pagenum: integer; data: gPointer); cdecl; var Mess: TLMNotify; NMHdr: tagNMHDR; c1,c2:integer; begin if TGtk3Widget(Data).InUpdate then exit; {$IFDEF GTK3DEBUGNOTEBOOK} DebugLn('GtkNotebookSwitchPage Data ',dbgHex({%H-}PtrUInt(Data)),' Realized ',dbgs(Widget^.get_realized),' pageNum=',dbgs(pageNum)); {$ENDIF} {page is deleted} { c1:=TGtk3NoteBook(Data).getPagesCount; c2:=TCustomTabControl(TGtk3NoteBook(Data).LCLObject).PageCount; if c1 < c2 then begin DebugLn('GtkNotebookSwitchPage PageIsDeleted '); exit; end;} FillChar(Mess{%H-}, SizeOf(Mess), 0); Mess.Msg := LM_NOTIFY; FillChar(NMHdr{%H-}, SizeOf(NMHdr), 0); NMHdr.code := TCN_SELCHANGING; NMHdr.hwndFrom := HWND(TGtk3Widget(Data)); NMHdr.idFrom := NotebookPageRealToLCLIndex(TCustomTabControl(TGtk3Widget(Data).LCLObject), pagenum); //use this to set pageindex to the correct page. // DebugLn('LCLObject ',dbgsName(TGtk3Widget(Data).LCLObject),' IdFrom ',dbgs(NMHdr.idFrom)); Mess.NMHdr := @NMHdr; Mess.Result := 0; // DebugLn('LCLObject ',dbgsName(TGtk3Widget(Data).LCLObject),' sending message ....'); TGtk3Widget(Data).DeliverMessage(Mess); if Mess.Result <> 0 then begin g_object_set_data(Widget,'switch-page-signal-stopped', {%H-}GPointer(pageNum)); g_signal_stop_emission_by_name(PGObject(Widget), 'switch-page'); // GtkNotebookAfterSwitchPage(Widget, page, pagenum, data); g_idle_add(@BackNoteBookSignal, Widget); Exit; end; end; function GtkNotebookSelectPage(ANoteBook: PGtkNotebook; p1: gboolean; Data: gPointer): GBoolean; cdecl; begin // does not trigger for some reason if ANoteBook=nil then ; if p1 then ; if Data=nil then ; {$IFDEF GTK3DEBUGNOTEBOOK} DebugLn('GtkNotebookSelectPage '); {$ENDIF} Result:=true; end; function TGtk3NoteBook.CreateWidget(const Params: TCreateParams): PGtkWidget; var Alloc:TGtkAllocation; begin FWidgetType := FWidgetType + [wtNotebook]; Result := LCLGtkNotebookNew; FCentralWidget := Result; PGtkNoteBook(FCentralWidget)^.set_scrollable(True); if (nboHidePageListPopup in TCustomTabControl(LCLObject).Options) then PGtkNoteBook(FCentralWidget)^.popup_disable; Alloc.x := Params.X; Alloc.y := Params.Y; Alloc.Width := Params.Width; Alloc.Height := Params.Height; g_signal_connect_data(FCentralWidget,'switch-page', TGCallback(@GtkNotebookSwitchPage), Self, nil, G_CONNECT_DEFAULT); // this one triggers after above switch-page g_signal_connect_data(FCentralWidget,'switch-page', TGCallback(@GtkNotebookAfterSwitchPage), Self, nil, G_CONNECT_DEFAULT); PGtkNotebook(Result)^.set_scrollable(True); // those signals doesn't trigger with gtk3-3.6 // g_signal_connect_data(FCentralWidget,'change-current-page', TGCallback(@GtkNotebookAfterSwitchPage), Self, nil, 0); // g_signal_connect_data(FCentralWidget,'select-page', TGCallback(@GtkNotebookSelectPage), Self, nil, 0); FCentralWidget^.show_all; FCentralWidget^.size_allocate(@Alloc); end; procedure TGtk3NoteBook.InitializeWidget; begin FDefaultClientRect := Rect(0, 0, 0, 0); inherited; SetTabPosition(TCustomTabControl(LCLObject).TabPosition); end; function TGtk3NoteBook.GetTabSize(AWinControl:TWinControl):integer; var AWidget: PGtkWidget; Alloc:TGtkAllocation; APage:PGtkWidget; APageAlloc:TGtkAllocation; R:TRect; begin Result := 0; if not WidgetMapped then Result := DefaultClientRect.Height else begin R := getClientRect; if PGtkNotebook(GetContainerWidget)^.tab_pos in [GTK_POS_TOP, GTK_POS_BOTTOM] then Result := GetContainerWidget^.get_allocated_height - R.Height else Result := GetContainerWidget^.get_allocated_width - R.Width; end; end; function TGtk3NoteBook.getClientRect: TRect; var AAlloc: TGtkAllocation; ACurrentPage: gint; APage: PGtkWidget; ATabSheet:HWND; begin Result := Rect(0, 0, 0, 0); ACurrentPage := -1; if not WidgetMapped then begin if not IsRectEmpty(FDefaultClientRect) then Result := DefaultClientRect else exit; end else if PGtkNoteBook(GetContainerWidget)^.get_n_pages = 0 then begin GetContainerWidget^.get_allocation(@AAlloc); Result := RectFromGtkAllocation(AAlloc); Types.OffsetRect(Result, -Result.Left, -Result.Top); end else begin ACurrentPage := PGtkNoteBook(GetContainerWidget)^.get_current_page; if (ACurrentPage >= 0) then begin APage := PGtkNoteBook(GetContainerWidget)^.get_nth_page(ACurrentPage); ATabSheet := HwndFromGtkWidget(APage); if (ATabSheet <> 0) and TGtk3Widget(ATabSheet).WidgetMapped then APage^.get_allocation(@AAlloc) else GetContainerWidget^.get_allocation(@AAlloc); Result := RectFromGtkAllocation(AAlloc); Types.OffsetRect(Result, -Result.Left, -Result.Top); end; end; // DebugLn(' nil then begin FOwnWidget := False; FWidget := AMenuBar; end else FOwnWidget := True; // Initializes the properties // FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE]; // FHasPaint := False; // FParams := AParams; InitializeWidget; end; procedure TGtk3MenuShell.InitializeWidget; begin if FOwnWidget then FWidget := CreateWidget(FParams); LCLIntf.SetProp(HWND(Self),'lclwidget',Self); end; { TGtk3MenuBar } function TGtk3MenuBar.CreateWidget(const Params: TCreateParams): PGtkWidget; begin FWidgetType := [wtWidget, wtMenuBar]; Result := TGtkMenuBar.new; PGtkMenuBar(Result)^.set_pack_direction(MenuDirection[TMenu(MenuObject).UseRightToLeftAlignment]); end; { TGtk3Menu } function TGtk3Menu.CreateWidget(const Params: TCreateParams): PGtkWidget; begin FWidgetType := [wtWidget, wtMenu]; Result := TGtkMenu.new; end; constructor TGtk3Menu.CreateFromMenuItem(const AMenuItem: TMenuItem); begin inherited Create(AMenuItem.GetParentMenu, nil); end; { TGtk3MenuItem } function TGtk3MenuItem.GetCaption: string; begin Result := ''; if IsWidgetOK then Result := PGtkMenuItem(FWidget)^.get_label; end; procedure TGtk3MenuItem.SetCaption(const AValue: string); begin if IsWidgetOK then PGtkMenuItem(FWidget)^.set_label(PgChar(AValue)); end; function TGtk3MenuItem.CreateWidget(const Params: TCreateParams): PGtkWidget; var ndx:integer; pl:PGsList; parentMenu:TMenuItem; picon:PGtkImage; pmenu:PGtkMenuItem; pimgmenu:PgtkImageMenuItem absolute pmenu; img:TGtk3Image; begin Result:=nil; FWidgetType := [wtWidget, wtMenuItem]; if MenuItem.Caption = cLineCaption then Result := TGtkSeparatorMenuItem.new else if (MenuItem.HasIcon) then begin pimgmenu := TGtkImageMenuItem.new(); MenuItem.UpdateImage(true); img:=Tgtk3Image(MenuItem.Bitmap.Handle); picon := TGtkImage.new_from_pixbuf(img.Handle); pimgmenu^.set_image(picon); pimgmenu^.set_always_show_image(true); Result:=pimgmenu; end else if MenuItem.RadioItem and not MenuItem.HasIcon then begin Result := TGtkRadioMenuItem.new(nil); if Assigned(menuItem.Parent) then begin ndx:=menuItem.Parent.IndexOf(MenuItem); if (ndx>0) then begin ParentMenu:=menuItem.Parent.Items[ndx-1]; if (ParentMenu.GroupIndex=MenuItem.GroupIndex) then begin pl:=PGtkRadioMenuItem(TGtk3MenuItem(ParentMenu.Handle).Widget)^.get_group; PGtkRadioMenuItem(Result)^.set_group(pl); end; end; end; //PGtkRadioMenuItem(Result)^.set_active(MenuItem.Checked); end else if MenuItem.IsCheckItem and not MenuItem.HasIcon then begin Result := TGtkCheckMenuItem.new; PGtkCheckMenuItem(Result)^.set_active(MenuItem.Checked); end else Result := TGtkMenuItem.new; if Assigned(Result) and (MenuItem.Caption <> cLineCaption) {and not MenuItem.HasIcon} then begin PGtkMenuItem(Result)^.use_underline := True; PGtkMenuItem(Result)^.set_label(PgChar(ReplaceAmpersandsWithUnderscores(MenuItem.Caption))); PGtkMenuItem(Result)^.set_sensitive(MenuItem.Enabled); end; end; constructor TGtk3MenuItem.Create(const AMenuItem: TMenuItem); begin inherited Create; MenuItem := AMenuItem; FOwnWidget := True; // Initializes the properties // FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE]; // FHasPaint := False; // FParams := AParams; InitializeWidget; end; class function TGtk3MenuItem.MenuItemEvent({%H-}AWidget: PGtkWidget; event: PGdkEvent; {%H-}data: GPointer): gboolean; cdecl; begin Result := False; if not Assigned(Application) or (Assigned(Application) and Application.Terminated) then exit; //DebugLn('TGtk3MenuItem.MenuItemEvent triggered ',dbgsName(TGtk3MenuItem(Data).MenuItem), // ' ',Gtk3EventToStr(event^.type_)); case event^.type_ of GDK_DELETE: begin // DebugLn('****** GDK_DELETE FOR ',dbgsName(TGtk3Widget(Data).LCLObject),' main_level=',dbgs(gtk_main_level)); end; GDK_DESTROY: begin // DebugLn('****** GDK_DESTROY FOR ' + dbgsName(TGtk3Widget(Data).LCLObject)); end; GDK_EXPOSE: begin // DebugLn('****** GDK_EXPOSE FOR ' + dbgsName(TGtk3Widget(Data).LCLObject)); // TGtk3Widget.DrawWidget is attached to 'draw' signal, Expose event doesn't trigger // under gtk3. // we use 'draw' signal Gtk3DrawEvent() // Result := TGtk3Widget(Data).GtkEventPaint(Widget, Event); end; GDK_MOTION_NOTIFY: begin // Result := TGtk3Widget(Data).GtkEventMouseMove(Widget, Event); end; GDK_BUTTON_PRESS: begin // Result := TGtk3Widget(Data).GtkEventMouse(Widget , Event); end; GDK_2BUTTON_PRESS: begin // if not TGtk3Widget(Data).LCLObject.Focused and TGtk3Widget(Data).LCLObject.CanFocus then // LCLIntf.SetFocus(HWND(TGtk3Widget(Data))); // Result := TGtk3Widget(Data).GtkEventMouse(Widget , Event); end; GDK_3BUTTON_PRESS: begin // if not TGtk3Widget(Data).LCLObject.Focused and TGtk3Widget(Data).LCLObject.CanFocus then // LCLIntf.SetFocus(HWND(TGtk3Widget(Data))); // Result := TGtk3Widget(Data).GtkEventMouse(Widget , Event); end; GDK_BUTTON_RELEASE: begin // Result := TGtk3Widget(Data).GtkEventMouse(Widget , Event); end; GDK_KEY_PRESS: begin // if Widget^.has_focus then // or (Widget = TGtk3Widget(data).GetContainerWidget) then // Result := TGtk3Widget(Data).GtkEventKey(Widget, Event, True); end; GDK_KEY_RELEASE: begin // if Widget^.has_focus then // or (Widget = TGtk3Widget(data).GetContainerWidget) then // Result := TGtk3Widget(Data).GtkEventKey(Widget, Event, False); end; GDK_ENTER_NOTIFY: begin // TGtk3Widget(Data).GtkEventMouseEnterLeave(Widget, Event); end; GDK_LEAVE_NOTIFY: begin // TGtk3Widget(Data).GtkEventMouseEnterLeave(Widget, Event); end; GDK_FOCUS_CHANGE: begin // end; GDK_CONFIGURE: begin // GDK_CONFIGURE end; GDK_MAP: begin // DebugLn('****** GDK_MAP FOR ',dbgsName(TGtk3Widget(Data).LCLObject)); end; GDK_UNMAP: begin // DebugLn('****** GDK_UNMAP FOR ',dbgsName(TGtk3Widget(Data).LCLObject)); end; GDK_PROPERTY_NOTIFY: begin // DebugLn('****** GDK_PROPERTY_NOTIFY FOR ',dbgsName(TGtk3Widget(Data).LCLObject)); end; GDK_CLIENT_EVENT: begin // DebugLn('****** GDK_CLIENT_EVENT FOR ',dbgsName(TGtk3Widget(Data).LCLObject)); end; GDK_VISIBILITY_NOTIFY: begin // Result := TGtk3Widget(Data).GtkEventShowHide(Widget, Event); // DebugLn('****** GDK_VISIBILITY_NOTIFY FOR ' + dbgsName(TGtk3Widget(Data).LCLObject)); end; GDK_SCROLL: begin // DebugLn('****** GDK_SCROLL ' + dbgsName(TGtk3Widget(Data).LCLObject)); end; else DebugLn('TGtk3MenuItem.MenuItemEvent unhandled event.'); end; end; class procedure TGtk3MenuItem.MenuItemActivated({%H-}AItem: PGtkMenuItem; AData: GPointer); cdecl; var Msg: TLMessage; begin // DebugLn('Gtk3MenuItemActivated ',dbgsName(TGtk3MenuItem(Adata))); if Assigned(TGtk3MenuItem(AData).MenuItem) and (TGtk3MenuItem(AData).Lock=0) then begin inc(TGtk3MenuItem(AData).Lock); try FillChar(Msg{%H-}, SizeOf(Msg), #0); Msg.Msg := LM_ACTIVATE; TGtk3MenuItem(AData).MenuItem.Dispatch(Msg); finally dec(TGtk3MenuItem(AData).Lock); end; end; end; procedure TGtk3MenuItem.InitializeWidget; begin FWidget := CreateWidget(FParams); LCLIntf.SetProp(HWND(Self),'lclwidget',Self); // move signal connections into attach events FWidget^.set_events(GDK_DEFAULT_EVENTS_MASK); g_signal_connect_data(FWidget, 'event', TGCallback(@MenuItemEvent), Self, nil, G_CONNECT_DEFAULT); g_signal_connect_data(FWidget,'activate',TGCallBack(@MenuItemActivated), Self, nil, G_CONNECT_DEFAULT); // must hide all by default // FWidget^.hide; end; procedure TGtk3MenuItem.SetCheck(ACheck: boolean); begin if Self.IsValidHandle and (lock=0) then PGtkCheckMenuItem(fWidget)^.active:=ACheck; end; { TGtk3ScrollableWin} function TGtk3ScrollableWin.GetHScrollBarPolicy: TGtkPolicyType; var AScrollWin: PGtkScrolledWindow; APolicy: TGtkPolicyType; begin Result := GTK_POLICY_AUTOMATIC; AScrollWin := getScrolledWindow; if not Gtk3IsScrolledWindow(AScrollWin) then exit; AScrollWin^.get_policy(@Result, @APolicy); end; function TGtk3ScrollableWin.GetVScrollBarPolicy: TGtkPolicyType; var AScrollWin: PGtkScrolledWindow; APolicy: TGtkPolicyType; begin Result := GTK_POLICY_AUTOMATIC; AScrollWin := getScrolledWindow; if not Gtk3IsScrolledWindow(AScrollWin) then exit; AScrollWin^.get_policy(@APolicy, @Result); end; procedure TGtk3ScrollableWin.SetBorderStyle(AValue: TBorderStyle); begin if FBorderStyle=AValue then Exit; FBorderStyle:=AValue; if IsWidgetOK then begin if AValue = bsNone then getScrolledWindow^.set_shadow_type(GTK_SHADOW_NONE) else getScrolledWindow^.set_shadow_type(GTK_SHADOW_ETCHED_IN); end; end; procedure TGtk3ScrollableWin.SetHScrollBarPolicy(AValue: TGtkPolicyType); var AScrollWin: PGtkScrolledWindow; APolicyH, APolicyV: TGtkPolicyType; begin AScrollWin := getScrolledWindow; if not Gtk3IsScrolledWindow(AScrollWin) or IsDesigning then exit; AScrollWin^.get_policy(@APolicyH, @APolicyV); AScrollWin^.set_policy(AValue, APolicyV); end; procedure TGtk3ScrollableWin.SetVScrollBarPolicy(AValue: TGtkPolicyType); var AScrollWin: PGtkScrolledWindow; APolicyH, APolicyV: TGtkPolicyType; begin AScrollWin := getScrolledWindow; if not Gtk3IsScrolledWindow(AScrollWin) or IsDesigning then exit; AScrollWin^.get_policy(@APolicyH, @APolicyV); AScrollWin^.set_policy(APolicyH, AValue); end; procedure ApplyNoHoverCss(Widget: PGtkWidget); var CssProvider: PGtkCssProvider; StyleContext: PGtkStyleContext; CssData: PChar; begin // Define the CSS data CssData := 'scrollbar { transition: none; }' + LineEnding + 'scrollbar:hover { background-color: transparent; }' + LineEnding + 'scrollbar slider:hover { background-color: transparent; }'; // Create a new CSS provider CssProvider := gtk_css_provider_new(); gtk_css_provider_load_from_data(CssProvider, CssData, -1, nil); // Get the style context of the widget StyleContext := gtk_widget_get_style_context(Widget); // Add the CSS provider to the style context gtk_style_context_add_provider(StyleContext, PGtkStyleProvider(CssProvider), GTK_STYLE_PROVIDER_PRIORITY_USER); // Unreference the CSS provider g_object_unref(CssProvider); end; class function TGtk3ScrollableWin.CheckIfScrollbarPressed(scrollbar: PGtkWidget; out AMouseOver: boolean; const ACheckModifier: TGdkModifierTypeIdx): boolean; var display: PGdkDisplay; seat: PGdkSeat; pointer: PGdkDevice; screen: PGdkScreen; x, y, win_x, win_y: gint; allocation: TGtkAllocation; state: TGdkModifierType; begin Result := False; AMouseOver := False; display := gdk_display_get_default(); seat := gdk_display_get_default_seat(display); // Get the pointer device (mouse) pointer := gdk_seat_get_pointer(seat); if pointer = nil then begin DebugLn('WARNING: No pointer device available'); Exit; end; screen := scrollbar^.get_screen; if (screen = nil) then screen := gdk_screen_get_default; gdk_device_get_position(pointer, @screen, @x, @y); gdk_window_get_origin(gtk_widget_get_window(scrollbar), @win_x, @win_y); // Translate the pointer position to the scrollbar's local coordinates x := x - win_x; y := y - win_y; // Get the scrollbar's allocation (local coordinates) gtk_widget_get_allocation(scrollbar, @allocation); // Check if the pointer is within the scrollbar's allocation if (x >= allocation.x) and (x < allocation.x + allocation.width) and (y >= allocation.y) and (y < allocation.y + allocation.height) then begin // Get the button state gdk_device_get_state(pointer, gtk_widget_get_window(scrollbar), nil, @state); AMouseOver := True; Result := (ACheckModifier in state); {$IFDEF GTK3DEBUGSCROLL} if Result then DebugLn(Format('Scrollbar is pressed and being dragged pointer x %d y %d',[x, y])) else DebugLn(Format('Mouse is over the scrollbar but not pressed pointer x %d y %d', [x, y])); {$ENDIF} end else begin {$IFDEF GTK3DEBUGSCROLL} DebugLn('**** Mouse is not over the scrollbar ****'); {$ENDIF} end; end; class function TGtk3ScrollableWin.RangeChangeValue(ARange: PGtkRange; AScrollType: TGtkScrollType; AValue: gdouble; AData: TGtk3Widget): gboolean; cdecl; var Msg: TLMVScroll; MaxValue: gdouble; StateFlags: TGtkStateFlags; begin Result := gtk_false; {$IFDEF GTK3DEBUGSCROLL} DebugLn(Format('>TGtk3ScrollableWin.RangeChangeValue Value: %d', [RoundToInt(AValue)]),' IsHScrollBar ',dbgs(PGtkOrientable(ARange)^.get_orientation = GTK_ORIENTATION_HORIZONTAL),' InUpdate=',dbgs(AData.InUpdate)); {$ENDIF} if PGtkOrientable(ARange)^.get_orientation = GTK_ORIENTATION_HORIZONTAL then Msg.Msg := LM_HSCROLL else Msg.Msg := LM_VSCROLL; if ARange^.adjustment^.page_size > 0 then MaxValue := ARange^.adjustment^.upper - ARange^.adjustment^.page_size else MaxValue := ARange^.adjustment^.upper; if (AValue > MaxValue) then AValue := MaxValue else if (AValue < ARange^.adjustment^.lower) then AValue := ARange^.adjustment^.lower; with Msg do begin Pos := Round(AValue); if Pos < High(SmallPos) then SmallPos := Pos else SmallPos := High(SmallPos); {$note to get this correct we must use TQtWidget.CreateFrom() for scrollbars} ScrollBar := HWND(AData); // HWND({%H-}PtrUInt(ARange)); ScrollCode := Gtk3ScrollTypeToScrollCode(AScrollType); end; AData.DeliverMessage(Msg, True); if Msg.Scrollcode = SB_THUMBTRACK then begin StateFlags := ARange^.get_state_flags; if not (GTK_STATE_FLAG_ACTIVE in StateFlags) then begin Msg.ScrollCode := SB_THUMBPOSITION; AData.DeliverMessage(Msg, False); Msg.ScrollCode := SB_ENDSCROLL; AData.DeliverMessage(Msg, False); end; end else ARange^.set_state_flags([GTK_STATE_FLAG_ACTIVE], True); if ([wtScrollingWinControl, wtWindow, wtHintWindow, wtDialog] * AData.WidgetType <> []) and ((Msg.ScrollCode = SB_LINEUP) or (Msg.ScrollCode = SB_LINEDOWN)) then Result := gtk_true; {$IFDEF GTK3DEBUGSCROLL} DebugLn(' nil) and gtk_widget_get_visible(HScrollbar) and (ScrollPolicyH <> GTK_POLICY_NEVER) then begin gtk_widget_get_allocation(HScrollbar, @HScrollbarAllocation); HScrollbarHeight := HScrollbarAllocation.height; end; //Check if the vertical scrollbar is visible VScrollbar := gtk_scrolled_window_get_vscrollbar(ScrolledWindow); if (VScrollbar <> nil) and gtk_widget_get_visible(VScrollbar) and (ScrollPolicyV <> GTK_POLICY_NEVER) then begin gtk_widget_get_allocation(VScrollbar, @VScrollbarAllocation); VScrollbarWidth := VScrollbarAllocation.width; end; //Now we calculate the client area. Result.Left := ViewportAllocation.x + Border.left + Padding.left; Result.Top := ViewportAllocation.y + Border.top + Padding.top; Result.Right := ViewportAllocation.x + ViewportAllocation.width - Border.right - Padding.right - VScrollbarWidth; Result.Bottom := ViewportAllocation.y + ViewportAllocation.height - Border.bottom - Padding.bottom - HScrollbarHeight; writeln(Format('Client Area Calculation: Left=%d, Top=%d, Right=%d, Bottom=%d', [Result.Left, Result.Top, Result.Right, Result.Bottom])); end; {$ENDIF} function TGtk3ScrollableWin.getClientBounds: TRect; var Allocation: TGtkAllocation; x:gint; y:gint; w:gint; h:gint; AViewport:PGtkViewport; AWindow:PGdkWindow; VOffset, HOffset:gint; Bar:PGtkScrollbar; begin Result := Rect(0, 0, 0, 0); if IsWidgetOK then begin (* if (Self is TGtk3CustomControl) then begin if Self is TGtk3Window then Result := GetViewportClientAreaWithScrollbars(PGtkScrolledWindow(TGtk3Window(Self).FScrollWin)) else Result := GetViewportClientAreaWithScrollbars(PGtkScrolledWindow(FWidget)); //DebugLn('TGtk3ScrollableWin.getClientBounds result ',dbgs(Result),' from viewport ',dbgsName(LCLObject)); exit; end else *) if [wtLayout] * WidgetType <> [] then begin Result := Rect(0, 0, 0, 0); AWindow := PGtkLayout(getContainerWidget)^.get_bin_window; if Assigned(AWindow) and Gtk3IsGdkWindow(AWindow) then begin Bar := getHorizontalScrollbar; if (Bar <> nil) and Gtk3IsWidget(Bar) and Bar^.get_visible and GTK3WidgetSet.OverlayScrolling then HOffset := Bar^.get_allocated_height else HOffset := 0; Bar := getVerticalScrollbar; if (Bar <> nil) and Gtk3IsWidget(Bar) and Bar^.get_visible and GTK3WidgetSet.OverlayScrolling then VOffset := Bar^.get_allocated_width else VOffset := 0; AWindow^.get_geometry(@x, @y, @w, @h); Result := Bounds(x, y, w - VOffset, h - HOffset); end; exit; end; AViewport := getViewPort; if Assigned(AViewport) and Gtk3IsGdkWindow(AViewport^.get_view_window) then begin AWindow := AViewport^.get_view_window; if Assigned(AWindow) then begin Bar := getHorizontalScrollbar; if (Bar <> nil) and Gtk3IsWidget(Bar) and Bar^.get_visible and GTK3WidgetSet.OverlayScrolling then HOffset := Bar^.get_allocated_height else HOffset := 0; Bar := getVerticalScrollbar; if (Bar <> nil) and Gtk3IsWidget(Bar) and Bar^.get_visible and GTK3WidgetSet.OverlayScrolling then VOffset := Bar^.get_allocated_width else VOffset := 0; AViewPort^.get_view_window^.get_geometry(@x, @y, @w, @h); Result := Bounds(x, y, w - VOffset, h - HOffset); end else begin AViewPort^.get_allocation(@Allocation); Result := RectFromGtkAllocation(Allocation); end; end else begin getContainerWidget^.get_allocation(@Allocation); Result := RectFromGtkAllocation(Allocation); end; end; if (Self is TGtk3Window) then exit; {$IFDEF GTK3DEBUGSIZE} if Assigned(AViewPort) then DebugLn('TGtk3ScrollableWin.getClientBounds result ',dbgs(Result),' from viewport ',dbgsName(LCLObject)) else ;//DebugLn('TGtk3ScrollableWin.getClientBounds result ',dbgs(Result),' no viewport ',dbgsName(LCLObject)); {$ENDIF} end; function TGtk3ScrollableWin.getViewport:PGtkViewport; begin Result := nil; end; { TGtk3Memo } function TGtk3Memo.CreateWidget(const Params: TCreateParams): PGtkWidget; var AMemo: TCustomMemo; ABuffer: PGtkTextBuffer; AScrollStyle: TGtkScrollStyle; begin FKeysToEat := []; AMemo := TCustomMemo(LCLObject); FWidgetType := FWidgetType + [wtMemo, wtScrollingWin]; Result := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil)); FCentralWidget := PGtkTextView(TGtkTextView.new); FCentralWidget^.set_has_window(True); if AMemo.WordWrap then PGtkTextView(FCentralWidget)^.set_wrap_mode(GTK_WRAP_WORD) else PGtkTextView(FCentralWidget)^.set_wrap_mode(GTK_WRAP_NONE); ABuffer := PGtkTextBuffer^.new(PGtkTextTagTable^.new); {%H-}ABuffer^.set_text(PgChar(AMemo.Text), -1); PGtkTextView(FCentralWidget)^.set_buffer(ABuffer); PGtkScrolledWindow(Result)^.add(FCentralWidget); AScrollStyle := Gtk3TranslateScrollStyle(AMemo.ScrollBars); //memo without scrollbars still grows if policy is NEVER, so cheat gtk. if AScrollStyle.Horizontal = GTK_POLICY_NEVER then AScrollStyle.Horizontal := GTK_POLICY_EXTERNAL; if AScrollStyle.Vertical = GTK_POLICY_NEVER then AScrollStyle.Vertical := GTK_POLICY_EXTERNAL; PGtkScrolledWindow(Result)^.set_policy(AScrollStyle.Horizontal, AScrollStyle.Vertical); PGtkScrolledWindow(Result)^.set_shadow_type(BorderStyleShadowMap[AMemo.BorderStyle]); PGtkScrolledWindow(Result)^.get_vscrollbar^.set_can_focus(False); PGtkScrolledWindow(Result)^.get_hscrollbar^.set_can_focus(False); FCentralWidget^.set_can_focus(True); PGtkScrolledWindow(Result)^.set_can_focus(False); end; function TGtk3Memo.EatArrowKeys(const AKey: Word): Boolean; begin Result := False; end; function TGtk3Memo.getHorizontalScrollbar: PGtkScrollbar; begin Result := nil; if not IsWidgetOk then exit; Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_hscrollbar); if Result <> nil then SetScrollBarsSignalHandlers(True); end; function TGtk3Memo.getVerticalScrollbar: PGtkScrollbar; begin Result := nil; if not IsWidgetOk then exit; Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_vscrollbar); if Result <> nil then SetScrollBarsSignalHandlers(False); end; function TGtk3Memo.GetScrolledWindow: PGtkScrolledWindow; begin if IsWidgetOK then Result := PGtkScrolledWindow(Widget) else Result := nil; end; function TGtk3Memo.GetAlignment: TAlignment; var AJustification: TGtkJustification; begin Result := taLeftJustify; if IsWidgetOk then begin AJustification := PGtkTextView(GetContainerWidget)^.get_justification; if AJustification = GTK_JUSTIFY_RIGHT then Result := taRightJustify else if AJustification = GTK_JUSTIFY_CENTER then Result := taCenter; end; end; function TGtk3Memo.GetReadOnly: Boolean; begin Result := True; if IsWidgetOk then Result := not PGtkTextView(GetContainerWidget)^.get_editable; end; function TGtk3Memo.GetWantTabs: Boolean; begin Result := False; if IsWidgetOK then Result := PGtkTextView(GetContainerWidget)^.get_accepts_tab; end; function TGtk3Memo.GetWordWrap: Boolean; begin Result := True; if IsWidgetOk then Result := PGtkTextView(GetContainerWidget)^.get_wrap_mode = GTK_WRAP_WORD; end; procedure TGtk3Memo.SetAlignment(AValue: TAlignment); begin if IsWidgetOk then PGtkTextView(GetContainerWidget)^.set_justification(AGtkJustification[AValue]); end; procedure TGtk3Memo.SetReadOnly(AValue: Boolean); begin if IsWidgetOk then PGtkTextView(GetContainerWidget)^.set_editable(not AValue); end; procedure TGtk3Memo.SetWantTabs(AValue: Boolean); begin if IsWidgetOK then PGtkTextView(GetContainerWidget)^.set_accepts_tab(AValue); end; procedure TGtk3Memo.SetWordWrap(AValue: Boolean); begin if IsWidgetOk then begin if AValue then PGtkTextView(GetContainerWidget)^.set_wrap_mode(GTK_WRAP_WORD) else PGtkTextView(GetContainerWidget)^.set_wrap_mode(GTK_WRAP_NONE); end; end; function TGtk3Memo.getText: String; var ABuffer: PGtkTextBuffer; AIter: TGtkTextIter; ALastIter: TGtkTextIter; begin Result := ''; if IsWidgetOk then begin ABuffer := PGtkTextView(FCentralWidget)^.get_buffer; ABuffer^.get_start_iter(@AIter); ABuffer^.get_end_iter(@ALastIter); Result := ABuffer^.get_text(@AIter, @ALastIter, False); end; // DebugLn('TGtk3Memo.getText Result=',Result); end; procedure TGtk3Memo.setText(const AValue: String); var ABuffer: PGtkTextBuffer; AIter: PGtkTextIter; begin // DebugLn('TGtk3Memo.setText AValue=',AValue); if IsWidgetOk then begin ABuffer := PGtkTextView(FCentralWidget)^.get_buffer; ABuffer^.set_text(PgChar(AValue), -1); AIter:=nil; ABuffer^.get_start_iter(AIter); ABuffer^.place_cursor(AIter); end; end; { TGtk3ListBox } procedure Gtk3ListBoxSelectionChanged({%H-}ASelection: PGtkTreeSelection; AData: GPointer); cdecl; var Msg: TLMessage; begin // DebugLn('Gtk3ListBoxSelectionChanged '); FillChar(Msg{%H-}, SizeOf(Msg), #0); Msg.Msg := LM_SELCHANGE; if not TGtk3Widget(AData).InUpdate then TGtk3Widget(AData).DeliverMessage(Msg, False); end; procedure FreeStoreStringList(aData: gpointer); cdecl; begin TGtkListStoreStringList(aData).Free; end; function TGtk3ListBox.CreateWidget(const Params: TCreateParams): PGtkWidget; var AListBox: TCustomListBox; ListStore: PGtkListStore; ItemList: TGtkListStoreStringList; AColumn: PGtkTreeViewColumn; Renderer : PGtkCellRenderer; begin FListBoxStyle := lbStandard; FWidgetType := FWidgetType + [wtTreeModel, wtListBox, wtScrollingWin]; AListBox := TCustomListBox(LCLObject); Result := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil)); Result^.show; ListStore := gtk_list_store_new (2, [G_TYPE_STRING, G_TYPE_POINTER, nil]); FCentralWidget := TGtkTreeView.new_with_model(PGtkTreeModel(ListStore)); PGtkTreeView(FCentralWidget)^.set_headers_visible(False); g_object_unref (liststore); ItemList := TGtkListStoreStringList.Create(PGtkListStore(PGtkTreeView(FCentralWidget)^.get_model), 0, LCLObject); g_object_set_data(PGObject(FCentralWidget),GtkListItemLCLListTag, ItemList); {if we use g_object_set_data_full then access violation occurs, so, revert to g_object_set_data} // g_object_set_data_full(PGObject(FCentralWidget),GtkListItemLCLListTag, ItemList, @FreeStoreStringList); Renderer := LCLIntfCellRenderer_New(); g_object_set_data(PGObject(renderer), 'lclwidget', Self); AColumn := gtk_tree_view_column_new_with_attributes ('LISTITEMS', renderer, ['text', 0, nil]); g_object_set_data(PGObject(AColumn), 'lclwidget', Self); // maybe create GtkCellLayout class with our implementation and set that layout // to AColumn // PGtkCellLayout(AColumn)^.set_cell_data_func() // PGtkCellLayout(AColumn)^.set_cell_data_func(renderer, @LCLIntfRenderer_GtkCellLayoutDataFunc, Self, nil); AColumn^.set_cell_data_func(renderer, @LCLIntfRenderer_ColumnCellDataFunc, Self, nil); PGtkTreeView(FCentralWidget)^.append_column(AColumn); AColumn^.set_clickable(True); // AColumn^set_cell_data_func(AColumn, renderer, @LCLIntfRenderer_ColumnCellDataFunc, Self, nil); PGtkScrolledWindow(Result)^.add(FCentralWidget); PGtkScrolledWindow(Result)^.get_vscrollbar^.set_can_focus(False); PGtkScrolledWindow(Result)^.get_hscrollbar^.set_can_focus(False); PGtkScrolledWindow(Result)^.set_policy(GTK_POLICY_NEVER, GTK_POLICY_AUTOMATIC); FListBoxStyle := AListBox.Style; if FListBoxStyle <> lbOwnerDrawVariable then begin AColumn^.set_sizing(GTK_TREE_VIEW_COLUMN_FIXED); PGtkTreeView(FCentralWidget)^.set_fixed_height_mode(True); end; end; function TGtk3ListBox.EatArrowKeys(const AKey: Word): Boolean; begin Result := False; end; procedure TGtk3ListBox.InitializeWidget; begin inherited InitializeWidget; if not IsDesigning then g_signal_connect_data(GetSelection, 'changed', TGCallback(@Gtk3ListBoxSelectionChanged), Self, nil, G_CONNECT_DEFAULT); end; function TGtk3ListBox.getHorizontalScrollbar: PGtkScrollbar; begin Result := nil; if not IsWidgetOk then exit; Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_hscrollbar); end; function TGtk3ListBox.getVerticalScrollbar: PGtkScrollbar; begin Result := nil; if not IsWidgetOk then exit; Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_vscrollbar); end; function TGtk3ListBox.GetScrolledWindow: PGtkScrolledWindow; begin if IsWidgetOK then Result := PGtkScrolledWindow(Widget) else Result := nil; end; function TGtk3ListBox.GetItemIndex: Integer; var TreeView: PGtkTreeView; Path: PGtkTreePath; Column: PGtkTreeViewColumn; Selection: PGtkTreeSelection; begin Result := -1; if Gtk3IsWidget(FWidget) then begin Path := nil; Column := nil; TreeView := PGtkTreeView(GetContainerWidget); TreeView^.get_cursor(@Path, @Column); if Path <> nil then begin Result := gtk_tree_path_get_indices(Path)^; if Result = 0 then begin Selection := TreeView^.get_selection; if not Selection^.path_is_selected(Path) then Result := -1; end; end; end; end; function TGtk3ListBox.GetMultiSelect: Boolean; var Selection: PGtkTreeSelection; begin if IsWidgetOk then begin Selection := GetSelection; if Selection <> nil then Result := Selection^.get_mode <> GTK_SELECTION_SINGLE; end; end; procedure TGtk3ListBox.SetItemIndex(AValue: Integer); var TreeView: PGtkTreeView; Selection: PGtkTreeSelection; Path: PGtkTreePath; begin if Gtk3IsWidget(FWidget) then begin TreeView := PGtkTreeView(GetContainerWidget); Selection := GetSelection; if (AValue < 0) then Path := nil else Path := gtk_tree_path_new_from_indices(AValue, [-1]); // if singleselection mode then selection = itemindex if Path <> nil then begin gtk_tree_view_set_cursor(TreeView, Path, nil, False); end else begin Path := gtk_tree_path_new_from_indices(0, [-1]); gtk_tree_view_set_cursor(TreeView, Path, nil, False); gtk_tree_selection_unselect_all(Selection); end; if Path <> nil then gtk_tree_path_free(Path); end; end; procedure TGtk3ListBox.SetListBoxStyle(AValue: TListBoxStyle); begin if FListBoxStyle=AValue then Exit; FListBoxStyle:=AValue; end; procedure TGtk3ListBox.SetMultiSelect(AValue: Boolean); var Selection: PGtkTreeSelection; begin if IsWidgetOk then begin Selection := GetSelection; if Selection <> nil then begin if AValue then Selection^.set_mode(GTK_SELECTION_MULTIPLE) else Selection^.set_mode(GTK_SELECTION_SINGLE); end; end; end; function TGtk3ListBox.GetSelCount: Integer; var Selection: PGtkTreeSelection; Rows: PGList; ListStoreModel: PGtkTreeModel; begin Result := 0; if not Gtk3IsWidget(FWidget) then exit; Selection := GetSelection; if Selection = nil then exit; Rows := Selection^.get_selected_rows(@ListStoreModel); Result := g_list_length(Rows); g_list_free(Rows); end; function TGtk3ListBox.GetSelection: PGtkTreeSelection; begin if not IsWidgetOk then exit(nil); Result := PGtkTreeView(GetContainerWidget)^.get_selection; end; function TGtk3ListBox.GetItemRect(const AIndex: integer): TRect; var AModel: PGtkTreeModel; Iter: TGtkTreeIter; AGdkRect: TGdkRectangle; ACol: TGtkTreeViewColumn; begin Result := Rect(0, 0, 0, 0); AModel := PGtkTreeView(getContainerWidget)^.model; if AModel = nil then exit; if AModel^.iter_nth_child(@Iter, nil, AIndex) then begin ACol := gtk_tree_view_get_column(PGtkTreeView(getContainerWidget), 0)^; gtk_tree_view_get_cell_area(PGtkTreeView(getContainerWidget), AModel^.get_path(@Iter), @ACol, @AGdkRect); Result := RectFromGdkRect(AGdkRect); end; end; function TGtk3ListBox.GetIndexAtXY(const X, Y: integer): integer; var Path: PGtkTreePath; Column: PGtkTreeViewColumn; CellX, CellY: Integer; Indices: PInteger; begin Result := -1; if gtk_tree_view_get_path_at_pos(PGtkTreeView(getContainerWidget), X, Y, @Path, @Column, @CellX, @CellY) then begin Indices := gtk_tree_path_get_indices(Path); if Assigned(Indices) then Result := Indices^; gtk_tree_path_free(Path); end; end; function TGtk3ListBox.GetItemSelected(const AIndex: Integer): Boolean; var ASelection: PGtkTreeSelection; AModel: PGtkTreeModel; Item: TGtkTreeIter; begin Result := False; if not IsWidgetOK then exit; AModel := PGtkTreeView(GetContainerWidget)^.model; if AModel = nil then exit; ASelection := GetSelection; if ASelection = nil then exit; if AModel^.iter_nth_child(@Item, nil, AIndex) then Result := ASelection^.iter_is_selected(@Item); end; function TGtk3ListBox.GetScrollWidth: integer; begin Result := Round(getHorizontalScrollbar^.get_adjustment^.get_upper); end; procedure TGtk3ListBox.SelectItem(const AIndex: Integer; ASelected: Boolean); var ASelection: PGtkTreeSelection; AModel: PGtkTreeModel; Iter: TGtkTreeIter; begin if not IsWidgetOK then exit; AModel := PGtkTreeView(getContainerWidget)^.model; if AModel = nil then exit; ASelection := GetSelection; if AModel^.iter_nth_child(@Iter, nil, AIndex) then begin case ASelected of True: if not ASelection^.iter_is_selected(@Iter) then ASelection^.select_iter(@Iter); False: if ASelection^.iter_is_selected(@Iter) then ASelection^.unselect_iter(@Iter); end; end; end; procedure TGtk3ListBox.SetTopIndex(const AIndex: Integer); var AModel: PGtkTreeModel; Iter: TGtkTreeIter; APath: PGtkTreePath; begin AModel := PGtkTreeView(getContainerWidget)^.model; if not AModel^.iter_nth_child(@Iter, nil, AIndex) then exit; APath := AModel^.get_path(@Iter); PGtkTreeView(getContainerWidget)^.scroll_to_cell(APath, nil, False, 0.0, 0.0); APath^.free; end; { TGtk3CheckListBox } procedure Gtk3WS_CheckListBoxDataFunc({%H-}tree_column: PGtkTreeViewColumn; cell: PGtkCellRenderer; tree_model: PGtkTreeModel; iter: PGtkTreeIter; {%H-}data: Pointer); cdecl; var b: byte; ADisabled: gboolean; AValue: TCheckBoxState; begin B := 0; ADisabled := False; gtk_tree_model_get(tree_model, iter, [gtk3CLBState, @b, -1]); gtk_tree_model_get(tree_model, iter, [gtk3CLBDisabled, @ADisabled, -1]); AValue := TCheckBoxState(b); // TCheckBoxState is 4 byte g_object_set(cell, 'inconsistent', [gboolean(AValue = cbGrayed), nil]); if AValue <> cbGrayed then gtk_cell_renderer_toggle_set_active(PGtkCellRendererToggle(cell), AValue = cbChecked); g_object_set(cell, 'activatable', [gboolean(not ADisabled), nil]); end; procedure Gtk3WS_CheckListBoxToggle({%H-}cellrenderertoggle : PGtkCellRendererToggle; arg1 : PGChar; AData: GPointer); cdecl; var Mess: TLMessage; Param: PtrInt; Iter : TGtkTreeIter; TreeView: PGtkTreeView; ListStore: PGtkTreeModel; Path: PGtkTreePath; AState: TCheckBoxState; begin Val(arg1, Param); TreeView := PGtkTreeView(TGtk3CheckListBox(AData).GetContainerWidget); ListStore := gtk_tree_view_get_model(TreeView); if gtk_tree_model_iter_nth_child(ListStore, @Iter, nil, Param) then begin TCustomCheckListBox(TGtk3Widget(AData).LCLObject).Toggle(Param); AState := TCustomCheckListBox(TGtk3Widget(AData).LCLObject).State[Param]; gtk_list_store_set(PGtkListStore(ListStore), @Iter, [gtk3CLBState, Byte(AState), -1]); end; Path := gtk_tree_path_new_from_indices(Param, [-1]); if Path <> nil then begin gtk_tree_view_set_cursor(TreeView, Path, nil, False); gtk_tree_path_free(Path); end; FillChar(Mess{%H-}, SizeOf(Mess), #0); Mess.Msg := LM_CHANGED; Mess.Result := 0; Mess.WParam := Param; DeliverMessage(TGtk3Widget(AData).LCLObject, Mess); end; function TGtk3CheckListBox.CreateWidget(const Params: TCreateParams ): PGtkWidget; var ACheckListBox: TCustomCheckListBox; ListStore: PGtkListStore; ItemList: TGtkListStoreStringList; AColumn: PGtkTreeViewColumn; Toggle: PGtkCellRendererToggle; Renderer : PGtkCellRenderer; begin FWidgetType := FWidgetType + [wtTreeModel, wtListBox, wtCheckListBox, wtScrollingWin]; ACheckListBox := TCustomCheckListBox(LCLObject); FListBoxStyle := lbStandard; Result := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil)); Result^.show; ListStore := gtk_list_store_new (4, [G_TYPE_UCHAR, G_TYPE_STRING, G_TYPE_POINTER, G_TYPE_BOOLEAN, nil]); FCentralWidget := TGtkTreeView.new_with_model(PGtkTreeModel(ListStore)); PGtkTreeView(FCentralWidget)^.set_headers_visible(False); g_object_unref (liststore); AColumn := gtk_tree_view_column_new; // checkable column Toggle := gtk_cell_renderer_toggle_new; g_object_set_data(PGObject(Toggle), 'lclwidget', Self); AColumn^.set_title('CHECKBINS'); AColumn^.pack_start(Toggle, True); AColumn^.set_cell_data_func(Toggle, @Gtk3WS_CheckListBoxDataFunc, Self, nil); Toggle^.set_active(True); PGtkTreeView(FCentralWidget)^.append_column(AColumn); AColumn^.set_clickable(True); g_signal_connect_data(Toggle, 'toggled', TGCallback(@Gtk3WS_CheckListBoxToggle), Self, nil, G_CONNECT_DEFAULT); Renderer := LCLIntfCellRenderer_New(); // gtk_cell_renderer_text_new; g_object_set_data(PGObject(Renderer), 'lclwidget', Self); AColumn := gtk_tree_view_column_new_with_attributes ('LISTITEMS', Renderer, ['text', 1, nil]); g_object_set_data(PGObject(AColumn), 'lclwidget', Self); // AColumn^.pack_start(Renderer, True); AColumn^.set_cell_data_func(Renderer, @LCLIntfRenderer_ColumnCellDataFunc, Self, nil); PGtkTreeView(FCentralWidget)^.append_column(AColumn); ItemList := TGtkListStoreStringList.Create(PGtkListStore(PGtkTreeView(FCentralWidget)^.get_model), 1, LCLObject); g_object_set_data(PGObject(FCentralWidget),GtkListItemLCLListTag, ItemList); AColumn^.set_clickable(True); // AColumn^set_cell_data_func(AColumn, renderer, @LCLIntfRenderer_ColumnCellDataFunc, Self, nil); PGtkScrolledWindow(Result)^.add(FCentralWidget); PGtkScrolledWindow(Result)^.get_vscrollbar^.set_can_focus(False); PGtkScrolledWindow(Result)^.get_hscrollbar^.set_can_focus(False); PGtkScrolledWindow(Result)^.set_policy(GTK_POLICY_NEVER, GTK_POLICY_AUTOMATIC); FListBoxStyle := ACheckListBox.Style; if ACheckListBox.MultiSelect then PGtkTreeView(FCentralWidget)^.get_selection^.set_mode(GTK_SELECTION_MULTIPLE) else PGtkTreeView(FCentralWidget)^.get_selection^.set_mode(GTK_SELECTION_SINGLE); // AListBox.Style; if FListBoxStyle <> lbOwnerDrawVariable then begin //AColumn^.set_sizing(GTK_TREE_VIEW_COLUMN_FIXED); //PGtkTreeView(FCentralWidget)^.set_fixed_height_mode(True); end; end; { TGtk3ListView } function Gtk3WS_ListViewItemPreSelected({%H-}selection: PGtkTreeSelection; {%H-}model: PGtkTreeModel; path: PGtkTreePath; path_is_currently_selected: GBoolean; AData: GPointer): GBoolean; cdecl; begin if path_is_currently_selected then ; // DebugLn('Gtk3WS_ListViewItemSelected ,path selected ',dbgs(path_is_currently_selected)); // this function is called *before* the item is selected // The result should be True to allow the Item to change selection Result := True; if (AData = nil) or TGtk3Widget(AData).InUpdate then exit; if not Assigned(TGtk3ListView(AData).FPreselectedIndices) then TGtk3ListView(AData).FPreselectedIndices := TFPList.Create; if TGtk3ListView(AData).FPreselectedIndices.IndexOf({%H-}Pointer(PtrInt(gtk_tree_path_get_indices(path)^))) = -1 then TGtk3ListView(AData).FPreselectedIndices.Add({%H-}Pointer(PtrInt(gtk_tree_path_get_indices(path)^))); end; procedure Gtk3WS_ListViewItemSelected(ASelection: PGtkTreeSelection; AData: GPointer); cdecl; var AList, TmpList: PGList; Msg: TLMNotify; NM: TNMListView; Path: PGtkTreePath; Indices: Integer; i, j: Integer; B: Boolean; begin if (AData = nil) or TGtk3Widget(AData).InUpdate then exit; if not Assigned(TGtk3ListView(AData).FPreselectedIndices) then exit; AList := gtk_tree_selection_get_selected_rows(ASelection, nil); TGtk3Widget(AData).BeginUpdate; // Prevents entering Gtk3WS_ListViewItemPreSelected try for i := 0 to TGtk3ListView(AData).FPreselectedIndices.Count - 1 do begin FillChar(Msg{%H-}, SizeOf(Msg), 0); Msg.Msg := CN_NOTIFY; FillChar(NM{%H-}, SizeOf(NM), 0); NM.hdr.hwndfrom := HWND(TGtk3Widget(AData)); NM.hdr.code := LVN_ITEMCHANGED; NM.iItem := {%H-}PtrInt(TGtk3ListView(AData).FPreselectedIndices.Items[i]); NM.iSubItem := 0; B := False; TmpList := AList; while TmpList <> nil do begin Path := PGtkTreePath(TmpList^.data); if Assigned(Path) then begin Indices := gtk_tree_path_get_indices(Path)^; B := Indices = {%H-}PtrInt(TGtk3ListView(AData).FPreselectedIndices.Items[i]); if B then break; end; TmpList := TmpList^.next; end; if not B then NM.uOldState := LVIS_SELECTED else NM.uNewState := LVIS_SELECTED; NM.uChanged := LVIF_STATE; Msg.NMHdr := @NM.hdr; DeliverMessage(TGtk3Widget(AData).LCLObject, Msg); end; finally FreeAndNil(TGtk3ListView(AData).FPreselectedIndices); if AList <> nil then begin TmpList := AList; while TmpList <> nil do begin Path := PGtkTreePath(TmpList^.data); if Assigned(Path) then gtk_tree_path_free(Path); TmpList := TmpList^.next; end; g_list_free(AList); end; TGtk3Widget(AData).EndUpdate; end; end; type TCustomListViewHack = class(TCustomListView); procedure TGtk3ListView.setItemWidth(const AImageListWidth: integer); var aImgWidth, aBorders: gint; AListView: TCustomListViewHack; aIconView: PGtkIconView; begin aImgWidth := AImageListWidth; aListView := TCustomListViewHack(LCLObject); if not (AListView.ViewStyle in [vsSmallIcon, vsIcon]) then exit; if not Gtk3IsWidget(getContainerWidget) then exit; if aImgWidth <= 0 then begin if AListView.ViewStyle = vsIcon then gtk_icon_size_lookup(Ord(GTK_ICON_SIZE_DIALOG), @aImgWidth, @aBorders) else gtk_icon_size_lookup(Ord(GTK_ICON_SIZE_LARGE_TOOLBAR), @aImgWidth, @aBorders); end; aIconView := PGtkIconView(GetContainerWidget); aBorders := aIconView^.get_margin_start + aIconView^.get_margin_end + (aIconView^.get_border_width * 2) + aIconView^.get_column_spacing + (aIconView^.get_spacing * 2); aIconView^.set_item_width(aImgWidth + aBorders); end; function TGtk3ListView.CreateWidget(const Params: TCreateParams): PGtkWidget; var AListView: TCustomListViewHack; AScrollStyle: TGtkScrollStyle; PtrType: GType; TreeModel: PGtkTreeModel; iter:TGtkTreeIter; pxb:PGdkPixbuf; err:gint; begin FImages := nil; FPreselectedIndices := nil; FWidgetType := FWidgetType + [wtTreeModel, wtListView, wtScrollingWin]; AListView := TCustomListViewHack(LCLObject); Result := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil)); PtrType := G_TYPE_POINTER; if AListView.ViewStyle in [vsIcon,vsSmallIcon] then begin TreeModel := PGtkTreeModel(gtk_list_store_new(3, [ G_TYPE_POINTER, // ListItem pointer G_TYPE_STRING, // text gdk_pixbuf_get_type() // pixbuf ])); FCentralWidget := TGtkIconView.new_with_model(TreeModel); PGtkIconView(FCentralWidget)^.set_text_column(1); PGtkIconView(FCentralWidget)^.set_pixbuf_column(2); PGtkIconView(FCentralWidget)^.selection_mode:=GTK_SELECTION_SINGLE; end else begin TreeModel := PGtkTreeModel(gtk_list_store_newv(1, @PtrType)); FCentralWidget := TGtkTreeView.new_with_model(TreeModel); end; FIsTreeView := not (AListView.ViewStyle in [vsIcon,vsSmallIcon]); FCentralWidget^.set_has_window(True); FCentralWidget^.show; PGtkScrolledWindow(Result)^.add(FCentralWidget); //PGtkScrolledWindow(Result)^.set_focus_child(FCentralWidget); AScrollStyle := Gtk3TranslateScrollStyle(AListView.ScrollBars); // gtk3 scrolled window hates GTK_POLICY_NONE PGtkScrolledWindow(Result)^.set_policy(AScrollStyle.Horizontal, AScrollStyle.Vertical); PGtkScrolledWindow(Result)^.set_shadow_type(BorderStyleShadowMap[AListView.BorderStyle]); PGtkScrolledWindow(Result)^.get_vscrollbar^.set_can_focus(False); PGtkScrolledWindow(Result)^.get_hscrollbar^.set_can_focus(False); g_object_unref (PGObject(TreeModel)); PGtkScrolledWindow(Result)^.set_can_focus(False); PGtkTreeView(FCentralWidget)^.set_can_focus(True); if FIsTreeView then begin gtk_tree_selection_set_select_function(PGtkTreeView(FCentralWidget)^.get_selection, TGtkTreeSelectionFunc(@Gtk3WS_ListViewItemPreSelected), Self, nil); g_signal_connect_data(PGtkTreeView(FCentralWidget)^.get_selection, 'changed', TGCallback(@Gtk3WS_ListViewItemSelected), Self, nil, G_CONNECT_DEFAULT); PGtkTreeView(FCentralWidget)^.set_headers_visible(AListView.ShowColumnHeaders and (AListView.ViewStyle = vsReport)); PGtkTreeView(FCentralWidget)^.resize_children; end else begin g_signal_connect_data (PGtkIconView(FCentralWidget), 'selection-changed', TGCallback(@selection_changed), Self, nil, G_CONNECT_DEFAULT); end; end; class function TGtk3ListView.selection_changed(AIconView: PGtkIconView; aData: gPointer): gboolean; cdecl; var pl, tmp: PGList; pndx: PGint; i, cnt: gint; Msg: TLMNotify; NM: TNMListView; ctl: TGtk3ListView; begin Result := gtk_false; ctl := TGtk3ListView(aData); pl := PGtkIconView(ctl.GetContainerWidget)^.get_selected_items(); if Assigned(pl) then begin try tmp := pl; while Assigned(tmp) do begin pndx := PGtkTreePath(tmp^.data)^.get_indices_with_depth(@cnt); // lv := TListView(ctl.LCLObject); ctl.BeginUpdate; try for i := 0 to cnt - 1 do begin FillChar(Msg{%H-}, SizeOf(Msg), 0); Msg.Msg := CN_NOTIFY; FillChar(NM{%H-}, SizeOf(NM), 0); NM.hdr.hwndfrom := HWND(ctl); NM.hdr.code := LVN_ITEMCHANGED; NM.iItem := {%H-}PtrInt(pndx^); NM.iSubItem := 0; NM.uNewState := LVIS_SELECTED; NM.uChanged := LVIF_STATE; Msg.NMHdr := @NM.hdr; ctl.DeliverMessage(Msg); inc(pndx); end; finally ctl.EndUpdate; end; gtk_tree_path_free(PGtkTreePath(tmp^.data)); tmp := tmp^.next; end; finally g_list_free(pl); end; end; end; function TGtk3ListView.EatArrowKeys(const AKey: Word): Boolean; begin Result := False; end; procedure TGtk3ListView.SetColor(AValue: TColor); var ADisabledColor, BgColor: TGdkRGBA; begin BgColor := TColortoTGdkRGBA(ColorToRgb(AValue)); getContainerWidget^.get_style_context^.get_background_color([GTK_STATE_FLAG_INSENSITIVE], @ADisabledColor); //override all if AValue = clDefault then gtk_widget_override_background_color(getContainerWidget, GTK_STATE_FLAG_NORMAL, nil) else gtk_widget_override_background_color(getContainerWidget, GTK_STATE_FLAG_NORMAL, @BgColor); //return system highlight color BgColor := TColortoTGdkRGBA(ColorToRgb(clHighlight)); gtk_widget_override_background_color(getContainerWidget, [GTK_STATE_FLAG_SELECTED], @BgColor); gtk_widget_override_background_color(getContainerWidget, [GTK_STATE_FLAG_INSENSITIVE], @ADisabledColor); end; destructor TGtk3ListView.Destroy; begin ClearImages; FreeAndNil(FImages); FreeAndNil(FPreselectedIndices); inherited Destroy; end; function TGtk3ListView.getHorizontalScrollbar: PGtkScrollbar; begin Result := nil; if not IsWidgetOk then exit; Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_hscrollbar); end; function TGtk3ListView.getVerticalScrollbar: PGtkScrollbar; begin Result := nil; if not IsWidgetOk then exit; Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_vscrollbar); end; function TGtk3ListView.GetScrolledWindow: PGtkScrolledWindow; begin if IsWidgetOK then Result := PGtkScrolledWindow(Widget) else Result := nil; end; procedure TGtk3ListView.ClearImages; var i: Integer; begin if Assigned(FImages) then begin for i := FImages.Count - 1 downto 0 do if FImages[i] <> nil then g_object_unref(FImages[i]); FImages.Clear; end; end; procedure TGtk3ListView.ColumnDelete(AIndex: Integer); var AColumn: PGtkTreeViewColumn; begin if IsWidgetOK and IsTreeView then begin AColumn := PGtkTreeView(GetContainerWidget)^.get_column(AIndex); if (AColumn<>nil) then PGtkTreeView(GetContainerWidget)^.remove_column(AColumn); end; end; function TGtk3ListView.ColumnGetWidth(AIndex: Integer): Integer; var AColumn: PGtkTreeViewColumn; begin Result := 0; if IsWidgetOK and IsTreeView then begin AColumn := PGtkTreeView(GetContainerWidget)^.get_column(AIndex); if (AColumn<>nil) then Result := AColumn^.get_width; end; end; procedure Gtk3WSLV_ListViewGetPixbufDataFuncForColumn(tree_column: PGtkTreeViewColumn; {%H-}cell: PGtkCellRenderer; tree_model: PGtkTreeModel; iter: PGtkTreeIter; AData: GPointer); cdecl; var ListItem: TListItem; Images: TFPList; // Widgets: PTVWidgets; ListColumn: TListColumn; ImageIndex: Integer; ColumnIndex: Integer; APath: PGtkTreePath; gv:TGValue; pb:PgdkPixbuf; begin fillchar(gv,sizeof(gv),0); gv.init(G_TYPE_OBJECT); gv.set_instance(nil); PGtkCellRendererPixbuf(cell)^.set_property('pixbuf',@gv); gtk_tree_model_get(tree_model, iter, [0, @ListItem, -1]); ListColumn := TListColumn(g_object_get_data(tree_column, 'TListColumn')); if ListColumn = nil then Exit; ColumnIndex := ListColumn.Index; Images := TGtk3ListView(AData).Images; if Images = nil then Exit; ImageIndex := -1; if (ListItem = nil) and TCustomListView(TGtk3Widget(AData).LCLObject).OwnerData then begin APath := gtk_tree_model_get_path(tree_model,iter); ListItem := TCustomListView(TGtk3Widget(AData).LCLObject).Items[gtk_tree_path_get_indices(APath)^]; gtk_tree_path_free(APath); end; if ListItem = nil then Exit; if ColumnIndex = 0 then ImageIndex := ListItem.ImageIndex else if ColumnIndex -1 <= ListItem.SubItems.Count-1 then ImageIndex := ListItem.SubItemImages[ColumnIndex-1]; if (ImageIndex > -1) and (ImageIndex <= Images.Count-1) then pb:=TGtk3Image(TBitmap(Images.Items[ImageIndex]).Handle).Handle^.copy else pb:=nil; gv.set_instance(pb); PGtkCellRendererPixbuf(cell)^.set_property('pixbuf',@gv); if Assigned(pb) then g_object_unref(pb); end; procedure Gtk3WS_ListViewColumnClicked(column: PGtkTreeViewColumn; AData: GPointer); cdecl; var AColumn: TListColumn; Msg: TLMNotify; NM: TNMListView; begin AColumn := TListColumn(g_object_get_data(PGObject(column), 'TListColumn')); if (AColumn = nil) or (AData = nil) then exit; FillChar(Msg{%H-}, SizeOf(Msg), 0); Msg.Msg := CN_NOTIFY; FillChar(NM{%H-}, SizeOf(NM), 0); NM.hdr.hwndfrom := {%H-}PtrUInt(AData); NM.hdr.code := LVN_COLUMNCLICK; NM.iItem := -1; NM.iSubItem := AColumn.Index; Msg.NMHdr := @NM.hdr; DeliverMessage(TGtk3Widget(AData).LCLObject, Msg); end; procedure TGtk3ListView.ColumnInsert(AIndex: Integer; AColumn: TListColumn); var AGtkColumn: PGtkTreeViewColumn; PixRenderer, TextRenderer: PGtkCellRenderer; begin if not IsWidgetOK or not IsTreeView then exit; AGtkColumn := TGtkTreeViewColumn.new; PixRenderer := gtk_cell_renderer_pixbuf_new(); TextRenderer := LCLIntfCellRenderer_New; AGtkColumn^.pack_start(PixRenderer, False); AGtkColumn^.pack_start(TextRenderer, True); // gtk_tree_view_column_set_cell_data_func(column, pixrenderer, TGtkTreeCellDataFunc(@Gtk2WSLV_ListViewGetPixbufDataFuncForColumn), WidgetInfo, nil); // gtk_tree_view_column_set_cell_data_func(column, textrenderer, TGtkTreeCellDataFunc(@LCLIntfCellRenderer_CellDataFunc), Self, nil); AGtkColumn^.set_cell_data_func(PixRenderer, @Gtk3WSLV_ListViewGetPixbufDataFuncForColumn, Self, nil); AGtkColumn^.set_cell_data_func(PGtkCellRenderer(TextRenderer), TGtkTreeCellDataFunc(@LCLIntfCellRenderer_CellDataFunc), Self, nil); //store the TColumn in the column data for callbacks g_object_set_data(AGtkColumn, PgChar('TListColumn'), gpointer(AColumn)); g_object_set_data(AGtkColumn, 'pix_renderer', PixRenderer); g_object_set_data(AGtkColumn, 'text_renderer', TextRenderer); g_signal_connect_data(AGtkColumn,'clicked', TGCallback(@Gtk3WS_ListViewColumnClicked), Self, nil, G_CONNECT_DEFAULT); PGtkTreeView(GetContainerWidget)^.insert_column(AGtkColumn, AIndex); AGtkColumn^.set_clickable(True); end; procedure TGtk3ListView.SetAlignment(AIndex: Integer; AColumn: TListColumn; AAlignment: TAlignment); var AGtkColumn: PGtkTreeViewColumn; AFloat: Double; AList: PGList; textrenderer: PGtkCellRenderer; Value: TGValue; begin if not IsWidgetOK or not IsTreeView then exit; AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex); if AGtkColumn = nil then exit; case AAlignment of taRightJustify: AFloat := 1; taCenter: AFloat := 0.5; else AFloat := 0; end; AList := PGtkCellLayout(AGtkColumn)^.get_cells; // AList := gtk_tree_view_column_get_cell_renderers(AColumn); textrenderer := PGtkCellRenderer(g_list_last(AList)^.data); g_list_free(AList); Value.g_type := G_TYPE_FLOAT; Value.set_float(AFloat); g_object_set_property(textrenderer, PChar('xalign'), @Value); {now we call set alignment because it calls update over visible rows in col} AGtkColumn^.set_alignment(AFloat); end; procedure TGtk3ListView.SetColumnAutoSize(AIndex: Integer; AColumn: TListColumn; AAutoSize: Boolean); const SizingMap: array[Boolean] of TGtkTreeViewColumnSizing = ( GTK_TREE_VIEW_COLUMN_FIXED {2}, GTK_TREE_VIEW_COLUMN_AUTOSIZE {1} ); var AGtkColumn: PGtkTreeViewColumn; begin if not IsWidgetOK or not IsTreeView then exit; AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex); if AGtkColumn <> nil then begin AGtkColumn^.set_resizable(True); AGtkColumn^.set_sizing(SizingMap[AAutoSize]); end; end; procedure TGtk3ListView.SetColumnCaption(AIndex: Integer; AColumn: TListColumn; const ACaption: String); var AGtkColumn: PGtkTreeViewColumn; begin if not IsWidgetOK or not IsTreeView then exit; AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex); if AGtkColumn <> nil then begin AGtkColumn^.set_title(PgChar(ACaption)); end; end; procedure TGtk3ListView.SetColumnMaxWidth(AIndex: Integer; AColumn: TListColumn; AMaxWidth: Integer); var AGtkColumn: PGtkTreeViewColumn; begin if not IsWidgetOK or not IsTreeView then exit; AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex); if AGtkColumn <> nil then begin if AMaxWidth <= 0 then AGtkColumn^.set_max_width(10000) else AGtkColumn^.set_max_width(AMaxWidth); end; end; procedure TGtk3ListView.SetColumnMinWidth(AIndex: Integer; AColumn: TListColumn; AMinWidth: Integer); var AGtkColumn: PGtkTreeViewColumn; begin if not IsWidgetOK or not IsTreeView then exit; AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex); if AGtkColumn <> nil then AGtkColumn^.set_min_width(AMinWidth); end; procedure TGtk3ListView.SetColumnWidth(AIndex: Integer; AColumn: TListColumn; AWidth: Integer); var AGtkColumn: PGtkTreeViewColumn; begin if not IsWidgetOK or not IsTreeView then exit; AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex); if AGtkColumn <> nil then begin AGtkColumn^.set_fixed_width(AWidth + Ord(AWidth < 1)); end; // AGtkColumn^.set_widget(); end; procedure TGtk3ListView.SetColumnVisible(AIndex: Integer; AColumn: TListColumn; AVisible: Boolean); var AGtkColumn: PGtkTreeViewColumn; begin if not IsWidgetOK or not IsTreeView then exit; AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex); if AGtkColumn <> nil then begin AGtkColumn^.set_visible(AVisible and (TListView(LCLObject).ViewStyle in [vsList, vsReport])); end; end; procedure TGtk3ListView.ColumnSetSortIndicator(const AIndex: Integer; const AColumn: TListColumn; const ASortIndicator: TSortIndicator); const GtkOrder : array [ TSortIndicator] of TGtkSortType = (GTK_SORT_ASCENDING {0}, GTK_SORT_ASCENDING {0}, GTK_SORT_DESCENDING {1}); var AGtkColumn: PGtkTreeViewColumn; begin AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex); if AGtkColumn <> nil then begin if ASortIndicator = siNone then AGtkColumn^.set_sort_indicator(false) else begin AGtkColumn^.set_sort_indicator(true); AgtkColumn^.set_sort_order(GtkOrder[ASortIndicator]); end; end; end; procedure TGtk3ListView.ItemDelete(AIndex: Integer); var AModel: PGtkTreeModel; Iter: TGtkTreeIter; begin if IsTreeView then AModel := PGtkTreeView(getContainerWidget)^.get_model else AModel := PGtkIconView(getContainerWidget)^.get_model; if gtk_tree_model_iter_nth_child(AModel, @Iter, nil, AIndex) then gtk_list_store_remove(PGtkListStore(AModel), @Iter); end; function TGtk3ListView.ItemDisplayRect(AIndex: Integer; ASubItem: integer; ACode: TDisplayCode): TRect; var AModel: PGtkTreeModel; Iter: TGtkTreeIter; Column: PGtkTreeViewColumn; Path: PGtkTreePath; ItemRect: TGdkRectangle; cell: PGtkCellRenderer; y, x: gint; begin Result := Rect(0, 0, 0, 0); if IsTreeView then AModel := PGtkTreeView(getContainerWidget)^.get_model else AModel := PGtkIconView(getContainerWidget)^.get_model; Path := gtk_tree_path_new_from_indices(AIndex, [-1]); try if Self.IsTreeView then begin Column := gtk_tree_view_get_column(PGtkTreeView(GetContainerWidget), ASubItem); gtk_tree_view_get_cell_area(PGtkTreeView(GetContainerWidget), Path, Column, @ItemRect); end else gtk_icon_view_get_cell_rect(PGtkIconView(getContainerWidget), Path, nil, @ItemRect); Result := RectFromGdkRect(ItemRect); finally gtk_tree_path_free(Path); end; end; procedure TGtk3ListView.ItemInsert(AIndex: Integer; AItem: TListItem); var AModel: PGtkTreeModel; Iter: TGtkTreeIter; NewIndex: Integer; bmp:TBitmap; pxb:PGdkPixbuf; w,h: gint; begin if not IsWidgetOK then exit; if IsTreeView then AModel := PGtkTreeView(getContainerWidget)^.get_model else AModel := PGtkIconView(getContainerWidget)^.get_model; if AIndex = -1 then NewIndex := AModel^.iter_n_children(nil) else NewIndex := AIndex; if IsTreeView then gtk_list_store_insert_with_values(PGtkListStore(AModel), @Iter, NewIndex, [0, Pointer(AItem), -1]) else begin bmp:=TBitmap.Create; if Assigned(TListView(LCLObject).LargeImages) then TListView(LCLObject).LargeImages.GetBitmap(AIndex,bmp) else begin gtk_icon_size_lookup(Ord(GTK_ICON_SIZE_LARGE_TOOLBAR), @w, @h); bmp.SetSize(w, h); end; pxb:=TGtk3Image(bmp.Handle).Handle^.copy; gtk_list_store_insert_with_values(PGtkListStore(AModel), @Iter, NewIndex, [0, Pointer(AItem), 1, PChar(AItem.Caption), 2, pxb, -1] ); // list_store takes ownership, so unref and ref again. g_object_unref(pxb); if not Assigned(FImages) then FImages := TFPList.Create; g_object_ref(pxb); FImages.Add(pxb); bmp.Free; end; end; function TGtk3ListView.ItemPosition(AIndex: integer): TPoint; var x, y: gint; begin Result := ItemDisplayRect(AIndex, 0, drBounds).TopLeft; if IsTreeView then begin gtk_tree_view_convert_bin_window_to_widget_coords( PGtkTreeView(GetContainerWidget), Result.x, Result.y, @x, @y); Result.x := x; Result.y := y; end; end; procedure TGtk3ListView.UpdateItem(AIndex:integer;AItem: TListItem); var Path: PGtkTreePath; ItemRect: TGdkRectangle; AModel: PGtkTreeModel; Iter: TGtkTreeIter; bmp:TBitmap; pxb:PGdkPixbuf; w,h: gint; begin if IsTreeView then begin Path := gtk_tree_path_new_from_indices(AIndex, [-1]); PGtkTreeView(GetContainerWidget)^.get_cell_area(Path, nil, @ItemRect); gtk_tree_path_free(Path); end else begin Path := gtk_tree_path_new_from_indices(AIndex, [-1]); AModel:=PGtkIconView(GetContainerWidget)^.get_model; AModel^.get_iter(@iter,path); bmp := TBitmap.Create; if (TCustomListViewHack(LCLObject).ViewStyle = vsIcon) and Assigned(TCustomListViewHack(LCLObject).LargeImages) then TCustomListViewHack(LCLObject).LargeImages.GetBitmap(AItem.ImageIndex, bmp) else if (TCustomListViewHack(LCLObject).ViewStyle = vsSmallIcon) and Assigned(TCustomListViewHack(LCLObject).SmallImages) then TCustomListViewHack(LCLObject).SmallImages.GetBitmap(AItem.ImageIndex, bmp) else begin gtk_icon_size_lookup(Ord(GTK_ICON_SIZE_LARGE_TOOLBAR), @w, @h); bmp.SetSize(w, h); end; pxb := TGtk3Image(Bmp.Handle).Handle^.copy; gtk_list_store_set(PGtkListStore(AModel), @Iter, [0, Pointer(AItem), 1, PChar(AItem.Caption), 2, pxb, -1] ); g_object_unref(pxb); if not Assigned(FImages) then FImages := TFPList.Create; g_object_ref(pxb); FImages.Add(pxb); gtk_tree_path_free(Path); bmp.Free; end; end; procedure TGtk3ListView.ItemSetText(AIndex, ASubIndex: Integer; AItem: TListItem; const AText: String); var Path: PGtkTreePath; ItemRect: TGdkRectangle; AModel: PGtkTreeModel; Iter: TGtkTreeIter; begin if not IsWidgetOK then exit; if IsTreeView then begin Path := gtk_tree_path_new_from_indices(AIndex, [-1]); if GetContainerWidget^.get_realized then begin PGtkTreeView(GetContainerWidget)^.get_cell_area(Path, nil, @ItemRect); // here may be optimization end; gtk_tree_path_free(Path); end else begin UpdateItem(AIndex,AItem); end; if GetContainerWidget^.get_visible and (ItemRect.height <> 0) then // item is visible GetContainerWidget^.queue_draw; end; procedure TGtk3ListView.ItemSetImage(AIndex, ASubIndex: Integer; AItem: TListItem); var Path: PGtkTreePath; ItemRect: TGdkRectangle; AModel: PGtkTreeModel; Iter: TGtkTreeIter; begin if not IsWidgetOK then exit; if IsTreeView then begin Path := gtk_tree_path_new_from_indices(AIndex, [-1]); if GetContainerWidget^.get_realized then begin PGtkTreeView(GetContainerWidget)^.get_cell_area(Path, nil, @ItemRect); // here may be optimization end; gtk_tree_path_free(Path); end else begin UpdateItem(AIndex,AItem); end; if GetContainerWidget^.get_visible and (ItemRect.height <> 0) then // item is visible GetContainerWidget^.queue_draw; end; procedure TGtk3ListView.ItemSetState(const AIndex: Integer; const AItem: TListItem; const AState: TListItemState; const AIsSet: Boolean); var Path: PGtkTreePath; ATreeSelection: PGtkTreeSelection; begin if not IsWidgetOK then exit; case AState of lisCut, lisDropTarget: begin //TODO: do something with the rowcolor ? end; lisFocused: begin Path := gtk_tree_path_new_from_string(PgChar(IntToStr(AIndex))); if IsTreeView then begin if AIsSet then PGtkTreeView(getContainerWidget)^.set_cursor(Path, nil, False) else PGtkTreeView(GetContainerWidget)^.set_cursor(Path, nil, False); end else begin PGtkIconView(GetContainerWidget)^.set_cursor(Path, nil, False); // valgrind says leak end; if Path <> nil then gtk_tree_path_free(Path); end; lisSelected: begin Path := gtk_tree_path_new_from_string(PgChar(IntToStr(AIndex))); if IsTreeView then begin ATreeSelection := PGtkTreeView(GetContainerWidget)^.get_selection; if AIsSet and not ATreeSelection^.path_is_selected(Path) then begin ATreeSelection^.select_path(Path); // BroadcastMsg := True; end else if not AIsSet and ATreeSelection^.path_is_selected(Path) then begin ATreeSelection^.unselect_path(Path); // BroadcastMsg := True; end; end else begin if AIsSet and not PGtkIconView(GetContainerWidget)^.path_is_selected(Path) then begin PGtkIconView(GetContainerWidget)^.select_path(Path); // BroadCastMsg := True; end else if not AIsSet and PGtkIconView(GetContainerWidget)^.path_is_selected(Path) then begin PGtkIconView(GetContainerWidget)^.unselect_path(Path); // BroadCastMsg := True; end; end; if Path <> nil then gtk_tree_path_free(Path); // if BroadcastMsg then // BroadCastListSelection(ALV, {%H-}PtrUInt(MainView), AIndex, not AIsSet); end; end; end; function TGtk3ListView.ItemGetState(const AIndex: Integer; const AItem: TListItem; const AState: TListItemState; out AIsSet: Boolean ): Boolean; var Path: PGtkTreePath; Column: PPGtkTreeViewColumn; Cell: PPGtkCellRenderer; APath: PGtkTreePath; AStr: PChar; begin Result := False; AIsSet := False; if not IsWidgetOK then exit; case AState of lisCut, lisDropTarget: begin //TODO: do something with the rowcolor ? end; lisFocused: begin Path := nil; Column := nil; Cell := nil; if IsTreeView then PGtkTreeView(GetContainerWidget)^.get_cursor(@Path, Column) else PGtkIconView(GetContainerWidget)^.get_cursor(@Path, Cell); if Assigned(Path) then begin AStr := gtk_tree_path_to_string(Path); AIsSet := (StrToIntDef(AStr,-1) = AIndex); if AStr <> nil then g_free(AStr); gtk_tree_path_free(Path); Result := True; end; end; lisSelected: begin APath := gtk_tree_path_new_from_string(PChar(IntToStr(AIndex))); if IsTreeView then AIsSet := PGtkTreeView(GetContainerWidget)^.get_selection^.path_is_selected(APath) else AIsSet := PGtkIconView(GetContainerWidget)^.path_is_selected(APath); if APath <> nil then gtk_tree_path_free(APath); Result := True; end; end; end; procedure TGtk3ListView.ScrollToRow(const ARow: integer); var ATreePath: PGtkTreePath; begin ATreePath := gtk_tree_path_new_from_indices(ARow, [-1]); if IsTreeView then gtk_tree_view_scroll_to_cell(PGtkTreeView(getContainerWidget), ATreePath, nil, False, 0.0, 0.0) else gtk_icon_view_scroll_to_path(PGtkIconView(getContainerWidget), ATreePath, False, 0.0, 0.0); gtk_tree_path_free(ATreePath); end; procedure TGtk3ListView.UpdateImageCellsSize; begin // must get renderer via property // gtk_tree_view_column_get_cell_renderers end; { TGtk3ComboBox } function TGtk3ComboBox.GetItemIndex: Integer; begin Result := -1; if Assigned(FWidget) and Gtk3IsComboBox(Widget) then Result := PGtkComboBox(Widget)^.get_active; end; procedure TGtk3ComboBox.SetDroppedDown(AValue: boolean); begin if Assigned(FWidget) and Gtk3IsComboBox(Widget) then begin if AValue then PGtkComboBox(Widget)^.popup else PGtkComboBox(Widget)^.popdown; end; end; procedure TGtk3ComboBox.SetItemIndex(AValue: Integer); begin if IsWidgetOK and Gtk3IsComboBox(Widget) then PGtkComboBox(Widget)^.set_active(AValue); end; function TGtk3ComboBox.GetCellView: PGtkCellView; var AList: PGList; i: Integer; begin if FCellView = nil then begin AList := PGtkComboBox(Widget)^.get_children; for i := 0 to g_list_length(AList) -1 do begin if Gtk3IsCellView(g_list_nth(AList, i)^.data) then begin FCellView := PGtkCellView(g_list_first(AList)^.data); break; end; end; g_list_free(AList); end; Result := FCellView; end; function TGtk3ComboBox.GetPopupWidget: PGtkWidget; begin Result := nil; if not IsWidgetOk then exit; if PGtkComboBox(Widget)^.priv3^.popup_widget <> nil then Result := PGtkComboBox(Widget)^.priv3^.popup_widget else if PGtkComboBox(Widget)^.priv3^.tree_view <> nil then Result := PGtkComboBox(Widget)^.priv3^.tree_view; end; function TGtk3ComboBox.GetButtonWidget: PGtkWidget; begin Result := nil; if not IsWidgetOk then exit; // button is of type GtkToggleButton if PGtkComboBox(Widget)^.priv3^.button <> nil then Result := PGtkComboBox(Widget)^.priv3^.button; end; function TGtk3ComboBox.GetArrowWidget: PGtkWidget; begin Result := nil; if not IsWidgetOk then exit; // arrow is type is GtkIcon if PGtkComboBox(Widget)^.priv3^.arrow <> nil then Result := PGtkComboBox(Widget)^.priv3^.arrow; end; function TGtk3ComboBox.getSelStart: integer; var AStartPos, AEndPos: gint; begin Result := 0; if PGtkComboBox(Widget)^.has_entry then begin PGtkEditable(PGtkComboBox(Widget)^.get_child)^.get_selection_bounds(@AStartPos, @AEndPos); Result := AStartPos; end; end; function TGtk3ComboBox.getSelLength: integer; var AStartPos, AEndPos: gint; begin Result := 0; if PGtkComboBox(Widget)^.has_entry then begin if PGtkEditable(PGtkComboBox(Widget)^.get_child)^.get_selection_bounds(@AStartPos, @AEndPos) then Result := AEndPos - AStartPos; end; end; function TGtk3ComboBox.getMaxLength: integer; begin Result := 0; if PGtkComboBox(Widget)^.has_entry then Result := PGtkEntry(PGtkComboBox(Widget)^.get_child)^.get_max_length; end; procedure TGtk3ComboBox.SetMaxLength(const AMaxLength: integer); begin if PGtkComboBox(Widget)^.has_entry then begin PGtkEntry(PGtkComboBox(Widget)^.get_child)^.set_max_length(AMaxLength); end; end; procedure TGtk3ComboBox.SetSelStart(const ANewStart: integer); var AStartPos, AEndPos: gint; begin if PGtkComboBox(Widget)^.has_entry then begin //PGtkEditable(PGtkComboBox(Widget)^.get_child)^.get_selection_bounds(@AStartPos, @AEndPos); //if AEndPos < ANewStart then // AEndPos := ANewStart; AStartPos := ANewStart; AEndPos := AStartPos + 1; PGtkEditable(PGtkComboBox(Widget)^.get_child)^.select_region(AStartPos, AEndPos); end; end; procedure TGtk3ComboBox.SetSelLength(const ANewLength: integer); var AStartPos, AEndPos: gint; begin if PGtkEditable(PGtkComboBox(Widget)^.get_child)^.get_selection_bounds(@AStartPos, @AEndPos) then begin PGtkEditable(PGtkComboBox(Widget)^.get_child)^.select_region(AStartPos, AStartPos + ANewLength); end; end; function TGtk3ComboBox.CreateWidget(const Params: TCreateParams): PGtkWidget; var ACombo: TCustomComboBox; ListStore: PGtkListStore; ItemList: TGtkListStoreStringList; Renderer: PGtkCellRenderer; bs: string; pos: gint; begin FWidgetType := FWidgetType + [wtTreeModel, wtComboBox]; ACombo := TCustomComboBox(LCLObject); ListStore := gtk_list_store_new (2, [G_TYPE_STRING, G_TYPE_POINTER, nil]); // LCLGtkComboBox is introduced because of inability to control width and height // of control. if ACombo.Style.HasEditBox then Result := LCLGtkComboBoxNewWithModelAndEntry(PGtkTreeModel(ListStore)) else Result := LCLGtkComboBoxNewWithModel(PGtkTreeModel(ListStore)); if ACombo.Style.HasEditBox then begin ItemList := TGtkListStoreStringList.Create(PGtkListStore(PGtkComboBox(Result)^.get_model), 0, LCLObject); g_object_set_data(PGObject(Result), GtkListItemLCLListTag, ItemList); PGtkComboBox(Result)^.set_entry_text_column(0); // do not allow combo button to get focus, entry should take focus if PGtkComboBox(Result)^.priv3^.button <> nil then PGtkComboBox(Result)^.priv3^.button^.set_can_focus(False); bs := Self.LCLObject.Caption; pos := 0; {%H-}PGtkEditable(PGtkComboBox(Result)^.get_child)^.insert_text(pgChar(PChar(bs)),length(bs),@pos); // set lclwidget data to entry g_object_set_data(PGtkComboBox(Result)^.get_child, 'lclwidget', Self); // when we scroll with mouse wheel over entry our scrollevent doesn't catch entry // but parent control with window (eg. form), so we are settint all events mask to // catch all mouse events on gtkentry. if IsDesigning then begin // maybe set disabled {$note this does not work, must make search via children list} (* g_signal_connect_data(PGtkComboBox(Result)^.priv3^.button, 'button-press-event', TGCallback(@disableMouseButtonEvent), Self, Nil, G_CONNECT_DEFAULT); g_signal_connect_data(PGtkComboBox(Result)^.priv3^.button, 'button-release-event', TGCallback(@disableMouseButtonEvent), Self, Nil, G_CONNECT_DEFAULT); g_signal_connect_data(PGtkComboBox(Result)^.priv3^.arrow, 'button-press-event', TGCallback(@disableMouseButtonEvent), Self, Nil, G_CONNECT_DEFAULT); g_signal_connect_data(PGtkComboBox(Result)^.priv3^.arrow, 'button-release-event', TGCallback(@disableMouseButtonEvent), Self, Nil, G_CONNECT_DEFAULT); *) PGtkComboBox(Result)^.priv3^.button^.set_sensitive(gtk_false); PGtkComboBox(Result)^.priv3^.arrow^.set_sensitive(gtk_false); g_signal_connect_data(PGtkEntry(PGtkComboBox(Result)^.get_child), 'button-press-event', TGCallback(@disableMouseButtonEvent), Self, Nil, G_CONNECT_DEFAULT); g_signal_connect_data(PGtkEntry(PGtkComboBox(Result)^.get_child), 'button-release-event', TGCallback(@disableMouseButtonEvent), Self, Nil, G_CONNECT_DEFAULT); // g_signal_connect_data(PGtkEntry(PGtkComboBox(Result)^.get_child), 'motion-notify-event', TGCallback(@motionNotifyEvent), Self, nil, G_CONNECT_DEFAULT); PGtkEntry(PGtkComboBox(Result)^.get_child)^.set_can_focus(False); end else PGtkEntry(PGtkComboBox(Result)^.get_child)^.set_events(GDK_DEFAULT_EVENTS_MASK); end else begin // FCentralWidget := PGtkWidget(TGtkComboBox.new_with_model(PGtkTreeModel(ListStore))); FCentralWidget := Result; ItemList := TGtkListStoreStringList.Create(PGtkListStore(PGtkComboBox(FCentralWidget)^.get_model), 0, LCLObject); g_object_set_data(PGObject(FCentralWidget), GtkListItemLCLListTag, ItemList); renderer := LCLIntfCellRenderer_New(); g_object_set_data(PGObject(renderer), 'lclwidget', Self); gtk_cell_layout_clear(PGtkCellLayout(FCentralWidget)); gtk_cell_layout_pack_start(PGtkCellLayout(FCentralWidget), renderer, True); if not ACombo.Style.IsOwnerDrawn then gtk_cell_layout_set_attributes(PGtkCellLayout(FCentralWidget), renderer, ['text', 0, nil]); gtk_cell_layout_set_cell_data_func(PGtkCellLayout(FCentralWidget), renderer, @LCLIntfCellRenderer_CellDataFunc, Self, nil); if Assigned(PGtkComboBox(Result)^.priv3^.cell_view) then g_object_set_data(PGObject(PGtkComboBox(Result)^.priv3^.cell_view), 'lclwidget', Self); if Assigned(PGtkComboBox(Result)^.priv3^.button) then g_object_set_data(PGObject(PGtkComboBox(Result)^.priv3^.button), 'lclwidget', Self); if Assigned(PGtkComboBox(Result)^.priv3^.arrow) then g_object_set_data(PGObject(PGtkComboBox(Result)^.priv3^.arrow), 'lclwidget', Self); FCentralWidget := nil; //FWidget will be returned from getContainerWidget // we need cell renderer, but we need f***g GtkEventBox too // maybe an workaround is possible for csDropDownList (use entry with readonly param). // if we have GtkEventBox, then ComboBox becomes FCentralWidget. // Maybe the best thing would be to organize complete combo around GtkEntry // Anyway , I dont see any mouse button event in this case, only when entry_set_above_child is used. // FCentralWidget := PGtkComboBox(TGtkComboBox.new_with_model(PGtkTreeModel(ListStore))); // PGtkEventBox(Result)^.add(FCentralWidget); // ItemList := TGtkListStoreStringList.Create(PGtkListStore(PGtkComboBox(FCentralWidget)^.get_model), 0, LCLObject); // g_object_set_data(PGObject(FCentralWidget), GtkListItemLCLListTag, ItemList); // PGtkEventBox(Result)^.set_visible_window(True); end; g_object_unref(ListStore); PGtkComboBox(Result)^.set_id_column(0); Result^.show; end; function TGtk3ComboBox.EatArrowKeys(const AKey: Word): Boolean; begin Result := AKey in [VK_UP, VK_DOWN]; end; function TGtk3ComboBox.getText: String; begin Result := ''; if Gtk3IsComboBox(Widget) then begin with PGtkComboBox(Widget)^ do begin if has_entry then begin Result := StrPas(PGtkEntry(get_child)^.Text); end else begin Result := active_id; end; end; end; end; procedure TGtk3ComboBox.setText(const AValue: String); begin if Gtk3IsComboBox(Widget) then begin with PGtkComboBox(Widget)^ do begin if has_entry then begin {%H-}PGtkEntry(get_child)^.Text := Pgchar(AValue); end else begin //active_id := Pgchar(AValue); TODO: Wait until property becomes writeble end; end; end; end; procedure TGtk3ComboBox.DumpPrivateStructValues(const ADbgEvent: String); var AComboWidget: PGtkComboBox; APrivate: PGtkComboBoxPrivate; begin exit; AComboWidget := PGtkComboBox(Widget); APrivate := PGtkComboBoxPrivate(AComboWidget^.priv3); DebugLn('** COMBO DUMP OF PGtkComboBoxPrivate struct EVENT=',ADbgEvent); DebugLn('BUTTON=',dbgHex({%H-}PtrUInt(APrivate^.button)),' ARROW=',dbgHex({%H-}PtrUInt(APrivate^.arrow)), ' SCROLLEDWINDOW=',dbgHex({%H-}PtrUInt(APrivate^.scrolled_window)), ' CELLVIEW=',dbgHex({%H-}PtrUInt(APrivate^.cell_view)), ' CELLAREA=',dbgHex({%H-}PtrUInt(APrivate^.area))); DebugLn(' PrivatePopupW ',dbgHex({%H-}PtrUInt(APrivate^.popup_widget)), ' PrivatePopupWin ',dbgHex({%H-}PtrUInt(APrivate^.popup_window)),' TreeView ',dbgHex({%H-}PtrUInt(APrivate^.tree_view))); if Gtk3IsWidget(APrivate^.popup_widget) then begin DebugLn('POPUPWIDGET VISIBLE ',dbgs(APrivate^.popup_widget^.get_visible), ' PopupInProgress=',dbgs(APrivate^.popup_in_progress),' POPUPSHOWN=', dbgs(APrivate^.popup_shown),' POPUPIDLE_ID=',dbgs(APrivate^.popup_idle_id)); if Gtk3IsMenu(APrivate^.popup_widget) then DebugLn('POPUPWIDGET IS MENU ') else if Gtk3IsMenuItem(APrivate^.popup_widget) then DebugLn('POPUPWIDGET IS MENUITEM '); end; end; function TGtk3ComboBox.CanFocus: Boolean; begin Result := False; if IsWidgetOK then begin if PGtkComboBox(FWidget)^.has_entry then Result := PGtkComboBox(FWidget)^.get_child^.can_focus else if GetButtonWidget <> nil then Result := GetButtonWidget^.can_focus; end; end; procedure TGtk3ComboBox.SetBounds(ALeft, ATop, AWidth, AHeight: integer); var ARect: TGdkRectangle; Alloc: TGtkAllocation; begin if (Widget=nil) then exit; LCLWidth := AWidth; LCLHeight := AHeight; ARect.x := ALeft; ARect.y := ATop; ARect.width := AWidth; ARect.Height := AHeight; with Alloc do begin x := ALeft; y := ATop; width := AWidth; height := AHeight; end; BeginUpdate; try {fixes gtk3 assertion} if not Widget^.get_realized then Widget^.realize; Widget^.size_allocate(@ARect); if Widget^.get_visible then Widget^.set_allocation(@Alloc); if LCLObject.Parent <> nil then Move(ALeft, ATop); finally EndUpdate; end; end; procedure TGtk3ComboBox.SetFocus; begin {$IFDEF GTK3DEBUGFOCUS} DebugLn('TGtk3ComboBox.SetFocus LCLObject ',dbgsName(LCLObject),' WidgetOK ',dbgs(IsWidgetOK), ' FWidget <> GetContainerWidget ',dbgs(FWidget <> GetContainerWidget)); {$ENDIF} if Assigned(LCLObject) then begin if IsWidgetOK then begin if PGtkComboBox(FWidget)^.has_entry then FWidget^.grab_focus else if GetButtonWidget <> nil then GetButtonWidget^.grab_focus; end else inherited SetFocus; end else inherited SetFocus; end; class procedure TGtk3ComboBox.ComboBoxChanged({%H-}ACombo: PGtkComboBox; AData: gpointer); cdecl; var Msg: TLMessage; begin if AData <> nil then begin if TGtk3Widget(AData).InUpdate then Exit; FillChar(Msg{%H-}, SizeOf(Msg), #0); Msg.Msg := LM_CHANGED; TGtk3Widget(AData).DeliverMessage(Msg); end; end; function GtkPopupCloseUp(AData: Pointer): gboolean; cdecl; begin LCLSendCloseUpMsg(TGtk3Widget(AData).LCLObject); Result := False;// stop the timer end; class procedure TGtk3ComboBox.NotifySignal(AObject: PGObject; pspec: PGParamSpec; AData: GPointer); cdecl; var AValue: TGValue; ComboBox: TCustomComboBox; begin if pspec^.name = 'popup-shown' then begin ComboBox := TCustomComboBox(TGtk3Widget(AData).LCLObject); AValue.g_type := G_TYPE_BOOLEAN; g_object_get_property(AObject, pspec^.name, @AValue); // get property value if AValue.data[0].v_int = 0 then // if 0 = False then it is close up g_timeout_add(0,@GtkPopupCloseUp, AData) else // in other case it is drop down begin ComboBox.IntfGetItems; LCLSendDropDownMsg(ComboBox); end; end; end; procedure Gtk3ComboMenuRealized({%H-}AWidget: PGtkWidget; AData: gPointer); cdecl; begin DebugLn('Gtk3ComboMenuRealized *****',dbgsName(TGtk3ComboBox(AData).LCLObject)); end; procedure TGtk3ComboBox.InitializeWidget; begin inherited InitializeWidget; if IsDesigning then exit; // appears-as-list make it appear as list ... no way, its read only property. //OnChange g_signal_connect_data(GetContainerWidget, 'changed', TGCallback(@ComboBoxChanged), Self, nil, G_CONNECT_DEFAULT); //OnCloseUp g_signal_connect_data(GetContainerWidget, 'notify', TGCallback(@NotifySignal), Self, nil, G_CONNECT_DEFAULT); //TODO: if we have an entry then use CreateFrom() to create TGtk3Entry if Gtk3IsEntry(PGtkComboBox(FWidget)^.get_child) then begin g_object_set_data(PGtkComboBox(FWidget)^.get_child, 'lclwidget', Self); g_signal_connect_data(PGtkComboBox(FWidget)^.get_child, 'event', TGCallback(@WidgetEvent), Self, nil, G_CONNECT_DEFAULT); end; if GetCellView <> nil then begin gtk_widget_set_events(FCellView, GDK_DEFAULT_EVENTS_MASK); g_object_set_data(FCellView, 'lclwidget', Self); g_signal_connect_data(FCellView, 'event', TGCallback(@WidgetEvent), Self, nil, G_CONNECT_DEFAULT); end; // set to all combo widgets lclwidget data, so we will easy find TGtk3ComboBox in events. if PGtkComboBox(GetContainerWidget)^.priv3^.button <> nil then begin g_object_set_data(PGObject(PGtkComboBox(GetContainerWidget)^.priv3^.button), 'lclwidget', Self); // invalid signal for type GtkCssCustomGadget // g_signal_connect_data(PGObject(PGtkComboBox(GetContainerWidget)^.priv3^.button), 'event', TGCallback(@WidgetEvent), Self, nil, G_CONNECT_DEFAULT); end; if PGtkComboBox(GetContainerWidget)^.priv3^.popup_widget <> nil then begin g_object_set_data(PGObject(PGtkComboBox(GetContainerWidget)^.priv3^.popup_widget), 'lclwidget', Self); // invalid signal for type GtkCssCustomGadget // g_signal_connect_data(PGObject(PGtkComboBox(GetContainerWidget)^.priv3^.popup_widget), 'event', TGCallback(@WidgetEvent), Self, nil, G_CONNECT_DEFAULT); //Stop gtk asserts. We must use signals on popup widget or event. //PGtkComboBox(GetContainerWidget)^.priv3^.popup_widget^.set_has_window(True); //PGtkComboBox(GetContainerWidget)^.priv3^.popup_widget^.set_can_focus(True); // g_signal_connect_data(PGObject(PGtkComboBox(GetContainerWidget)^.priv3^.popup_widget), 'map', TGCallback(@Gtk3ComboMenuRealized), Self, nil, 0); end; if PGtkComboBox(GetContainerWidget)^.priv3^.area <> nil then g_object_set_data(PGObject(PGtkComboBox(GetContainerWidget)^.priv3^.area), 'lclwidget', Self); // if combo doesnt use menu if PGtkComboBox(GetContainerWidget)^.priv3^.tree_view <> nil then g_object_set_data(PGObject(PGtkComboBox(GetContainerWidget)^.priv3^.tree_view), 'lclwidget', Self); // real popup menu if PGtkComboBox(GetContainerWidget)^.priv3^.box <> nil then g_object_set_data(PGObject(PGtkComboBox(GetContainerWidget)^.priv3^.box), 'lclwidget', Self); end; function TGtk3ComboBox.GetDroppedDown: boolean; var AValue: TGValue; begin Result := False; if Assigned(FWidget) and Gtk3IsComboBox(Widget) then begin AValue.g_type := G_TYPE_BOOLEAN; g_object_get_property(PGObject(Widget), 'popup-shown', @AValue); Result := AValue.data[0].v_int <> 0; end; end; class procedure TGtk3ComboBox.ComboSizeAllocate(AWidget:PGtkWidget; AGdkRect: PGdkRectangle; Data:gpointer); cdecl; var Msg: TLMSize; NewSize: TSize; ACtl: TGtk3ComboBox; AState: TGdkWindowState; Alloc: TGtkAllocation; begin if AWidget=nil then ; ACtl := TGtk3ComboBox(Data); {$IF DEFINED(GTK3DEBUGCOMBOBOX) OR DEFINED(GTK3DEBUGSIZE)} with AGdkRect^ do DebugLn('**** ComboSizeAllocate **** ....',dbgsName(ACtl.LCLObject), ' ',Format('GTK x %d y %d w %d h %d',[x, y, width, height]), Format(' LCL W=%d H=%d LLW %d LLH %d',[ACtl.LCLObject.Width, ACtl.LCLObject.Height, ACtl.LCLWidth, ACtl.LCLHeight])); {$ENDIF} with Alloc do begin x := AGdkRect^.x; y := AGdkRect^.y; Width := AGdkRect^.width; Height := AGdkRect^.height; end; //gtk3 combobox is pretty ugly with it's layout gtk_widget_set_clip(AWidget, @Alloc); if not Assigned(ACtl.LCLObject) then exit; // return size w/o frame NewSize.cx := AGdkRect^.width; NewSize.cy := AGdkRect^.height; if not (csDesigning in ACtl.LCLObject.ComponentState) then begin if ACtl.InUpdate then exit; end; if ((NewSize.cx <> ACtl.LCLObject.Width) or (NewSize.cy <> ACtl.LCLObject.Height) or ACtl.LCLObject.ClientRectNeedsInterfaceUpdate) then begin {TODO: check if this is needed} ACtl.LCLObject.DoAdjustClientRectChange; end; FillChar(Msg{%H-}, SizeOf(Msg), #0); Msg.Msg := LM_SIZE; Msg.SizeType := SIZE_RESTORED; Msg.SizeType := Msg.SizeType or Size_SourceIsInterface; Msg.Width := Word(NewSize.cx); Msg.Height := Word(NewSize.cy); ACtl.DeliverMessage(Msg); end; procedure TGtk3ComboBox.ConnectSizeAllocateSignal(ToWidget:PGtkWidget); begin g_signal_connect_data(ToWidget,'size-allocate',TGCallback(@ComboSizeAllocate), Self, nil, G_CONNECT_DEFAULT); end; { TGtk3Button } function TGtk3Button.getLayout: Integer; begin Result := FLayout; // PGtkButton(FWidget)^.get_image_position; end; function TGtk3Button.getMargin: Integer; begin Result := FMargin; end; procedure TGtk3Button.SetLayout(AValue: Integer); begin FLayout := AValue; if IsWidgetOk then begin PGtkButton(FWidget)^.set_image_position(TGtkPositionType(AValue)); // set margin and spacing when layout is changed SetMargin(FMargin); end; end; procedure TGtk3Button.SetMargin(AValue: Integer); begin FMargin := AValue; if not IsWidgetOK then exit; if FMargin = -1 then PGtkButton(FWidget)^.set_alignment(0.5, 0.5) else begin case FLayout of 0 {GTK_POS_LEFT}: PGtkButton(FWidget)^.set_alignment(0, 0.5); 1 {GTK_POS_RIGHT}: PGtkButton(FWidget)^.set_alignment(1.0, 0.5); 2 {GTK_POS_TOP}: PGtkButton(FWidget)^.set_alignment(0.5, 0); 3 {GTK_POS_BOTTOM}: PGtkButton(FWidget)^.set_alignment(0.5, 1); end; end; end; procedure TGtk3Button.SetSpacing(AValue: Integer); var ATGValue: TGValue; AImage: PGtkWidget; begin // if FSpacing=AValue then Exit; FSpacing:=AValue; if AValue < 0 then FSpacing := 2; ATGValue.g_type := G_TYPE_INT; ATGValue.set_int(AValue); // no way under gtk3 ... we cannot set style property image-spacing // so we are using cheat AImage := PGtkButton(FWidget)^.get_image; if AImage <> nil then begin if AValue < 0 then AVAlue := 0; //TODO: margin depends on layout ! This is ok for left (default) layout PGtkImage(AImage)^.set_margin_right(AValue); end; end; class procedure TGtk3Button.ButtonClicked(aButton:PGtkButton; pData:pointer); cdecl; var Msg: TLMessage; begin Msg := Default(TLMessage); Msg.Msg := LM_CLICKED; TGtk3Widget(pData).DeliverMessage(Msg, True); end; procedure TGtk3Button.SetImage(AImage: TBitmap); begin if Assigned(fImage) then fImage.free; fImage:=AImage; end; function TGtk3Button.getText: String; begin if IsWidgetOK then Result := {%H-}ReplaceUnderscoresWithAmpersands(PGtkButton(FWidget)^.get_label()) else Result := ''; end; procedure TGtk3Button.setText(const AValue: String); begin if IsWidgetOk then begin {%H-}PGtkButton(FWidget)^.set_label(PgChar({%H-}ReplaceAmpersandsWithUnderscores(AValue))); end; end; function TGtk3Button.CreateWidget(const Params: TCreateParams): PGtkWidget; var btn:PGtkButton absolute Result; begin Result := LCLGtkButtonNew; btn^.set_use_underline(true); if not IsDesigning then g_signal_connect_data(btn,'clicked', TGCallback(@ButtonClicked), Self, nil, G_CONNECT_DEFAULT); if not IsDesigning then LCLObject.ControlStyle:=LCLObject.ControlStyle+[csClickEvents]; FMargin := -1; FLayout := ord(GTK_POS_LEFT); FSpacing := 2; // default gtk3 spacing is 2 end; destructor TGtk3Button.Destroy; begin SetImage(nil); inherited Destroy; end; function TGtk3Button.IsWidgetOk: Boolean; begin Result := (FWidget <> nil) and Gtk3IsButton(FWidget); end; procedure TGtk3Button.SetDefault(const ADefault: Boolean); begin if IsWidgetOk then GetContainerWidget^.set_can_default(ADefault); end; { TGtk3ToggleButton } procedure Gtk3Toggled({%H-}AWidget: PGtkToggleButton; AData: gPointer); cdecl; var Msg: TLMessage; begin FillChar(Msg{%H-}, SizeOf(Msg), 0); Msg.Msg := LM_CHANGED; if (TGtk3Widget(AData).LCLObject <> nil) and not TGtk3Widget(AData).InUpdate then TGtk3Widget(AData).DeliverMessage(Msg, False); end; procedure TGtk3ToggleButton.InitializeWidget; begin inherited InitializeWidget; if not IsDesigning then g_signal_connect_data(FWidget, 'toggled', TGCallback(@Gtk3Toggled), Self, nil, G_CONNECT_DEFAULT); end; function TGtk3ToggleButton.CreateWidget(const Params: TCreateParams): PGtkWidget; var btn: PGtkToggleButton; begin btn := TGtkToggleButton.new; btn^.use_underline := True; Result := PGtkWidget(btn); end; { TGtk3CheckBox } function TGtk3CheckBox.GetState: TCheckBoxState; begin Result := cbUnchecked; if IsWidgetOk then begin if PGtkCheckButton(FWidget)^.get_inconsistent then Result := cbGrayed else if PGtkCheckButton(FWidget)^.get_active then Result := cbChecked; end; end; procedure TGtk3CheckBox.SetState(AValue: TCheckBoxState); begin if IsWidgetOK then begin if AValue = cbGrayed then PGtkCheckButton(FWidget)^.set_inconsistent(True) else PGtkCheckButton(FWidget)^.set_active(AValue = cbChecked); end; end; function TGtk3CheckBox.CreateWidget(const Params: TCreateParams): PGtkWidget; var check: PGtkCheckButton; begin check := TGtkCheckButton.new; Result := PGtkWidget(check); check^.set_use_underline(True); end; procedure TGtk3CheckBox.SetBounds(ALeft,ATop,AWidth,AHeight:integer); var Alloc:TGtkAllocation; begin if LCLObject.Name = 'HiddenRadioButton' then exit; LCLWidth := AWidth; LCLHeight := AHeight; // not needed // Widget^.set_size_request(AWidth, AHeight); Alloc.x := ALeft; Alloc.y := ATop; Alloc.width := AWidth; Alloc.height := AHeight; Widget^.set_allocation(@Alloc); Move(ALeft, ATop); end; { TGtk3RadioButton } function TGtk3RadioButton.CreateWidget(const Params: TCreateParams): PGtkWidget; var btn: PGtkRadioButton; w: PGtkWidget; ctl, Parent: TWinControl; rb: TRadioButton; //pl: PGsList; i: Integer; begin if Self.LCLObject.Name='HiddenRadioButton' then exit; btn := TGtkRadioButton.new(nil); btn^.use_underline := True; Result := PGtkWidget(btn); ctl := Self.LCLObject; if Assigned(ctl) then begin Parent := ctl.Parent; if (Parent is TRadioGroup) then begin if (TRadioGroup(Parent).Items.Count>0) then begin rb := TRadioButton(Parent.Controls[0]); if rb<>ctl then begin w := TGtk3RadioButton(rb.Handle).Widget; //pl := PGtkRadioButton(w)^.get_group; //PGtkRadioButton(Result)^.set_group(pl); PGtkRadioButton(Result)^.join_group(PGtkRadioButton(w)); end; end end else begin for i := 0 to Parent.ControlCount - 1 do if (Parent.Controls[i] is TRadioButton) and TWinControl(Parent.Controls[i]).HandleAllocated then begin rb := TRadioButton(Parent.Controls[i]); w := TGtk3RadioButton(rb.Handle).Widget; //pl := PGtkRadioButton(w)^.get_group; //PGtkRadioButton(Result)^.set_group(pl); PGtkRadioButton(Result)^.join_group(PGtkRadioButton(w)); Break; end; end; end; end; procedure TGtk3RadioButton.InitializeWidget; begin if Self.LCLObject.Name='HiddenRadioButton' then begin exit; { PGtkRadioButton(Self.Widget)^.set_group(nil); // PGtkRadioButton(Self.Widget)^.set_inconsistent(true); PGtkRadioButton(Self.Widget)^.set_visible(false);} end; inherited InitializeWidget; end; function TGtk3RadioButton.getClientRect:TRect; var Alloc:TGtkAllocation; R: TRect; begin Result := Rect(0, 0, 0, 0); //Famous "HiddenRadioButton" if (Widget = nil) then exit; Widget^.get_allocation(@Alloc); Result := Bounds(Alloc.x, Alloc.y, Alloc.Width, Alloc.Height); Types.OffsetRect(Result, -Result.Left, -Result.Top); end; { TGtk3CustomControl } function TGtk3CustomControl.CreateWidget(const Params: TCreateParams): PGtkWidget; begin FHasPaint := True; FKeysToEat := []; FWidgetType := [wtWidget, wtLayout, wtTabControl, wtScrollingWin, wtCustomControl]; // this hack is requred for controls without custom WS classes if LCLObject is TUpDown then include(FWidgetType,wtSpinEdit); Result := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil)); FCentralWidget := TGtkLayout.new(nil, nil); //FCentralWidget^.set_has_window(True); PGtkScrolledWindow(Result)^.add(FCentralWidget); PGtkScrolledWindow(Result)^.set_policy(GTK_POLICY_EXTERNAL, GTK_POLICY_EXTERNAL); Result^.set_can_focus(False); FCentralWidget^.set_can_focus(True); FCentralWidget^.set_app_paintable(True); PGtkScrolledWindow(Result)^.set_shadow_type(BorderStyleShadowMap[TCustomControl(LCLObject).BorderStyle]); if not (csDesigning in LCLObject.ComponentState) then g_object_set(PGObject(FCentralWidget), 'resize-mode', [GTK_RESIZE_QUEUE, nil]); gtk_layout_set_size(PGtkLayout(FCentralWidget), 1, 1); end; function TGtk3CustomControl.EatArrowKeys(const AKey: Word): Boolean; begin Result := False; end; procedure TGtk3CustomControl.DoBeforeLCLPaint; var DC: TGtk3DeviceContext; NColor: TColor; begin inherited DoBeforeLCLPaint; if not Visible then exit; DC := TGtk3DeviceContext(Context); NColor := LCLObject.Color; if (NColor <> clNone) and (NColor <> clDefault) then begin DC.CurrentBrush.Color := ColorToRGB(NColor); DC.fillRect(0, 0, LCLObject.Width, LCLObject.Height); end; if BorderStyle <> bsNone then begin DC.CurrentPen.Color := ColorToRGB(clBtnShadow); // not sure what color to use here? DC.drawRect(0, 0, LCLObject.Width, LCLObject.Height, False, True); end; end; procedure TGtk3CustomControl.OffsetMousePos(APoint: PPoint); var Hadjustment, Vadjustment: PGtkAdjustment; HValue, VValue: longint; begin inherited OffsetMousePos(APoint); // Retrieve adjustments Hadjustment := GetScrolledWindow^.get_hadjustment; Vadjustment := GetScrolledWindow^.get_vadjustment; // Get the adjustment values HValue := Round(gtk_adjustment_get_value(Hadjustment)); VValue := Round(gtk_adjustment_get_value(Vadjustment)); // Apply adjustment values to the mouse position Dec(APoint^.x, HValue); Dec(APoint^.y, VValue); end; class procedure TGtk3CustomControl.RangeValueChanged(range: PGtkRange; data: gpointer); cdecl; var PrevValue, CurrentValue, Delta: gdouble; Control: TGtk3CustomControl; Msg: TLMVScroll; APressed, AMouseOver: boolean; Adjustment: PGtkAdjustment; begin Control := TGtk3CustomControl(data); {$IFDEF GTK3DEBUGSCROLL} writeln('>TGtk3CustomControl.RangeValueChanged ', dbgsName(Control.LCLObject), ' InUpdate=', Control.InUpdate); {$ENDIF} if Control.InUpdate then begin {$IFDEF GTK3DEBUGSCROLL} writeln(' 0 then begin if gtk_orientable_get_orientation(PGtkOrientable(range)) = GTK_ORIENTATION_VERTICAL then begin Msg.Msg := LM_VSCROLL; end else begin Msg.Msg := LM_HSCROLL; end; APressed := Control.CheckIfScrollbarPressed(PGtkScrollBar(range), AMouseOver, GDK_BUTTON1_MASK); if APressed then Msg.ScrollCode := SB_THUMBTRACK else Msg.ScrollCode := SB_THUMBPOSITION; Msg.Pos := Round(CurrentValue); Msg.ScrollBar := HWND(Control); Control.DeliverMessage(Msg); end; {$IFDEF GTK3DEBUGSCROLL} WriteLn(' [] then begin PreferredWidth := 0; PreferredHeight := 0; end; end; function TGtk3CustomControl.getClientRect: TRect; var Allocation: TGtkAllocation; R: TRect; w, h, x, y, VOffset, HOffset: gint; AViewPort: PGtkViewport; Bar:PGtkScrollbar; AWindow: PGdkWindow; AHorzPolicy, AVertPolicy: TGtkPolicyType; begin if [wtLayout] * WidgetType <> [] then begin Result := Rect(0, 0, 0, 0); AWindow := PGtkLayout(getContainerWidget)^.get_bin_window; if (AWindow <> nil) and Gtk3IsGdkWindow(AWindow) then begin HOffset := 0; VOffset := 0; gtk_scrolled_window_get_policy(PGtkScrolledWindow(Widget), @AHorzPolicy, @AVertPolicy); if AHorzPolicy < GTK_POLICY_NEVER then begin Bar := getHorizontalScrollbar; if (Bar <> nil) and Gtk3IsWidget(Bar) and Bar^.get_visible and GTK3WidgetSet.OverlayScrolling then HOffset := Bar^.get_allocated_height; end; if AVertPolicy < GTK_POLICY_NEVER then begin Bar := getVerticalScrollbar; if (Bar <> nil) and Gtk3IsWidget(Bar) and Bar^.get_visible and GTK3WidgetSet.OverlayScrolling then VOffset := Bar^.get_allocated_width end; Result := Rect(0, 0, AWindow^.get_width - VOffset, AWindow^.get_height - HOffset); end else begin Result := Rect(0, 0, PGtkLayout(GetContainerWidget)^.get_allocated_width, PGtkLayout(GetContainerWidget)^.get_allocated_height); end; //writeln('CustomControl clientRect=',dbgs(Result)); exit; end; AViewPort := getViewport; if Gtk3IsViewPort(AViewPort) and Gtk3IsGdkWindow(AViewPort^.get_view_window) then begin AViewPort^.get_view_window^.get_geometry(@x, @y, @w, @h); Bar := getHorizontalScrollbar; if (Bar <> nil) and Gtk3IsWidget(Bar) and Bar^.get_visible and GTK3WidgetSet.OverlayScrolling then HOffset := Bar^.get_allocated_height else HOffset := 0; Bar := getVerticalScrollbar; if (Bar <> nil) and Gtk3IsWidget(Bar) and Bar^.get_visible and GTK3WidgetSet.OverlayScrolling then VOffset := Bar^.get_allocated_width else VOffset := 0; Result := Rect(0, 0, AViewPort^.get_view_window^.get_width - VOffset, AViewPort^.get_view_window^.get_height - HOffset); {$IFDEF GTK3DEBUGSIZE} DebugLn('TGtk3CustomControl.GetClientRect via Viewport ',dbgsName(LCLObject),' Result ',dbgs(Result),' X=',dbgs(X),' Y=',dbgs(Y),' AllocH=',dbgs(AViewPort^.get_allocated_height),' OffsetH=',HOffset.ToString,' VOffset=',VOffset.ToString); getContainerWidget^.get_allocation(@Allocation); with ALlocation do begin DebugLn(Format(' GtkFixed alloc x %d y %d width %d height %d',[x, y, width, height])); end; {$ENDIF} exit; end else begin FCentralWidget^.get_allocation(@Allocation); if (Allocation.x = -1) and (Allocation.y = -1) and (Allocation.width = 0) and (Allocation.Height = 0) then FWidget^.get_allocation(@Allocation); end; with Allocation do R := Rect(x, y, width + x, height + y); if IsRectEmpty(R) then R := Rect(0, 0, 0, 0); Result := R; {$IFDEF GTK3DEBUGSIZE} DebugLn('TGtk3CustomControl.GetClientRect via GtkFixed ',dbgsName(LCLObject),' Result=',dbgs(Result)); {$ENDIF} // DebugLn('TGtk3CustomControl.GetClientRect normal ',dbgsName(LCLObject),' Result ',dbgs(Result)); Types.OffsetRect(Result, -Result.Left, -Result.Top); end; function TGtk3CustomControl.getHorizontalScrollbar: PGtkScrollbar; var HPolicy:TGtkPolicyType; VPolicy:TGtkPolicyType; begin Result := nil; if not IsWidgetOk then exit; PGtkScrolledWindow(Widget)^.get_policy(@HPolicy, @VPolicy); if HPolicy >= GTK_POLICY_NEVER then exit; Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_hscrollbar); g_object_set_data(Result,'lclwidget',Self); end; function TGtk3CustomControl.getVerticalScrollbar: PGtkScrollbar; var VPolicy:TGtkPolicyType; HPolicy:TGtkPolicyType; begin Result := nil; if not IsWidgetOk then exit; PGtkScrolledWindow(Widget)^.get_policy(@HPolicy, @VPolicy); if VPolicy >= GTK_POLICY_NEVER then exit; Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_vscrollbar); g_object_set_data(Result,'lclwidget',Self); end; function TGtk3CustomControl.GetScrolledWindow: PGtkScrolledWindow; begin if IsWidgetOK then Result := PGtkScrolledWindow(Widget) else Result := nil; end; { TGtk3ScrollingWinControl } function TGtk3ScrollingWinControl.CreateWidget(const Params: TCreateParams ): PGtkWidget; begin FHasPaint := True; FWidgetType := [wtWidget, wtContainer, wtScrollingWin, wtScrollingWinControl]; Result := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil)); FCentralWidget := TGtkFixed.new; FCentralWidget^.set_has_window(True); FCentralWidget^.show; PGtkScrolledWindow(Result)^.add_with_viewport(FCentralWidget); // PGtkScrolledWindow(Result)^.add(FCentralWidget); PGtkViewport(PGtkScrolledWindow(Result)^.get_child)^.set_shadow_type(BorderStyleShadowMap[bsNone]); PGtkScrolledWindow(Result)^.set_shadow_type(BorderStyleShadowMap[TScrollingWinControl(LCLObject).BorderStyle]); PGtkScrolledWindow(Result)^.get_vscrollbar^.set_can_focus(False); PGtkScrolledWindow(Result)^.get_hscrollbar^.set_can_focus(False); PGtkScrolledWindow(Result)^.set_policy(GTK_POLICY_NEVER, GTK_POLICY_NEVER); // this is very important PGtkScrolledWindow(Result)^.set_can_focus(False); FCentralWidget^.set_can_focus(True); end; { TGtk3Window } function TGtk3Window.GetTitle: String; begin if Gtk3IsGtkWindow(fWidget) then Result:=PGtkWindow(fWidget)^.get_title() else Result:='' end; procedure TGtk3Window.SetIcon(AValue: PGdkPixBuf); begin // if FIcon=AValue then Exit; if Assigned(FIcon) then begin FIcon^.unref; FIcon := nil; end; if Gtk3IsGdkPixbuf(AValue) then FIcon := PGdkPixbuf(AValue)^.copy else FIcon := nil; // DebugLn('Setting icon ',dbgHex(PtrUInt(FIcon)),' AppIcon ',dbgHex(PtrUInt(GTK3WidgetSet.AppIcon))); if Gtk3IsGtkWindow(fWidget) then PGtkWindow(Widget)^.set_icon(FIcon); end; function TGtk3Window.GetSkipTaskBarHint: Boolean; begin Result := False; if Gtk3IsGtkWindow(fWidget) then Result := PGtkWindow(Widget)^.get_skip_taskbar_hint; end; procedure TGtk3Window.SetSkipTaskBarHint(AValue: Boolean); begin if Gtk3IsGtkWindow(fWidget) then PGtkWindow(Widget)^.set_skip_taskbar_hint(AValue); end; procedure TGtk3Window.SetTitle(const AValue: String); begin if Gtk3IsGtkWindow(fWidget) then {%H-}PGtkWindow(FWidget)^.set_title(PGChar(AValue)); end; class function TGtk3Window.WindowStateSignal(AWidget: PGtkWidget; AEvent: PGdkEvent; AData: gPointer): gboolean; cdecl; var Msg: TLMSize; AState: TGdkWindowState; //AScreen: PGdkScreen; msk: TGdkWindowState; begin Result := False; FillChar(Msg{%H-}, SizeOf(Msg), #0); Msg.Msg := LM_SIZE; Msg.SizeType := SIZE_RESTORED; msk:=AEvent^.window_state.changed_mask; AState:=AEvent^.window_state.new_window_state; if GDK_WINDOW_STATE_ICONIFIED in msk then begin if GDK_WINDOW_STATE_ICONIFIED in AState then Msg.SizeType := SIZE_MINIMIZED end else if GDK_WINDOW_STATE_MAXIMIZED in msk then begin if GDK_WINDOW_STATE_MAXIMIZED in AState then Msg.SizeType := SIZE_MAXIMIZED end else if GDK_WINDOW_STATE_FULLSCREEN in msk then begin if GDK_WINDOW_STATE_FULLSCREEN in AState then Msg.SizeType := SIZE_FULLSCREEN end else if GDK_WINDOW_STATE_FOCUSED in msk then begin {$IFDEF GTK3DEBUGWINDOWSTATE} if GDK_WINDOW_STATE_FOCUSED in AState then DebugLn('Gtk3WindowState: Focused') else DebugLn('Gtk3WindowState: Defocused'); {$ENDIF} exit; end else if GDK_WINDOW_STATE_WITHDRAWN in msk then begin {$IFDEF GTK3DEBUGWINDOWSTATE} if GDK_WINDOW_STATE_WITHDRAWN in AState then DebugLn('Gtk3WindowState: Shown') else DebugLn('Gtk3WindowState: Hidden'); {$ENDIF} exit; end else begin //DebugLn(format('other changes state=%.08x mask=%.08x',[AState,msk])); exit; end; Msg.SizeType := Msg.SizeType or Size_SourceIsInterface; Msg.Width := Word(AWidget^.window^.get_width); Msg.Height := Word(AWidget^.window^.get_height); {$IFDEF GTK3DEBUGWINDOWSTATE} DebugLn('GetWindowState SizeType=',dbgs(Msg.SizeType),' realized ',dbgs(AWidget^.get_realized)); {$ENDIF} TGtk3Window(AData).DeliverMessage(Msg); // DeliverMessage(Msg); end; class procedure TGtk3Window.WindowSizeAllocate(AWidget:PGtkWidget;AGdkRect: PGdkRectangle;Data:gpointer);cdecl; var Msg: TLMSize; NewSize: TSize; ACtl: TGtk3Widget; AState: TGdkWindowState; Alloc: TGtkAllocation; ADefW, ADefH: gint; begin if AWidget=nil then ; ACtl := TGtk3Widget(Data); //When gtk3 form is shown for the first time under some window manager there's //geometry out of sync. We fix it via map-event and WidgetMapped property. if g_object_get_data(aWidget,'lcl-window-first-map') <> nil then begin g_object_set_data(aWidget,'lcl-window-first-map', nil); if not IsRectEmpty(TGtk3Window(ACtl).FFirstMapRect) then begin with TGtk3Window(ACtl) do Types.OffsetRect(FFirstMapRect, -FFirstMapRect.Left, -FFirstMapRect.Top); AGdkRect^ := GdkRectFromRect(TGtk3Window(ACtl).FFirstMapRect); TGtk3Window(ACtl).FFirstMapRect := Rect(0, 0, 0, 0); end; end; {$IFDEF GTK3DEBUGFORMS} if Assigned(ACtl.LCLObject) then begin with ACtl.LCLObject do begin writeln(Format('TGtk3Window.WindowSizeAllocate %s Gdk x %d y %d w %d h %d LCL l %d t %d w %d h %d applied w %d h %d cliRect %s WMap %s',[dbgsName(ACtl.LCLObject), AGdkRect^.x, AGdkRect^.y, AGdkRect^.width, AGdkRect^.height, Left, Top, Width, Height, ACtl.LCLWidth, ACtl.LCLHeight, dbgs(ACtl.LCLObject.ClientRect), BoolToStr(ACtl.WidgetMapped, True)])); end; if (AGdkRect^.x = 0) and (AGdkRect^.y = 0) and (AGdkRect^.width = 200) and (AGdkRect^.height = 200) and ACtl.WidgetMapped then begin // this is wrong size. This one is sent by kwin. writeln('***** Dump size values for ',G_OBJECT_TYPE_NAME(AWidget)); with PGtkWindow(AWidget)^ do begin get_allocation(@Alloc); get_size(@NewSize.cx, @NewSize.cy); get_default_size(@ADefW, @ADefH); end; with Alloc do writeln(Format('WSA Alloc x %d y %d w %d h %d NS w %d h %d DEF w %d h %d', [x, y, width, height, NewSize.cx, NewSize.cy, ADefW, ADefH])); end; end; {$ENDIF} if decoration_flags(TCustomForm(Actl.LCLObject))<>[] then PGtkWIndow(Actl.widget)^.get_size(@newSize.cx, @newsize.cy) else begin NewSize.cx := AGdkRect^.width; NewSize.cy := AGdkRect^.height; end; //writeln(format('Gkt3SizeAllocate w=%d h=%d',[NewSize.cx,NewSize.cy])); if not Assigned(ACtl.LCLObject) then exit; // do not loop with LCL ! if not (csDesigning in ACtl.LCLObject.ComponentState) and ACtl.InUpdate then exit; if ((NewSize.cx <> ACtl.LCLObject.Width) or (NewSize.cy <> ACtl.LCLObject.Height) or ACtl.LCLObject.ClientRectNeedsInterfaceUpdate) then ACtl.LCLObject.DoAdjustClientRectChange; FillChar(Msg{%H-}, SizeOf(Msg), #0); Msg.Msg := LM_SIZE; Msg.SizeType := SIZE_RESTORED; if ACtl is TGtk3Window then begin AState := TGtk3Window(ACtl).getWindowState; if GDK_WINDOW_STATE_ICONIFIED in AState then Msg.SizeType := SIZE_MINIMIZED else if GDK_WINDOW_STATE_MAXIMIZED in AState then Msg.SizeType := SIZE_MAXIMIZED else if GDK_WINDOW_STATE_FULLSCREEN in AState then Msg.SizeType := SIZE_FULLSCREEN; end; Msg.SizeType := Msg.SizeType or Size_SourceIsInterface; Msg.Width := Word(NewSize.cx); Msg.Height := Word(NewSize.cy); ACtl.DeliverMessage(Msg); end; class function TGtk3Window.WindowMapEvent(awidget: PGtkWindow; AEvent: PGdkEventAny; adata: gpointer): gboolean; cdecl; var wx:gint; wy:gint; w:gint; h:gint; Alloc:TGtkAllocation; begin if Gtk3IsGtkWindow(aWidget) then begin gtk_window_get_position(aWidget, @wx, @wy); gtk_window_get_size(aWidget, @w, @h); end; gtk_widget_get_allocation(aWidget, @Alloc); //under some window managers there's discrepancy gdk window have it's default gtk size, not lcl one //so sends 2 size-allocate events. I've introduced "lcl-window-first-map" gobject data to control //if we are out of sync. Alloc contains correct data. if not TGtk3Widget(AData).WidgetMapped and ((Alloc.width <> w) or (Alloc.height <> h) or (wx <> Alloc.x) or (wy <> Alloc.y)) then begin g_object_set_data(aWidget,'lcl-window-first-map', aData); TGtk3Window(aData).FFirstMapRect := RectFromGdkRect(Alloc); end; TGtk3Widget(AData).WidgetMapped := True; Result := gtk_false; end; procedure TGtk3Window.ConnectSizeAllocateSignal(ToWidget:PGtkWidget); begin g_signal_connect_data(ToWidget,'size-allocate',TGCallback(@WindowSizeAllocate), Self, nil, G_CONNECT_DEFAULT); g_signal_connect_data(ToWidget,'map-event',TGCallback(@WindowMapEvent), Self, nil, G_CONNECT_DEFAULT); end; class function TGtk3Window.decoration_flags(Aform: TCustomForm): TGdkWMDecoration; var icns:TBorderIcons; bs:TFormBorderStyle; begin Result := []; icns:=AForm.BorderIcons; bs:=AForm.BorderStyle; case bs of bsSingle: Include(Result, GDK_DECOR_TITLE{GDK_DECOR_BORDER}); bsDialog: Result += [GDK_DECOR_BORDER, GDK_DECOR_TITLE]; bsSizeable: begin if biMaximize in icns then Include(Result, GDK_DECOR_MAXIMIZE); if biMinimize in icns then Include(Result, GDK_DECOR_MINIMIZE); Result += [GDK_DECOR_BORDER, GDK_DECOR_RESIZEH, GDK_DECOR_TITLE]; end; bsSizeToolWin: Result += [GDK_DECOR_BORDER, GDK_DECOR_RESIZEH, GDK_DECOR_TITLE]; bsToolWindow: Include(Result, GDK_DECOR_BORDER); bsNone: Result := []; end; if GDK_DECOR_TITLE in Result then if biSystemMenu in icns then Include(Result, GDK_DECOR_MENU); end; procedure TGtk3Window.DoBeforeLCLPaint; var DC: TGtk3DeviceContext; NColor: TColor; begin inherited DoBeforeLCLPaint; if not Visible then exit; DC := TGtk3DeviceContext(Context); NColor := LCLObject.Color; if (NColor <> clNone) and (NColor <> clDefault) and (NColor <> clForm) then begin DC.CurrentBrush.Color := ColorToRGB(NColor); DC.fillRect(0, 0, LCLObject.Width, LCLObject.Height); end; if BorderStyle <> bsNone then begin DC.CurrentPen.Color := ColorToRGB(clBtnShadow); // not sure what color to use here? DC.drawRect(0, 0, LCLObject.Width, LCLObject.Height, False, True); end; end; function TGtk3Window.ShowState(nstate:integer):boolean; // winapi ShowWindow var AState: TGdkWindowState; begin if not Gtk3IsGtkWindow(fWidget) then exit(false); case nstate of SW_SHOWNORMAL: begin AState:=fWidget^.window^.get_state; if GDK_WINDOW_STATE_ICONIFIED in AState then PgtkWindow(fWidget)^.deiconify else if GDK_WINDOW_STATE_MAXIMIZED in AState then PgtkWindow(fWidget)^.unmaximize else if GDK_WINDOW_STATE_FULLSCREEN in AState then PgtkWindow(fWidget)^.unfullscreen else PgtkWindow(fWidget)^.show; end; SW_SHOWMAXIMIZED: PgtkWindow(fWidget)^.maximize; SW_MINIMIZE: PgtkWindow(fWidget)^.iconify; SW_SHOWFULLSCREEN: PgtkWindow(fWidget)^.fullscreen; else PgtkWindow(fWidget)^.show; end; Result:=true end; procedure TGtk3Window.UpdateWindowState; // LCL WindowState const ShowCommands: array[TWindowState] of Integer = (SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED, SW_SHOWFULLSCREEN); begin ShowState(ShowCommands[TCustomForm(LCLObject).WindowState]); end; function TGtk3Window.CreateWidget(const Params: TCreateParams): PGtkWidget; var AForm: TCustomForm; decor: TGdkWMDecoration; begin FIcon := nil; FFirstMapRect := Rect(0, 0, 0, 0); FHasPaint := True; FMenuBar := nil; AForm := TCustomForm(LCLObject); if not Assigned(LCLObject.Parent) then begin Result := TGtkWindow.new(GTK_WINDOW_TOPLEVEL); FWidget:=Result; //gtk_widget_realize(Result); FWidget^.set_events(GDK_DEFAULT_EVENTS_MASK); Title:=Params.Caption; decor:=decoration_flags(AForm); gtk_window_set_decorated(PGtkWindow(Result),(decor <> [])); //gdk_window_set_decorations(Result^.window, decor); if AForm.AlphaBlend then gtk_widget_set_opacity(Result, TForm(LCLObject).AlphaBlendValue/255); if not gtk_window_get_decorated(PGtkWindow(Result)) then gtk_window_set_type_hint(PGtkWindow(Result), GDK_WINDOW_TYPE_HINT_UTILITY); FWidgetType := [wtWidget, wtLayout, wtScrollingWin, wtWindow]; end else begin Result := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil)); // cannot gtk_widget_realize(Result), because that needs a valid widget parent FWidgetType := [wtWidget, wtLayout, wtScrollingWin, wtCustomControl] end; Text := Params.Caption; FBox := TGtkVBox.new(GTK_ORIENTATION_VERTICAL, 0); FScrollWin := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil)); g_object_set_data(FScrollWin,'lclscrollingwindow',GPointer(1)); g_object_set_data(PGObject(FScrollWin), 'lclwidget', Self); FCentralWidget := TGtkLayout.new(nil, nil); // FCentralWidget^.set_has_window(True); //if AForm.AutoScroll then FScrollWin^.add(FCentralWidget); //else // FScrollWin^.add_with_viewport(FCentralWidget); FScrollWin^.show; FBox^.pack_end(FScrollWin, True, True, 0); FBox^.show; FScrollWin^.get_vscrollbar^.set_can_focus(False); FScrollWin^.get_hscrollbar^.set_can_focus(False); FScrollWin^.set_policy(GTK_POLICY_NEVER, GTK_POLICY_NEVER); PGtkContainer(Result)^.add(FBox); g_signal_connect_data(Result,'window-state-event', TGCallback(@WindowStateSignal), Self, nil, G_CONNECT_DEFAULT); g_object_set(PGObject(FCentralWidget), 'resize-mode', [GTK_RESIZE_QUEUE, nil]); gtk_layout_set_size(PGtkLayout(FCentralWidget), 1, 1); gtk_widget_realize(Result); if not Assigned(LCLObject.Parent) then gdk_window_set_decorations(Result^.window, decor); if not (csDesigning in AForm.ComponentState) then UpdateWindowState; Result^.Hide; // issue #41412 end; function TGtk3Window.EatArrowKeys(const AKey: Word): Boolean; begin Result := False; end; function TGtk3Window.getText: String; begin // query widget Result:=Title; // return cached if Result='' then Result := inherited GetText; end; procedure TGtk3Window.setText(const AValue: String); begin // set cached text inherited SetText(AValue); // set widget text Title := AValue; end; {$IFDEF GTK3DEBUGFORMS} procedure ChildCallback(Child: PGtkWidget; Data: gpointer); cdecl; var Level: PtrInt; S: string; I:Integer; begin // Log the child widget type S := ''; Level := PtrInt(Data^); for I := 1 to Level - 1 do S := S + ' '; WriteLn(S + 'Found child widget of type: ', g_type_name(PGObject(Child)^.g_type_instance.g_class^.g_type)); if Gtk3IsContainer(Child) then begin inc(Level); gtk_container_foreach(PGtkContainer(Child), @ChildCallback, @Level); end; end; {$ENDIF} function TGtk3Window.getViewport:PGtkViewport; var W: PGtkWidget; {$IFDEF GTK3DEBUGFORMS} AInt: PtrInt; {$ENDIF} begin W := FScrollWin^.get_child; if Gtk3IsViewPort(W) then Result := PGtkViewport(W) else Result := nil; {$IFDEF GTK3DEBUGFORMS} if Result <> nil then writeln('TGtk3Window.GetViewport: result class is ' +g_type_name(PGObject(Result)^.g_type_instance.g_class^.g_type)+ '. Found type=',g_type_name(PGObject(W)^.g_type_instance.g_class^.g_type),' g_type=',PGObject(W)^.g_type_instance.g_class^.g_type,' g_type_is_a=',g_type_is_a(PGObject(W)^.g_type_instance.g_class^.g_type, gtk_viewport_get_type)) else begin writeln('TGtk3Window.GetViewport: result is nil, check if we are GtkLayout ? ',Gtk3IsLayout(W)); if Gtk3IsLayout(W) then begin AInt := 1; gtk_container_foreach(PGtkContainer(W), @ChildCallback, @AInt); end; end; {$ENDIF} end; function TGtk3Window.getClientRect: TRect; var Allocation: TGtkAllocation; R: TRect; w: gint; h: gint; x: gint; y: gint; AViewPort: PGtkViewport; MenuSize:Integer; begin AViewPort := PGtkViewPort(FCentralWidget^.get_parent); if WidgetMapped and Gtk3IsViewPort(AViewPort) and Gtk3IsGdkWindow(AViewPort^.get_view_window) then begin AViewPort^.get_view_window^.get_geometry(@x, @y, @w, @h); Result := Rect(0, 0, AViewPort^.get_view_window^.get_width, AViewPort^.get_view_window^.get_height); // DebugLn('GetClientRect via Viewport ',dbgsName(LCLObject),' Result ',dbgs(Result)); exit; end else begin if not FCentralWidget^.get_realized and not FCentralWidget^.get_mapped then begin // calculate our own client rect somehow. if (LCLObject is TCustomForm) then begin MenuSize := 0; if (TCustomForm(LCLObject).Menu <> nil) or (FMenuBar <> nil) then MenuSize := GetSystemMetrics(SM_CYMENU) else MenuSize := 0; Allocation.x := LCLObject.Left; Allocation.y := LCLObject.Top; Allocation.width := LCLObject.Width; // border Allocation.Height := LCLObject.Height - MenuSize; end else begin Allocation.X := -1; Allocation.Y := -1; Allocation.Width := 1; Allocation.Height := 1; end; end else FCentralWidget^.get_allocation(@Allocation); end; with Allocation do R := Rect(x, y, width + x, height + y); if IsRectEmpty(R) then R := Rect(0, 0, 0, 0); Result := R; Types.OffsetRect(Result, -Result.Left, -Result.Top); {$IFDEF GTK3DEBUGFORMS} DebugLn('TGtk3Window.GetClientRect ',dbgsName(LCLObject),' Result ',dbgs(Result),' CentralWidget mapped ? ',dbgs(FCentralWidget^.get_mapped),' Realized ? ',dbgs(FCentralWidget^.get_realized)); {$ENDIF} end; procedure TGtk3Window.SetBounds(ALeft,ATop,AWidth,AHeight:integer); var ARect: TGdkRectangle; Geometry: TGdkGeometry; AHints: TGdkWindowHints; AFixedWidthHeight: Boolean; AForm: TCustomForm; AMinSize, ANaturalSize: gint; Alloc:TGtkAllocation; x, y: gint; begin AForm := TCustomForm(LCLObject); BeginUpdate; ARect.x := ALeft; ARect.y := ATop; ARect.width := AWidth; ARect.Height := AHeight; try {fixes gtk3 assertion} Widget^.get_preferred_width(@AMinSize, @ANaturalSize); Widget^.get_preferred_height(@AMinSize, @ANaturalSize); Widget^.get_allocation(@Alloc); {$IFDEF GTK3DEBUGFORMS} with Alloc do DebugLn(Format('TGtk3Window.setBounds(%d, %d, %d, %d) Natural w=%d h=%d alloc x %d y %d w %d h %d',[ALeft, ATop ,AWidth, AHeight, ANaturalSize, ANaturalSize2, x, y, width, height])); {$ENDIF} Widget^.size_allocate(@ARect); if Gtk3IsGtkWindow(fWidget) and not (csDesigning in AForm.ComponentState) {and (AForm.Parent = nil) and (AForm.ParentWindow = 0)} then begin AFixedWidthHeight := AForm.BorderStyle in [bsDialog, bsSingle, bsToolWindow]; with Geometry do begin if not AFixedWidthHeight and (AForm.Constraints.MinWidth > 0) then min_width := AForm.Constraints.MinWidth else min_width := AForm.Width; if not AFixedWidthHeight and (AForm.Constraints.MaxWidth > 0) then max_width := AForm.Constraints.MaxWidth else max_width := AForm.Width; if not AFixedWidthHeight and (AForm.Constraints.MinHeight > 0) then min_height := AForm.Constraints.MinHeight else min_height := AForm.Height; if not AFixedWidthHeight and (AForm.Constraints.MaxHeight > 0) then max_height := AForm.Constraints.MaxHeight else max_height := AForm.Height; base_width := AForm.Width; base_height := AForm.Height; width_inc := 1; height_inc := 1; min_aspect := 0; max_aspect := 1; win_gravity := PGtkWindow(Widget)^.get_gravity end; if AFixedWidthHeight then PGtkWindow(Widget)^.set_geometry_hints(nil, @Geometry, [GDK_HINT_POS, GDK_HINT_MIN_SIZE, GDK_HINT_MAX_SIZE]) else begin if AForm.BorderStyle <> bsNone then begin AHints := [GDK_HINT_POS, GDK_HINT_BASE_SIZE]; if (AForm.Constraints.MinHeight > 0) or (AForm.Constraints.MinWidth > 0) then Include(AHints, GDK_HINT_MIN_SIZE); if (AForm.Constraints.MaxHeight > 0) or (AForm.Constraints.MaxWidth > 0) then Include(AHints, GDK_HINT_MAX_SIZE); PGtkWindow(Widget)^.set_geometry_hints(nil, @Geometry, AHints); end; end; end; if Gtk3IsGtkWindow(FWidget) then begin //PGtkWindow(Widget)^.set_default_size(AWidth, AHeight); PGtkWindow(Widget)^.set_resizable(true); {$IF DEFINED(GTK3DEBUGCORE) OR DEFINED(GTK3DEBUGSIZE)} writeln('Window ',dbgsName(LCLObject),' move/size ',dbgs(Bounds(ALeft, ATop, AWidth, AHeight))); {$ENDIF} PGtkWindow(Widget)^.resize(AWidth, AHeight); {Must apply transient window origin here. Not sure if this is needed for decorated windows, but non decorated with popupparent must align.} x := 0; y := 0; if not PGtkWindow(Widget)^.get_decorated and (PGtkWindow(Widget)^.transient_for <> nil) then PGtkWindow(Widget)^.transient_for^.window^.get_origin(@x, @y); PGtkWindow(Widget)^.move(ALeft + x, ATop + y); end; finally EndUpdate; end; end; function TGtk3Window.getHorizontalScrollbar: PGtkScrollbar; begin Result := nil; if not IsWidgetOk then exit; Result := PGtkScrollBar(FScrollWin^.get_hscrollbar); end; function TGtk3Window.getVerticalScrollbar: PGtkScrollbar; begin Result := nil; if not IsWidgetOk then exit; Result := PGtkScrollBar(FScrollWin^.get_vscrollbar); end; function TGtk3Window.GetScrolledWindow: PGtkScrolledWindow; begin if IsWidgetOK then Result := FScrollWin else Result := nil; end; destructor TGtk3Window.Destroy; begin if Gtk3IsGdkPixbuf(FIcon) then begin FIcon^.unref; FIcon := nil; end; inherited Destroy; end; procedure TGtk3Window.Activate; begin if Gtk3IsGtkWindow(fWidget) then begin if Gtk3IsGdkWindow(PGtkWindow(FWidget)^.window) then begin PGtkWindow(FWidget)^.window^.raise_; PGtkWindow(FWidget)^.present; PGtkWindow(FWidget)^.activate; end; end; end; procedure TGtk3Window.ActivateWindow(AEvent: PGdkEvent); var MsgActivate: TLMActivate; FIsActivated: Boolean; begin if not Gtk3IsGtkWindow(FWidget) then exit; //gtk3 does not handle activate/deactivate at all //even cannot catch it via GDK_FOCUS event ?!? FillChar(MsgActivate{%H-}, SizeOf(MsgActivate), #0); MsgActivate.Msg := LM_ACTIVATE; if (AEvent <> nil) and PGtkWindow(Widget)^.is_active then MsgActivate.Active := WA_ACTIVE else MsgActivate.Active := WA_INACTIVE; MsgActivate.ActiveWindow := HWND(Self); // DebugLn('TGtk3Window.ActivateWindow ',dbgsName(LCLObject),' Active ',dbgs(PGtkWindow(Widget)^.is_active), // ' CustomFormActive ',dbgs(TCustomForm(LCLObject).Active)); FIsActivated := TCustomForm(LCLObject).Active; {do not send activate if form is already activated, also do not send activate if TCustomForm.Parent is assigned since it's form embedded into another control or form} if (Boolean(MsgActivate.Active) = FIsActivated) or (LCLObject.Parent <> nil) then else begin // DebugLn('TGtk3Window.ActivateWindow Active ',dbgs(MsgActivate.Active = WA_ACTIVE), // ' Message delivery to lcl ',dbgs(MsgActivate.Active)); DeliverMessage(MsgActivate); end; end; function TGtk3Window.CloseQuery: Boolean; var Msg : TLMessage; begin {$IFDEF GTK3DEBUGCORE} DebugLn('TGtk3Window.CloseQuery'); {$ENDIF} FillChar(Msg{%H-}, SizeOf(Msg), 0); Msg.Msg := LM_CLOSEQUERY; DeliverMessage(Msg); Result := False; end; function TGtk3Window.GetWindow: PGdkWindow; begin Result := FWidget^.window; end; function TGtk3Window.GetMenuBar: PGtkMenuBar; var ABox:PGtkBox; begin if not Assigned(FMenuBar) then begin FMenuBar := TGtkMenuBar.new; // our menubar (needed for main menu) // MenuBar // -> Menu Menu2 // Item 1 Item 3 // Item 2 g_object_set_data(Widget,'lclmenubar',GPointer(1)); ABox := PGtkBox(PGtkWindow(Widget)^.get_child); ABox^.pack_start(FMenuBar, False, False, 0); end; Result := FMenuBar; end; function TGtk3Window.GetBox: PGtkBox; begin Result := FBox; end; function TGtk3Window.GetWindowState: TGdkWindowState; begin Result := []; if IsWidgetOK and (FWidget^.get_realized) then Result := FWidget^.window^.get_state; end; { TGtk3HintWindow } function TGtk3HintWindow.CreateWidget(const Params: TCreateParams): PGtkWidget; var AForm: THintWindow; begin FText := ''; FHasPaint := True; AForm := THintWindow(LCLObject); FWidgetType := [wtWidget, wtContainer, wtWindow, wtHintWindow]; Result := TGtkWindow.new(GTK_WINDOW_POPUP); FBox := TGtkVBox.new(GTK_ORIENTATION_VERTICAL, 0); PGtkContainer(Result)^.add(FBox); FCentralWidget := TGtkFixed.new; FCentralWidget^.set_size_request(AForm.Width,AForm.Height+1); FBox^.pack_start(fCentralWidget, true, true, 0); PGtkWindow(Result)^.set_can_focus(false); FBox^.set_can_focus(False); FCentralWidget^.set_can_focus(False); Result^.Hide; // issue #41412 end; procedure TGtk3HintWindow.InitializeWidget; var ParentWidget: TGtk3Widget; begin inherited; with LCLObject as THintWindow do begin if HintControl is TWinControl then with HintControl as TWinControl do begin ParentWidget := TGtk3Widget(Handle); FWidget^.realize; GetWindow^.set_transient_for(ParentWidget.GetWindow); end; end; end; { TGtk3Dialog } procedure TGtk3Dialog.SetCallbacks; begin // common callbacks for all kind of dialogs g_signal_connect_data(fWidget, 'destroy', TGCallback(@TGtk3Dialog.DestroyCB), Self, nil, G_CONNECT_DEFAULT); g_signal_connect_data(fWidget, 'delete-event', TGCallback(@TGtk3Dialog.CloseQueryCB), Self, nil, G_CONNECT_DEFAULT); g_signal_connect_data(fWidget, 'response', TGCallback(@Tgtk3DIalog.ResponseCB), Self, nil, G_CONNECT_DEFAULT); g_signal_connect_data(fWidget, 'close', TGCallback(@Tgtk3DIalog.CloseCB), Self, nil, G_CONNECT_DEFAULT); (* g_signal_connect_data(fWidget, 'key-press-event', TGCallback(@GTKDialogKeyUpDownCB), Self, nil, 0); g_signal_connect_data(fWidget, 'key-release-event', TGCallback(@GTKDialogKeyUpDownCB), Self, nil, 0);*) g_signal_connect_data(fWidget, 'realize', TGCallback(@Tgtk3Dialog.RealizeCB), Self, nil, G_CONNECT_DEFAULT); end; class function Tgtk3Dialog.RealizeCB(dlg: TGtk3Dialog): GBoolean; cdecl; begin Result := False; if (dlg=nil) then exit; // actually key intercepion is not required {if dlg.FWidget^.get_has_window and Gtk3IsGdkWindow(dlg.FWidget^.window) then begin gdk_window_set_events(dlg.FWidget^.window, gdk_window_get_events(dlg.FWidget^.window) or GDK_KEY_RELEASE_MASK or GDK_KEY_PRESS_MASK); end;} if (wtDialog in dlg.WidgetType) then begin if Assigned(dlg.CommonDialog) then TCommonDialog(dlg.CommonDialog).DoShow; end; Result := True; end; class function TGtk3Dialog.DestroyCB(dlg:TGtk3Dialog): GBoolean; cdecl; begin Result := True; // if (AWidget=nil) then ; if not Assigned(dlg) then exit; dlg.CommonDialog.UserChoice := mrCancel; dlg.CommonDialog.Close; end; class function TGtk3Dialog.ResponseCB(response_id:gint; dlg: TGtk3Dialog): GBoolean; cdecl; begin if Assigned(dlg) then Result:=dlg.response_handler(TGtkResponseType(response_id)) else Result:= false; end; function TGtk3Dialog.response_handler(response_id:TGtkResponseType):boolean; begin (* case response_id of GTK_RESPONSE_NONE:; GTK_RESPONSE_REJECT: ; GTK_RESPONSE_ACCEPT:; GTK_RESPONSE_DELETE_EVENT:; GTK_RESPONSE_OK:; GTK_RESPONSE_CANCEL:; GTK_RESPONSE_CLOSE:; GTK_RESPONSE_YES:; GTK_RESPONSE_NO:; GTK_RESPONSE_APPLY:; GTK_RESPONSE_HELP:; end;*) if response_id=GTK_RESPONSE_YES then begin Self.CommonDialog.UserChoice:=mrYes; end else if response_id=GTK_RESPONSE_NO then begin Self.CommonDialog.UserChoice:=mrNo; end else if response_id=GTK_RESPONSE_OK then begin Self.CommonDialog.UserChoice:=mrOk; end else if response_id=GTK_RESPONSE_CANCEL then begin Self.CommonDialog.UserChoice:=mrCancel; end else if response_id=GTK_RESPONSE_CLOSE then begin Self.CommonDialog.UserChoice:=mrClose; end; Result:=false; end; function TGtk3Dialog.close_handler(): boolean; begin Result:=false; end; class function TGtk3Dialog.CloseCB(dlg: TGtk3Dialog): GBoolean; cdecl; begin if Assigned(dlg) then Result:=dlg.close_handler() else Result:= true; end; class function TGtk3Dialog.CloseQueryCB(w:PGtkWidget;dlg:TGtk3Dialog): GBoolean; cdecl; var theDialog : TCommonDialog; CanClose: boolean; //AHandle: HWND; begin Result := False; // true = do nothing, false = destroy or hide window if (dlg=nil) then exit; // data is not the commondialog. Get it manually. // AHandle := HwndFromGtkWidget(AWidget); if (dlg <> nil) and (wtDialog in TGtk3Widget(dlg).WidgetType) then begin theDialog := dlg.CommonDialog; if theDialog = nil then exit; if theDialog.OnCanClose<>nil then begin CanClose:=True; theDialog.DoCanClose(CanClose); Result := not CanClose; end; end; end; function TGtk3Dialog.CreateWidget(const Params: TCreateParams): PGtkWidget; begin FWidgetType := [wtWidget, wtDialog]; Result := TGtkDialog.new; DebugLn('WARNING: TGtk3Dialog.CreateWidget should be used in real dialog constructor .'); end; procedure TGtk3Dialog.InitializeWidget; begin g_object_set_data(FWidget,'lclwidget', Self); end; procedure TGtk3Dialog.CloseDialog; begin if fWidget<>nil then fWidget^.destroy_; end; { TGtk3FileDialog } function TGtk3FileDialog.CreateWidget(const Params: TCreateParams): PGtkWidget; begin DebugLn('ERROR: TGtk3FileDialog.CreateWidget error.'); // Result := nil; Result := TGtkFileChooserDialog.new; // gtk_file_chooser_dialog_new(); end; constructor TGtk3FileDialog.Create(const ACommonDialog: TCommonDialog); var FileDialog: TFileDialog absolute ACommonDialog; Action: TGtkFileChooserAction; Button1: String; AFileDialog: PGtkFileChooserDialog; AParams: TCreateParams; begin inherited Create; FOwnWidget := True; // Initializes the properties FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE]; FWidgetType := [wtWidget, wtDialog]; // FHasPaint := False; CommonDialog := ACommonDialog; // Defines an action for the dialog and creates it Action := GTK_FILE_CHOOSER_ACTION_OPEN; Button1 := GTK_STOCK_OPEN; if (FileDialog is TSaveDialog) or (FileDialog is TSavePictureDialog) then begin Action := GTK_FILE_CHOOSER_ACTION_SAVE; Button1 := GTK_STOCK_SAVE; end else if FileDialog is TSelectDirectoryDialog then Action := GTK_FILE_CHOOSER_ACTION_SELECT_FOLDER; FWidget := gtk_file_chooser_dialog_new(PgChar(FileDialog.Title), nil, Action, PChar(GTK_STOCK_CANCEL), [GTK_RESPONSE_CANCEL, PChar(Button1), GTK_RESPONSE_OK, nil]); AFileDialog := PGtkFileChooserDialog(FWidget); if FileDialog is TSaveDialog then begin gtk_file_chooser_set_do_overwrite_confirmation(PGtkFileChooser(AFileDialog), ofOverwritePrompt in TOpenDialog(FileDialog).Options); end; if FileDialog.InitialDir <> '' then gtk_file_chooser_set_current_folder(PGtkFileChooser(AFileDialog), Pgchar(FileDialog.InitialDir)); if gtk_file_chooser_get_action(PGtkFileChooser(AFileDialog)) in [GTK_FILE_CHOOSER_ACTION_SAVE, GTK_FILE_CHOOSER_ACTION_CREATE_FOLDER] then gtk_file_chooser_set_current_name(PGtkFileChooser(AFileDialog), Pgchar(FileDialog.FileName)); InitializeWidget; end; { TGtk3FontSelectionDialog } procedure TGtk3FontSelectionDialog.InitializeWidget; var fnt:TFont; pch:PgtkFontChooser; fontDesc: PPangoFontDescription; family: String; stretch: TPangoStretch; weight: TPangoWeight; begin fWidget:=TGtkFontChooserDialog.new(PChar(CommonDialog.Title),nil); fontDesc := TPangoFontDescription.new; try fnt:=TFontDialog(CommonDialog).Font; if fnt.Size = 0 then FontDesc^.set_size(10 * PANGO_SCALE) else FontDesc^.set_size(fnt.Size * PANGO_SCALE); family := fnt.Name; ExtractPangoFontFaceSuffixes(family, stretch, weight); fontDesc^.set_family(PChar(family)); if (fsBold in fnt.Style) and (weight < PANGO_WEIGHT_SEMIBOLD) then // bold is specified by the fsBold flag only fontDesc^.set_weight(PANGO_WEIGHT_BOLD) else fontDesc^.set_weight(weight); if fsItalic in fnt.Style then begin // we need to specify the exact style for the font dialog if PangoFontHasItalicFace(fWidget^.get_pango_context, family) then fontDesc^.set_style(PANGO_STYLE_ITALIC) else fontDesc^.set_style(PANGO_STYLE_OBLIQUE); end else fontDesc^.set_style(PANGO_STYLE_NORMAL); if (stretch = PANGO_STRETCH_NORMAL) then fontDesc^.set_stretch(GetPangoFontDefaultStretch(family)) else fontDesc^.set_stretch(stretch); pch:=PGtkFontChooser(fWidget); pch^.set_font_desc(fontDesc); finally fontDesc^.free; end; inherited InitializeWidget; end; function TGtk3FontSelectionDialog.response_handler(resp_id: TGtkResponseType): boolean; var fnt:TFont; pch:PgtkFontChooser; pfc:PPangoFontFace; pfd:PPangoFontDescription; fnts:TfontStyles; family: Pgchar; begin if resp_id=GTK_RESPONSE_OK then begin fnt:=TFontDialog(CommonDialog).Font; pch:=PGtkFontChooser(fWidget); pfc:=pch^.get_font_face(); pfd:=pfc^.describe; { this stuff is implemened in gtk3objects.Tgtk3Font.UpdateLogFont so this is backward mapping of properties } family := pfd^.get_family(); fnt.Name:=AppendPangoFontFaceSuffixes(family, pfd^.get_stretch, pfd^.get_weight); fnt.Size:=pch^.get_font_size() div PANGO_SCALE; fnts:=[]; if pfd^.get_weight >= PANGO_WEIGHT_SEMIBOLD then include(fnts,fsBold); // do not differentiate oblique and italic if (pfd^.get_style >= PANGO_STYLE_OBLIQUE) then include(fnts,fsItalic); fnt.Style:=fnts; end; Result:=inherited response_handler(resp_id); end; constructor TGtk3FontSelectionDialog.Create(const ACommonDialog: TCommonDialog); begin inherited Create; FOwnWidget := True; // Initializes the properties FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE]; FWidgetType := [wtWidget, wtDialog]; // FHasPaint := False; CommonDialog := ACommonDialog; InitializeWidget; Self.SetCallbacks; end; { TGtk3ColorSelectionDialog } procedure TGtk3ColorSelectionDialog.InitializeWidget; var clr:TColor; rgba:TGdkRGBA; begin fWidget := TGtkColorSelectionDialog.new(PChar(Self.CommonDialog.Title)); clr:=ColorToRgb(TColorDialog(Self.CommonDialog).Color); rgba.red:=Red(clr)/255; rgba.blue:=Blue(clr)/255; rgba.green:=Green(clr)/255; rgba.alpha:=(clr shl 24)/255; gtk_color_selection_set_current_rgba ( PgtkColorSelection(PGtkColorSelectionDialog(fWidget)^.color_selection), @rgba); end; constructor TGtk3ColorSelectionDialog.Create(const ACommonDialog: TCommonDialog ); begin inherited Create; FOwnWidget := True; // Initializes the properties FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE]; FWidgetType := [wtWidget, wtDialog]; // FHasPaint := False; CommonDialog := ACommonDialog; TGtk3Widget(Self).InitializeWidget; Self.SetCallbacks; end; { TGtk3newColorSelectionDialog } procedure TGtk3newColorSelectionDialog.InitializeWidget; var rgba:TGdkRGBA; dlg:TColorDialog; begin dlg:=TColorDialog(CommonDialog); fWidget:= TGtkColorChooserDialog.new(PChar(Self.CommonDialog.Title), nil); self.color_to_rgba(dlg.Color, rgba); PGtkColorChooser(fWidget)^.use_alpha:=(cdShowAlphaChannel in dlg.Options); if (cdPreventFullOpen in dlg.Options) then // drop basic palette that way PGtkColorChooser(fWidget)^.add_palette(GTK_ORIENTATION_HORIZONTAL,9,10,nil); PGtkColorChooser(fWidget)^.set_rgba(@rgba); inherited; end; function TGtk3newColorSelectionDialog.response_handler(resp_id: TGtkResponseType): boolean; var clr:TColor; rgba:TGdkRGBA; begin if resp_id=GTK_RESPONSE_OK then begin PGtkColorChooser(fWidget)^.get_rgba(@rgba); clr:=self.rgba_to_color(rgba); if not PGtkColorChooser(fWidget)^.use_alpha then clr:=clr and $00ffffff; TColorDialog(Self.CommonDialog).Color:=clr; end; Result:=inherited response_handler(resp_id); end; constructor TGtk3newColorSelectionDialog.Create(const ACommonDialog: TCommonDialog ); begin inherited Create; FOwnWidget := True; // Initializes the properties LCLObject := nil; FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE]; FWidgetType := [wtWidget, wtDialog]; // FHasPaint := False; CommonDialog := ACommonDialog; TGtk3Widget(Self).InitializeWidget; Self.SetCallbacks; end; class procedure TGtk3newColorSelectionDialog.color_to_rgba(clr: TColor; out rgba: TgdkRGBA); begin rgba := TColortoTGdkRGBA(clr); end; class function TGtk3newColorSelectionDialog.rgba_to_color(const rgba: TgdkRGBA ): TColor; begin Result := TGdkRGBAToTColor(rgba); end; { TGtk3GLArea } procedure TGtk3GLArea.Update(ARect: PRect); begin if IsWidgetOK then PGtkGLArea(Widget)^.queue_render; end; function TGtk3GLArea.CreateWidget(const Params: TCreateParams): PGtkWidget; begin FWidgetType := [wtWidget, wtGLArea]; Result := TGtkGLArea.new; end; { TGtk3DesignWidget } procedure TGtk3DesignWidget.BringDesignerToFront; begin {$IFDEF GTK3DEBUGDESIGNER} writeln('>BringDesignerToFront '); {$ENDIF} if Gtk3IsGdkWindow(getContainerWidget^.window) then getContainerWidget^.window^.raise_; {$IFDEF GTK3DEBUGDESIGNER} writeln(' nil then begin gdk_cairo_get_clip_rectangle(AContext, @ARect); {$IFDEF GTK3DEBUGDESIGNER} writeln('>Gtk3DrawDesigner '); {$ENDIF} Result := TGtk3DesignWidget(Data).GtkEventPaint(AWidget, AContext); // workaround for lcl painted widgets until we found why gtk3 sends wrong rect // if (TGtk3Widget(Data).FHasPaint) and if (ARect.height < (TGtk3DesignWidget(Data).getContainerWidget^.get_allocated_height div 4) ) then begin {$IFDEF GTK3DEBUGDESIGNER} with ARect do writeln('Queued new draw for designer ?!? x=',x,' y=',y,' w=',width,' h=',height); {$ENDIF} //do not queue any draw for now //with ARect do // AWidget^.queue_draw_area(x, y , width, height); end; {$IFDEF GTK3DEBUGDESIGNER} writeln(' 0 then Result := FDesignContext else Result := inherited GetContext; end; procedure TGtk3DesignWidget.InitializeWidget; begin inherited InitializeWidget; g_signal_handler_disconnect(getContainerWidget, FDrawSignal); g_signal_connect_data(getContainerWidget,'draw', TGCallback(@Gtk3DrawDesigner), Self, nil, G_CONNECT_DEFAULT); BringDesignerToFront; end; function TGtk3DesignWidget.GtkEventPaint(Sender: PGtkWidget; AContext: Pcairo_t ): Boolean; cdecl; var Msg: TLMPaint; AStruct: TPaintStruct; AClipRect: TGdkRectangle; localClip:TRect; P: TPoint; begin Result := gtk_false; if not FHasPaint then exit; FillChar(Msg{%H-}, SizeOf(Msg), #0); Msg.Msg := LM_PAINT; FillChar(AStruct{%H-}, SizeOf(TPaintStruct), 0); Msg.PaintStruct := @AStruct; with PaintData do begin if GetContainerWidget = nil then PaintWidget := Widget else PaintWidget := GetContainerWidget; ClipRegion := nil; gdk_cairo_get_clip_rectangle(AContext, @AClipRect); localClip:=RectFromGdkRect(AClipRect); ClipRect := @localClip; end; FContext := 0; FCairoContext := AContext; Msg.DC := BeginPaint(HWND(Self), AStruct); FDesignContext := Msg.DC; FContext := Msg.DC; Msg.PaintStruct^.rcPaint := PaintData.ClipRect^; Msg.PaintStruct^.hdc := FDesignContext; P := getClientOffset; TGtk3DeviceContext(Msg.DC).translate(P); try try //DoBeforeLCLPaint; {$IFDEF GTK3DEBUGDESIGNER} writeln('>TGtk3DesignWidget.Paint DC=',dbgHex(Msg.DC),' offset=',dbgs(P),' surface=',cairo_surface_get_type(cairo_get_target(AContext))); {$ENDIF} LCLObject.WindowProc(TLMessage(Msg)); {$IFDEF GTK3DEBUGDESIGNER} writeln('