1 {
2 *****************************************************************************
3 * gtk3widgets.pas *
4 * ------------- *
5 * *
6 * *
7 *****************************************************************************
8
9 *****************************************************************************
10 This file is part of the Lazarus Component Library (LCL)
11
12 See the file COPYING.modifiedLGPL.txt, included in this distribution,
13 for details about the license.
14 *****************************************************************************
15 }
16
17 unit gtk3widgets;
18 {$i gtk3defines.inc}
19 {$mode objfpc}
20 {$H+}
21
22 interface
23
24 uses
25 Classes, SysUtils, types, math,
26 // LCL
27 Controls, StdCtrls, ExtCtrls, Buttons, ComCtrls, Graphics, Dialogs, Forms, Menus, ExtDlgs,
28 Spin, CheckLst, PairSplitter, LCLType, LMessages, LCLMessageGlue, LCLIntf,
29 // LazUtils
30 LazLoggerBase, GraphType, LazUtilities,
31 // GTK3
32 LazGtk3, LazGdk3, LazGObject2, LazGLib2, LazCairo1, LazPango1, LazGdkPixbuf2,
33 gtk3objects, gtk3procs, gtk3private, Gtk3CellRenderer;
34
35 type
36 TByteSet = set of byte;
37
38 // records
39 TPaintData = record
40 PaintWidget: PGtkWidget;
41 ClipRect: PRect;
42 ClipRegion: Pcairo_region_t;
43 end;
44
45 TDefaultRGBA = record
46 R: Double;
47 G: Double;
48 B: Double;
49 Alpha: Double;
50 end;
51
52 TGtk3WidgetType = (wtWidget, wtStaticText, wtProgressBar, wtLayout,
53 wtContainer, wtMenuBar, wtMenu, wtMenuItem, wtEntry, wtSpinEdit,
54 wtNotebook, wtTabControl, wtComboBox,
55 wtGroupBox, wtCalendar, wtTrackBar, wtScrollBar,
56 wtScrollingWin, wtListBox, wtListView, wtCheckListBox, wtMemo, wtTreeModel,
57 wtCustomControl, wtScrollingWinControl,
58 wtWindow, wtDialog, wtHintWindow, wtGLArea);
59 TGtk3WidgetTypes = set of TGtk3WidgetType;
60
61 { TGtk3Widget }
62
63 TGtk3Widget = class(TGtk3Object, IUnknown)
64 private
65 FFocusableByMouse: Boolean; {shell we call SetFocus on mouse down. Default = False}
66 FEnterLeaveTime: Cardinal;
67 FHasPaint: Boolean;
68 FKeysToEat: TByteSet;
69 FPaintData: TPaintData;
70 FContext: HDC;
71 FCairoContext: Pcairo_t;
72 FWidgetType: TGtk3WidgetTypes;
73 FParams: TCreateParams;
74 FOwnWidget: Boolean;
75 FOwner: PGtkWidget;
76 FCentralWidget: PGtkWidget;
77 FWidget: PGtkWidget;
78 FProps: TStringList;
79 FWidgetRGBA: array [0{GTK_STATE_NORMAL}..4{GTK_STATE_INSENSITIVE}] of TDefaultRGBA;
80 FCentralWidgetRGBA: array [0{GTK_STATE_NORMAL}..4{GTK_STATE_INSENSITIVE}] of TDefaultRGBA;
81 fText:string;
CanSendLCLMessagenull82 function CanSendLCLMessage: Boolean;
GetCairoContextnull83 function GetCairoContext: Pcairo_t;
GetEnablednull84 function GetEnabled: Boolean;
GetFontnull85 function GetFont: PPangoFontDescription;
GetStyleContextnull86 function GetStyleContext: PGtkStyleContext;
GetVisiblenull87 function GetVisible: Boolean;
88 procedure SetEnabled(AValue: Boolean);
89 procedure SetFont(AValue: PPangoFontDescription);
90 procedure SetVisible(AValue: Boolean);
91 procedure SetStyleContext(AValue: PGtkStyleContext);
92 class procedure destroy_event(w:Tgtk3Widget;{%H-}data:gpointer);cdecl;
93 protected
94 // IUnknown implementation
QueryInterfacenull95 function QueryInterface(constref iid: TGuid; out obj): LongInt; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
_AddRefnull96 function _AddRef: LongInt; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
_Releasenull97 function _Release: LongInt; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
EatArrowKeysnull98 function EatArrowKeys(const AKey: Word): Boolean; virtual;
getTextnull99 function getText: String; virtual;
100 procedure setText(const AValue: String); virtual;
GetContextnull101 function GetContext: HDC; virtual;
CreateWidgetnull102 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; virtual;
103 procedure DestroyWidget; virtual;
104 procedure DoBeforeLCLPaint; virtual;
105
GetColornull106 function GetColor: TColor; virtual;
107 procedure SetColor(AValue: TColor); virtual;
GetFontColornull108 function GetFontColor: TColor; virtual;
109 procedure SetFontColor(AValue: TColor); virtual;
110 public
111 LCLObject: TWinControl;
112 public
113 constructor Create(const AWinControl: TWinControl; const AParams: TCreateParams); virtual; overload;
114 constructor CreateFrom(const AWinControl: TWinControl; AWidget: PGtkWidget); virtual;
115
116 procedure InitializeWidget; virtual;
117 procedure UpdateWidgetConstraints;virtual;
118 procedure DeInitializeWidget;
119 procedure RecreateWidget;
120 procedure DestroyNotify({%H-}AWidget: PGtkWidget); virtual;
121 destructor Destroy; override;
122
CanFocusnull123 function CanFocus: Boolean; virtual;
GetFocusableByMousenull124 function GetFocusableByMouse: Boolean;
getClientOffsetnull125 function getClientOffset: TPoint; virtual;
getWidgetPosnull126 function getWidgetPos: TPoint; virtual;
127
128 procedure OffsetMousePos(APoint: PPoint); virtual;
129
ClientToScreennull130 function ClientToScreen(var P:TPoint):boolean;
ScreenToClientnull131 function ScreenToClient(var P: TPoint): Integer;
132
DeliverMessagenull133 function DeliverMessage(var Msg; const AIsInputEvent: Boolean = False): LRESULT; virtual;
GtkEventMouseEnterLeavenull134 function GtkEventMouseEnterLeave(Sender: PGtkWidget; Event: PGdkEvent): Boolean; virtual; cdecl;
GtkEventKeynull135 function GtkEventKey(Sender: PGtkWidget; Event: PGdkEvent; AKeyPress: Boolean): Boolean; virtual; cdecl;
GtkEventMousenull136 function GtkEventMouse(Sender: PGtkWidget; Event: PGdkEvent): Boolean; virtual; cdecl;
GtkEventMouseMovenull137 function GtkEventMouseMove(Sender: PGtkWidget; Event: PGdkEvent): Boolean; virtual; cdecl;
GtkEventPaintnull138 function GtkEventPaint(Sender: PGtkWidget; AContext: Pcairo_t): Boolean; virtual; cdecl;
GtkEventResizenull139 function GtkEventResize(Sender: PGtkWidget; Event: PGdkEvent): Boolean; virtual; cdecl;
140 procedure GtkEventFocus(Sender: PGtkWidget; Event: PGdkEvent); cdecl;
141 procedure GtkEventDestroy; cdecl;
GtkEventMouseWheelnull142 function GtkEventMouseWheel(Sender: PGtkWidget; Event: PGdkEvent): Boolean; virtual; cdecl;
143
IsValidHandlenull144 function IsValidHandle: Boolean;
IsWidgetOknull145 function IsWidgetOk: Boolean; virtual;
IsIconicnull146 function IsIconic: Boolean; virtual;
147
getTypenull148 function getType: TGType;
getTypeNamenull149 function getTypeName: PgChar;
150
151 procedure lowerWidget; virtual;
152 procedure raiseWidget; virtual;
153 procedure stackUnder(AWidget: PGtkWidget); virtual;
154
GetCapturenull155 function GetCapture: TGtk3Widget; virtual;
SetCapturenull156 function SetCapture: HWND; virtual;
157
getClientRectnull158 function getClientRect: TRect; virtual;
getClientBoundsnull159 function getClientBounds: TRect; virtual;
160
161 procedure SetBounds(ALeft,ATop,AWidth,AHeight:integer);virtual;
162 procedure SetLclFont(const AFont:TFont);virtual;
163
GetContainerWidgetnull164 function GetContainerWidget: PGtkWidget; virtual;
GetPositionnull165 function GetPosition(out APoint: TPoint): Boolean; virtual;
166 procedure Release; override;
167 procedure Hide; virtual;
getParentnull168 function getParent: TGtk3Widget;
GetWindownull169 function GetWindow: PGdkWindow; virtual;
170 procedure Move(ALeft, ATop: Integer);
171 procedure Activate; virtual;
172 procedure preferredSize(var PreferredWidth, PreferredHeight: integer; {%H-}WithThemeSpace: Boolean); virtual;
173 procedure SetCursor(ACursor: HCURSOR);
174 procedure SetFocus; virtual;
175 procedure SetParent(AParent: TGtk3Widget; const ALeft, ATop: Integer); virtual;
176 procedure Show; virtual;
177 procedure ShowAll; virtual;
178 procedure Update(ARect: PRect); virtual;
179 property CairoContext: Pcairo_t read GetCairoContext;
180 property Color: TColor read GetColor write SetColor;
181 property Context: HDC read GetContext;
182 property Enabled: Boolean read GetEnabled write SetEnabled;
183 property Font: PPangoFontDescription read GetFont write SetFont;
184 property FontColor: TColor read GetFontColor write SetFontColor;
185 property KeysToEat: TByteSet read FKeysToEat write FKeysToEat;
186 property PaintData: TPaintData read FPaintData write FPaintData;
187 property StyleContext: PGtkStyleContext read GetStyleContext write SetStyleContext;
188 property Text: String read getText write setText;
189 property Visible: Boolean read GetVisible write SetVisible;
190 property Widget: PGtkWidget read FWidget;
191 property WidgetType: TGtk3WidgetTypes read FWidgetType;
192 end;
193
194 { TGtk3Editable }
195
196 TGtk3Editable = class(TGtk3Widget)
197 private
GetReadOnlynull198 function GetReadOnly: Boolean;
199 procedure SetReadOnly(AValue: Boolean);
200 protected
201 PrivateCursorPos: Integer; // used only for delayed selStart and selLength
202 PrivateSelection: Integer;
getCaretPosnull203 function getCaretPos: TPoint; virtual;
204 procedure SetCaretPos(AValue: TPoint); virtual;
205 public
getSelStartnull206 function getSelStart: Integer; virtual;
getSelLengthnull207 function getSelLength: Integer; virtual;
208 procedure setSelStart(AValue: Integer); virtual;
209 procedure setSelLength(AValue: Integer); virtual;
210 property CaretPos: TPoint read GetCaretPos write SetCaretPos;
211 property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
212 end;
213
214 { TGtk3Entry }
215
216 TGtk3Entry = class(TGtk3Editable)
217 private
GetAlignmentnull218 function GetAlignment: TAlignment;
219 procedure SetAlignment(AValue: TAlignment);
220 protected
EatArrowKeysnull221 function EatArrowKeys(const AKey: Word): Boolean; override;
222 procedure InsertText(const atext:pchar;len:gint;var pos:gint;edt:TGtk3Entry);cdecl;
getTextnull223 function getText: String; override;
224 procedure setText(const AValue: String); override;
CreateWidgetnull225 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
226 public
227 procedure SetBounds(Left,Top,Width,Height:integer);override;
228 procedure InitializeWidget; override;
229 procedure UpdateWidgetConstraints;override;
230 procedure SetEchoMode(AVisible: Boolean);
231 procedure SetMaxLength(AMaxLength: Integer);
232 procedure SetPasswordChar(APasswordChar: Char);
233 procedure SetNumbersOnly(ANumbersOnly:boolean);
234 procedure SetTextHint(const AHint:string);
235 procedure SetFrame(const aborder:boolean);
GetTextHintnull236 function GetTextHint:string;
IsWidgetOknull237 function IsWidgetOk: Boolean; override;
238 property Alignment: TAlignment read GetAlignment write SetAlignment;
239 property TextHint:string read GetTextHint write SetTextHint;
240 end;
241
242 { TGtk3SpinEdit }
243
244 TGtk3SpinEdit = class(TGtk3Entry)
245 private
GetMaximumnull246 function GetMaximum: Double;
GetMinimumnull247 function GetMinimum: Double;
GetNumDigitsnull248 function GetNumDigits: Integer;
GetNumericnull249 function GetNumeric: Boolean;
GetStepnull250 function GetStep: Double;
GetValuenull251 function GetValue: Double;
252 procedure SetNumDigits(AValue: Integer);
253 procedure SetNumeric(AValue: Boolean);
254 procedure SetStep(AValue: Double);
255 procedure SetValue(AValue: Double);
256 protected
CreateWidgetnull257 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
EatArrowKeysnull258 function EatArrowKeys(const {%H-}AKey: Word): Boolean; override;
259 public
IsWidgetOknull260 function IsWidgetOk: Boolean; override;
261 procedure SetRange(AMin, AMax: Double);
262 property Minimum: Double read GetMinimum;
263 property Maximum: Double read GetMaximum;
264 property Numeric: Boolean read GetNumeric write SetNumeric;
265 property NumDigits: Integer read GetNumDigits write SetNumDigits;
266 property Step: Double read GetStep write SetStep;
267 property Value: Double read GetValue write SetValue;
268 end;
269
270 { TGtk3Range }
271
272 TGtk3Range = class(TGtk3Widget)
273 private
GetPositionnull274 function GetPosition: Integer; reintroduce;
GetRangenull275 function GetRange: TPoint;
276 procedure SetPosition(AValue: Integer);
277 procedure SetRange(AValue: TPoint);
278 public
279 procedure InitializeWidget; override;
280 procedure SetStep(AStep: Integer; APageSize: Integer);
281 property Range: TPoint read GetRange write SetRange;
282 property Position: Integer read GetPosition write SetPosition;
283 end;
284
285 { TGtk3TrackBar }
286
287 TGtk3TrackBar = class(TGtk3Range)
288 private
289 FOrientation: TTrackBarOrientation;
GetReversednull290 function GetReversed: Boolean;
291 procedure SetReversed(AValue: Boolean);
292 protected
CreateWidgetnull293 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
294 public
295 procedure SetBounds(ALeft,ATop,AWidth,AHeight:integer);override;
GetTrackBarOrientationnull296 function GetTrackBarOrientation: TTrackBarOrientation;
297 procedure SetScalePos(AValue: TTrackBarScalePos);
298 procedure SetTickMarks(AValue: TTickMark; ATickStyle: TTickStyle);
299 property Reversed: Boolean read GetReversed write SetReversed;
300 end;
301
302 { TGtk3ScrollBar }
303
304 TGtk3ScrollBar = class(TGtk3Range)
305 protected
306 class procedure value_changed (bar:TGtk3Scrollbar);cdecl;
CreateWidgetnull307 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
308 public
309 procedure SetParams;
310 end;
311
312 { TGtk3ProgressBar }
313
314 TGtk3ProgressBar = class(TGtk3Widget)
315 private
GetOrientationnull316 function GetOrientation: TProgressBarOrientation;
GetPositionnull317 function GetPosition: Integer; reintroduce;
GetShowTextnull318 function GetShowText: Boolean;
GetStylenull319 function GetStyle: TProgressBarStyle;
320 procedure SetOrientation(AValue: TProgressBarOrientation);
321 procedure SetPosition(AValue: Integer);
322 procedure SetShowText(AValue: Boolean);
323 procedure SetStyle(AValue: TProgressBarStyle);
324 protected
CreateWidgetnull325 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
326 public
327 procedure InitializeWidget; override;
328 property Orientation: TProgressBarOrientation read GetOrientation write SetOrientation;
329 property Position: Integer read GetPosition write SetPosition;
330 property ShowText: Boolean read GetShowText write SetShowText;
331 property Style: TProgressBarStyle read GetStyle write SetStyle;
332 end;
333
334 { TGtk3Calendar }
335
336 TGtk3Calendar = class(TGtk3Widget)
337 protected
CreateWidgetnull338 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
339 public
340 procedure GetDate(out AYear, AMonth, ADay: Word);
341 procedure SetDate(const AYear, AMonth, ADay: Word);
342 procedure SetDisplayOptions(const ADisplayOptions: TGtkCalendarDisplayOptions);
343 end;
344
345 { TGtk3StaticText }
346
347 TGtk3StaticText = class(TGtk3Widget)
348 private
GetAlignmentnull349 function GetAlignment: TAlignment;
GetStaticBorderStylenull350 function GetStaticBorderStyle: TStaticBorderStyle;
351 procedure SetAlignment(AValue: TAlignment);
352 procedure SetStaticBorderStyle(AValue: TStaticBorderStyle);
353 protected
getTextnull354 function getText: String; override;
355 procedure setText(const AValue: String); override;
CreateWidgetnull356 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
357 public
358 property Alignment: TAlignment read GetAlignment write SetAlignment;
359 property StaticBorderStyle: TStaticBorderStyle read GetStaticBorderStyle write SetStaticBorderStyle;
360 end;
361
362 { TGtk3Container }
363
364 TGtk3Container = class(TGtk3Widget)
365 public
366 procedure AddChild(AWidget: PGtkWidget; const ALeft, ATop: Integer); virtual;
367 end;
368
369 { TGtk3Page }
370
371 TGtk3Page = class(TGtk3Container)
372 private
373 FPageLabel: PGtkLabel;
374 protected
375 procedure setText(const AValue: String); override;
getTextnull376 function getText: String; override;
CreateWidgetnull377 function CreateWidget(const Params: TCreateParams):PGtkWidget; override;
378 procedure DestroyWidget; override;
379 public
getClientOffsetnull380 function getClientOffset:TPoint;override;
getClientRectnull381 function getClientRect: TRect; override;
382 end;
383
384 { TGtk3NoteBook }
385
386 TGtk3NoteBook = class (TGtk3Container)
387 protected
CreateWidgetnull388 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
389 public
390 procedure InitializeWidget;override;
getClientRectnull391 function getClientRect: TRect; override;
getPagesCountnull392 function getPagesCount: integer;
393 procedure InsertPage(ACustomPage: TCustomPage; AIndex: Integer);
394 procedure MovePage(ACustomPage: TCustomPage; ANewIndex: Integer);
395 procedure RemovePage(AIndex: Integer);
396 procedure SetPageIndex(AIndex: Integer);
397 procedure SetShowTabs(const AShowTabs: Boolean);
398 procedure SetTabPosition(const ATabPosition: TTabPosition);
399 procedure SetTabLabelText(AChild: TCustomPage; const AText: String);
GetTabLabelTextnull400 function GetTabLabelText(AChild: TCustomPage): String;
401 end;
402
403 { TGtk3Bin }
404
405 TGtk3Bin = class(TGtk3Container)
406
407 end;
408
409
410 { TGtk3Paned }
411
412 TGtk3Paned = class(TGtk3Container)
413 protected
CreateWidgetnull414 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
415 end;
416
417 { TGtk3SplitterSide }
418
419 TGtk3SplitterSide = class(TGtk3Container)
420 protected
CreateWidgetnull421 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
422 end;
423
424
425 { TGtk3MenuShell }
426
427 TGtk3MenuShell = class(TGtk3Container)
428 public
429 MenuObject: TMenu;
430 constructor Create(const AMenu: TMenu; AMenuBar: PGtkMenuBar); virtual; overload;
431 procedure Insert(AMenuShell: PGtkMenuShell; APosition: Integer);
432 procedure InitializeWidget; override;
433 end;
434
435 { TGtk3MenuBar }
436
437 TGtk3MenuBar = class(TGtk3MenuShell)
438 protected
CreateWidgetnull439 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
440 end;
441
442 { TGtk3Menu }
443
444 TGtk3Menu = class(TGtk3MenuShell)
445 protected
CreateWidgetnull446 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
447 public
448 PopupPoint: TPoint;
449 constructor CreateFromMenuItem(const AMenuItem: TMenuItem); virtual; overload;
450 end;
451
452 { TGtk3MenuItem }
453
454 TGtk3MenuItem = class(TGtk3Bin)
455 private
GetCaptionnull456 function GetCaption: string;
457 procedure SetCaption(const AValue: string);
458 protected
CreateWidgetnull459 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
460 public
461 Lock:integer;
462 MenuItem: TMenuItem;
463 constructor Create(const AMenuItem: TMenuItem); virtual; overload;
464 procedure InitializeWidget; override;
465 procedure SetCheck(ACheck:boolean);
466 property Caption: string read GetCaption write SetCaption;
467 end;
468
469 { TGtk3ScrollableWin }
470
471 TGtk3ScrollableWin = class(TGtk3Container)
472 private
473 FBorderStyle: TBorderStyle;
474 FScrollX: Integer;
475 FScrollY: Integer;
GetHScrollBarPolicynull476 function GetHScrollBarPolicy: TGtkPolicyType;
GetVScrollBarPolicynull477 function GetVScrollBarPolicy: TGtkPolicyType;
478 procedure SetBorderStyle(AValue: TBorderStyle);
479 procedure SetHScrollBarPolicy(AValue: TGtkPolicyType); virtual;
480 procedure SetVScrollBarPolicy(AValue: TGtkPolicyType); virtual;
481 public
482 procedure SetScrollBarsSignalHandlers;
getClientBoundsnull483 function getClientBounds: TRect; override;
getHorizontalScrollbarnull484 function getHorizontalScrollbar: PGtkScrollbar; virtual; abstract;
getVerticalScrollbarnull485 function getVerticalScrollbar: PGtkScrollbar; virtual; abstract;
getScrolledWindownull486 function getScrolledWindow: PGtkScrolledWindow; virtual; abstract;
487 property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle;
488 property HScrollBarPolicy: TGtkPolicyType read GetHScrollBarPolicy write SetHScrollBarPolicy;
489 property VScrollBarPolicy: TGtkPolicyType read GetVScrollBarPolicy write SetVScrollBarPolicy;
490 property ScrollX: Integer read FScrollX write FScrollX;
491 property ScrollY: Integer read FScrollY write FScrollY;
492 end;
493
494 { TGtk3ToolBar }
495
496 TGtk3ToolBar = class(TGtk3Container)
497 private
498 fBmpList:TList;
499 procedure ButtonClicked(data: gPointer); cdecl;
500 procedure ClearGlyphs;
501 public
502 destructor Destroy;override;
CreateWidgetnull503 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
504 end;
505
506 { TGtk3Memo }
507
508 TGtk3Memo = class(TGtk3ScrollableWin)
509 private
GetAlignmentnull510 function GetAlignment: TAlignment;
GetReadOnlynull511 function GetReadOnly: Boolean;
GetWantTabsnull512 function GetWantTabs: Boolean;
GetWordWrapnull513 function GetWordWrap: Boolean;
514 procedure SetAlignment(AValue: TAlignment);
515 procedure SetReadOnly(AValue: Boolean);
516 procedure SetWantTabs(AValue: Boolean);
517 procedure SetWordWrap(AValue: Boolean);
518 protected
getTextnull519 function getText: String; override;
520 procedure setText(const AValue: String); override;
CreateWidgetnull521 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
EatArrowKeysnull522 function EatArrowKeys(const {%H-}AKey: Word): Boolean; override;
523 public
getHorizontalScrollbarnull524 function getHorizontalScrollbar: PGtkScrollbar; override;
getVerticalScrollbarnull525 function getVerticalScrollbar: PGtkScrollbar; override;
GetScrolledWindownull526 function GetScrolledWindow: PGtkScrolledWindow; override;
527 public
528 property Alignment: TAlignment read GetAlignment write SetAlignment;
529 property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
530 property WantTabs: Boolean read GetWantTabs write SetWantTabs;
531 property WordWrap: Boolean read GetWordWrap write SetWordWrap;
532 end;
533
534 { TGtk3ListBox }
535
536 TGtk3ListBox = class(TGtk3ScrollableWin)
537 private
538 FListBoxStyle: TListBoxStyle;
GetItemIndexnull539 function GetItemIndex: Integer;
GetMultiSelectnull540 function GetMultiSelect: Boolean;
541 procedure SetItemIndex(AValue: Integer);
542 procedure SetListBoxStyle(AValue: TListBoxStyle);
543 procedure SetMultiSelect(AValue: Boolean);
544 protected
CreateWidgetnull545 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
EatArrowKeysnull546 function EatArrowKeys(const {%H-}AKey: Word): Boolean; override;
547 public
548 procedure InitializeWidget; override;
getHorizontalScrollbarnull549 function getHorizontalScrollbar: PGtkScrollbar; override;
getVerticalScrollbarnull550 function getVerticalScrollbar: PGtkScrollbar; override;
GetScrolledWindownull551 function GetScrolledWindow: PGtkScrolledWindow; override;
552 public
GetSelCountnull553 function GetSelCount: Integer;
GetSelectionnull554 function GetSelection: PGtkTreeSelection;
GetItemSelectednull555 function GetItemSelected(const AIndex: Integer): Boolean;
556 procedure SelectItem(const AIndex: Integer; ASelected: Boolean);
557 procedure SetTopIndex(const AIndex: Integer);
558 property ItemIndex: Integer read GetItemIndex write SetItemIndex;
559 property MultiSelect: Boolean read GetMultiSelect write SetMultiSelect;
560 property ListBoxStyle: TListBoxStyle read FListBoxStyle write SetListBoxStyle;
561 end;
562
563 { TGtk3CheckListBox }
564
565 TGtk3CheckListBox = class(TGtk3ListBox)
566 protected
CreateWidgetnull567 function CreateWidget(const {%H-}Params: TCreateParams): PGtkWidget; override;
568 end;
569
570 { TGtk3ListView }
571
572 TGtk3ListView = class(TGtk3ScrollableWin)
573 private
574 FPreselectedIndices: TFPList;
575 FImages: TFPList;
576 FIsTreeView: Boolean;
577 protected
CreateWidgetnull578 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
EatArrowKeysnull579 function EatArrowKeys(const {%H-}AKey: Word): Boolean; override;
selection_changednull580 class function selection_changed(ctl:TGtk3ListView):gboolean;cdecl;
581 public
582 destructor Destroy; override;
583 {interface implementation}
getHorizontalScrollbarnull584 function getHorizontalScrollbar: PGtkScrollbar; override;
getVerticalScrollbarnull585 function getVerticalScrollbar: PGtkScrollbar; override;
GetScrolledWindownull586 function GetScrolledWindow: PGtkScrolledWindow; override;
587 procedure ClearImages;
588 procedure ColumnDelete(AIndex: Integer);
ColumnGetWidthnull589 function ColumnGetWidth(AIndex: Integer): Integer;
590 procedure ColumnInsert(AIndex: Integer; AColumn: TListColumn);
591 procedure SetAlignment(AIndex: Integer; {%H-}AColumn: TListColumn; AAlignment: TAlignment);
592 procedure SetColumnAutoSize(AIndex: Integer; {%H-}AColumn: TListColumn; AAutoSize: Boolean);
593 procedure SetColumnCaption(AIndex: Integer; {%H-}AColumn: TListColumn; const ACaption: String);
594 procedure SetColumnMaxWidth(AIndex: Integer; {%H-}AColumn: TListColumn; AMaxWidth: Integer);
595 procedure SetColumnMinWidth(AIndex: Integer; {%H-}AColumn: TListColumn; AMinWidth: Integer);
596 procedure SetColumnWidth(AIndex: Integer; {%H-}AColumn: TListColumn; AWidth: Integer);
597 procedure SetColumnVisible(AIndex: Integer; {%H-}AColumn: TListColumn; AVisible: Boolean);
598 procedure ColumnSetSortIndicator(const AIndex: Integer; const {%H-}AColumn: TListColumn; const ASortIndicator: TSortIndicator);
599
600 procedure UpdateItem(AIndex:integer;AItem: TListItem);
601 procedure ItemDelete(AIndex: Integer);
602 procedure ItemInsert(AIndex: Integer; AItem: TListItem);
603 procedure ItemSetText(AIndex, ASubIndex: Integer; AItem: TListItem; const AText: String);
604 procedure ItemSetImage(AIndex, ASubIndex: Integer; AItem: TListItem);
605 procedure ItemSetState(const AIndex: Integer; const {%H-}AItem: TListItem; const AState: TListItemState;
606 const AIsSet: Boolean);
ItemGetStatenull607 function ItemGetState(const AIndex: Integer; const {%H-}AItem: TListItem; const AState: TListItemState;
608 out AIsSet: Boolean): Boolean;
609
610 procedure UpdateImageCellsSize;
611
612 property Images: TFPList read FImages write FImages;
613 property IsTreeView: Boolean read FIsTreeView;
614 end;
615
616 { TGtk3Box }
617
618 TGtk3Box = class(TGtk3Container)
619
620 end;
621
622 { TGtk3StatusBar }
623
624 TGtk3StatusBar = class(TGtk3Box)
625 protected
CreateWidgetnull626 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
627 end;
628
629 { TGtk3Panel }
630
631 TGtk3Panel = class(TGtk3Bin)
632 private
633 FBorderStyle: TBorderStyle;
634 protected
635 procedure SetColor(AValue: TColor); override;
CreateWidgetnull636 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
637 procedure DoBeforeLCLPaint; override;
638 procedure setText(const AValue: String); override;
639 public
640 property BorderStyle: TBorderStyle read FBorderStyle write FBorderStyle;
641 end;
642
643 { TGtk3GroupBox }
644
645 TGtk3GroupBox = class(TGtk3Bin)
646 protected
CreateWidgetnull647 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
getTextnull648 function getText: String; override;
649 procedure setText(const AValue: String); override;
650 public
651 end;
652
653 { TGtk3ComboBox }
654
655 TGtk3ComboBox = class(TGtk3Bin)
656 private
657 FCellView: PGtkCellView;
GetItemIndexnull658 function GetItemIndex: Integer;
659 procedure SetDroppedDown(AValue: boolean);
660 procedure SetItemIndex(AValue: Integer);
GetDroppedDownnull661 function GetDroppedDown: boolean;
662 protected
CreateWidgetnull663 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
EatArrowKeysnull664 function EatArrowKeys(const AKey: Word): Boolean; override;
getTextnull665 function getText: String; override;
666 procedure setText(const AValue: String); override;
667 public
668 procedure DumpPrivateStructValues(const ADbgEvent: String);
669 public
CanFocusnull670 function CanFocus: Boolean; override;
671 procedure SetFocus; override;
GetCellViewnull672 function GetCellView: PGtkCellView;
GetPopupWidgetnull673 function GetPopupWidget: PGtkWidget;
GetButtonWidgetnull674 function GetButtonWidget: PGtkWidget;
GetCellViewFramenull675 function GetCellViewFrame: PGtkWidget;
676 procedure InitializeWidget; override;
677 property DroppedDown: boolean read GetDroppedDown write SetDroppedDown;
678 property ItemIndex: Integer read GetItemIndex write SetItemIndex;
679 end;
680
681 { TGtk3Button }
682
683 TGtk3Button = class(TGtk3Bin)
684 private
685 FMargin: Integer;
686 FLayout: Integer;
687 FSpacing: Integer;
688 FImage: TBitmap;
getLayoutnull689 function getLayout: Integer;
getMarginnull690 function getMargin: Integer;
691 procedure SetLayout(AValue: Integer);
692 procedure SetMargin(AValue: Integer);
693 procedure SetSpacing(AValue: Integer);
694 protected
695 procedure ButtonClicked(pData:pointer);cdecl;
696 procedure SetImage(AImage:TBitmap);
getTextnull697 function getText: String; override;
698 procedure setText(const AValue: String); override;
CreateWidgetnull699 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
700 public
701 destructor Destroy;override;
IsWidgetOknull702 function IsWidgetOk: Boolean; override;
703 procedure SetDefault(const ADefault: Boolean);
704 property Layout: Integer read getLayout write SetLayout;
705 property Margin: Integer read getMargin write SetMargin;
706 property Spacing: Integer read FSpacing write SetSpacing;
707 property Image:TBitmap read fImage write SetImage;
708 end;
709
710 { TGtk3ToggleButton }
711
712 TGtk3ToggleButton = class(TGtk3Button)
713 protected
CreateWidgetnull714 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
715 public
716 procedure InitializeWidget; override;
717 end;
718
719 { TGtk3CheckBox }
720
721 TGtk3CheckBox = class(TGtk3ToggleButton)
722 private
GetStatenull723 function GetState: TCheckBoxState;
724 procedure SetState(AValue: TCheckBoxState);
725 protected
CreateWidgetnull726 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
727 public
728 property State: TCheckBoxState read GetState write SetState;
729 end;
730
731 { TGtk3RadioButton }
732
733 TGtk3RadioButton = class(TGtk3CheckBox)
734 private
735 protected
CreateWidgetnull736 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
737 public
738 procedure InitializeWidget; override;
739 end;
740
741 { TGtk3CustomControl }
742
743 TGtk3CustomControl = class(TGtk3ScrollableWin)
744 private
745 protected
CreateWidgetnull746 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
EatArrowKeysnull747 function EatArrowKeys(const {%H-}AKey: Word): Boolean; override;
748 public
749 procedure InitializeWidget; override;
getClientRectnull750 function getClientRect: TRect; override;
getHorizontalScrollbarnull751 function getHorizontalScrollbar: PGtkScrollbar; override;
getVerticalScrollbarnull752 function getVerticalScrollbar: PGtkScrollbar; override;
GetScrolledWindownull753 function GetScrolledWindow: PGtkScrolledWindow; override;
754 end;
755
756 { TGtk3ScrollingWinControl }
757
758 TGtk3ScrollingWinControl = class(TGtk3CustomControl)
759 protected
CreateWidgetnull760 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
761 end;
762
763 { TGtk3Splitter }
764
765 TGtk3Splitter = class(TGtk3Panel)
766 public
767 end;
768
769
770 { TGtk3Window }
771
772 TGtk3Window = class(TGtk3ScrollableWin) {we are TGtk3Bin actually, but it won't hurt since we need scroll}
773 private
774 FIcon: PGdkPixBuf;
775 FScrollWin: PGtkScrolledWindow;
776 FMenuBar: PGtkMenuBar;
777 FBox: PGtkBox;
GetSkipTaskBarHintnull778 function GetSkipTaskBarHint: Boolean;
GetTitlenull779 function GetTitle: String;
780 procedure SetIcon(AValue: PGdkPixBuf);
781 procedure SetSkipTaskBarHint(AValue: Boolean);
782 procedure SetTitle(const AValue: String);
783 protected
CreateWidgetnull784 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
EatArrowKeysnull785 function EatArrowKeys(const {%H-}AKey: Word): Boolean; override;
getTextnull786 function getText: String; override;
787 procedure setText(const AValue: String); override;
788 public
getClientBoundsnull789 // function getClientBounds: TRect; override;
790 function getClientRect: TRect; override;
getHorizontalScrollbarnull791 function getHorizontalScrollbar: PGtkScrollbar; override;
getVerticalScrollbarnull792 function getVerticalScrollbar: PGtkScrollbar; override;
GetScrolledWindownull793 function GetScrolledWindow: PGtkScrolledWindow; override;
ShowStatenull794 function ShowState(nstate:integer):boolean; // winapi ShowWindow
795 procedure UpdateWindowState; // LCL WindowState
decoration_flagsnull796 class function decoration_flags(Aform: TCustomForm): longint;
797 public
798 procedure SetBounds(ALeft,ATop,AWidth,AHeight:integer);override;
799 destructor Destroy; override;
800 procedure Activate; override;
801 procedure Gtk3ActivateWindow(AEvent: PGdkEvent);
Gtk3CloseQuerynull802 function Gtk3CloseQuery: Boolean;
GetWindownull803 function GetWindow: PGdkWindow; override;
GetMenuBarnull804 function GetMenuBar: PGtkMenuBar;
GetBoxnull805 function GetBox: PGtkBox;
GetWindowStatenull806 function GetWindowState: TGdkWindowState;
807 property Icon: PGdkPixBuf read FIcon write SetIcon;
808 property SkipTaskBarHint: Boolean read GetSkipTaskBarHint write SetSkipTaskBarHint;
809 property Title: String read GetTitle write SetTitle;
810 end;
811
812 { TGtk3HintWindow }
813
814 TGtk3HintWindow = class(TGtk3Window)
815 private
816 protected
CreateWidgetnull817 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
818 end;
819
820 { TGtk3Dialog }
821
822 TGtk3Dialog = class(TGtk3Widget)
823 private
CloseCBnull824 class function CloseCB(dlg:TGtk3Dialog): GBoolean; cdecl;
CloseQueryCBnull825 class function CloseQueryCB(w:PGtkWidget;dlg:TGtk3Dialog): GBoolean; cdecl;
DestroyCBnull826 class function DestroyCB(dlg:TGtk3Dialog): GBoolean; cdecl;
ResponseCBnull827 class function ResponseCB(response_id:gint; dlg: TGtk3Dialog): GBoolean; cdecl;
RealizeCBnull828 class function RealizeCB(dlg:TGtk3Dialog): GBoolean; cdecl;
829 protected
response_handlernull830 function response_handler(response_id:gint):boolean;virtual;
close_handlernull831 function close_handler():boolean;virtual;
832 procedure SetCallbacks;virtual;
CreateWidgetnull833 function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
834 public
835 CommonDialog: TCommonDialog;
836 procedure InitializeWidget; override;
837 procedure CloseDialog;virtual;
838 end;
839
840 { TGtk3FileDialog }
841
842 TGtk3FileDialog = class(TGtk3Dialog)
843 private
844 protected
CreateWidgetnull845 function CreateWidget(const {%H-}Params: TCreateParams): PGtkWidget; override;
846 public
847 constructor Create(const ACommonDialog: TCommonDialog); virtual; overload;
848 end;
849
850 { TGtk3FontSelectionDialog }
851
852 TGtk3FontSelectionDialog = class(TGtk3Dialog)
853 protected
response_handlernull854 function response_handler(resp_id:gint):boolean; override;
855 public
856 procedure InitializeWidget; override;
857 constructor Create(const ACommonDialog: TCommonDialog); virtual; overload;
858 end;
859
860 { TGtk3ColorSelectionDialog }
861
862 TGtk3ColorSelectionDialog = class(TGtk3Dialog)
863 public
864 procedure InitializeWidget; override;
865 constructor Create(const ACommonDialog: TCommonDialog); virtual; overload;
866 end;
867
868 { TGtk3newColorSelectionDialog }
869
870 TGtk3newColorSelectionDialog = class(TGtk3Dialog)
871 protected
response_handlernull872 function response_handler(resp_id:gint):boolean;override;
873 public
874 constructor Create(const ACommonDialog: TCommonDialog); virtual; overload;
875 procedure InitializeWidget;override;
876 class procedure color_to_rgba(clr:TColor;out rgba:TgdkRGBA);
rgba_to_colornull877 class function rgba_to_color(const rgba:TgdkRGBA):TColor;
878 end;
879
880 { TGtk3GLArea }
881 TGtk3GLArea = class(TGtk3Widget)
882 protected
CreateWidgetnull883 function CreateWidget(const {%H-}Params: TCreateParams): PGtkWidget; override;
884 public
885 procedure Update({%H-}ARect: PRect); override;
886 end;
887
888
889
890 {main event filter for all widgets, also called from widgetset main eventfilter}
Gtk3WidgetEventnull891 function Gtk3WidgetEvent(widget: PGtkWidget; event: PGdkEvent; data: GPointer): gboolean; cdecl;
892
893 implementation
894
895 uses gtk3int,imglist,lclproc;
896
897 const
898 GDK_DEFAULT_EVENTS_MASK: TGdkEventMask =
899 2 + //GDK_EXPOSURE_MASK
900 4 + //GDK_POINTER_MOTION_MASK
901 8 + //GDK_POINTER_MOTION_HINT_MASK
902 16 + //GDK_BUTTON_MOTION_MASK
903 32 + //GDK_BUTTON1_MOTION_MASK
904 64 + //GDK_BUTTON2_MOTION_MASK
905 128 + //GDK_BUTTON3_MOTION_MASK
906 256 + //GDK_BUTTON_PRESS_MASK
907 512 + //GDK_BUTTON_RELEASE_MASK
908 1024 + //GDK_KEY_PRESS_MASK
909 2048 + //GDK_KEY_RELEASE_MASK
910 4096 + //GDK_ENTER_NOTIFY_MASK
911 8192 + //GDK_LEAVE_NOTIFY_MASK
912 16384 + //GDK_FOCUS_CHANGE_MASK
913 32768 + //GDK_STRUCTURE_MASK
914 65536 + //GDK_PROPERTY_CHANGE_MASK
915 131072 + //GDK_VISIBILITY_NOTIFY_MASK
916 262144 + //GDK_PROXIMITY_IN_MASK
917 524288 + //GDK_PROXIMITY_OUT_MASK
918 1048576 + //GDK_SUBSTRUCTURE_MASK
919 2097152 + //GDK_SCROLL_MASK
920 4194304; //GDK_TOUCH_MASK
921 // 8388608 //GDK_SMOOTH_SCROLL_MASK: there is a bug in GTK3, see https://stackoverflow.com/questions/11775161/gtk3-get-mouse-scroll-direction
922
Gtk3EventToStrnull923 function Gtk3EventToStr(AEvent: TGdkEventType): String;
924 begin
925 Result := 'GDK_NOTHING';
926 case AEvent of
927 GDK_DELETE: Result := 'GDK_DELETE';
928 GDK_DESTROY: Result := 'GDK_DESTROY';
929 GDK_EXPOSE: Result := 'GDK_EXPOSE';
930 GDK_MOTION_NOTIFY: Result := 'GDK_MOTION_NOTIFY';
931 GDK_BUTTON_PRESS: Result := 'GDK_BUTTON_PRESS';
932 GDK_2BUTTON_PRESS: Result := 'GDK_2BUTTON_PRESS';
933 GDK_3BUTTON_PRESS: Result := 'GDK_3BUTTON_PRESS';
934 GDK_BUTTON_RELEASE: Result := 'GDK_BUTTON_RELEASE';
935 GDK_KEY_PRESS: Result := 'GDK_KEY_PRESS';
936 GDK_KEY_RELEASE: Result := 'GDK_KEY_RELEASE';
937 GDK_ENTER_NOTIFY: Result := 'GDK_ENTER_NOTIFY';
938 GDK_LEAVE_NOTIFY: Result := 'GDK_LEAVE_NOTIFY';
939 GDK_FOCUS_CHANGE: Result := 'GDK_FOCUS_CHANGE';
940 GDK_CONFIGURE: Result := 'GDK_CONFIGURE';
941 GDK_MAP: Result := 'GDK_MAP';
942 GDK_UNMAP: Result := 'GDK_UNMAP';
943 GDK_PROPERTY_NOTIFY: Result := 'GDK_PROPERTY_NOTIFY';
944 GDK_SELECTION_CLEAR: Result := 'GDK_SELECTION_CLEAR';
945 GDK_SELECTION_REQUEST: Result := 'GDK_SELECTION_REQUEST';
946 GDK_SELECTION_NOTIFY: Result := 'GDK_SELECTION_NOTIFY';
947 GDK_PROXIMITY_IN: Result := 'GDK_PROXIMITY_IN';
948 GDK_PROXIMITY_OUT: Result := 'GDK_PROXIMITY_OUT';
949 GDK_DRAG_ENTER: Result := 'GDK_DRAG_ENTER';
950 GDK_DRAG_LEAVE: Result := 'GDK_DRAG_LEAVE';
951 GDK_DRAG_MOTION_: Result := 'GDK_DRAG_MOTION_';
952 GDK_DRAG_STATUS_: Result := 'GDK_DRAG_STATUS_';
953 GDK_DROP_START: Result := 'GDK_DROP_START';
954 GDK_DROP_FINISHED: Result := 'GDK_DROP_FINISHED';
955 GDK_CLIENT_EVENT: Result := 'GDK_CLIENT_EVENT';
956 GDK_VISIBILITY_NOTIFY: Result := 'GDK_VISIBILITY_NOTIFY';
957 GDK_SCROLL: Result := 'GDK_SCROLL';
958 GDK_WINDOW_STATE: Result := 'GDK_WINDOW_STATE';
959 GDK_SETTING: Result := 'GDK_SETTING';
960 GDK_OWNER_CHANGE: Result := 'GDK_OWNER_CHANGE';
961 GDK_GRAB_BROKEN: Result := 'GDK_GRAB_BROKEN';
962 GDK_DAMAGE: Result := 'GDK_DAMAGE';
963 GDK_TOUCH_BEGIN: Result := 'GDK_TOUCH_BEGIN';
964 GDK_TOUCH_UPDATE: Result := 'GDK_TOUCH_UPDATE';
965 GDK_TOUCH_END: Result := 'GDK_TOUCH_END';
966 GDK_TOUCH_CANCEL: Result := 'GDK_TOUCH_CANCEL';
967 GDK_EVENT_LAST: Result := 'GDK_EVENT_LAST';
968 end;
969 end;
970
Gtk3MenuItemEventnull971 function Gtk3MenuItemEvent({%H-}widget: PGtkWidget; event: PGdkEvent; {%H-}data: GPointer): gboolean; cdecl;
972 begin
973 Result := False;
974
975 if not Assigned(Application) or (Assigned(Application) and Application.Terminated) then
976 exit;
977
978 // DebugLn('Gtk3MenuItemEvent triggered ',dbgsName(TGtk3MenuItem(Data).MenuItem),
979 // ' ',Gtk3EventToStr(event^.type_));
980
981 case event^.type_ of
982 GDK_DELETE:
983 begin
984 // DebugLn('****** GDK_DELETE FOR ',dbgsName(TGtk3Widget(Data).LCLObject),' main_level=',dbgs(gtk_main_level));
985 end;
986 GDK_DESTROY:
987 begin
988 // DebugLn('****** GDK_DESTROY FOR ' + dbgsName(TGtk3Widget(Data).LCLObject));
989 end;
990 GDK_EXPOSE:
991 begin
992 // DebugLn('****** GDK_EXPOSE FOR ' + dbgsName(TGtk3Widget(Data).LCLObject));
993 // Gtk3DrawWidget is attached to 'draw' signal, Expose event doesn't trigger
994 // under gtk3.
995 // we use 'draw' signal Gtk3DrawEvent()
996 // Result := TGtk3Widget(Data).GtkEventPaint(Widget, Event);
997 end;
998 GDK_MOTION_NOTIFY:
999 begin
1000 // Result := TGtk3Widget(Data).GtkEventMouseMove(Widget, Event);
1001 end;
1002 GDK_BUTTON_PRESS:
1003 begin
1004 // Result := TGtk3Widget(Data).GtkEventMouse(Widget , Event);
1005 end;
1006 GDK_2BUTTON_PRESS:
1007 begin
1008 // if not TGtk3Widget(Data).LCLObject.Focused and TGtk3Widget(Data).LCLObject.CanFocus then
1009 // LCLIntf.SetFocus(HWND(TGtk3Widget(Data)));
1010 // Result := TGtk3Widget(Data).GtkEventMouse(Widget , Event);
1011 end;
1012 GDK_3BUTTON_PRESS:
1013 begin
1014 // if not TGtk3Widget(Data).LCLObject.Focused and TGtk3Widget(Data).LCLObject.CanFocus then
1015 // LCLIntf.SetFocus(HWND(TGtk3Widget(Data)));
1016 // Result := TGtk3Widget(Data).GtkEventMouse(Widget , Event);
1017 end;
1018 GDK_BUTTON_RELEASE:
1019 begin
1020 // Result := TGtk3Widget(Data).GtkEventMouse(Widget , Event);
1021 end;
1022 GDK_KEY_PRESS:
1023 begin
1024 // if Widget^.has_focus then // or (Widget = TGtk3Widget(data).GetContainerWidget) then
1025 // Result := TGtk3Widget(Data).GtkEventKey(Widget, Event, True);
1026 end;
1027 GDK_KEY_RELEASE:
1028 begin
1029 // if Widget^.has_focus then // or (Widget = TGtk3Widget(data).GetContainerWidget) then
1030 // Result := TGtk3Widget(Data).GtkEventKey(Widget, Event, False);
1031 end;
1032
1033 GDK_ENTER_NOTIFY:
1034 begin
1035 // TGtk3Widget(Data).GtkEventMouseEnterLeave(Widget, Event);
1036 end;
1037 GDK_LEAVE_NOTIFY:
1038 begin
1039 // TGtk3Widget(Data).GtkEventMouseEnterLeave(Widget, Event);
1040 end;
1041 GDK_FOCUS_CHANGE:
1042 begin
1043 //
1044 end;
1045 GDK_CONFIGURE:
1046 begin
1047 // GDK_CONFIGURE
1048 end;
1049 GDK_MAP:
1050 begin
1051 // DebugLn('****** GDK_MAP FOR ',dbgsName(TGtk3Widget(Data).LCLObject));
1052 end;
1053 GDK_PROPERTY_NOTIFY:
1054 begin
1055 // DebugLn('****** GDK_PROPERTY_NOTIFY FOR ',dbgsName(TGtk3Widget(Data).LCLObject));
1056 end;
1057 GDK_CLIENT_EVENT:
1058 begin
1059 // DebugLn('****** GDK_CLIENT_EVENT FOR ',dbgsName(TGtk3Widget(Data).LCLObject));
1060 end;
1061 GDK_VISIBILITY_NOTIFY:
1062 begin
1063 // Result := TGtk3Widget(Data).GtkEventShowHide(Widget, Event);
1064 // DebugLn('****** GDK_VISIBILITY_NOTIFY FOR ' + dbgsName(TGtk3Widget(Data).LCLObject));
1065 end;
1066 GDK_SCROLL:
1067 begin
1068 // DebugLn('****** GDK_SCROLL ' + dbgsName(TGtk3Widget(Data).LCLObject));
1069 end;
1070 end;
1071 end;
1072
1073 const act_count:integer=0;
1074
1075 function Gtk3WidgetEvent(widget: PGtkWidget; event: PGdkEvent; data: GPointer): gboolean; cdecl;
1076 begin
1077 {$IFDEF GTK3DEBUGCOMBOBOX}
1078 if (Data <> nil) and (wtComboBox in TGtk3Widget(Data).WidgetType) and
1079 (event^.type_ <> GDK_MOTION_NOTIFY) then
1080 begin
1081 if (Widget = TGtk3ComboBox(Data).GetPopupWidget) then
1082 DebugLn('***** Gtk3WidgetEvent(MENU triggered ',dbgsName(TGtk3Widget(Data).LCLObject),
1083 ' ',Gtk3EventToStr(event^.type_))
1084 else
1085 if (Widget = TGtk3ComboBox(Data).GetButtonWidget) then
1086 DebugLn('***** Gtk3WidgetEvent(BUTTON triggered ',dbgsName(TGtk3Widget(Data).LCLObject),
1087 ' ',Gtk3EventToStr(event^.type_))
1088 else
1089 if (Widget = PGtkWidget(TGtk3ComboBox(Data).GetCellView)) then
1090 DebugLn('***** Gtk3WidgetEvent(CELLVIEW triggered ',dbgsName(TGtk3Widget(Data).LCLObject),
1091 ' ',Gtk3EventToStr(event^.type_))
1092 else
1093 if (Widget = TGtk3ComboBox(Data).Widget) then
1094 DebugLn('***** Gtk3WidgetEvent(EVENTBOX triggered ',dbgsName(TGtk3Widget(Data).LCLObject),
1095 ' ',Gtk3EventToStr(event^.type_));
1096 end;
1097 {$ENDIF}
1098 {$IFDEF GTK3DEBUGCORE}
1099 // if event^.type_ = GDK_EXPOSE then
1100 if event^.type_ <> GDK_MOTION_NOTIFY then
1101 DebugLn('Gtk3WidgetEvent triggered ',dbgsName(TGtk3Widget(Data).LCLObject),
1102 ' ',Gtk3EventToStr(event^.type_));
1103 {$ENDIF}
1104 Result := False;
1105 if Assigned(Application) and Application.Terminated then
1106 exit;
1107 case event^.type_ of
1108 GDK_DELETE:
1109 begin
1110 // DebugLn('****** GDK_DELETE FOR ',dbgsName(TGtk3Widget(Data).LCLObject),' main_level=',dbgs(gtk_main_level));
1111 if wtWindow in TGtk3Widget(Data).WidgetType then
1112 begin
1113 TGtk3Window(Data).Gtk3CloseQuery;
1114 // let lcl destroy widget
1115 Result := True;
1116 end;
1117 end;
1118 GDK_DESTROY:
1119 begin
1120 // DebugLn('****** GDK_DESTROY FOR ' + dbgsName(TGtk3Widget(Data).LCLObject));
1121 end;
1122 GDK_EXPOSE:
1123 begin
1124 DebugLn('****** GDK_EXPOSE FOR ' + dbgsName(TGtk3Widget(Data).LCLObject));
1125 // Gtk3DrawWidget is attached to 'draw' signal, Expose event doesn't trigger
1126 // under gtk3.
1127 // we use 'draw' signal Gtk3DrawEvent()
1128 // Result := TGtk3Widget(Data).GtkEventPaint(Widget, Event);
1129 end;
1130 GDK_MOTION_NOTIFY:
1131 begin
1132 if wtWindow in TGtk3Widget(Data).WidgetType then
1133 begin
1134 if Widget = TGtk3Widget(Data).Widget then
1135 exit;
1136 end;
1137 Result := TGtk3Widget(Data).GtkEventMouseMove(Widget, Event);
1138 end;
1139 GDK_BUTTON_PRESS:
1140 begin
1141 writeln('Press:',TGtk3Widget(Data).LCLObject.ClassName);
1142 // set focus before gtk does that, so we have same behaviour as other ws
1143 if TGtk3Widget(Data).GetFocusableByMouse and
1144 not TGtk3Widget(Data).LCLObject.Focused and
1145 TGtk3Widget(Data).LCLObject.CanFocus then
1146 begin
1147 //FIXME: combobox updates popup-shown property too late
1148 // so we dont know yet if its dropped down or not
1149 if (wtComboBox in TGtk3Widget(Data).WidgetType) then
1150 begin
1151 TGtk3ComboBox(Data).DumpPrivateStructValues('GDK_BUTTON_PRESS btn='+IntToStr(Event^.button.button));
1152 end;
1153 if (wtWindow in TGtk3Widget(Data).WidgetType) then
1154 begin
1155 TGtk3Widget(Data).Activate;
1156 end else
1157 LCLIntf.SetFocus(HWND(TGtk3Widget(Data)));
1158 end;
1159
1160 if TGtk3Widget(Data).LCLObject is TButtonControl then exit;
1161
1162
1163 Result:=TGtk3Widget(Data).GtkEventMouse(Widget , Event);
1164 end;
1165 GDK_2BUTTON_PRESS:
1166 begin
1167 // set focus before gtk does that, so we have same behaviour as other ws
1168 if TGtk3Widget(Data).GetFocusableByMouse and
1169 not TGtk3Widget(Data).LCLObject.Focused and
1170 TGtk3Widget(Data).LCLObject.CanFocus then
1171 LCLIntf.SetFocus(HWND(TGtk3Widget(Data)));
1172
1173 if TGtk3Widget(Data).LCLObject is TButtonControl then exit;
1174 Result := TGtk3Widget(Data).GtkEventMouse(Widget , Event);
1175 end;
1176 GDK_3BUTTON_PRESS:
1177 begin
1178 // set focus before gtk does that, so we have same behaviour as other ws
1179 if TGtk3Widget(Data).GetFocusableByMouse and
1180 not TGtk3Widget(Data).LCLObject.Focused and
1181 TGtk3Widget(Data).LCLObject.CanFocus then
1182 LCLIntf.SetFocus(HWND(TGtk3Widget(Data)));
1183
1184 if TGtk3Widget(Data).LCLObject is TButtonControl then exit;
1185
1186
1187 Result := TGtk3Widget(Data).GtkEventMouse(Widget , Event);
1188 end;
1189 GDK_BUTTON_RELEASE:
1190 begin
1191 writeln('Release:',TGtk3Widget(Data).LCLObject.ClassName);
1192 {if not ((csClickEvents in TGtk3Widget(Data).LCLObject.ControlStyle) and
1193 (csClicked in TGtk3Widget(Data).LCLObject.ControlState)) then }
1194
1195 if TGtk3Widget(Data).LCLObject is TButtonControl then exit;
1196
1197 Result := TGtk3Widget(Data).GtkEventMouse(Widget , Event);
1198 end;
1199 GDK_KEY_PRESS:
1200 begin
1201 if Widget^.has_focus then
1202 Result := TGtk3Widget(Data).GtkEventKey(Widget, Event, True);
1203 end;
1204 GDK_KEY_RELEASE:
1205 begin
1206 if Widget^.has_focus then // or (Widget = TGtk3Widget(data).GetContainerWidget) then
1207 Result := TGtk3Widget(Data).GtkEventKey(Widget, Event, False);
1208 end;
1209 GDK_ENTER_NOTIFY:
1210 begin
1211 if wtWindow in TGtk3Widget(Data).WidgetType then
1212 begin
1213 if Widget <> TGtk3Widget(Data).GetContainerWidget then
1214 exit;
1215 end;
1216 (*
1217 DebugLn('** ENTER_NOTIFY ',dbgs(Event^.crossing.send_event),' TIME ',dbgs(Event^.crossing.time),' MODE ',dbgs(Event^.crossing.mode),
1218 ' WIDGET ',dbgHex(PtrUInt(Widget)),' LCLObject ',dbgsName(TGtk3Widget(Data).LCLObject),
1219 ' Widget=?',dbgs(Widget=TGtk3Widget(Data).GetContainerWidget));
1220 *)
1221 (*
1222 if wtComboBox in TGtk3Widget(Data).WidgetType then
1223 begin
1224 // DebugLn('** ENTER_NOTIFY ',dbgs(Event^.crossing.send_event),' TIME ',dbgs(Event^.crossing.time),' MODE ',dbgs(Event^.crossing.mode),
1225 // ' ENTERLEAVETIME=',dbgs(TGtk3ComboBox(Data).FEnterLeaveTime),' WIDGET ',dbgHex(PtrUInt(Widget)));
1226 TGtk3ComboBox(Data).DumpPrivateStructValues('GDK_ENTER_NOTIFY');
1227 if Widget <> TGtk3Widget(Data).Widget then
1228 exit;
1229 // upisi u combobox enter time, ako je enter.time - leave.time < 20 onda ne salji msg !
1230 TGtk3ComboBox(Data).FEnterLeaveTime := Event^.crossing.time;
1231 end;
1232 *)
1233 TGtk3Widget(Data).GtkEventMouseEnterLeave(Widget, Event);
1234 end;
1235 GDK_LEAVE_NOTIFY:
1236 begin
1237 if wtWindow in TGtk3Widget(Data).WidgetType then
1238 begin
1239 if Widget <> TGtk3Widget(Data).GetContainerWidget then
1240 exit;
1241 end;
1242 (*
1243 DebugLn('** LEAVE_NOTIFY ',dbgs(Event^.crossing.send_event),' TIME ',dbgs(Event^.crossing.time),' MODE ',dbgs(Event^.crossing.mode),
1244 ' WIDGET ',dbgHex(PtrUInt(Widget)),' LCLObject ',dbgsName(TGtk3Widget(Data).LCLObject),
1245 ' Widget=?',dbgs(Widget=TGtk3Widget(Data).GetContainerWidget));
1246 *)
1247 (*
1248 if wtComboBox in TGtk3Widget(Data).WidgetType then
1249 begin
1250 // DebugLn('** LEAVE_NOTIFY ',dbgs(Event^.crossing.send_event),' TIME ',dbgs(Event^.crossing.time),' MODE ',dbgs(Event^.crossing.mode),
1251 // ' TIME DIFF=',dbgs(Event^.crossing.time - TGtk3ComboBox(Data).FEnterLeaveTime),
1252 // ' WIDGET ',dbgHex(PtrUInt(Widget)));
1253 if Widget <> TGtk3Widget(Data).Widget then
1254 exit;
1255 if Event^.crossing.time - TGtk3ComboBox(Data).FEnterLeaveTime < 100 then
1256 begin
1257 exit(False);
1258 end;
1259 end;
1260 *)
1261 TGtk3Widget(Data).GtkEventMouseEnterLeave(Widget, Event);
1262 end;
1263 GDK_FOCUS_CHANGE:
1264 begin
1265 if event^.focus_change.in_=1 then
1266 begin
1267 if act_count=0 then
1268 Application.IntfAppActivate();
1269 inc(act_count);
1270 end
1271 else
1272 begin
1273 if act_count>0 then
1274 Application.IntfAppDeactivate();
1275 dec(act_count);
1276 end;
1277
1278 if wtComboBox in TGtk3Widget(Data).WidgetType then
1279 begin
1280 TGtk3ComboBox(Data).DumpPrivateStructValues('GDK_FOCUS_CHANGE='+IntToStr(Event^.focus_change.in_));
1281 //FIXME: combobox updates popup-shown property too late
1282 // so we dont know yet if its dropped down or not
1283 if TGtk3ComboBox(Data).DroppedDown then
1284 exit;
1285 end;
1286 TGtk3Widget(Data).GtkEventFocus(Widget, Event);
1287 end;
1288 GDK_CONFIGURE:
1289 begin
1290 (* DOES NOT WORK AS DOCUMENTATION SAYS
1291 if Data <> nil then
1292 begin
1293 if wtWindow in TGtk3Widget(Data).WidgetType then
1294 begin
1295 TGtk3Window(Data).Gtk3ActivateWindow(Event);
1296 DebugLn('** WindowState event ',dbgsName(TGtk3Widget(Data).LCLObject),' windowState=',dbgs(TGtk3Window(Data).GetWindowState));
1297 end else
1298 DebugLn('** WindowState event not wtWindow ',dbgsName(TGtk3Widget(Data).LCLObject));
1299 end;
1300 *)
1301 Result := TGtk3Widget(Data).GtkEventResize(Widget, Event);
1302 end;
1303 GDK_MAP:
1304 begin
1305 // DebugLn('****** GDK_MAP FOR ',dbgsName(TGtk3Widget(Data).LCLObject));
1306 end;
1307 GDK_UNMAP:
1308 begin
1309 // DebugLn('****** GDK_UNMAP FOR ',dbgsName(TGtk3Widget(Data).LCLObject));
1310 end;
1311 GDK_PROPERTY_NOTIFY:
1312 begin
1313 // DebugLn('****** GDK_PROPERTY_NOTIFY FOR ',dbgsName(TGtk3Widget(Data).LCLObject));
1314 end;
1315 GDK_CLIENT_EVENT:
1316 begin
1317 // DebugLn('****** GDK_CLIENT_EVENT FOR ',dbgsName(TGtk3Widget(Data).LCLObject));
1318 end;
1319 GDK_VISIBILITY_NOTIFY:
1320 begin
1321 // ONLY HERE WE CAN CATCH Activate/Deactivate but problem is that
1322 // PGtkWindow does not update active property properly
1323 // so PGtkWindow(Widget)^.is_active returns TRUE even if window isn't active anymore
1324 if wtWindow in TGtk3Widget(Data).WidgetType then
1325 begin
1326 TGtk3Window(Data).Gtk3ActivateWindow(Event);
1327 end;
1328 // Result := TGtk3Widget(Data).GtkEventShowHide(Widget, Event);
1329 // DebugLn('****** GDK_VISIBILITY_NOTIFY FOR ' + dbgsName(TGtk3Widget(Data).LCLObject));
1330 end;
1331 GDK_SCROLL:
1332 begin
1333 // DebugLn('****** GDK_SCROLL ' + dbgsName(TGtk3Widget(Data).LCLObject));
1334 Result := TGtk3Widget(Data).GtkEventMouseWheel(Widget, Event);
1335 end;
1336 GDK_WINDOW_STATE:
1337 begin
1338 // DebugLn('****** GDK_WINDOW_STATE FOR ' + dbgsName(TGtk3Widget(Data).LCLObject));
1339 // this doesn't work as expected ... must use GDK_CONFIGURE to get active status ?!?
1340 end;
1341 GDK_GRAB_BROKEN: //could be broken eg. because of popupmenu
1342 begin
1343 DebugLn('****** GDK_GRAB_BROKEN (no problem if popupmenu is activated) ' + dbgsName(TGtk3Widget(Data).LCLObject));
1344 end;
1345 otherwise
1346 DebugLn('****** GDK unhandled event type ' + dbgsName(TGtk3Widget(Data).LCLObject));
1347 WriteLn(event^.type_);
1348
1349 end;
1350 end;
1351
Gtk3DrawWidgetnull1352 function Gtk3DrawWidget(AWidget: PGtkWidget; AContext: Pcairo_t; Data: gpointer): gboolean; cdecl;
1353 var
1354 ARect: TGdkRectangle;
1355 begin
1356 Result := False;
1357 if Data <> nil then
1358 begin
1359 gdk_cairo_get_clip_rectangle(AContext, @ARect);
1360 // DebugLn('**** Sending paint event to ',dbgsName(TGtk3Widget(Data).LCLObject),' clip ',dbgs(RectFromGdkRect(ARect)),' w=',dbgs(ARect.Width),' h=',dbgs(ARect.height));
1361 Result := TGtk3Widget(Data).GtkEventPaint(AWidget, AContext);
1362 // workaround for lcl painted widgets until we found why gtk3 sends wrong rect
1363 if (TGtk3Widget(Data).FHasPaint) and
1364 (ARect.height < (TGtk3Widget(Data).GetContainerWidget^.get_allocated_height div 4) ) then
1365 AWidget^.queue_draw;
1366 end;
1367 end;
1368
1369 procedure Gtk3MapWidget(AWidget: PGtkWidget; Data: gPointer); cdecl;
1370 var
1371 Allocation: TGtkAllocation;
1372 ARect: TRect;
1373 AWindow: PGdkWindow;
1374 xx,yy,w,h: Gint;
1375 begin
1376 AWidget^.get_allocation(@Allocation);
1377 {$IFDEF GTK3DEBUGCORE}
1378 DebugLn('**** Gtk3MapWidget ....',dbgsName(TGtk3Widget(Data).LCLObject));
1379 with Allocation do
1380 DebugLn(' Allocation ',Format('x %d y %d w %d h %d',[x,y,width,height]));
1381 {$ENDIF}
1382 ARect := TGtk3Widget(Data).LCLObject.BoundsRect;
1383 {$IFDEF GTK3DEBUGCORE}
1384 with ARect do
1385 DebugLn(' Rect ',Format('x %d y %d w %d h %d',[Left,Top,Right - Left, Bottom - Top]));
1386 {$ENDIF}
1387 if ARect.Left<ARect.Right then ;
1388
1389 AWindow := AWidget^.get_window;
1390 // at least TPanel needs this
1391 if Gtk3IsGdkWindow(AWindow) and (g_object_get_data(AWindow,'lclwidget') = nil) then
1392 g_object_set_data(AWindow,'lclwidget', TGtk3Widget(Data));
1393 if (AWindow <> nil) and AWidget^.get_has_window then
1394 begin
1395 // do resize to lcl size when mapping widget
1396 gdk_window_set_events(AWindow, GDK_DEFAULT_EVENTS_MASK);
1397 { if not (wtWindow in TGtk3Widget(Data).WidgetType) then
1398 begin }
1399 with TGtk3Widget(Data).LCLObject do
1400 begin
1401 xx := Left;
1402 yy := Top;
1403 w := Width;
1404 h := Height;
1405 end;
1406 TGtk3Widget(Data).BeginUpdate;
1407 AWindow^.move(xx, yy);
1408 AWindow^.resize(w, h);
1409 TGtk3Widget(Data).EndUpdate;
1410 { end else
1411 begin
1412 // DebugLn('TGtk3Window is mapped , setting lclwidget property to PGdkWindow ...');
1413 // now we set 'lclwidget' to our window.
1414 // g_object_set_data(AWindow,'lclwidget', TGtk3Widget(Data));
1415 end;}
1416 end else
1417 begin
1418 if wtMemo in TGtk3Widget(Data).WidgetType then
1419 begin
1420 // gdk_window_get_geometry(AWindow, @xx,@yy,@w,@h);
1421 // gdk_window_get_position(AWindow, @xx,@yy);
1422 // DebugLn(' ***** Window ',Format('x %d y %d w %d h %d',[xx,yy,w,h]),' lclobject ',dbgsName(TGtk3Widget(Data).LCLObject));
1423 end;
1424
1425 end;
1426 end;
1427
1428 procedure Gtk3SizeAllocate(AWidget: PGtkWidget; AGdkRect: PGdkRectangle; Data: gpointer); cdecl;
1429 var
1430 Msg: TLMSize;
1431 NewSize: TSize;
1432 ACtl: TGtk3Widget;
1433 AState:integer;
1434 begin
1435 if AWidget=nil then ;
1436 //TODO: Move to TGtk3Widget.GtkResizeEvent
1437 {$IFDEF GTK3DEBUGSIZE}
1438 with AGdkRect^ do
1439 DebugLn('**** Gtk3SizeAllocate **** ....',dbgsName(TGtk3Widget(Data).LCLObject),
1440 ' ',Format('x %d y %d w %d h %d',[x, y, width, height]));
1441 {$ENDIF}
1442
1443 ACtl := TGtk3Widget(Data);
1444
1445 // return size w/o frame
1446 NewSize.cx := AGdkRect^.width;
1447 NewSize.cy := AGdkRect^.height;
1448
1449 //writeln(format('Gkt3SizeAllocate w=%d h=%d',[NewSize.cx,NewSize.cy]));
1450
1451 if not Assigned(ACtl.LCLObject) then exit;
1452
1453 // do not loop with LCL but do not apply it to TQtMainWindow !
1454 if not (csDesigning in ACtl.LCLObject.ComponentState) then
1455 begin
1456 if ACtl.InUpdate then
1457 exit;
1458 // if not (ClassType = TQtMainWindow) and InUpdate then
1459 // exit;
1460 end;
1461
1462 if ((NewSize.cx <> ACtl.LCLObject.Width) or (NewSize.cy <> ACtl.LCLObject.Height) or
1463 ACtl.LCLObject.ClientRectNeedsInterfaceUpdate) then
1464 begin
1465 ACtl.LCLObject.DoAdjustClientRectChange;
1466 end;
1467
1468 FillChar(Msg{%H-}, SizeOf(Msg), #0);
1469
1470 Msg.Msg := LM_SIZE;
1471 Msg.SizeType := SIZE_RESTORED;
1472
1473 if ACtl is TGtk3Window then
1474 begin
1475 AState:=TGtk3Window(ACtl).getWindowState;
1476 if AState and GDK_WINDOW_STATE_ICONIFIED<>0 then
1477 Msg.SizeType := SIZE_MINIMIZED
1478 else
1479 if AState and GDK_WINDOW_STATE_MAXIMIZED<>0 then
1480 Msg.SizeType := SIZE_MAXIMIZED
1481 else
1482 if AState and GDK_WINDOW_STATE_FULLSCREEN<>0 then
1483 Msg.SizeType := SIZE_FULLSCREEN;
1484
1485 end;
1486
1487 Msg.SizeType := Msg.SizeType or Size_SourceIsInterface;
1488
1489 if ACtl.WidgetType*[wtEntry,wtComboBox,wtScrollBar,wtSpinEdit,wtHintWindow]<>[] then
1490 begin
1491 Msg.Width := ACtl.LCLObject.Width;//Word(NewSize.cx);
1492 Msg.Height := ACtl.LCLObject.Height;//Word(NewSize.cy);
1493 end else
1494 if {ACtl is TGtk3Window} ACtl.WidgetType*[wtWindow,wtDialog,wtGroupBox,
1495 {wtScrollingWinControl,}wtScrollingWin,wtNotebook,wtContainer]<>[] then
1496 begin
1497 Msg.Width := Word(NewSize.cx);
1498 Msg.Height := Word(NewSize.cy);
1499 end else
1500 begin
1501 Msg.Width := ACtl.LCLObject.Width;//Word(NewSize.cx);
1502 Msg.Height := ACtl.LCLObject.Height;//Word(NewSize.cy);
1503 end;
1504
1505 {if msg.Width=995 then
1506 writeln('Trap 995');}
1507
1508 ACtl.DeliverMessage(Msg);
1509
1510 (* if (wtWindow in ACtl.WidgetType) and
1511 ((AGdkRect^.x <> ACtl.LCLObject.Left) or (AGdkRect^.y <> ACtl.LCLObject.Top)) then
1512 begin
1513 FillChar(MoveMsg, SizeOf(MoveMsg), #0);
1514 MoveMsg.Msg := LM_MOVE;
1515 MoveMsg.MoveType := MoveMsg.MoveType or Move_SourceIsInterface;
1516 MoveMsg.XPos := SmallInt(AGdkRect^.x);
1517 MoveMsg.YPos := SmallInt(AGdkRect^.y);
1518 {$IFDEF GTK3DEBUGEVENTS}
1519 DebugLn('SEND MOVE MESSAGE X=',dbgs(AGdkRect^.x),' Y=',dbgs(AGdkRect^.y),' control ',dbgsName(ACtl.LCLObject));
1520 {$ENDIF}
1521 ACtl.DeliverMessage(MoveMsg);
1522 end; *)
1523 end;
1524
Gtk3ResizeEventnull1525 function Gtk3ResizeEvent(AWidget: PGtkWidget; AEvent: PGdkEvent; Data: gpointer): gboolean; cdecl;
1526 var
1527 ARect: TGdkRectangle;
1528 begin
1529 Result := False;
1530 ARect.X := AEvent^.configure.x;
1531 ARect.Y := AEvent^.configure.y;
1532 ARect.width := AEvent^.configure.width;
1533 ARect.height := AEvent^.configure.height;
1534 // DebugLn('**** Gtk3ResizeEvent(CONFIGURE) **** ....',dbgsName(TGtk3Widget(Data).LCLObject),' ARect ',dbgs(RectFromGdkRect(ARect)));
1535 Gtk3SizeAllocate(AWidget, @ARect, Data);
1536 end;
1537
1538 procedure Gtk3WidgetHide({%H-}AWidget: PGtkWidget; AData: gpointer); cdecl;
1539 var
1540 Msg: TLMShowWindow;
1541 Gtk3Widget: TGtk3Widget;
1542 begin
1543 Gtk3Widget := TGtk3Widget(AData);
1544 {do not pass message to LCL if LCL setted up control visibility}
1545 if Gtk3Widget.inUpdate then
1546 exit;
1547 // DebugLn('SEND LM_HIDE FOR ',dbgsName(Gtk3Widget.LCLObject));
1548 FillChar(Msg{%H-}, SizeOf(Msg), #0);
1549
1550 Msg.Msg := LM_SHOWWINDOW;
1551 Msg.Show := False;
1552
1553 Gtk3Widget.DeliverMessage(Msg);
1554 end;
1555
1556 procedure Gtk3WidgetShow({%H-}AWidget: PGtkWidget; AData: gpointer); cdecl;
1557 var
1558 Msg: TLMShowWindow;
1559 Gtk3Widget: TGtk3Widget;
1560 begin
1561 Gtk3Widget := TGtk3Widget(AData);
1562 {do not pass message to LCL if LCL setted up control visibility}
1563 if Gtk3Widget.inUpdate then
1564 exit;
1565 // DebugLn('SEND LM_SHOW FOR ',dbgsName(Gtk3Widget.LCLObject));
1566 FillChar(Msg{%H-}, SizeOf(Msg), #0);
1567
1568 Msg.Msg := LM_SHOWWINDOW;
1569 Msg.Show := True;
1570
1571 Gtk3Widget.DeliverMessage(Msg);
1572 end;
1573
GtkModifierStateToShiftStatenull1574 function GtkModifierStateToShiftState(AState: TGdkModifierType;
1575 AIsKeyEvent: Boolean): Cardinal;
1576 begin
1577 Result := 0;
1578 if AState and GDK_SHIFT_MASK <> 0 then
1579 Result := Result or MK_SHIFT;
1580 if AState and GDK_CONTROL_MASK <> 0 then
1581 Result := Result or MK_CONTROL;
1582 if AState and GDK_MOD1_MASK <> 0 then
1583 begin
1584 if AIsKeyEvent then
1585 Result := Result or KF_ALTDOWN
1586 else
1587 Result := Result or MK_ALT;
1588 end;
1589 end;
1590
SubtractScrollnull1591 function SubtractScroll(AWidget: PGtkWidget; APosition: TPoint): TPoint;
1592 begin
1593 Result := APosition;
1594 if Gtk3IsScrolledWindow(AWidget) then
1595 begin
1596 with gtk_scrolled_window_get_hadjustment(PGtkScrolledWindow(AWidget))^ do
1597 dec(Result.x, Trunc(value - lower));
1598 with gtk_scrolled_window_get_vadjustment(PGtkScrolledWindow(AWidget))^ do
1599 dec(Result.y, Trunc(value - lower));
1600 end;
1601 end;
1602
Gtk3ScrolledWindowScrollEventnull1603 function Gtk3ScrolledWindowScrollEvent(AScrollWindow: PGtkScrolledWindow; AEvent: PGdkEvent; AData: gPointer): gboolean; cdecl;
1604 var
1605 Msg: TLMVScroll;
1606 AValue: Double;
1607 Range: PGtkRange;
1608 begin
1609 {$IFDEF SYNSCROLLDEBUG}
1610 debugln(['Gtk3ScrolledWindowScrollEvent ']);
1611 {$ENDIF}
1612 Result := False;
1613 case AEvent^.scroll.direction of
1614 0, 1{GDK_SCROLL_UP,
1615 GDK_SCROLL_DOWN}: Msg.Msg := LM_VSCROLL;
1616 2, 3{GDK_SCROLL_LEFT,
1617 GDK_SCROLL_RIGHT}: Msg.Msg := LM_HSCROLL;
1618 else
1619 begin
1620 if AEvent^.scroll.direction = GDK_SCROLL_SMOOTH then
1621 DebugLn('Gtk3ScrolledWindowScrollEvent: Use PGtkWidget^.set_events(GDK_DEFAULT_EVENTS_MASK) in CreateWidget to prevent GTK3 bug with GDK_SCROLL_SMOOTH')
1622 else
1623 DebugLn('Gtk3ScrolledWindowScrollEvent: Unknown scroll direction: ', dbgs(AEvent^.scroll.direction));
1624 end;
1625 Exit;
1626 end;
1627
1628 case Msg.Msg of
1629 LM_VSCROLL: Range := PGtkRange(AScrollWindow^.get_vscrollbar);
1630 LM_HSCROLL: Range := PGtkRange(AScrollWindow^.get_hscrollbar);
1631 end;
1632
1633 AValue := power(Range^.adjustment^.page_size, 2 / 3);
1634
1635 if (AEvent^.scroll.direction = GDK_SCROLL_UP) or
1636 (AEvent^.scroll.direction = GDK_SCROLL_LEFT)
1637 then
1638 AValue := -AValue;
1639
1640 AValue := gtk_range_get_value(Range) + AValue;
1641
1642 AValue := Max(AValue, Range^.adjustment^.lower);
1643 AValue := Min(AValue, Range^.adjustment^.upper - Range^.adjustment^.page_size);
1644
1645 with Msg do
1646 begin
1647 Pos := Round(AValue);
1648 if Pos < High(SmallPos) then
1649 SmallPos := Pos
1650 else
1651 SmallPos := High(SmallPos);
1652
1653 ScrollBar := HWND({%H-}PtrUInt(AData));
1654 ScrollCode := SB_THUMBPOSITION;
1655 end;
1656 Result := TGtk3Widget(AData).DeliverMessage(Msg) <> 0;
1657 // DeliverMessage(.LCLObject, Msg) <> 0;
1658 end;
1659
Gtk3ScrollEventnull1660 function Gtk3ScrollEvent(AWidget: PGtkWidget; AEvent: PGdkEvent; AData: GPointer): GBoolean; cdecl;
1661 var
1662 AWinControl: TWinControl;
1663 EventXY: TPoint;
1664 AState: Cardinal;
1665 ShiftState: TShiftState;
1666 MappedXY: TPoint;
1667 MessE : TLMMouseEvent;
1668 begin
1669 Result := False;
1670 if AWidget=nil then ;
1671 AWinControl := TGtk3Widget(AData).LCLObject;
1672
1673 if AEvent^.scroll.send_event = NO_PROPAGATION_TO_PARENT then
1674 exit;
1675
1676 EventXY := Point(LazUtilities.TruncToInt(AEvent^.Scroll.X),LazUtilities.TruncToInt(AEvent^.scroll.Y));
1677 AState := GtkModifierStateToShiftState(AEvent^.scroll.state, False);
1678 ShiftState := [];
1679 if AState and MK_SHIFT <> 0 then
1680 ShiftState := ShiftState + [ssShift];
1681 if AState and MK_CONTROL <> 0 then
1682 ShiftState := ShiftState + [ssCtrl];
1683 if AState and MK_ALT <> 0 then
1684 ShiftState := ShiftState + [ssAlt];
1685 // MappedXY := TranslateGdkPointToClientArea(AEvent^.scroll.window, EventXY,
1686 // {%H-}TGtk3Widget(AWinControl.Handle).GetContainerWidget);
1687 MappedXY := EventXY;
1688 MappedXY := SubtractScroll(TGtk3Widget(AWinControl.Handle).GetContainerWidget, MappedXY);
1689 //DebugLn('gtkMouseWheelCB ',DbgSName(AWinControl),' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y));
1690
1691 // this is a mouse wheel event
1692 FillChar(MessE{%H-},SizeOf(MessE),0);
1693 MessE.Msg := LM_MOUSEWHEEL;
1694 case AEvent^.scroll.direction of
1695 0 {GDK_SCROLL_UP}: MessE.WheelDelta := 120;
1696 1 {GDK_SCROLL_DOWN}: MessE.WheelDelta := -120;
1697 else
1698 exit;
1699 end;
1700 MessE.X := MappedXY.X;
1701 MessE.Y := MappedXY.Y;
1702 MessE.State := ShiftState;
1703 MessE.UserData := AWinControl;
1704 MessE.Button := 0;
1705
1706 // send the message directly to the LCL
1707 NotifyApplicationUserInput(AWinControl, MessE.Msg);
1708 if DeliverMessage(AWinControl, MessE) <> 0 then
1709 Result := True // message handled by LCL, stop processing
1710 else
1711 AEvent^.scroll.send_event := NO_PROPAGATION_TO_PARENT;
1712
1713 // DebugLn('Gtk3ScrollEvent for ', dbgsName(TGtk3Widget(AData).LCLObject),' Result ',dbgs(Result));
1714 end;
1715
1716
1717 { TGtk3SplitterSide }
1718
TGtk3SplitterSide.CreateWidgetnull1719 function TGtk3SplitterSide.CreateWidget(const Params: TCreateParams): PGtkWidget;
1720 begin
1721 Result:=TGtkScrolledWindow.new(nil, nil);
1722 end;
1723
1724 { TGtk3Paned }
1725
TGtk3Paned.CreateWidgetnull1726 function TGtk3Paned.CreateWidget(const Params: TCreateParams): PGtkWidget;
1727 const
1728 ornt:array[TPairSplitterType] of TGtkOrientation=(
1729 GTK_ORIENTATION_HORIZONTAL,
1730 GTK_ORIENTATION_VERTICAL
1731 );
1732 begin
1733 Result:=TGtkPaned.new(ornt[TPairSplitter(Self.LCLObject).SplitterType]);
1734 end;
1735
1736 { TGtk3Widget }
1737
GtkEventMouseEnterLeavenull1738 function TGtk3Widget.GtkEventMouseEnterLeave(Sender: PGtkWidget; Event: PGdkEvent): Boolean;
1739 cdecl;
1740 var
1741 Msg: TLMessage;
1742 // MouseMsg: TLMMouseMove absolute Msg;
1743 {$IFDEF GTK3DEBUGCORE}
1744 MousePos: TPoint;
1745 {$ENDIF}
1746 begin
1747 Result := False;
1748 FillChar(Msg{%H-}, SizeOf(Msg), #0);
1749 if Event^.type_ = GDK_ENTER_NOTIFY then
1750 Msg.Msg := LM_MOUSEENTER
1751 else
1752 Msg.Msg := LM_MOUSELEAVE;
1753
1754 NotifyApplicationUserInput(LCLObject, Msg.Msg);
1755 Result := DeliverMessage(Msg, True) <> 0;
1756 {$IFDEF GTK3DEBUGCORE}
1757 MousePos.X := Round(Event^.crossing.x);
1758 MousePos.Y := Round(Event^.crossing.y);
1759 DebugLn('GtkEventMouseEnterLeave: mousePos ',dbgs(MousePos),' Object ',dbgsName(LCLObject),
1760 ' IsEnter ',dbgs(Event^.type_ = GDK_ENTER_NOTIFY),' Result=',dbgs(Result));
1761 {$ENDIF}
1762 end;
1763
GtkEventMouseMovenull1764 function TGtk3Widget.GtkEventMouseMove(Sender: PGtkWidget; Event: PGdkEvent
1765 ): Boolean; cdecl;
1766 var
1767 Msg: TLMMouseMove;
1768 MousePos: TPoint;
1769 begin
1770 Result := False;
1771
1772 {$IFDEF GTK3DEBUGEVENTS}
1773 R := GetClientBounds;
1774 DebugLn(['GtkEventMouseMove: ',dbgsName(LCLObject),' Send=',dbgs(Event^.motion.send_event),
1775 ' state=',dbgs(event^.motion.state),
1776 ' x=',dbgs(Round(event^.motion.x)),
1777 ' y=',dbgs(Round(event^.motion.y)),
1778 ' x_root=',dbgs(Round(event^.motion.x_root)),
1779 ' y_root=',dbgs(Round(event^.motion.y_root)),
1780 ' STOP PROCESSING ? ',dbgs(Event^.motion.send_event = NO_PROPAGATION_TO_PARENT),
1781 ' GtkBounds ',dbgs(R),' LCLBounds ',dbgs(LCLObject.BoundsRect),' W=',dbgs(LCLObject.Width)]
1782 );
1783 {$ENDIF}
1784
1785 if Event^.motion.send_event = NO_PROPAGATION_TO_PARENT then
1786 exit;
1787
1788 FillChar(Msg{%H-}, SizeOf(Msg), #0);
1789
1790 MousePos.x := Round(Event^.motion.x);
1791 MousePos.y := Round(Event^.motion.y);
1792
1793 OffsetMousePos(@MousePos);
1794
1795 Msg.XPos := SmallInt(MousePos.X);
1796 Msg.YPos := SmallInt(MousePos.Y);
1797
1798 if Mouse.CursorPos=MousePos then exit;
1799
1800 Msg.Keys := GdkModifierStateToLCL(Event^.motion.state, False);
1801
1802 Msg.Msg := LM_MOUSEMOVE;
1803
1804 NotifyApplicationUserInput(LCLObject, Msg.Msg);
1805 if Widget^.get_parent <> nil then
1806 Event^.motion.send_event := NO_PROPAGATION_TO_PARENT;
1807 DeliverMessage(Msg, True);
1808 end;
1809
TGtk3Widget.GtkEventPaintnull1810 function TGtk3Widget.GtkEventPaint(Sender: PGtkWidget; AContext: Pcairo_t
1811 ): Boolean; cdecl;
1812 var
1813 Msg: TLMPaint;
1814 AStruct: TPaintStruct;
1815 AClipRect: TGdkRectangle;
1816 localClip:TRect;
1817 begin
1818 Result := False;
1819
1820 if not FHasPaint then
1821 exit;
1822
1823 FillChar(Msg{%H-}, SizeOf(Msg), #0);
1824
1825 Msg.Msg := LM_PAINT;
1826 //New(AStruct);
1827 FillChar(AStruct{%H-}, SizeOf(TPaintStruct), 0);
1828 Msg.PaintStruct := @AStruct;
1829
1830 with PaintData do
1831 begin
1832 if GetContainerWidget = nil then
1833 PaintWidget := Widget
1834 else
1835 PaintWidget := GetContainerWidget;
1836 ClipRegion := nil;
1837 // gdk_cairo_region(AContext, ClipRegion);
1838 // Event^.expose.region;
1839 //if ClipRect = nil then
1840 // New(ClipRect);
1841 gdk_cairo_get_clip_rectangle(AContext, @AClipRect);
1842 localClip:=RectFromGdkRect(AClipRect);
1843 ClipRect := @localClip;
1844 end;
1845
1846 FCairoContext := AContext;
1847 Msg.DC := BeginPaint(THandle(Self), AStruct);
1848 FContext := Msg.DC;
1849
1850 Msg.PaintStruct^.rcPaint := PaintData.ClipRect^;
1851 Msg.PaintStruct^.hdc := FContext;
1852
1853 try
1854 try
1855 // DebugLn('**** Sending paint event to ',dbgsName(LCLObject),' clipRect=',dbgs(PaintData.ClipRect^),' P=',dbgs(P));
1856 DoBeforeLCLPaint;
1857 LCLObject.WindowProc(TLMessage(Msg));
1858 finally
1859 FCairoContext := nil;
1860 //Dispose(PaintData.ClipRect);
1861 Fillchar(FPaintData, SizeOf(FPaintData), 0);
1862 FContext := 0;
1863 EndPaint(THandle(Self), AStruct);
1864 //Dispose(AStruct);
1865 end;
1866 except
1867 Application.HandleException(nil);
1868 end;
1869 end;
1870
GtkEventResizenull1871 function TGtk3Widget.GtkEventResize(Sender: PGtkWidget; Event: PGdkEvent
1872 ): Boolean; cdecl;
1873 begin
1874 {-$IF DEFINED(GTK3DEBUGEVENTS) OR DEFINED(GTK3DEBUGSIZE)}
1875 DebugLn('GtkEventResize: ',dbgsName(LCLObject),' Send=',dbgs(Event^.configure.send_event),
1876 ' x=',dbgs(Round(event^.configure.x)),
1877 ' y=',dbgs(Round(event^.configure.y)),
1878 ' w=',dbgs(Round(event^.configure.width)),
1879 ' h=',dbgs(Round(event^.configure.height)));
1880 {-$ENDIF}
1881 Result := false;
1882 end;
1883
1884 procedure TGtk3Widget.GtkEventFocus(Sender: PGtkWidget; Event: PGdkEvent);
1885 cdecl;
1886 var
1887 Msg: TLMessage;
1888 begin
1889 {$IF DEFINED(GTK3DEBUGEVENTS) OR DEFINED(GTK3DEBUGFOCUS)}
1890 DebugLn('TGtk3Widget.GtkEventFocus ',dbgsName(LCLObject),' FocusIn ',dbgs(Event^.focus_change.in_ <> 0));
1891 {$ENDIF}
1892 FillChar(Msg{%H-}, SizeOf(Msg), #0);
1893 if Event^.focus_change.in_ <> 0 then
1894 Msg.Msg := LM_SETFOCUS
1895 else
1896 Msg.Msg := LM_KILLFOCUS;
1897 DeliverMessage(Msg);
1898 end;
1899
1900 procedure TGtk3Widget.GtkEventDestroy; cdecl;
1901 var
1902 Msg: TLMessage;
1903 begin
1904 FillChar(Msg{%H-}, SizeOf(Msg), #0);
1905 Msg.Msg := LM_DESTROY;
1906 DeliverMessage(Msg);
1907 Release;
1908 end;
1909
TGtk3Widget.GtkEventMouseWheelnull1910 function TGtk3Widget.GtkEventMouseWheel(Sender: PGtkWidget; Event: PGdkEvent
1911 ): Boolean; cdecl;
1912 var
1913 Msg: TLMMouseEvent;
1914 EventXY: TPoint;
1915 begin
1916 // gtk3 have ugly bug with scroll-event
1917 // https://bugzilla.gnome.org/show_bug.cgi?id=675959
1918 Result := False;
1919 EventXY := Point(LazUtilities.TruncToInt(Event^.scroll.x), LazUtilities.TruncToInt(Event^.scroll.y));
1920 FillChar(Msg{%H-},SizeOf(Msg),0);
1921 Msg.Msg := LM_MOUSEWHEEL;
1922 //DebugLn('Scroll ',Format('deltaX %2.2n deltaY %2.2n x %2.2n y %2.2n rootx %2.2n rooty %2.2n',
1923 // [Event^.scroll.delta_x, Event^.scroll.delta_y, Event^.scroll.x, Event^.scroll.y,
1924 // Event^.scroll.x_root, Event^.scroll.y_root]));
1925 if Event^.scroll.direction = GDK_SCROLL_UP then
1926 Msg.WheelDelta := 120
1927 else
1928 if Event^.scroll.direction = GDK_SCROLL_DOWN then
1929 Msg.WheelDelta := -120
1930 else
1931 exit;
1932 Msg.X := EventXY.X;
1933 Msg.Y := EventXY.Y;
1934 Msg.State := GdkModifierStateToShiftState(Event^.scroll.state);
1935 Msg.UserData := LCLObject;
1936 Msg.Button := 0;
1937
1938 NotifyApplicationUserInput(LCLObject, Msg.Msg);
1939 if Widget^.get_parent <> nil then
1940 Event^.motion.send_event := NO_PROPAGATION_TO_PARENT;
1941 if DeliverMessage(Msg, True) <> 0 then
1942 Result := True;
1943 end;
1944
TGtk3Widget.IsValidHandlenull1945 function TGtk3Widget.IsValidHandle: Boolean;
1946 begin
1947 Result := Assigned(FWidget) and Gtk3IsWidget(FWidget) and not FWidget^.in_destruction;
1948 end;
1949
IsWidgetOknull1950 function TGtk3Widget.IsWidgetOk: Boolean;
1951 begin
1952 Result := Gtk3IsWidget(FWidget);
1953 end;
1954
TGtk3Widget.IsIconicnull1955 function TGtk3Widget.IsIconic: Boolean;
1956 begin
1957 Result := False;
1958 if IsWidgetOk then
1959 begin
1960 if FWidget^.get_window <> nil then
1961 Result := gdk_window_get_state(FWidget^.get_window) and GDK_WINDOW_STATE_ICONIFIED <> 0;
1962 end;
1963 end;
1964
getTypenull1965 function TGtk3Widget.getType: TGType;
1966 begin
1967 Result := getContainerWidget^.g_type_instance.g_class^.g_type;
1968 end;
1969
getTypeNamenull1970 function TGtk3Widget.getTypeName: PgChar;
1971 begin
1972 Result := g_type_name(getType);
1973 end;
1974
1975 procedure TGtk3Widget.lowerWidget;
1976 begin
1977 if Gtk3IsGdkWindow(FWidget^.window) then
1978 FWidget^.window^.lower;
1979 end;
1980
1981 procedure TGtk3Widget.raiseWidget;
1982 begin
1983 if Gtk3IsGdkWindow(FWidget^.window) then
1984 FWidget^.window^.raise_;
1985 end;
1986
1987 procedure TGtk3Widget.stackUnder(AWidget: PGtkWidget);
1988 begin
1989 // FWidget^.
1990 end;
1991
TGtk3Widget.GetCapturenull1992 function TGtk3Widget.GetCapture: TGtk3Widget;
1993 var
1994 AHandle: HWND;
1995 begin
1996 AHandle := HwndFromGtkWidget(gtk_grab_get_current);
1997 if AHandle <> 0 then
1998 Result := TGtk3Widget(AHandle);
1999 end;
2000
SetCapturenull2001 function TGtk3Widget.SetCapture: HWND;
2002 begin
2003 Result := HWND(GetCapture);
2004 gtk_grab_add(GetContainerWidget);
2005 end;
2006
GtkEventKeynull2007 function TGtk3Widget.GtkEventKey(Sender: PGtkWidget; Event: PGdkEvent; AKeyPress: Boolean): Boolean;
2008 cdecl;
2009 const
2010 CN_KeyDownMsgs: array[Boolean] of UINT = (CN_KEYDOWN, CN_SYSKEYDOWN);
2011 CN_KeyUpMsgs: array[Boolean] of UINT = (CN_KEYUP, CN_SYSKEYUP);
2012 LM_KeyDownMsgs: array[Boolean] of UINT = (LM_KEYDOWN, LM_SYSKEYDOWN);
2013 LM_KeyUpMsgs: array[Boolean] of UINT = (LM_KEYUP, LM_SYSKEYUP);
2014 CN_CharMsg: array[Boolean] of UINT = (CN_CHAR, CN_SYSCHAR);
2015 LM_CharMsg: array[Boolean] of UINT = (LM_CHAR, LM_SYSCHAR);
2016 var
2017 AEvent: TGdkEventKey;
2018 Msg: TLMKey;
2019 CharMsg: TLMChar;
2020 AEventString: String;
2021 KeyValue, ACharCode: Word;
2022 LCLModifiers: Word;
2023 IsSysKey: Boolean;
2024 UTF8Char: TUTF8Char;
2025 AChar: Char;
2026 IsArrowKey: Boolean;
2027 begin
2028 //TODO: finish LCL messaging
2029 Result := False;
2030 AEvent := Event^.key;
2031 FillChar(Msg{%H-}, SizeOf(Msg), 0);
2032 AEventString := AEvent.string_;
2033
2034 if gdk_keyval_is_lower(AEvent.keyval) then
2035 KeyValue := Word(gdk_keyval_to_upper(AEvent.keyval))
2036 else
2037 KeyValue := Word(AEvent.keyval);
2038
2039 // state=16 = numlock= on.
2040
2041 LCLModifiers := GtkModifierStateToShiftState(AEvent.state, True);
2042
2043 if length(AEventString) = 0 then
2044 begin
2045 if KeyValue = GDK_KEY_Alt_L then
2046 LCLModifiers := LCLModifiers or KF_ALTDOWN
2047 else
2048 if (KeyValue = GDK_KEY_Control_L) or (KeyValue = GDK_KEY_Control_R) then
2049 LCLModifiers := LCLModifiers or MK_CONTROL
2050 else
2051 if (KeyValue = GDK_KEY_Shift_L) or (KeyValue = GDK_KEY_Shift_R) then
2052 LCLModifiers := LCLModifiers or MK_SHIFT;
2053 // writeln('MODIFIERS BY KEYS ',LCLModifiers);
2054 end;
2055
2056 IsSysKey := LCLModifiers and KF_ALTDOWN <> 0;
2057
2058 if not AKeyPress then
2059 LCLModifiers := LCLModifiers or KF_UP;
2060
2061 // else
2062 // writeln('KeyRelease: ',dbgsName(LCLObject),' Dump state=',AEvent.state,' hwkey=',KeyCode,' keyvalue=',KeyValue,' modifier=',AEvent.Bitfield0.is_modifier);
2063
2064 // this is just for testing purposes.
2065 ACharCode := GdkKeyToLCLKey(KeyValue);
2066 if KeyValue > VK_UNDEFINED then
2067 KeyValue := ACharCode; // VK_UNKNOWN;
2068
2069 if AKeyPress and (ACharCode = VK_TAB) then
2070 begin
2071 if Sender^.is_focus then
2072 Self.LCLObject.SelectNext(Self.LCLObject,true,true);
2073 exit;
2074 end;
2075
2076 IsArrowKey := (AEventString='') and ((ACharCode = VK_UP) or (ACharCode = VK_DOWN) or (ACharCode = VK_LEFT) or (ACharCode = VK_RIGHT));
2077
2078 {$IFDEF GTK3DEBUGKEYPRESS}
2079 if AKeyPress then
2080 writeln('EVENT KeyPress: ',dbgsName(LCLObject),' Dump state=',AEvent.state,' keyvalue=',KeyValue,' modifier=',AEvent.Bitfield0.is_modifier,
2081 ' KeyValue ',KeyValue,' MODIFIERS ',LCLModifiers,' CharCode ',ACharCode,' EAT ',EatArrowKeys(ACharCode))
2082 else
2083 writeln('EVENT KeyRelease: ',dbgsName(LCLObject),' Dump state=',AEvent.state,' keyvalue=',KeyValue,' modifier=',AEvent.Bitfield0.is_modifier,
2084 ' KeyValue ',KeyValue,' MODIFIERS ',LCLModifiers,' CharCode ',ACharCode,
2085 ' EAT ',EatArrowKeys(ACharCode));
2086 {$ENDIF}
2087
2088 if (ACharCode <> VK_UNKNOWN) then
2089 begin
2090 if AKeyPress then
2091 Msg.Msg := CN_KeyDownMsgs[IsSysKey]
2092 else
2093 Msg.Msg := CN_KeyUpMsgs[IsSysKey];
2094 Msg.CharCode := ACharCode;
2095 Msg.KeyData := PtrInt((KeyValue shl 16) or (LCLModifiers shl 16) or $0001);
2096
2097 NotifyApplicationUserInput(LCLObject, Msg.Msg);
2098
2099 if not CanSendLCLMessage then
2100 exit;
2101
2102 if (DeliverMessage(Msg, True) <> 0) or (Msg.CharCode = VK_UNKNOWN) or (IsArrowKey{EatArrowKeys(ACharCode)}) then
2103 begin
2104 {$IFDEF GTK3DEBUGKEYPRESS}
2105 DebugLn('CN_KeyDownMsgs handled ... exiting');
2106 {$ENDIF}
2107 if ([wtEntry,wtMemo] * WidgetType <>[]) then
2108 exit(false)
2109 else
2110 exit(True);
2111 end;
2112
2113 if not CanSendLCLMessage then
2114 exit;
2115
2116 if AKeyPress then
2117 Msg.Msg := LM_KeyDownMsgs[IsSysKey]
2118 else
2119 Msg.Msg := LM_KeyUpMsgs[IsSysKey];
2120 Msg.CharCode := ACharCode;
2121 Msg.KeyData := PtrInt((KeyValue shl 16) or (LCLModifiers shl 16) or $0001);
2122
2123 NotifyApplicationUserInput(LCLObject, Msg.Msg);
2124
2125 if not CanSendLCLMessage then
2126 exit;
2127
2128 {$warning workaround for GtkTreeView key bindings.Must find out what LCL does with
2129 this keys.}
2130 if {IsArrowKey and} ([wtListBox,wtListView,wtEntry,wtMemo] * WidgetType <> []) then
2131 // let gtk3 select cell for now. Must check what LCL does with arrow keys
2132 // since gtk3 becomes crazy after delivery of this message
2133 else
2134 if (DeliverMessage(Msg, True) <> 0) or (Msg.CharCode = 0) then
2135 begin
2136 Result := Msg.CharCode = 0;
2137 {$IFDEF GTK3DEBUGKEYPRESS}
2138 DebugLn('LM_KeyDownMsgs handled ... exiting ',dbgs(ACharCode),' Result=',dbgs(Result),' AKeyPress=',dbgs(AKeyPress));
2139 {$ENDIF}
2140 exit;
2141 end;
2142
2143 if not CanSendLCLMessage then
2144 exit;
2145
2146 end;
2147
2148 if AKeyPress and (length(AEventString) > 0) then
2149 begin
2150 UTF8Char := AEventString;
2151 // TODO: If not IsControlKey
2152 Result := LCLObject.IntfUTF8KeyPress(UTF8Char, 1, IsSysKey);
2153
2154 if not CanSendLCLMessage then
2155 exit;
2156
2157 if Result then
2158 begin
2159 {$IFDEF GTK3DEBUGKEYPRESS}
2160 DebugLn('LCLObject.IntfUTF8KeyPress handled ... exiting');
2161 {$ENDIF}
2162 exit;
2163 end;
2164
2165 // create the CN_CHAR / CN_SYSCHAR message
2166 FillChar(CharMsg{%H-}, SizeOf(CharMsg), 0);
2167 CharMsg.Msg := CN_CharMsg[IsSysKey];
2168 CharMsg.KeyData := Msg.KeyData;
2169 AChar := AEventString[1];
2170 CharMsg.CharCode := Word(AChar);
2171 NotifyApplicationUserInput(LCLObject, CharMsg.Msg);
2172
2173 if not CanSendLCLMessage then
2174 exit;
2175
2176 Result := (DeliverMessage(CharMsg, True) <> 0) or (CharMsg.CharCode = VK_UNKNOWN);
2177
2178 if not CanSendLCLMessage then
2179 exit;
2180
2181 if Result then
2182 begin
2183 {$IFDEF GTK3DEBUGKEYPRESS}
2184 DebugLn('CN_CharMsg handled ... exiting');
2185 {$ENDIF}
2186 exit;
2187 end;
2188
2189 //Send a LM_(SYS)CHAR
2190 CharMsg.Msg := LM_CharMsg[IsSysKey];
2191
2192 NotifyApplicationUserInput(LCLObject, CharMsg.Msg);
2193
2194 if not CanSendLCLMessage then
2195 exit;
2196
2197 DeliverMessage(CharMsg, True);
2198
2199 if not CanSendLCLMessage then
2200 exit;
2201 end;
2202 if AKeyPress then
2203 begin
2204 {$IFDEF GTK3DEBUGKEYPRESS}
2205 if Msg.CharCode in FKeysToEat then
2206 begin
2207 DebugLn('EVENT: ******* KeyPress charcode is in keys to eat (FKeysToEat), charcode=',dbgs(Msg.CharCode));
2208 end;
2209 {$ENDIF}
2210 Result := Msg.CharCode in FKeysToEat;
2211 end;
2212 end;
2213
GtkEventMousenull2214 function TGtk3Widget.GtkEventMouse(Sender: PGtkWidget; Event: PGdkEvent): Boolean;
2215 cdecl;
2216 var
2217 Msg: TLMMouse;
2218 MsgPopup : TLMMouse;
2219 MousePos: TPoint;
2220 MButton: guint;
2221 begin
2222 Result := False;
2223 {$IF DEFINED(GTK3DEBUGEVENTS) OR DEFINED(GTK3DEBUGMOUSE)}
2224 DebugLn('TGtk3Widget.GtkEventMouse ',dbgsName(LCLObject),
2225 ' propagate=',dbgs(not (Event^.button.send_event = NO_PROPAGATION_TO_PARENT)));
2226 {$ENDIF}
2227 if Event^.button.send_event = NO_PROPAGATION_TO_PARENT then
2228 exit;
2229
2230 FillChar(Msg{%H-}, SizeOf(Msg), #0);
2231
2232 MousePos.x := Round(Event^.button.x);
2233 MousePos.y := Round(Event^.button.y);
2234
2235 Msg.Keys := GdkModifierStateToLCL(Event^.button.state, False);
2236
2237 Msg.XPos := SmallInt(MousePos.X);
2238 Msg.YPos := SmallInt(MousePos.Y);
2239
2240 MButton := Event^.button.button;
2241
2242 case Event^.type_ of
2243 GDK_BUTTON_PRESS:
2244 begin
2245 if MButton = GTK3_LEFT_BUTTON then
2246 begin
2247 Msg.Msg := LM_LBUTTONDOWN;
2248 Msg.Keys := Msg.Keys or MK_LBUTTON;
2249 end
2250 else
2251 if MButton = GTK3_RIGHT_BUTTON then
2252 begin
2253 Msg.Msg := LM_RBUTTONDOWN;
2254 Msg.Keys := Msg.Keys or MK_RBUTTON;
2255 end
2256 else
2257 if MButton = GTK3_MIDDLE_BUTTON then
2258 begin
2259 Msg.Msg := LM_MBUTTONDOWN;
2260 Msg.Keys := Msg.Keys or MK_MBUTTON;
2261 end;
2262 end;
2263 GDK_2BUTTON_PRESS: //-> double click GDK_DOUBLE_BUTTON_PRESS
2264 begin
2265 if MButton = GTK3_LEFT_BUTTON then
2266 begin
2267 Msg.Msg := LM_LBUTTONDBLCLK;
2268 Msg.Keys := Msg.Keys or MK_LBUTTON;
2269 end
2270 else
2271 if MButton = GTK3_RIGHT_BUTTON then
2272 begin
2273 Msg.Msg := LM_RBUTTONDBLCLK;
2274 Msg.Keys := Msg.Keys or MK_RBUTTON;
2275 end
2276 else
2277 if MButton = GTK3_MIDDLE_BUTTON then
2278 begin
2279 Msg.Msg := LM_MBUTTONDBLCLK;
2280 Msg.Keys := Msg.Keys or MK_MBUTTON;
2281 end;
2282 end;
2283 GDK_BUTTON_RELEASE:
2284 begin
2285 if MButton = GTK3_LEFT_BUTTON then
2286 begin
2287 Msg.Msg := LM_LBUTTONUP;
2288 Msg.Keys := Msg.Keys or MK_LBUTTON;
2289 end
2290 else
2291 if MButton = GTK3_RIGHT_BUTTON then
2292 begin
2293 Msg.Msg := LM_RBUTTONUP;
2294 Msg.Keys := Msg.Keys or MK_RBUTTON;
2295 end
2296 else
2297 if MButton = GTK3_MIDDLE_BUTTON then
2298 begin
2299 Msg.Msg := LM_MBUTTONUP;
2300 Msg.Keys := Msg.Keys or MK_MBUTTON;
2301 end;
2302 end;
2303 end;
2304
2305 {$IF DEFINED(GTK3DEBUGEVENTS) OR DEFINED(GTK3DEBUGMOUSE)}
2306 DebugLn('TGtk3Widget.GtkEventMouse ',dbgsName(LCLObject),
2307 ' msg=',dbgs(msg.Msg), ' point=',dbgs(Msg.XPos),',',dbgs(Msg.YPos));
2308 {$ENDIF}
2309 NotifyApplicationUserInput(LCLObject, Msg.Msg);
2310 Event^.button.send_event := NO_PROPAGATION_TO_PARENT;
2311
2312 Result := false;
2313 if Msg.Msg = LM_RBUTTONDOWN then
2314 begin
2315 MsgPopup := Msg;
2316 MsgPopup.Msg := LM_CONTEXTMENU;
2317 MsgPopup.XPos := SmallInt(Round(Event^.button.x_root));
2318 MsgPopup.YPos := SmallInt(Round(Event^.button.y_root));
2319 Result := DeliverMessage(MsgPopup, True) <> 0;
2320 end;
2321 if not Result then
2322 Result := DeliverMessage(Msg, True) <> 0;
2323 if Event^.type_ = GDK_BUTTON_RELEASE then
2324 begin
2325 Msg.Msg := LM_CLICKED;
2326 DeliverMessage(Msg, True);
2327 end;
2328 end;
2329
GetVisiblenull2330 function TGtk3Widget.GetVisible: Boolean;
2331 begin
2332 Result := Assigned(FWidget) and FWidget^.visible;
2333 end;
2334
2335 procedure TGtk3Widget.SetEnabled(AValue: Boolean);
2336 begin
2337 if IsWidgetOK then
2338 FWidget^.set_sensitive(AValue);
2339 end;
2340
2341 procedure TGtk3Widget.SetFont(AValue: PPangoFontDescription);
2342 begin
2343 if IsWidgetOk then
2344 begin
2345 GetContainerWidget^.override_font(AValue);
2346 end;
2347 end;
2348
2349 procedure TGtk3Widget.SetFontColor(AValue: TColor);
2350 var
2351 AColor: TGdkRGBA;
2352 i: TGtkStateType;
2353 begin
2354 if IsWidgetOK then
2355 begin
2356 AColor := TColortoTGdkRGBA(ColorToRgb(AValue));
2357 if FWidget <> GetContainerWidget then
2358 begin
2359 with FWidget^ do
2360 begin
2361 for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do
2362 override_color(i, @AColor);
2363 end;
2364 end;
2365 with GetContainerWidget^ do
2366 begin
2367 for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do
2368 override_color(i, @AColor);
2369 end;
2370 end;
2371 end;
2372
2373 procedure TGtk3Widget.SetColor(AValue: TColor);
2374 var
2375 AColor: TGdkRGBA;
2376 i: TGtkStateType;
2377 ARgba: TGdkRGBA;
2378 begin
2379 // new way (gtk3) but still buggy
2380 if IsWidgetOK and (0 > 1) then
2381 begin
2382 if AValue = clDefault then
2383 begin
2384 (*
2385 with FDefaultRGBA do
2386 begin
2387 writeln('clDefault ',Format('R %2.2n G %2.2n B %2.2n A %2.2n',[R, G, B , Alpha]));
2388 ARgba.red := R;
2389 ARgba.green := G;
2390 ARgba.blue := B;
2391 ARgba.alpha := Alpha;
2392 end;
2393 *)
2394 end else
2395 begin
2396 ARgba := TColortoTGdkRGBA(ColorToRGB(AValue));
2397 {$info GTK3: set GdkRGBA.alpah to 1.0?}
2398
2399 {ColorToCairoRGB(ColorToRGB(AValue), R, G, B);
2400 ARgba.red := R;
2401 ARgba.green := G;
2402 ARgba.blue := B;
2403 ARgba.alpha := 1.0;}
2404 end;
2405 if FWidget <> GetContainerWidget then
2406 begin
2407 with FWidget^ do
2408 begin
2409 for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do
2410 begin
2411 if AValue = clDefault then
2412 begin
2413 ARgba.red := FWidgetRGBA[i].R;
2414 ARgba.green := FWidgetRGBA[i].G;
2415 ARgba.blue := FWidgetRGBA[i].B;
2416 ARgba.alpha := FWidgetRGBA[i].Alpha;
2417 end;
2418 FWidget^.override_background_color(i, @ARgba);
2419 end;
2420 end;
2421 end;
2422 with GetContainerWidget^ do
2423 begin
2424 for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do
2425 begin
2426 //if AVAlue = clDefault then
2427 // GetContainerWidget^.get_style_context^.get_background_color(GTK_STATE_NORMAL, @ARgba);
2428 if AValue = clDefault then
2429 begin
2430 ARgba.red := FCentralWidgetRGBA[i].R;
2431 ARgba.green := FCentralWidgetRGBA[i].G;
2432 ARgba.blue := FCentralWidgetRGBA[i].B;
2433 ARgba.alpha := FCentralWidgetRGBA[i].Alpha;
2434 end;
2435 GetContainerWidget^.override_background_color(i, @ARgba);
2436 end;
2437 end;
2438 end;
2439
2440 if IsWidgetOK then
2441 begin
2442 AColor := TColortoTGdkRGBA(ColorToRgb(AValue));
2443 if FWidget <> GetContainerWidget then
2444 begin
2445 with FWidget^ do
2446 begin
2447 for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do
2448 if AValue = clDefault then
2449 override_background_color(i, nil)
2450 else
2451 override_background_color(i, @AColor);
2452 end;
2453 end;
2454 with GetContainerWidget^ do
2455 begin
2456 for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do
2457 begin
2458 if AValue = clDefault then
2459 override_background_color(i, nil)
2460 else
2461 override_background_color(i, @AColor);
2462 end;
2463 end;
2464 end;
2465 end;
2466
TGtk3Widget.GetStyleContextnull2467 function TGtk3Widget.GetStyleContext: PGtkStyleContext;
2468 begin
2469 Result := nil;
2470 if IsWidgetOK then
2471 Result := GetContainerWidget^.get_style_context;
2472 end;
2473
TGtk3Widget.GetFontnull2474 function TGtk3Widget.GetFont: PPangoFontDescription;
2475 var
2476 AContext: PPangoContext;
2477 begin
2478 Result := nil;
2479 if IsWidgetOK then
2480 begin
2481 AContext := GetContainerWidget^.get_pango_context;
2482 Result := pango_context_get_font_description(AContext);
2483 end;
2484 end;
2485
CanSendLCLMessagenull2486 function TGtk3Widget.CanSendLCLMessage: Boolean;
2487 begin
2488 Result := IsWidgetOk and (LCLObject <> nil);
2489 end;
2490
GetCairoContextnull2491 function TGtk3Widget.GetCairoContext: Pcairo_t;
2492 begin
2493 Result := FCairoContext;
2494 end;
2495
GetEnablednull2496 function TGtk3Widget.GetEnabled: Boolean;
2497 begin
2498 Result := False;
2499 if IsWidgetOK then
2500 Result := FWidget^.get_sensitive;
2501 end;
2502
TGtk3Widget.GetFontColornull2503 function TGtk3Widget.GetFontColor: TColor;
2504 var
2505 AStyle: PGtkStyleContext;
2506 AGdkRGBA: TGdkRGBA;
2507 begin
2508 Result := clDefault;
2509 if IsWidgetOK then
2510 begin
2511 AStyle := GetStyleContext;
2512 AStyle^.get_background_color(GTK_STATE_NORMAL, @AGdkRGBA);
2513 Result := TGdkRGBAToTColor(AGdkRGBA);
2514 end;
2515 end;
2516
GetColornull2517 function TGtk3Widget.GetColor: TColor;
2518 var
2519 AStyle: PGtkStyleContext;
2520 AColor: TGdkRGBA;
2521 begin
2522 Result := clDefault;
2523 if IsWidgetOK then
2524 begin
2525 AStyle := GetStyleContext;
2526 AStyle^.get_background_color(GTK_STATE_NORMAL, @AColor);
2527 Result := TGdkRGBAToTColor(AColor);
2528 end;
2529 end;
2530
2531 procedure TGtk3Widget.SetStyleContext(AValue: PGtkStyleContext);
2532 begin
2533 {$NOTE Gtk3: Find a nice way to assign StyleContext}
2534 {if IsWidgetOK then
2535 GetContainerWidget^.set_style(AValue);}
2536 end;
2537
2538 class procedure TGtk3Widget.destroy_event(w: Tgtk3Widget; data: gpointer); cdecl;
2539 begin
2540 if Assigned(w) then
2541 w.fWidget:=nil;
2542 end;
2543
TGtk3Widget.getTextnull2544 function TGtk3Widget.getText: String;
2545 begin
2546 Result := fText; // default text storage
2547 end;
2548
2549 procedure TGtk3Widget.setText(const AValue: String);
2550 begin
2551 fText:=AValue;
2552 // DebugLn('WARNING: ',dbgsName(LCLObject),' self=',dbgsName(Self),' does not implement setText !');
2553 end;
2554
2555 procedure TGtk3Widget.SetVisible(AValue: Boolean);
2556 begin
2557 if IsWidgetOK then
2558 FWidget^.Visible := AValue;
2559 end;
2560
QueryInterfacenull2561 function TGtk3Widget.QueryInterface(constref iid: TGuid; out obj): LongInt; cdecl;
2562 begin
2563 if GetInterface(iid, obj) then
2564 Result := 0
2565 else
2566 Result := E_NOINTERFACE;
2567 end;
2568
TGtk3Widget._AddRefnull2569 function TGtk3Widget._AddRef: LongInt; cdecl;
2570 begin
2571 Result := -1; // no ref counting
2572 end;
2573
_Releasenull2574 function TGtk3Widget._Release: LongInt; cdecl;
2575 begin
2576 Result := -1;
2577 end;
2578
EatArrowKeysnull2579 function TGtk3Widget.EatArrowKeys(const AKey: Word): Boolean;
2580 begin
2581 Result := AKey in [VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN];
2582 end;
2583
TGtk3Widget.GetContextnull2584 function TGtk3Widget.GetContext: HDC;
2585 begin
2586 Result := FContext;
2587 end;
2588
TGtk3Widget.CreateWidgetnull2589 function TGtk3Widget.CreateWidget(const Params: TCreateParams): PGtkWidget;
2590 begin
2591 Result := PGtkWidget(TGtkWidget.newv(32, 0 ,nil));
2592 end;
2593
2594 procedure TGtk3Widget.DestroyWidget;
2595 begin
2596 if IsValidHandle and FOwnWidget then
2597 begin
2598 fOwnWidget:=false;
2599 DbgOut(#10'destroying '+Classname+' ... ');
2600 FWidget^.destroy_;
2601 DbgOut(Classname+' destroyed.'+#10);
2602 end;
2603 FWidget := nil;
2604 end;
2605
2606 procedure TGtk3Widget.DoBeforeLCLPaint;
2607 begin
2608 //
2609 end;
2610
2611 constructor TGtk3Widget.Create(const AWinControl: TWinControl;
2612 const AParams: TCreateParams);
2613 begin
2614 inherited Create;
2615 FContext := 0;
2616 FHasPaint := False;
2617 FWidget := nil;
2618 FOwner := nil;
2619 FCentralWidget := nil;
2620 FOwnWidget := True;
2621 // Initializes the properties
2622 FProps := nil;
2623 LCLObject := AWinControl;
2624 FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE];
2625 // FHasPaint := False;
2626
2627 FParams := AParams;
2628 InitializeWidget;
2629 end;
2630
2631 constructor TGtk3Widget.CreateFrom(const AWinControl: TWinControl;
2632 AWidget: PGtkWidget);
2633 begin
2634 inherited Create;
2635 FContext := 0;
2636 FHasPaint := False;
2637 FWidget := nil;
2638 FOwner := nil;
2639 FCentralWidget := nil;
2640 FOwnWidget := False;
2641 // Initializes the properties
2642 FProps := nil;
2643 LCLObject := AWinControl;
2644 FWidget := AWidget;
2645 // FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE];
2646 // FHasPaint := False;
2647 end;
2648
2649 procedure TGtk3Widget.InitializeWidget;
2650 var
2651 ARect: TGdkRectangle;
2652 ARgba: TGdkRGBA;
2653 i: TGtkStateType;
2654 begin
2655 FFocusableByMouse := False;
2656 FCentralWidget := nil;
2657 FCairoContext := nil;
2658 FContext := 0;
2659 FEnterLeaveTime := 0;
2660
2661 FWidgetType := [wtWidget];
2662 FWidget := CreateWidget(FParams);
2663
2664 if not (wtWindow in FWidgetType) then
2665 begin
2666 FWidget^.show_all;
2667 with ARect do
2668 begin
2669 x := LCLObject.Left;
2670 y := LCLObject.Top;
2671 width := LCLObject.Width;
2672 height := LCLObject.Height;
2673 end;
2674 FWidget^.set_allocation(@ARect);
2675
2676 UpdateWidgetConstraints;
2677 end;
2678 LCLIntf.SetProp(HWND(Self),'lclwidget',Self);
2679
2680 // connect events
2681 // move signal connections into attach events
2682 if not gtk_widget_get_realized(FWidget) then
2683 FWidget^.set_events(GDK_DEFAULT_EVENTS_MASK);
2684 g_signal_connect_data(FWidget, 'destroy', TGCallback(@TGtk3Widget.destroy_event), Self, nil, 0);
2685 g_signal_connect_data(FWidget, 'event', TGCallback(@Gtk3WidgetEvent), Self, nil, 0);
2686
2687 for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do
2688 begin
2689 FWidget^.get_style_context^.get_background_color(i, @ARgba);
2690 with FWidgetRGBA[i] do
2691 begin
2692 R := ARgba.red;
2693 G := ARgba.green;
2694 B := ARgba.blue;
2695 Alpha := ARgba.alpha;
2696 end;
2697 end;
2698
2699 if FCentralWidget <> nil then
2700 begin
2701 FCentralWidget^.set_events(GDK_DEFAULT_EVENTS_MASK);
2702 g_signal_connect_data(FCentralWidget, 'event', TGCallback(@Gtk3WidgetEvent), Self, nil, 0);
2703 for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do
2704 begin
2705 FCentralWidget^.get_style_context^.get_background_color(i, @ARgba);
2706 with FCentralWidgetRGBA[i] do
2707 begin
2708 R := ARgba.red;
2709 G := ARgba.green;
2710 B := ARgba.blue;
2711 Alpha := ARgba.alpha;
2712 end;
2713 end;
2714 end else
2715 begin
2716 for i := GTK_STATE_NORMAL to GTK_STATE_INSENSITIVE do
2717 FCentralWidgetRGBA[i] := FWidgetRGBA[i];
2718 end;
2719 g_signal_connect_data(GetContainerWidget,'draw', TGCallback(@Gtk3DrawWidget), Self, nil, 0);
2720 g_signal_connect_data(GetContainerWidget,'scroll-event', TGCallback(@Gtk3ScrollEvent), Self, nil, 0);
2721
2722 // must hide all by default
2723 FWidget^.hide;
2724
2725 g_signal_connect_data(FWidget,'hide', TGCallback(@Gtk3WidgetHide), Self, nil, 0);
2726 g_signal_connect_data(FWidget,'show', TGCallback(@Gtk3WidgetShow), Self, nil, 0);
2727 g_signal_connect_data(FWidget,'map', TGCallback(@Gtk3MapWidget), Self, nil, 0);
2728 g_signal_connect_data(FWidget,'size-allocate',TGCallback(@Gtk3SizeAllocate), Self, nil, 0);
2729 // g_signal_connect_data(FWidget, 'motion_notify_event', TGCallback(@Gtk3MotionNotifyEvent), LCLObject, nil, 0);
2730 end;
2731
2732
2733 procedure TGtk3Widget.UpdateWidgetConstraints;
2734 var mh,nh,mw,nw:gint;
2735 begin
2736 // some GTK3 widgets my report unacceptible for LCL values
2737 // i.e. GtkEntry have 152px minimal and natural width
2738 // this has to be handled in specific classes
2739 fWidget^.get_preferred_height(@mh,@nh);
2740 fWidget^.get_preferred_width(@mw,@nw);
2741
2742 if mh>LCLObject.Constraints.MinHeight then
2743 LCLObject.Constraints.MinHeight:=mh;
2744 if mw>LCLObject.Constraints.MinWidth then
2745 LCLObject.Constraints.MinWidth:=mw;
2746 end;
2747
2748 procedure TGtk3Widget.DeInitializeWidget;
2749 begin
2750
2751 end;
2752
2753 procedure TGtk3Widget.RecreateWidget;
2754 begin
2755
2756 end;
2757
2758 procedure TGtk3Widget.DestroyNotify(AWidget: PGtkWidget);
2759 begin
2760
2761 end;
2762
2763 destructor TGtk3Widget.Destroy;
2764 begin
2765 DestroyWidget;
2766 inherited Destroy;
2767 end;
2768
CanFocusnull2769 function TGtk3Widget.CanFocus: Boolean;
2770 begin
2771 Result := False;
2772 if IsWidgetOK then
2773 Result := FWidget^.can_focus or GetContainerWidget^.can_focus;
2774 end;
2775
GetFocusableByMousenull2776 function TGtk3Widget.GetFocusableByMouse: Boolean;
2777 begin
2778 Result := FFocusableByMouse;
2779 end;
2780
getClientOffsetnull2781 function TGtk3Widget.getClientOffset: TPoint;
2782 var
2783 Allocation: TGtkAllocation;
2784 R: TRect;
2785 begin
2786 {offset between inner and outer rect of widget.
2787 It tricky since some widgets have regular offset eg
2788 Parent (FWidget) = (120,80) Child (FCentralWidget) = (2,2)
2789 but some are
2790 Parent (FWidget) = (120,80) Child (FCentralWidget) = (122,82).
2791 Such widgets are usually those with FCentralWidget^.get_has_window}
2792 Result := Point(0, 0);
2793 if Widget <> getContainerWidget then
2794 begin
2795 GetContainerWidget^.get_allocation(@Allocation);
2796 Result.X := Allocation.X;
2797 Result.Y := Allocation.Y;
2798 end else
2799 exit;
2800 R := getClientBounds;
2801 Result := Point(Result.x + R.Left, Result.y + R.Top);
2802 end;
2803
getWidgetPosnull2804 function TGtk3Widget.getWidgetPos: TPoint;
2805 var
2806 Allocation: TGtkAllocation;
2807 begin
2808 Result := Point(0, 0);
2809 if IsWidgetOk then
2810 begin
2811 FWidget^.get_allocation(@Allocation);
2812 Result := Point(Allocation.X, Allocation.Y);
2813 end;
2814 end;
2815
2816 procedure TGtk3Widget.OffsetMousePos(APoint: PPoint);
2817 begin
2818 with getClientOffset do
2819 begin
2820 dec(APoint^.x, x);
2821 dec(APoint^.y, y);
2822 end;
2823 end;
2824
TGtk3Widget.ClientToScreennull2825 function TGtk3Widget.ClientToScreen(var P: TPoint): boolean;
2826 var
2827 TempAlloc: TGtkAllocation;
2828 Pt: TPoint;
2829 w,tw:PgtkWidget;
2830 x,y:integer;
2831 gw:PgdkWindow;
2832 begin
2833 Result := False;
2834 Pt := Point(0, 0);
2835
2836 if not IsWidgetOk then
2837 begin
2838 DebugLn('TGtk3Widget.ClientToScreen invalid widget ...');
2839 exit;
2840 end;
2841
2842 { most usable source
2843 https://stackoverflow.com/questions/2088962/how-do-you-find-the-absolute-position-of-a-gtk-widget-in-a-window
2844 }
2845
2846 w:=fWidget;
2847 tw:=w^.get_toplevel;
2848 gw:=tw^.window;
2849 while Assigned(w) {and (w<>tw)} do
2850 begin
2851 w^.get_allocation(@TempAlloc);
2852 pt.X:=pt.X+TempAlloc.X;
2853 pt.Y:=pt.Y+TempAlloc.Y;
2854 w:=w^.parent;
2855 end;
2856
2857 gw^.get_origin(@x,@y);
2858 pt.x+=x;
2859 pt.y+=y;
2860 p:=pt;
2861 Result:=true;
2862
2863 end;
2864
TGtk3Widget.ScreenToClientnull2865 function TGtk3Widget.ScreenToClient(var P: TPoint): Integer;
2866 var
2867 AGtkWidget: PGtkWidget;
2868 AWindow: PGdkWindow;
2869 X,Y: Integer;
2870 Allocation: TGtkAllocation;
2871 begin
2872 Result:=-1;
2873 AGtkWidget := GetContainerWidget;
2874 if Assigned(AGtkWidget) and Gtk3IsGdkWindow(AGtkWidget^.window) then
2875 begin
2876 AWindow := AGtkWidget^.window;
2877 PGdkWindow(AWindow)^.get_origin(@X, @Y);
2878 AGtkWidget^.get_allocation(@Allocation);
2879 if not AGtkWidget^.get_has_window and (AGtkWidget^.get_parent <> nil) then
2880 begin
2881 AGtkWidget^.get_allocation(@Allocation);
2882 P.X := P.X - X - Allocation.x;
2883 P.Y := P.Y - Y - Allocation.y;
2884 exit;
2885 end;
2886 end else
2887 if Gtk3IsGdkWindow(fWidget^.window) then
2888 begin
2889 AWindow := fWidget^.window;
2890 PGdkWindow(AWindow)^.get_origin(@X, @Y);
2891 end else
2892 begin
2893 fWidget^.get_allocation(@Allocation);
2894 P.X := P.X - X - Allocation.x;
2895 P.Y := P.Y - Y - Allocation.y;
2896 exit;
2897 end;
2898 dec(P.X, X);
2899 dec(P.Y, Y);
2900 end;
2901
TGtk3Widget.DeliverMessagenull2902 function TGtk3Widget.DeliverMessage(var Msg; const AIsInputEvent: Boolean
2903 ): LRESULT;
2904 begin
2905 Result := LRESULT(AIsInputEvent);
2906 if LCLObject = nil then
2907 Exit;
2908 try
2909 if LCLObject.HandleAllocated then
2910 begin
2911 LCLObject.WindowProc(TLMessage(Msg));
2912 Result := TLMessage(Msg).Result;
2913 end;
2914 except
2915 Application.HandleException(nil);
2916 end;
2917 end;
2918
getClientRectnull2919 function TGtk3Widget.getClientRect: TRect;
2920 var
2921 AAlloc: TGtkAllocation;
2922 begin
2923 //writeln('GetClientRect ',LCLObject.Name,':',LCLObject.Name);
2924 Result := LCLObject.BoundsRect;
2925 if not IsWidgetOK then
2926 exit;
2927 if GetContainerWidget^.get_realized then
2928 begin
2929 GetContainerWidget^.get_allocation(@AAlloc);
2930 Result := Rect(AAlloc.x, AAlloc.y, AAlloc.width + AAlloc.x,AAlloc.height + AAlloc.y);
2931 end else
2932 if FWidget^.get_realized then
2933 begin
2934 FWidget^.get_allocation(@AAlloc);
2935 Result := Rect(AAlloc.x, AAlloc.y, AAlloc.width + AAlloc.x,AAlloc.height + AAlloc.y);
2936 end;
2937 OffsetRect(Result, -Result.Left, -Result.Top);
2938 end;
2939
getClientBoundsnull2940 function TGtk3Widget.getClientBounds: TRect;
2941 var
2942 AAlloc: TGtkAllocation;
2943 begin
2944 Result := Rect(0, 0, 0, 0);
2945 if IsWidgetOk then
2946 begin
2947 if FWidget^.get_realized then
2948 begin
2949 FWidget^.get_allocation(@AAlloc);
2950 Result := Rect(AAlloc.x, AAlloc.y, AAlloc.width + AAlloc.x,AAlloc.height + AAlloc.y);
2951 end else
2952 if GetContainerWidget^.get_realized then
2953 begin
2954 GetContainerWidget^.get_allocation(@AAlloc);
2955 Result := Rect(AAlloc.x, AAlloc.y, AAlloc.width + AAlloc.x,AAlloc.height + AAlloc.y);
2956 end;
2957 end;
2958 end;
2959
2960 procedure TGtk3Widget.SetBounds(ALeft,ATop,AWidth,AHeight:integer);
2961 var
2962 ARect: TGdkRectangle;
2963 Alloc: TGtkAllocation;
2964 AMinSize, ANaturalSize: gint;
2965 begin
2966 if (Widget=nil) then
2967 exit;
2968
2969 if Self is TGtk3Button then
2970 begin
2971 dec(AWidth,4);
2972 dec(AHeight,4);
2973 end;
2974
2975 ARect.x := ALeft;
2976 ARect.y := ATop;
2977 ARect.width := AWidth;
2978 ARect.Height := AHeight;
2979 with Alloc do
2980 begin
2981 x := ALeft;
2982 y := ATop;
2983 width := AWidth;
2984 height := AHeight;
2985 end;
2986 BeginUpdate;
2987 try
2988 {fixes gtk3 assertion}
2989 Widget^.get_preferred_width(@AMinSize, @ANaturalSize);
2990 Widget^.get_preferred_height(@AMinSize, @ANaturalSize);
2991
2992
2993 Widget^.set_size_request(AWidth,AHeight);
2994
2995 Widget^.size_allocate(@ARect);
2996 Widget^.set_allocation(@Alloc);
2997 if LCLObject.Parent <> nil then
2998 move(ALeft, ATop);
2999 // we must trigger get_preferred_width after changing size
3000 {if wtProgressBar in WidgetType then
3001 getContainerWidget^.set_size_request(AWidth, AHeight);}
3002 finally
3003 EndUpdate;
3004 end;
3005 end;
3006
3007 procedure TGtk3Widget.SetLclFont(const AFont:TFont);
3008 var
3009 AGtkFont: PPangoFontDescription;
3010 APangoStyle: TPangoStyle;
3011 begin
3012 if not IsWidgetOk then exit;
3013 if IsFontNameDefault(AFont.Name) then
3014 begin
3015 AGtkFont := Self.Font;
3016 end else
3017 begin
3018 AGtkFont := pango_font_description_from_string(PgChar(AFont.Name));
3019 AGtkFont^.set_family(PgChar(AFont.Name));
3020 end;
3021
3022 if AFont.Size <> 0 then
3023 AGtkFont^.set_size(Abs(AFont.Size) * PANGO_SCALE);
3024
3025 if fsItalic in AFont.Style then
3026 APangoStyle := PANGO_STYLE_ITALIC
3027 else
3028 APangoStyle := PANGO_STYLE_NORMAL;
3029 AGtkFont^.set_style(APangoStyle);
3030 if fsBold in AFont.Style then
3031 AGtkFont^.set_weight(PANGO_WEIGHT_BOLD);
3032 Font := AGtkFont;
3033 FontColor := AFont.Color;
3034 end;
3035
GetContainerWidgetnull3036 function TGtk3Widget.GetContainerWidget: PGtkWidget;
3037 begin
3038 if Assigned(FCentralWidget) then
3039 Result := FCentralWidget
3040 else
3041 Result := FWidget;
3042 end;
3043
TGtk3Widget.GetPositionnull3044 function TGtk3Widget.GetPosition(out APoint: TPoint): Boolean;
3045 var
3046 GdkWindow: PGdkWindow;
3047 GtkLeft, GtkTop: GInt;
3048 Alloc:TGtkAllocation;
3049 prnt:TGtk3Widget;
3050 wtype:TGType;
3051 begin
3052 fWidget^.get_allocation(@Alloc);
3053 if (alloc.X=-1) and (alloc.Y=-1) and (alloc.height=1) and (alloc.width=1) then
3054 // default allocation
3055 else
3056 begin
3057 APoint.X:=alloc.X;
3058 APoint.Y:=alloc.Y;
3059 end;
3060
3061 prnt:=self.GetParent; // TGtk3Widget
3062 if (prnt<>nil) then
3063 begin
3064 wtype:=prnt.getType; // parent widget type
3065 if (wtype<>gtk_fixed_get_type()) and
3066 (wtype<>gtk_layout_get_type()) then
3067 begin
3068 // widget is not on a normal client area. e.g. TPage
3069 Apoint.X:=0;
3070 APoint.Y:=0;
3071 Result:=true;
3072 end
3073 else
3074 if (wtype=gtk_fixed_get_type()) and
3075 prnt.Widget^.get_has_window then
3076 begin
3077 // widget on a fixed, but fixed w/o window
3078 prnt.Widget^.get_allocation(@alloc);
3079 Dec(Apoint.X, alloc.x);
3080 Dec(APoint.Y, alloc.y);
3081 Result:=true;
3082 end;
3083 end;
3084
3085 if (self.getType=gtk_window_get_type()) then
3086 begin
3087 GdkWindow:=Self.Widget^.window;
3088 if (GdkWindow<>nil) and (Self.FWidget^.get_mapped) then
3089 begin
3090 // window is mapped = window manager has put the window somewhere
3091 gdk_window_get_root_origin(GdkWindow, @GtkLeft, @GtkTop);
3092 APoint.X := GtkLeft;
3093 APoint.Y := GtkTop;
3094 Result:=true;
3095 end else
3096 begin
3097 // the gtk has not yet put the window to the final position
3098 // => the gtk/gdk position is not reliable
3099 // => use the LCL coords
3100 Apoint.X:=LCLObject.Left;
3101 Apoint.Y:=LCLObject.Top;
3102 Result:=true;
3103 end;
3104 //DebugLn(['TGtk3WidgetSet.GetWindowRelativePosition ',GetWidgetDebugReport(aWidget),' Left=',Left,' Top=',Top,' GdkWindow=',GdkWindow<>nil]);
3105 end;
3106 //DebugLn(['TGtk3WidgetSet.GetWindowRelativePosition ',GetWidgetDebugReport(aWidget),' Left=',Left,' Top=',Top]);
3107 end;
3108
3109 procedure TGtk3Widget.Release;
3110 begin
3111 LCLObject := nil;
3112 Free;
3113 end;
3114
3115 procedure TGtk3Widget.Hide;
3116 begin
3117 if Assigned(FWidget) then
3118 FWidget^.hide;
3119 end;
3120
TGtk3Widget.getParentnull3121 function TGtk3Widget.getParent: TGtk3Widget;
3122 begin
3123 Result := Gtk3WidgetFromGtkWidget(Widget^.get_parent);
3124 end;
3125
GetWindownull3126 function TGtk3Widget.GetWindow: PGdkWindow;
3127 begin
3128 Result := FWidget^.window;
3129 end;
3130
3131 procedure TGtk3Widget.Move(ALeft, ATop: Integer);
3132 var
3133 AParent: TGtk3Widget;
3134 begin
3135 AParent := getParent;
3136 if (AParent <> nil) then
3137 begin
3138 if (wtContainer in AParent.WidgetType) then
3139 PGtkFixed(AParent.GetContainerWidget)^.move(FWidget, ALeft, ATop)
3140 else
3141 if (wtLayout in AParent.WidgetType) then
3142 PGtkLayout(AParent.GetContainerWidget)^.move(FWidget, ALeft, ATop);
3143 end;
3144 end;
3145
3146 procedure TGtk3Widget.Activate;
3147 begin
3148 if IsWidgetOK then
3149 begin
3150 if not FWidget^.visible then
3151 exit;
3152 if Gtk3IsGdkWindow(FWidget^.window) then
3153 FWidget^.window^.raise_
3154 else
3155 begin
3156 FWidget^.get_parent_window^.raise_;
3157 end;
3158 if FWidget^.can_focus then
3159 FWidget^.grab_focus;
3160 end;
3161 end;
3162
3163 procedure TGtk3Widget.preferredSize(var PreferredWidth,
3164 PreferredHeight: integer; WithThemeSpace: Boolean);
3165 var
3166 AMinH: gint;
3167 AMinW: gint;
3168 begin
3169 if IsWidgetOK then
3170 begin
3171 {$IFDEF GTK3DEBUGPREFERREDSIZE}
3172 Widget^.get_size_request(@AMinW, @AMinH);
3173 DebugLn('>',dbgsName(LCLObject),'.preferredSize W=',dbgs(PreferredWidth),' H=',dbgs(PreferredHeight),' WithThemeSpace ',dbgs(WithThemeSpace),' AMinW=',dbgs(AMinW),' AMinH=',dbgs(AMinH));
3174 {$ENDIF}
3175 GetContainerWidget^.get_preferred_height(@AMinH, @PreferredHeight);
3176 GetContainerWidget^.get_preferred_width(@AMinW, @PreferredWidth);
3177 {$IFDEF GTK3DEBUGPREFERREDSIZE}
3178 if WithThemeSpace then
3179 begin
3180 GetContainerWidget^.get_style_context^.get_margin(GTK_STATE_NORMAL, @ABorder);
3181 with ABorder do
3182 DebugLn('BorderSpaces ',Format('L %d T %d R %d B %d',[Left, Top, Right, Bottom]));
3183 GetContainerWidget^.get_style_context^.get_padding(GTK_STATE_NORMAL, @ABorder);
3184 with ABorder do
3185 DebugLn('Padding ',Format('L %d T %d R %d B %d',[Left, Top, Right, Bottom]));
3186 end;
3187 DebugLn('<',dbgsName(LCLObject),'.preferredSize W=',dbgs(PreferredWidth),' H=',dbgs(PreferredHeight),' WithThemeSpace ',dbgs(WithThemeSpace),' AMinH=',dbgs(AMinH),' AMinW=',dbgs(AMinW));
3188 {$ENDIF}
3189 end;
3190 end;
3191
3192 procedure TGtk3Widget.SetCursor(ACursor: HCURSOR);
3193 begin
3194 if IsWidgetOk then
3195 begin
3196 if GetContainerWidget^.get_has_window and Gtk3IsGdkWindow(GetContainerWidget^.window) then
3197 SetWindowCursor(GetContainerWidget^.window, ACursor, False, True)
3198 else
3199 if Widget^.get_has_window and Gtk3IsGdkWindow(Widget^.window) then
3200 SetWindowCursor(Widget^.window, ACursor, False, True);
3201 end;
3202 end;
3203
3204 procedure TGtk3Widget.SetFocus;
3205 begin
3206 if GetContainerWidget^.can_focus then
3207 GetContainerWidget^.grab_focus
3208 else
3209 if FWidget^.can_focus then
3210 FWidget^.grab_focus;
3211 end;
3212
3213 procedure TGtk3Widget.SetParent(AParent: TGtk3Widget; const ALeft, ATop: Integer
3214 );
3215 begin
3216 if FWidget=nil then exit;;
3217 if wtLayout in AParent.WidgetType then
3218 PGtkLayout(AParent.GetContainerWidget)^.put(FWidget, ALeft, ATop)
3219 else
3220 if wtContainer in AParent.WidgetType then
3221 PGtkFixed(AParent.GetContainerWidget)^.put(FWidget, ALeft, ATop)
3222 else
3223 if wtNotebook in AParent.WidgetType then
3224 // do nothing !
3225 else
3226 FWidget^.set_parent(AParent.GetContainerWidget);
3227 end;
3228
3229 procedure TGtk3Widget.Show;
3230 begin
3231 if IsValidHandle then
3232 begin
3233 FWidget^.show;
3234 end;
3235 end;
3236
3237 procedure TGtk3Widget.ShowAll;
3238 begin
3239 if IsValidHandle then
3240 FWidget^.show_all;
3241 end;
3242
3243 procedure TGtk3Widget.Update(ARect: PRect);
3244 begin
3245 if IsWidgetOK then
3246 begin
3247 if ARect <> nil then
3248 begin
3249 with ARect^ do
3250 FWidget^.queue_draw_area(Left, Top, Right - Left, Bottom - Top);
3251 if FWidget <> GetContainerWidget then
3252 with ARect^ do
3253 GetContainerWidget^.queue_draw_area(Left, Top, Right - Left, Bottom - Top);
3254 end else
3255 begin
3256 FWidget^.queue_draw;
3257 if FWidget <> GetContainerWidget then
3258 GetContainerWidget^.queue_draw;
3259 end;
3260 end;
3261 end;
3262
3263 { TGtk3StatusBar }
3264
CreateWidgetnull3265 function TGtk3StatusBar.CreateWidget(const Params: TCreateParams): PGtkWidget;
3266 begin
3267 Result := TGtkEventBox.new;
3268 FCentralWidget := TGtkHBox.new(GTK_ORIENTATION_HORIZONTAL, 1);
3269 PGtkBox(FCentralWidget)^.set_homogeneous(True);
3270 PGtkEventBox(Result)^.add(FCentralWidget);
3271 //TODO: add routines to set panels
3272 end;
3273
3274 { TGtk3Panel }
3275
3276 procedure TGtk3Panel.SetColor(AValue: TColor);
3277 var
3278 AGdkRGBA: TGdkRGBA;
3279 //AColor: TGdkColor;
3280 begin
3281 inherited SetColor(AValue);
3282 exit;
3283 if (AValue = clDefault) or (AValue = clBackground) then
3284 begin
3285 // this is just to test if we can get transparent panel again
3286 // clDefault must be extracted from style
3287
3288 // nil resets color to gtk default
3289 FWidget^.override_background_color(GTK_STATE_FLAG_NORMAL, nil);
3290 StyleContext^.get_background_color(GTK_STATE_FLAG_NORMAL, @AGdkRGBA);
3291
3292 // writeln('ACOLOR R=',AColor.Red,' G=',AColor.green,' B=',AColor.blue);
3293 // AColor := TColorToTGDKColor(AValue);
3294 {AGdkRGBA.alpha := 0;
3295 AGdkRGBA.red := AColor.red / 65535.00;
3296 AGdkRGBA.blue := AColor.blue / 65535.00;
3297 AGdkRGBA.green := AColor.red / 65535.00;}
3298 FWidget^.override_background_color(GTK_STATE_FLAG_NORMAL, @AGdkRGBA);
3299 FWidget^.override_background_color(GTK_STATE_FLAG_ACTIVE, @AGdkRGBA);
3300 FWidget^.override_background_color(GTK_STATE_FLAG_FOCUSED, @AGdkRGBA);
3301 FWidget^.override_background_color(GTK_STATE_FLAG_PRELIGHT, @AGdkRGBA);
3302 FWidget^.override_background_color(GTK_STATE_FLAG_SELECTED, @AGdkRGBA);
3303 end else
3304 begin
3305 //AColor := TColorToTGDKColor(AValue);
3306 // writeln('ACOLOR R=',AColor.Red,' G=',AColor.green,' B=',AColor.blue);
3307 //inherited SetColor(AValue);
3308 end;
3309 end;
3310
CreateWidgetnull3311 function TGtk3Panel.CreateWidget(const Params: TCreateParams): PGtkWidget;
3312 var
3313 AGdkRGBA: TGdkRGBA;
3314 begin
3315 FHasPaint := True;
3316 FBorderStyle := bsNone;
3317
3318 // wtLayout = using GtkLayout
3319 // FWidgetType := [wtWidget, wtLayout];
3320 // Result := TGtkLayout.new(nil, nil);
3321
3322 FWidgetType := [wtWidget, wtContainer];
3323 Result := TGtkFixed.new();
3324 Result^.set_has_window(True);
3325 // as GtkFixed have no child control here - nobody triggers resizing
3326 // GNOME takes care of it, but other WM - not
3327 // this is here to make TGtk3Panel shown under Plasma
3328 Result^.set_size_request(LCLObject.Width,LCLObject.Height);
3329
3330 // AColor := Result^.style^.bg[0];
3331 // writeln('BG COLOR R=',AColor.red,' G=',AColor.green,' B=',AColor.blue);
3332 // now we make panel completely transparent.
3333 // SetColor must usr override_background_color for panel
3334 // we must implement cairo_pattern_t since background can be brush
3335 AGdkRGBA.alpha := 0;
3336 AGdkRGBA.red := 0; // AColor.Red / 65535.00;
3337 AGdkRGBA.blue := 0; // AColor.Blue / 65535.00;
3338 AGdkRGBA.green := 0; // AColor.green / 65535.00;
3339 Result^.override_background_color(GTK_STATE_FLAG_NORMAL, @AGdkRGBA);
3340 Result^.override_background_color(GTK_STATE_FLAG_ACTIVE, @AGdkRGBA);
3341 Result^.override_background_color(GTK_STATE_FLAG_FOCUSED, @AGdkRGBA);
3342 Result^.override_background_color(GTK_STATE_FLAG_PRELIGHT, @AGdkRGBA);
3343 Result^.override_background_color(GTK_STATE_FLAG_SELECTED, @AGdkRGBA);
3344 end;
3345
3346 procedure TGtk3Panel.DoBeforeLCLPaint;
3347 var
3348 DC: TGtk3DeviceContext;
3349 NColor: TColor;
3350 begin
3351 inherited DoBeforeLCLPaint;
3352 if not Visible then
3353 exit;
3354
3355 DC := TGtk3DeviceContext(FContext);
3356
3357 NColor := LCLObject.Color;
3358 if (NColor <> clNone) and (NColor <> clDefault) then
3359 begin
3360 DC.CurrentBrush.Color := ColorToRGB(NColor);
3361 DC.fillRect(0, 0, LCLObject.Width, LCLObject.Height);
3362 end;
3363
3364 if BorderStyle <> bsNone then
3365 begin
3366 DC.CurrentPen.Color := ColorToRGB(clBtnShadow); // not sure what color to use here?
3367 DC.drawRect(0, 0, LCLObject.Width, LCLObject.Height, False, True);
3368 end;
3369 end;
3370
3371 procedure TGtk3Panel.setText(const AValue: String);
3372 begin
3373 if FText = AValue then
3374 exit;
3375 FText := AValue;
3376 if Self.Visible then
3377 FWidget^.queue_draw;
3378 end;
3379
3380 { TGtk3GroupBox }
3381
TGtk3GroupBox.CreateWidgetnull3382 function TGtk3GroupBox.CreateWidget(const Params: TCreateParams): PGtkWidget;
3383 begin
3384 FHasPaint := True;
3385 //dont use layout for now
3386 FWidgetType := [wtWidget, wtContainer, wtGroupBox];
3387 Result := TGtkFrame.new(PChar(Self.LCLObject.Caption));
3388 //FCentralWidget := TGtkLayout.new(nil,nil);
3389 FCentralWidget := TGtkFixed.new;
3390 PGtkBin(Result)^.add(FCentralWidget);
3391 FCentralWidget^.set_has_window(True);
3392 PgtkFrame(result)^.set_label_align(0.1,0.5);
3393 end;
3394
getTextnull3395 function TGtk3GroupBox.getText: String;
3396 begin
3397 Result := '';
3398 if IsWidgetOK then
3399 begin
3400 if PGtkFrame(Widget)^.get_label_widget = nil then
3401 exit;
3402 Result := PGtkFrame(Widget)^.get_label;
3403 end;
3404 end;
3405
3406 procedure TGtk3GroupBox.setText(const AValue: String);
3407 begin
3408 if IsWidgetOK then
3409 begin
3410 if AValue = '' then
3411 PGtkFrame(Widget)^.set_label_widget(nil)
3412 // maybe DoAdjustClientRect here
3413 else
3414 begin
3415 if PGtkFrame(Widget)^.get_label_widget = nil then
3416 PGtkFrame(Widget)^.set_label_widget(TGtkLabel.new(''));
3417 PGtkFrame(Widget)^.set_label(PgChar(AValue));
3418 end;
3419 end;
3420 end;
3421
3422
3423 { TGtk3Editable }
3424
gtk3EditableDelayedSelStartnull3425 function gtk3EditableDelayedSelStart(AData: Pointer): gboolean; cdecl;
3426 var
3427 AWidget: PGtkEditable;
3428 AEditable: TGtk3Editable;
3429 begin
3430 Result := False;
3431 AEditable := TGtk3Editable(AData);
3432 AWidget := PGtkEditable(TGtk3Widget(AData).Widget);
3433 if (AEditable.PrivateCursorPos <> -1) and (AEditable.PrivateSelection <> -1) then
3434 begin
3435 gtk_editable_select_region(AWidget,AEditable.PrivateCursorPos, AEditable.PrivateSelection);
3436 // gtk_editable_set_position(AWidget, TGtk3Editable(AData).PrivateCursorPos);
3437 end;
3438 AEditable.PrivateCursorPos := -1;
3439 AEditable.PrivateSelection := -1;
3440 g_idle_remove_by_data(AData);
3441 end;
3442
GetReadOnlynull3443 function TGtk3Editable.GetReadOnly: Boolean;
3444 begin
3445 Result := False;
3446 if IsWidgetOK then
3447 Result := not PGtkEditable(FWidget)^.get_editable;
3448 end;
3449
3450 procedure TGtk3Editable.SetReadOnly(AValue: Boolean);
3451 begin
3452 if IsWidgetOK then
3453 PGtkEditable(FWidget)^.set_editable(not AValue);
3454 end;
3455
TGtk3Editable.getCaretPosnull3456 function TGtk3Editable.getCaretPos: TPoint;
3457 begin
3458 Result := Point(0, 0);
3459 if not IsWidgetOk then
3460 exit;
3461 Result.X := PGtkEditable(FWidget)^.get_position;
3462 end;
3463
3464 procedure TGtk3Editable.SetCaretPos(AValue: TPoint);
3465 begin
3466 if not IsWidgetOk then
3467 exit;
3468 PGtkEditable(FWidget)^.set_position(AValue.X);
3469 end;
3470
getSelStartnull3471 function TGtk3Editable.getSelStart: Integer;
3472 var
3473 AStart: gint;
3474 AStop: gint;
3475 begin
3476 Result := 0;
3477 if not IsWidgetOk then
3478 exit;
3479 if PGtkEditable(FWidget)^.get_selection_bounds(@AStart, @AStop) then
3480 begin
3481 Result := AStart;
3482 end;
3483 end;
3484
TGtk3Editable.getSelLengthnull3485 function TGtk3Editable.getSelLength: Integer;
3486 var
3487 AStart: gint;
3488 AStop: gint;
3489 begin
3490 Result := 0;
3491 if not IsWidgetOk then
3492 exit;
3493 if PGtkEditable(FWidget)^.get_selection_bounds(@AStart, @AStop) then
3494 begin
3495 Result := AStop - AStart;
3496 end;
3497 end;
3498
3499 procedure TGtk3Editable.setSelStart(AValue: Integer);
3500 begin
3501 if not IsWidgetOk then
3502 exit;
3503 CaretPos := Point(AValue, 0);
3504 (*
3505 if InUpdate then
3506 begin
3507 PrivateCursorPos := AValue;
3508 CaretPos := Point(AValue, 0);
3509 // setDelayed when mouse events are finished.
3510 // This is needed to SetSelStart/SetSelLength inside changed event of text edit
3511 // g_idle_add(@gtk3EditableDelayedSelStart, Self);
3512 end else
3513 CaretPos := Point(AValue, 0);
3514 *)
3515 // DebugLn('TGtk3Editable.SetSelStart ',dbgsName(LCLObject),' value=',dbgs(AValue));
3516 (*
3517 PGtkEditable(FWidget)^.get_selection_bounds(@AStart, @AStop);
3518 if AStop < AValue then
3519 AStop := AValue;
3520 PGtkEditable(FWidget)^.select_region(AValue, AStop);
3521 *)
3522 end;
3523
3524 procedure TGtk3Editable.setSelLength(AValue: Integer);
3525 var
3526 AStart: gint;
3527 AStop: gint;
3528 begin
3529 if not IsWidgetOk then
3530 exit;
3531 PGtkEditable(FWidget)^.get_selection_bounds(@AStart, @AStop);
3532 AStart := CaretPos.X;
3533 // DebugLn('TGtk3Editable.SetSelLength ',dbgsName(LCLObject),' value=',dbgs(AValue),' AStart=',dbgs(AStart),' InUpdate ',dbgs(InUpdate));
3534 if InUpdate then
3535 begin
3536 PrivateCursorPos := AStart;
3537 PrivateSelection := AValue;
3538 // g_idle_add(@gtk3EditableDelayedSelStart, Self)
3539 // setDelayed later
3540 PGtkEditable(FWidget)^.select_region(AStart, AStart + AValue)
3541 end else
3542 PGtkEditable(FWidget)^.select_region(AStart, AStart + AValue);
3543 end;
3544
3545 { TGtk3Entry }
3546
3547 procedure Gtk3EntryDeletedText({%H-}AEntry: PGtkEntryBuffer; {%H-}APosition: guint; {%H-}ANumChars: guint; AData: GPointer); cdecl;
3548 var
3549 Msg: TLMessage;
3550 begin
3551 FillChar(Msg{%H-}, SizeOf(Msg), 0);
3552 Msg.Msg := CM_TEXTCHANGED;
3553 TGtk3Widget(AData).DeliverMessage(Msg);
3554 end;
3555
3556 procedure Gtk3EntryInsertedText({%H-}AEntry: PGtkEntryBuffer; {%H-}APosition: guint; {%H-}AChars: PGChar; {%H-}ANumChars: guint; AData: GPointer); cdecl;
3557 var
3558 Msg: TLMessage;
3559 begin
3560 FillChar(Msg{%H-}, SizeOf(Msg), 0);
3561 Msg.Msg := CM_TEXTCHANGED;
3562 TGtk3Widget(AData).DeliverMessage(Msg);
3563 end;
3564
3565 procedure Gtk3EntryChanged({%H-}AEntry: PGtkEntryBuffer; AData: GPointer); cdecl;
3566 var
3567 Msg: TLMessage;
3568 begin
3569 FillChar(Msg{%H-}, SizeOf(Msg), 0);
3570 Msg.Msg := CM_TEXTCHANGED;
3571 TGtk3Widget(AData).DeliverMessage(Msg);
3572 end;
3573
GetAlignmentnull3574 function TGtk3Entry.GetAlignment: TAlignment;
3575 var
3576 AFloat: GFloat;
3577 begin
3578 Result := taLeftJustify;
3579 if not IsWidgetOk then
3580 exit;
3581 AFloat := PGtkEntry(FWidget)^.get_alignment;
3582 if AFloat = 1 then
3583 Result := taRightJustify
3584 else
3585 if AFloat = 0.5 then
3586 Result := taCenter;
3587 end;
3588
3589 procedure TGtk3Entry.SetAlignment(AValue: TAlignment);
3590 var
3591 AFloat: GFloat;
3592 begin
3593 AFloat := 0;
3594 if not IsWidgetOk then
3595 exit;
3596 case AValue of
3597 taCenter: AFloat := 0.5;
3598 taRightJustify: AFloat := 1.0;
3599 end;
3600 PGtkEntry(FWidget)^.set_alignment(AFloat);
3601 end;
3602
EatArrowKeysnull3603 function TGtk3Entry.EatArrowKeys(const AKey: Word): Boolean;
3604 begin
3605 Result := AKey in [VK_UP, VK_DOWN];
3606 end;
3607
3608 procedure TGtk3Entry.InsertText(const atext:pchar;len:gint;var pos:gint;edt:TGtk3Entry);cdecl;
3609 var
3610 i:integer;
3611 begin
3612 if TCustomEdit(edt.LCLObject).NumbersOnly then
3613 begin
3614 for i := 0 to len-1 do
3615 begin
3616 if not (atext[i] in ['0'..'9']) then
3617 begin
3618 g_signal_stop_emission_by_name(Self, 'insert-text');
3619 exit;
3620 end;
3621 end;
3622 end;
3623 end;
3624
getTextnull3625 function TGtk3Entry.getText: String;
3626 begin
3627 if IsValidHandle and IsWidgetOk then
3628 Result := StrPas(PGtkEntry(Widget)^.get_text)
3629 else
3630 Result := '';
3631 end;
3632
3633 procedure TGtk3Entry.setText(const AValue: String);
3634 begin
3635 if IsValidHandle and IsWidgetOK then
3636 PGtkEntry(Widget)^.set_text(PgChar(AValue));
3637 end;
3638
TGtk3Entry.CreateWidgetnull3639 function TGtk3Entry.CreateWidget(const Params: TCreateParams): PGtkWidget;
3640 begin
3641 Result := PGtkWidget(TGtkEntry.new);
3642 FWidgetType := FWidgetType + [wtEntry];
3643 fText:=Params.Caption;
3644 PrivateCursorPos := -1;
3645 PrivateSelection := -1;
3646 end;
3647
3648 procedure TGtk3Entry.SetBounds(Left, Top, Width, Height: integer);
3649 var val:TGvalue;
3650 begin
3651 val.clear;
3652 val.init(G_TYPE_UINT);
3653 val.set_uint(Width);
3654
3655 inherited SetBounds(Left, Top, Width, Height);
3656 PGtkEntry(FWidget)^.set_property('width-request',@val);
3657 val.unset;
3658 end;
3659
3660 procedure TGtk3Entry.InitializeWidget;
3661 begin
3662 inherited InitializeWidget;
3663
3664 fWidget^.set_size_request(fParams.Width,fParams.Height);
3665 PgtkEntry(fWidget)^.set_text(PgChar(fParams.Caption));
3666
3667 Self.SetTextHint(TCustomEdit(Self.LCLObject).TextHint);
3668 Self.SetNumbersOnly(TCustomEdit(Self.LCLObject).NumbersOnly);
3669
3670 g_signal_connect_data(FWidget, 'changed', TGCallback(@Gtk3EntryChanged), Self, nil, 0);
3671 g_signal_connect_data(FWidget, 'insert-text', TGCallback(@TGtk3Entry.InsertText), Self, nil, 0);
3672
3673 //g_signal_connect_data(PGtkEntry(FWidget)^.get_buffer, 'deleted-text', TGCallback(@Gtk3EntryDeletedText), Self, nil, 0);
3674 //g_signal_connect_data(PGtkEntry(FWidget)^.get_buffer, 'inserted-text', TGCallback(@Gtk3EntryInsertedText), Self, nil, 0);
3675 end;
3676
3677 procedure TGtk3Entry.UpdateWidgetConstraints;
3678 var mh,nh,mw,nw:gint;
3679 begin
3680 // GtkEntry have 152px minimal and natural width
3681 fWidget^.get_preferred_height(@mh,@nh);
3682 fWidget^.get_preferred_width(@mw,@nw);
3683
3684 if mh>LCLObject.Constraints.MinHeight then
3685 LCLObject.Constraints.MinHeight:=mh;
3686
3687 // LCLObject.Constraints.MinWidth:=0;
3688 end;
3689
3690 procedure TGtk3Entry.SetPasswordChar(APasswordChar: Char);
3691 var
3692 PWChar: Integer;
3693 begin
3694 if IsWidgetOK then
3695 begin
3696 PWChar := ord(APasswordChar);
3697 if (PWChar < 192) or (PWChar = ord('*')) then
3698 PWChar := 9679;
3699 PGtkEntry(FWidget)^.set_invisible_char(PWChar);
3700 end;
3701 end;
3702
3703 procedure TGtk3Entry.SetNumbersOnly(ANumbersOnly:boolean);
3704 const
3705 ips:array[boolean]of TGtkInputPurpose=(GTK_INPUT_PURPOSE_FREE_FORM,GTK_INPUT_PURPOSE_NUMBER);
3706 begin
3707 // this is not enough for numeric input - it is just a hint for GUI
3708 if IsWidgetOK then
3709 PGtkEntry(FWidget)^.set_input_purpose(ips[ANumbersOnly]);
3710 end;
3711
3712 procedure TGtk3Entry.SetTextHint(const AHint: string);
3713 begin
3714 if IsWidgetOK and (Ahint<>'') then
3715 PGtkEntry(FWidget)^.set_placeholder_text(PgChar(AHint));
3716 end;
3717
3718 procedure TGtk3Entry.SetFrame(const aborder: boolean);
3719 begin
3720 if IsWidgetOk then
3721 PGtkEntry(FWidget)^.set_has_frame(aborder);
3722 end;
3723
TGtk3Entry.GetTextHintnull3724 function TGtk3Entry.GetTextHint:string;
3725
3726 begin
3727 if IsWidgetOK then
3728 Result:=PGtkEntry(FWidget)^.get_placeholder_text()
3729 else
3730 Result:='';
3731 end;
3732
3733 procedure TGtk3Entry.SetEchoMode(AVisible: Boolean);
3734 begin
3735 if IsWidgetOK then
3736 PGtkEntry(FWidget)^.set_visibility(AVisible);
3737 end;
3738
3739 procedure TGtk3Entry.SetMaxLength(AMaxLength: Integer);
3740 begin
3741 if IsWidgetOK then
3742 begin
3743 PGtkEntry(FWidget)^.set_max_length(AMaxLength);
3744 PGtkEntry(FWidget)^.set_width_chars(AMaxLength);
3745 end;
3746
3747 end;
3748
TGtk3Entry.IsWidgetOknull3749 function TGtk3Entry.IsWidgetOk: Boolean;
3750 begin
3751 Result := (FWidget <> nil) and Gtk3IsEntry(FWidget);
3752 end;
3753
3754 { TGtk3SpinEdit }
3755
GetMaximumnull3756 function TGtk3SpinEdit.GetMaximum: Double;
3757 var
3758 AFloat: gdouble;
3759 begin
3760 Result := 0;
3761 if IsWidgetOk then
3762 PGtkSpinButton(FWidget)^.get_range(@AFloat ,@Result);
3763 end;
3764
TGtk3SpinEdit.GetMinimumnull3765 function TGtk3SpinEdit.GetMinimum: Double;
3766 var
3767 AFloat: gdouble;
3768 begin
3769 Result := 0;
3770 if IsWidgetOk then
3771 PGtkSpinButton(FWidget)^.get_range(@Result ,@AFloat);
3772 end;
3773
TGtk3SpinEdit.GetNumDigitsnull3774 function TGtk3SpinEdit.GetNumDigits: Integer;
3775 begin
3776 Result := 0;
3777 if IsWidgetOk then
3778 Result := Integer(PGtkSpinButton(FWidget)^.get_digits);
3779 end;
3780
TGtk3SpinEdit.GetNumericnull3781 function TGtk3SpinEdit.GetNumeric: Boolean;
3782 begin
3783 Result := False;
3784 if IsWidgetOk then
3785 Result := PGtkSpinButton(FWidget)^.get_numeric;
3786 end;
3787
TGtk3SpinEdit.GetStepnull3788 function TGtk3SpinEdit.GetStep: Double;
3789 var
3790 AFloat: Double;
3791 begin
3792 Result := 0;
3793 if IsWidgetOk then
3794 PGtkSpinButton(FWidget)^.get_increments(@Result, @AFloat);
3795 end;
3796
TGtk3SpinEdit.GetValuenull3797 function TGtk3SpinEdit.GetValue: Double;
3798 begin
3799 Result := 0;
3800 if IsWidgetOk then
3801 Result := PGtkSpinButton(FWidget)^.get_value;
3802 end;
3803
3804 procedure TGtk3SpinEdit.SetNumDigits(AValue: Integer);
3805 begin
3806 if IsWidgetOk then
3807 PGtkSpinButton(FWidget)^.set_digits(GUint(AValue));
3808 end;
3809
3810 procedure TGtk3SpinEdit.SetNumeric(AValue: Boolean);
3811 begin
3812 if IsWidgetOk then
3813 PGtkSpinButton(FWidget)^.set_numeric(AValue);
3814 end;
3815
3816 procedure TGtk3SpinEdit.SetStep(AValue: Double);
3817 var
3818 AStep: gdouble;
3819 APage: gdouble;
3820 begin
3821 if IsWidgetOk then
3822 begin
3823 PGtkSpinButton(FWidget)^.get_increments(@AStep, @APage);
3824 PGtkSpinButton(FWidget)^.set_increments(AValue, APage);
3825 end;
3826 end;
3827
3828 procedure TGtk3SpinEdit.SetValue(AValue: Double);
3829 begin
3830 if IsWidgetOk then
3831 begin
3832 PGtkSpinButton(FWidget)^.set_value(AValue);
3833 end;
3834 end;
3835
CreateWidgetnull3836 function TGtk3SpinEdit.CreateWidget(const Params: TCreateParams): PGtkWidget;
3837 var
3838 ASpin: TCustomSpinEdit;
3839 begin
3840 PrivateCursorPos := -1;
3841 PrivateSelection := -1;
3842 ASpin := TCustomSpinEdit(LCLObject);
3843 FWidgetType := FWidgetType + [wtSpinEdit];
3844 // Adjustment := TGtkAdjustment.new(ASpin.Value, ASpin.MinValue, ASpin.MaxValue, ASpin.Increment,
3845 // ASpin.Increment, ASpin.Increment);
3846 Result := TGtkSpinButton.new_with_range(ASpin.MinValue, ASpin.MaxValue, ASpin.Increment);
3847 end;
3848
EatArrowKeysnull3849 function TGtk3SpinEdit.EatArrowKeys(const AKey: Word): Boolean;
3850 begin
3851 Result := False;
3852 end;
3853
TGtk3SpinEdit.IsWidgetOknull3854 function TGtk3SpinEdit.IsWidgetOk: Boolean;
3855 begin
3856 Result := (FWidget <> nil) and Gtk3IsSpinButton(FWidget);
3857 end;
3858
3859 procedure TGtk3SpinEdit.SetRange(AMin, AMax: Double);
3860 begin
3861 if IsWidgetOk then
3862 PGtkSpinButton(FWidget)^.set_range(AMin, AMax);
3863 end;
3864
3865 { TGtk3Range }
3866
3867 procedure Gtk3RangeChanged({%H-}ARange: PGtkRange; AData: gPointer); cdecl;
3868 var
3869 Msg: TLMessage;
3870 begin
3871 if AData <> nil then
3872 begin
3873 if TGtk3Widget(AData).InUpdate then
3874 Exit;
3875 FillChar(Msg{%H-}, SizeOf(Msg), #0);
3876 Msg.Msg := LM_CHANGED;
3877 TGtk3Widget(AData).DeliverMessage(Msg);
3878 end;
3879 end;
3880
GetPositionnull3881 function TGtk3Range.GetPosition: Integer;
3882 begin
3883 Result := 0;
3884 if IsWidgetOK then
3885 Result := Round(PGtkRange(FWidget)^.get_value);
3886 end;
3887
GetRangenull3888 function TGtk3Range.GetRange: TPoint;
3889 begin
3890 Result := Point(0, 0);
3891 if IsWidgetOK then
3892 PGtkRange(FWidget)^.get_slider_range(@Result.X, @Result.Y);
3893 end;
3894
3895 procedure TGtk3Range.SetPosition(AValue: Integer);
3896 begin
3897 if IsWidgetOK then
3898 PGtkRange(FWidget)^.set_value(gDouble(AValue));
3899 end;
3900
3901 procedure TGtk3Range.SetRange(AValue: TPoint);
3902 var
3903 dx,dy: gdouble;
3904 begin
3905 if IsWidgetOK then
3906 begin
3907 dx := AValue.X;
3908 dy := AValue.Y;
3909 PGtkRange(FWidget)^.set_range(dx, dy);
3910 end;
3911 end;
3912
3913 procedure TGtk3Range.InitializeWidget;
3914 begin
3915 inherited InitializeWidget;
3916 g_signal_connect_data(GetContainerWidget, 'value-changed', TGCallback(@Gtk3RangeChanged), Self, nil, 0);
3917 end;
3918
3919 procedure TGtk3Range.SetStep(AStep: Integer; APageSize: Integer);
3920 begin
3921 if IsWidgetOk then
3922 PGtkRange(FWidget)^.set_increments(gDouble(AStep), gDouble(APageSize));
3923 end;
3924
3925 { TGtk3TrackBar }
3926
GetReversednull3927 function TGtk3TrackBar.GetReversed: Boolean;
3928 begin
3929 Result := False;
3930 if IsWidgetOK then
3931 Result := PGtkScale(FWidget)^.get_inverted;
3932 end;
3933
3934 procedure TGtk3TrackBar.SetReversed(AValue: Boolean);
3935 begin
3936 if IsWidgetOK then
3937 PGtkScale(FWidget)^.set_inverted(AValue);
3938 end;
3939
TGtk3TrackBar.CreateWidgetnull3940 function TGtk3TrackBar.CreateWidget(const Params: TCreateParams): PGtkWidget;
3941 var
3942 ATrack: TCustomTrackBar;
3943 begin
3944 ATrack := TCustomTrackBar(LCLObject);
3945 FWidgetType := FWidgetType + [wtTrackBar];
3946
3947 { Result := TGtkHBox.new(1,0);
3948 fCentralWidget:=PGtkWidget(TGtkScale.new(Ord(ATrack.Orientation), nil));
3949 PgtkBox(Result)^.add(fCentralWidget);}
3950
3951 Result :=PGtkWidget(TGtkScale.new(Ord(ATrack.Orientation), nil));
3952
3953 FOrientation := ATrack.Orientation;
3954 if ATrack.Reversed then
3955 PGtkScale(Result)^.set_inverted(True);
3956 PGtkScale(Result)^.set_digits(0);
3957 end;
3958
3959 procedure TGtk3TrackBar.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
3960 begin
3961 Widget^.set_size_request(AWidth,AHeight);
3962 inherited SetBounds(ALeft, ATop, AWidth, AHeight);
3963 end;
3964
GetTrackBarOrientationnull3965 function TGtk3TrackBar.GetTrackBarOrientation: TTrackBarOrientation;
3966 begin
3967 Result := FOrientation;
3968 end;
3969
3970 procedure TGtk3TrackBar.SetScalePos(AValue: TTrackBarScalePos);
3971 begin
3972 if IsWidgetOK then
3973 PGtkScale(FWidget)^.set_value_pos(TGtkPositionType(AValue));
3974 end;
3975
3976 procedure TGtk3TrackBar.SetTickMarks(AValue: TTickMark; ATickStyle: TTickStyle);
3977 var
3978 i,cnt,fldw: Integer;
3979 Track:TCustomTrackbar;
3980 const
3981 tick_map:array[TTrackBarOrientation,0..1] of TGtkPositionType =
3982 ((GTK_POS_TOP,GTK_POS_BOTTOM), // trHorizontal
3983 (GTK_POS_LEFT,GTK_POS_RIGHT) // trVertical
3984 );
3985 begin
3986 if IsWidgetOK then
3987 begin
3988 PGtkScale(FWidget)^.set_draw_value(ATickStyle <> tsNone);
3989 if ATickStyle = tsNone then
3990 PGtkScale(FWidget)^.clear_marks
3991 else
3992 begin
3993 PGtkScale(FWidget)^.clear_marks;
3994 Track:=TCustomTrackbar(LCLObject);
3995 cnt:=round(abs(Track.max-Track.min)/Track.LineSize);
3996 // highly-dense marks just enlarge GtkScale automatically
3997 // it is up to user concent to do this
3998 if Track.Orientation=trHorizontal then
3999 fldw:=Track.Width
4000 else
4001 fldw:=Track.Height;
4002 if cnt*Track.LineSize<fldw then
4003 for i := Track.Min to Track.Max do
4004 begin
4005 if AValue in [tmBoth, tmTopLeft] then
4006 PGtkScale(FWidget)^.add_mark(gDouble(i), tick_map[Track.Orientation,0], nil);
4007 if AValue in [tmBoth, tmBottomRight] then
4008 PGtkScale(FWidget)^.add_mark(gDouble(i), tick_map[Track.Orientation,1], nil);
4009 end;
4010 end;
4011 end;
4012 end;
4013
4014 { TGtk3ScrollBar }
4015 class procedure TGtk3ScrollBar.value_changed(bar: TGtk3Scrollbar); cdecl;
4016 var
4017 scr:TScrollBar;
4018 pgs:PGtkScrollbar;
4019 ARange: PGtkRange;
4020 begin
4021 scr:=TScrollbar(bar.LCLObject);
4022 pgs:=PGtkScrollbar(bar.FWidget);
4023 arange:=PGtkRange(pgs);
4024 scr.SetParams(
4025 round(arange^.adjustment^.value),
4026 round(arange^.adjustment^.lower),
4027 round(arange^.adjustment^.upper),
4028 round(arange^.adjustment^.page_size));
4029 end;
4030
CreateWidgetnull4031 function TGtk3ScrollBar.CreateWidget(const Params: TCreateParams): PGtkWidget;
4032 var
4033 AScrollbar: TCustomScrollBar;
4034 ARange: PGtkRange;
4035 begin
4036 AScrollBar := TCustomScrollBar(LCLObject);
4037 FWidgetType := FWidgetType + [wtScrollBar];
4038 Result := TGtkScrollbar.new(Ord(AScrollBar.Kind), nil);
4039 ARange := PGtkRange(Result);
4040 // ARange^.set_can_focus(True);
4041 with AScrollBar do
4042 begin
4043 ARange^.adjustment^.configure(Position, Min, Max + PageSize,
4044 SmallChange, LargeChange, PageSize);
4045 ARange^.adjustment^.set_value(Position);
4046 g_signal_connect_data(ARange^.adjustment,
4047 'value-changed', TGCallback(@TGtk3ScrollBar.value_changed), Self, nil, 0);
4048 end;
4049 end;
4050
4051 procedure TGtk3ScrollBar.SetParams;
4052 var
4053 ARange: PGtkRange;
4054 begin
4055 if not IsWidgetOk then
4056 exit;
4057 ARange := PGtkRange(Widget);
4058 with TCustomScrollbar(LCLObject) do
4059 begin
4060 ARange^.adjustment^.configure(Position, Min, Max + PageSize,
4061 SmallChange, LargeChange, PageSize);
4062 ARange^.adjustment^.set_value(Position);
4063 ARange^.adjustment^.changed;
4064 // gtk_adjustment_changed(Range^.adjustment);
4065 end;
4066 end;
4067
4068 { TGtk3Calendar }
4069
TGtk3Calendar.CreateWidgetnull4070 function TGtk3Calendar.CreateWidget(const Params: TCreateParams): PGtkWidget;
4071 begin
4072 FWidgetType := [wtWidget, wtCalendar];
4073 Result := TGtkFrame.new(nil);
4074 FCentralWidget := TGtkCalendar.new;
4075 PGtkContainer(Result)^.add(FCentralWidget);
4076 FCentralWidget^.set_can_focus(True);
4077 end;
4078
4079 procedure TGtk3Calendar.GetDate(out AYear, AMonth, ADay: Word);
4080 begin
4081 AYear := 0;
4082 AMonth := 0;
4083 ADay := 0;
4084 if IsWidgetOk then
4085 PGtkCalendar(GetContainerWidget)^.get_date(@AYear, @AMonth, @ADay);
4086 end;
4087
4088 procedure TGtk3Calendar.SetDate(const AYear, AMonth, ADay: Word);
4089 begin
4090 if IsWidgetOK then
4091 begin
4092 PGtkCalendar(GetContainerWidget)^.select_month(AMonth, AYear);
4093 PGtkCalendar(GetContainerWidget)^.select_day(ADay);
4094 end;
4095 end;
4096
4097 procedure TGtk3Calendar.SetDisplayOptions(
4098 const ADisplayOptions: TGtkCalendarDisplayOptions);
4099 begin
4100 if IsWidgetOK then
4101 PGtkCalendar(GetContainerWidget)^.set_display_options(ADisplayOptions);
4102 end;
4103
4104 { TGtk3StaticText }
4105
TGtk3StaticText.GetAlignmentnull4106 function TGtk3StaticText.GetAlignment: TAlignment;
4107 var
4108 X: gfloat;
4109 Y: gfloat;
4110 begin
4111 Result := taLeftJustify;
4112 if IsWidgetOK then
4113 begin
4114 PGtkLabel(GetContainerWidget)^.get_alignment(@X, @Y);
4115 if X = 1 then
4116 Result := taRightJustify
4117 else
4118 if X = 0.5 then
4119 Result := taCenter;
4120 end;
4121 end;
4122
TGtk3StaticText.GetStaticBorderStylenull4123 function TGtk3StaticText.GetStaticBorderStyle: TStaticBorderStyle;
4124 var
4125 AShadowType: TGtkShadowType;
4126 begin
4127 Result := sbsNone;
4128 if IsWidgetOK then
4129 begin
4130 AShadowType := PGtkFrame(Widget)^.get_shadow_type;
4131 if AShadowType = GTK_SHADOW_ETCHED_IN then
4132 Result := sbsSingle
4133 else
4134 if AShadowType = GTK_SHADOW_IN then
4135 Result := sbsSunken;
4136 end;
4137 end;
4138
4139 procedure TGtk3StaticText.SetAlignment(AValue: TAlignment);
4140 begin
4141 if IsWidgetOk then
4142 PGtkLabel(GetContainerWidget)^.set_alignment(AGtkJustificationF[AValue], 0);
4143 end;
4144
4145 procedure TGtk3StaticText.SetStaticBorderStyle(AValue: TStaticBorderStyle);
4146 begin
4147 if IsWidgetOK then
4148 PGtkFrame(Widget)^.set_shadow_type(StaticBorderShadowMap[AValue]);
4149 end;
4150
TGtk3StaticText.getTextnull4151 function TGtk3StaticText.getText: String;
4152 begin
4153 Result := '';
4154 if IsWidgetOk then
4155 Result := PGtkLabel(getContainerWidget)^.get_text;
4156 end;
4157
4158 procedure TGtk3StaticText.setText(const AValue: String);
4159 begin
4160 if IsWidgetOk then
4161 PGtkLabel(getContainerWidget)^.set_text(PgChar(AValue));
4162 end;
4163
CreateWidgetnull4164 function TGtk3StaticText.CreateWidget(const Params: TCreateParams): PGtkWidget;
4165 var
4166 AStaticText: TCustomStaticText;
4167 begin
4168 FWidgetType := FWidgetType + [wtStaticText];
4169 AStaticText := TCustomStaticText(LCLObject);
4170 Result := TGtkFrame.new('');
4171 PGtkFrame(Result)^.set_shadow_type(StaticBorderShadowMap[AStaticText.BorderStyle]);
4172 FCentralWidget := TGtkLabel.new('');
4173 FCentralWidget^.set_has_window(True);
4174 PGtkFrame(Result)^.set_label_widget(nil);
4175 PGtkFrame(Result)^.add(FCentralWidget);
4176 PGtkLabel(FCentralWidget)^.set_alignment(AGtkJustificationF[AStaticText.Alignment], 0.0);
4177 end;
4178
4179 { TGtk3ProgressBar }
4180
TGtk3ProgressBar.GetOrientationnull4181 function TGtk3ProgressBar.GetOrientation: TProgressBarOrientation;
4182 var
4183 AOrientation: TGtkOrientation;
4184 begin
4185 Result := pbHorizontal;
4186 if IsWidgetOk then
4187 begin
4188 AOrientation := PGtkOrientable(getContainerWidget)^.get_orientation;
4189 if AOrientation = GTK_ORIENTATION_HORIZONTAL then
4190 begin
4191 if PGtkProgressBar(getContainerWidget)^.get_inverted then
4192 Result := pbRightToLeft
4193 else
4194 Result := pbHorizontal;
4195 end else
4196 begin
4197 if PGtkProgressBar(getContainerWidget)^.get_inverted then
4198 Result := pbTopDown
4199 else
4200 Result := pbVertical;
4201 end;
4202 end;
4203 end;
4204
GetPositionnull4205 function TGtk3ProgressBar.GetPosition: Integer;
4206 begin
4207 Result := 0;
4208 if IsWidgetOk then
4209 Result := Round(PGtkProgressBar(GetContainerWidget)^.get_fraction);
4210 end;
4211
GetShowTextnull4212 function TGtk3ProgressBar.GetShowText: Boolean;
4213 begin
4214 Result := False;
4215 if IsWidgetOK then
4216 Result := PGtkProgressBar(GetContainerWidget)^.get_show_text;
4217 end;
4218
GetStylenull4219 function TGtk3ProgressBar.GetStyle: TProgressBarStyle;
4220 begin
4221 Result := pbstNormal;
4222 if Assigned(LCLObject) and IsWidgetOk then
4223 Result := TCustomProgressBar(LCLObject).Style;
4224 end;
4225
4226 procedure TGtk3ProgressBar.SetOrientation(AValue: TProgressBarOrientation);
4227 begin
4228 if IsWidgetOk then
4229 begin
4230 case AValue of
4231 pbHorizontal,pbRightToLeft:
4232 begin
4233 PGtkOrientable(GetContainerWidget)^.set_orientation(GTK_ORIENTATION_HORIZONTAL);
4234 PGtkProgressBar(GetContainerWidget)^.set_inverted(AValue = pbRightToLeft);
4235 end;
4236 pbVertical, pbTopDown:
4237 begin
4238 PGtkOrientable(GetContainerWidget)^.set_orientation(GTK_ORIENTATION_VERTICAL);
4239 PGtkProgressBar(GetContainerWidget)^.set_inverted(AValue = pbVertical);
4240 end;
4241 end;
4242 end;
4243 end;
4244
4245 procedure TGtk3ProgressBar.SetPosition(AValue: Integer);
4246 var
4247 ABar: TCustomProgressBar;
4248 fraction: gDouble;
4249 begin
4250 if not Assigned(LCLObject) or not IsWidgetOK then
4251 exit;
4252 ABar := TCustomProgressBar(LCLObject);
4253 if ((ABar.Max - ABar.Min) <> 0) then
4254 fraction := (AValue - ABar.Min) / (ABar.Max - ABar.Min)
4255 else
4256 fraction := 0;
4257 PGtkProgressBar(GetContainerWidget)^.set_fraction(fraction);
4258 end;
4259
4260 procedure TGtk3ProgressBar.SetShowText(AValue: Boolean);
4261 begin
4262 if IsWidgetOK then
4263 PGtkProgressBar(GetContainerWidget)^.set_show_text(AValue);
4264 end;
4265
ProgressPulseTimeoutnull4266 function ProgressPulseTimeout(data: gpointer): gboolean; cdecl;
4267 begin
4268 Result := {%H-}PtrUInt(g_object_get_data(data, 'lclprogressbarstyle')) = 1;
4269 if Result then
4270 PGtkProgressBar(Data)^.pulse;
4271 end;
4272
4273 procedure ProgressDestroy(data: gpointer); cdecl;
4274 begin
4275 g_source_remove({%H-}PtrUInt(data));
4276 end;
4277
4278 procedure TGtk3ProgressBar.SetStyle(AValue: TProgressBarStyle);
4279 begin
4280 if IsWidgetOk then
4281 begin
4282 g_object_set_data(GetContainerWidget,'lclprogressbarstyle', {%H-}Pointer(PtrUInt(Ord(AValue))));
4283 if AValue = pbstNormal then
4284 begin
4285 Position := TCustomProgressBar(LCLObject).Position;
4286 end else
4287 begin
4288 g_object_set_data_full(GetContainerWidget, 'timeout',
4289 {%H-}Pointer(PtrUInt(g_timeout_add(100, @ProgressPulseTimeout, GetContainerWidget))), @ProgressDestroy);
4290 PGtkProgressBar(GetContainerWidget)^.pulse;
4291 end;
4292 end;
4293 end;
4294
4295 {we must override preferred width since gtk3 have strange opinion about minimum width of progress bar}
4296 procedure get_progress_preferred_width(widget: PGtkWidget; minimum_width: Pgint; natural_width: Pgint); cdecl;
4297 var
4298 Handle: HWND;
4299 begin
4300 Handle := HwndFromGtkWidget(Widget);
4301 if Handle <> 0 then
4302 begin
4303 minimum_width^ := TGtk3Widget(Handle).LCLObject.Width;
4304 natural_width^ := TGtk3Widget(Handle).LCLObject.Width;
4305 end else
4306 begin
4307 minimum_width^ := 0;
4308 natural_width^ := 0;
4309 DebugLn('ERROR: get_progress_preferred_width cannot find GtkWidget LCL Handle ....');
4310 end;
4311 end;
4312
4313 {we must override preferred height since gtk3 have strange opinion about height of progress bar}
4314 procedure get_progress_preferred_height(widget: PGtkWidget; minimum_height: Pgint; natural_height: Pgint); cdecl;
4315 var
4316 Handle: HWND;
4317 begin
4318 Handle := HwndFromGtkWidget(Widget);
4319 if Handle <> 0 then
4320 begin
4321 minimum_height^ := TGtk3Widget(Handle).LCLObject.Height;
4322 natural_height^ := TGtk3Widget(Handle).LCLObject.Height;
4323 // TODO: get spacing from style property
4324 // Widget^.get_style_context^.get_style_property();
4325 end else
4326 begin
4327 minimum_height^ := 0;
4328 natural_height^ := 0;
4329 DebugLn('ERROR: get_progress_preferred_height cannot find GtkWidget LCL Handle ....');
4330 end;
4331 end;
4332
TGtk3ProgressBar.CreateWidgetnull4333 function TGtk3ProgressBar.CreateWidget(const Params: TCreateParams): PGtkWidget;
4334 var
4335 AProgress: TCustomProgressBar;
4336 begin
4337 AProgress := TCustomProgressBar(LCLObject);
4338 if AProgress=nil then ;
4339 FWidgetType := FWidgetType + [wtProgressBar];
4340 Result := TGtkEventBox.new;
4341 FCentralWidget := TGtkProgressBar.new;
4342 PGtkEventBox(Result)^.add(FCentralWidget);
4343 FCentralWidget^.set_can_focus(True);
4344 end;
4345
4346 var
4347 AProgressClassHookInitialized: Boolean = False;
4348
4349 procedure TGtk3ProgressBar.InitializeWidget;
4350 var
4351 AClass: PGTypeClass;
4352 begin
4353 inherited InitializeWidget;
4354 //TODO: move hook check variable code into Gtk3WidgetSet.
4355 if not AProgressClassHookInitialized then
4356 begin
4357 AProgressClassHookInitialized := True;
4358 AClass := g_type_class_ref(gtk_progress_bar_get_type);
4359 PGtkWidgetClass(AClass)^.get_preferred_width := @get_progress_preferred_width;
4360 PGtkWidgetClass(AClass)^.get_preferred_height := @get_progress_preferred_height;
4361 g_type_class_unref(AClass);
4362 end;
4363 end;
4364
4365 { TGtk3Container }
4366
4367 procedure TGtk3Container.AddChild(AWidget: PGtkWidget; const ALeft, ATop: Integer);
4368 begin
4369 if Assigned(FCentralWidget) then
4370 PGtkFixed(PGtkScrolledWindow(FCentralWidget)^.get_child)^.put(AWidget, ALeft, ATop)
4371 else
4372 PGtkContainer(FWidget)^.add(AWidget);
4373 end;
4374
4375 { TGtk3ToolBar }
4376
4377 procedure TGtk3ToolBar.ClearGlyphs;
4378 var i:integer;
4379 begin
4380 if Assigned(fBmpList) then
4381 for i:=fBmpList.Count-1 downto 0 do
4382 TObject(fBmpList[i]).Free;
4383 end;
4384
4385 destructor TGtk3ToolBar.Destroy;
4386 begin
4387 ClearGlyphs;
4388 fBmpList.Free;
4389 inherited Destroy;
4390 end;
4391
4392 procedure TGtk3ToolBar.ButtonClicked(data: gPointer);cdecl;
4393 begin
4394 if TObject(data) is TToolButton then
4395 TToolButton(data).Click;
4396 end;
4397
TGtk3ToolBar.CreateWidgetnull4398 function TGtk3ToolBar.CreateWidget(const Params: TCreateParams): PGtkWidget;
4399 var
4400 i:integer;
4401 AToolBar: TToolBar;
4402 btn:TToolButton;
4403 gtb:PGtkToolItem;
4404 wmenu,wicon:PGtkWidget;
4405 pb:PGdkPixBuf;
4406 bmp:TBitmap;
4407 resolution:TCustomImageListResolution;
4408 raw:TRawImage;
4409 bs:string;
4410 begin
4411 AToolBar := TToolBar(LCLObject);
4412 FHasPaint := False;
4413 FWidgetType := [wtWidget, wtContainer];
4414 Result:=PGtkWidget(TGtkToolbar.new);
4415
4416 if not Assigned(fBmpList) then
4417 fBmpList:=TList.Create;
4418
4419 ClearGlyphs;
4420
4421 // allocate appropriate number of tool items
4422 for i:=0 to AToolbar.ButtonCount-1 do
4423 begin
4424 btn:=AToolBar.Buttons[i];
4425 bs:= ReplaceAmpersandsWithUnderscores(btn.Caption);
4426 wicon:=nil;
4427 if btn is TToolButton then
4428 begin
4429 if (btn.ImageIndex>=0) and
4430 assigned(AToolbar.Images) and
4431 not (btn.Style in [tbsSeparator,tbsDivider]) then
4432 begin
4433 if Assigned(AToolBar.Images) and (btn.ImageIndex>=0) then
4434 begin
4435 bmp:=TBitmap.Create; { this carries gdk pixmap }
4436 resolution:=AToolBar.Images.Resolution[AToolBar.ImagesWidth]; // not AToolBar.Images.Width, issue #36465
4437 resolution.GetRawImage(btn.ImageIndex,raw);
4438 { convince the bitmap it has actually another format }
4439 bmp.BeginUpdate();
4440 //raw.Description.Init_BPP32_R8G8B8A8_BIO_TTB(resolution.Width,resolution.Height);
4441 bmp.LoadFromRawImage(raw,false);
4442 bmp.EndUpdate();
4443 pb:=TGtk3Image(bmp.Handle).Handle;
4444 wicon := TGtkImage.new_from_pixbuf(pb);
4445 fBmpList.Add(bmp);
4446 end
4447 else
4448 wicon := nil;
4449 end;
4450
4451 case btn.Style of
4452 tbsSeparator:
4453 gtb:=TGtkSeparatorToolItem.new();
4454 tbsDropDown:
4455 begin
4456 gtb:=TGtkMenuToolButton.new(wicon,PgChar(bs));
4457 if Assigned(btn.DropdownMenu) then
4458 begin
4459 wmenu:=TGtk3Menu(btn.DropdownMenu.Handle).Widget;
4460 PGtkMenuToolButton(gtb)^.set_menu(wmenu);
4461 end;
4462 end;
4463 tbsCheck:
4464 begin
4465 gtb:=TGtkToggleToolButton.new();
4466 PGtkToolButton(gtb)^.set_label(PgChar(bs));
4467 PGtkToolButton(gtb)^.set_icon_widget(wicon);
4468 end
4469 else
4470 gtb:=TGtkToolButton.new(wicon,PgChar(bs));
4471 end;
4472 if not (btn.Style in [tbsSeparator,tbsDivider]) then
4473 begin
4474 gtb^.set_tooltip_text(PgChar(btn.Hint));
4475 PgtkToolButton(gtb)^.set_use_underline(true);
4476 end;
4477 PGtkToolBar(Result)^.add(gtb);
4478
4479 if not (btn.Style in [tbsSeparator,tbsDivider]) then
4480 g_signal_connect_data(gtb,'clicked',
4481 TGCallback(@TGtk3Toolbar.ButtonClicked), btn, nil, 0);
4482 end;
4483 end;
4484
4485 end;
4486
4487 { TGtk3Page }
4488
4489 procedure TGtk3Page.setText(const AValue: String);
4490 var
4491 bs:string;
4492 begin
4493 if Assigned(FPageLabel) then
4494 begin
4495 bs:=ReplaceAmpersandsWithUnderscores(Avalue);
4496 FPageLabel^.set_text(PChar(bs));
4497 end;
4498 end;
4499
TGtk3Page.getTextnull4500 function TGtk3Page.getText: String;
4501 begin
4502 if Assigned(FPageLabel) then
4503 Result := FPageLabel^.get_text
4504 else
4505 Result := '';
4506 end;
4507
CreateWidgetnull4508 function TGtk3Page.CreateWidget(const Params: TCreateParams): PGtkWidget;
4509 begin
4510 FWidgetType := FWidgetType + [wtContainer];
4511 FPageLabel:= TGtkLabel.new(PChar(Params.Caption));
4512 FPageLabel^.set_use_underline(true);
4513 Self.FHasPaint:=true;
4514 // ref it to save it in case TabVisble is set to false
4515 FPageLabel^.ref;
4516 Result := TGtkHBox.new(GTK_ORIENTATION_HORIZONTAL, 0);
4517 FCentralWidget := TGtkFixed.new;
4518 PGtkHBox(Result)^.pack_start(FCentralWidget, True , True, 0);
4519 PGtkFixed(FCentralWidget)^.set_has_window(True);
4520 // PGtkFixed(FCentralWidget)^.set_can_focus(True);
4521 end;
4522
4523 procedure TGtk3Page.DestroyWidget;
4524 begin
4525 inherited DestroyWidget;
4526 // unref it to allow it to be destroyed
4527 FPageLabel^.unref;
4528 end;
4529
TGtk3Page.getClientOffsetnull4530 function TGtk3Page.getClientOffset: TPoint;
4531 var
4532 Allocation: TGtkAllocation;
4533 R: TRect;
4534 begin
4535 Self.Widget^.get_allocation(@Allocation);
4536 Result.X := -Allocation.X;
4537 Result.Y := -Allocation.Y;
4538
4539 R := getClientBounds;
4540 Result := Point(Result.x + R.Left, Result.y + R.Top);
4541 end;
4542
4543
getClientRectnull4544 function TGtk3Page.getClientRect: TRect;
4545 var
4546 AParent: PGtkWidget;
4547 AParentObject: TGtk3Widget;
4548 begin
4549 if not getContainerWidget^.get_realized then
4550 begin
4551 AParent := FWidget^.get_parent;
4552 AParentObject := TGtk3Widget(HwndFromGtkWidget(AParent));
4553 if AParentObject <> nil then
4554 Result := AParentObject.getClientRect
4555 else
4556 Result := inherited getClientRect;
4557 end else
4558 Result := inherited getClientRect;
4559 // DebugLn('TGtk3Page.GetClientRect Result=',dbgs(Result),' Realized ',dbgs(getContainerWidget^.get_realized));
4560 end;
4561
4562 { TGtk3NoteBook }
4563
NotebookPageRealToLCLIndexnull4564 function NotebookPageRealToLCLIndex(const ATabControl: TCustomTabControl; AIndex: integer): integer;
4565 var
4566 I: Integer;
4567 begin
4568 Result := AIndex;
4569 if csDesigning in ATabControl.ComponentState then exit;
4570 I := 0;
4571 while (I < ATabControl.PageCount) and (I <= Result) do
4572 begin
4573 if not ATabControl.Page[I].TabVisible then Inc(Result);
4574 Inc(I);
4575 end;
4576 end;
4577
GtkNotebookAfterSwitchPagenull4578 // function GtkNotebookAfterSwitchPage(widget: PGtkWidget; pagenum: integer; data: gPointer): GBoolean; cdecl;
4579 procedure GtkNotebookAfterSwitchPage(widget: PGtkWidget; {%H-}page: PGtkWidget; pagenum: integer; data: gPointer); cdecl;
4580 var
4581 Mess: TLMNotify;
4582 NMHdr: tagNMHDR;
4583 LCLPageIndex: Integer;
4584 begin
4585 if widget=nil then ;
4586 if TGtk3Widget(Data).InUpdate then
4587 exit;
4588 {page is deleted}
4589 { DebugLn('GtkNotebookAfterSwitchPage ');
4590 if TGtk3NoteBook(Data).getPagesCount < TCustomTabControl(TGtk3NoteBook(Data).LCLObject).PageCount then
4591 begin
4592 DebugLn('GtkNotebookAfterSwitchPage PageIsDeleted');
4593 exit;
4594 end;}
4595 FillChar(Mess{%H-}, SizeOf(Mess), 0);
4596 Mess.Msg := LM_NOTIFY;
4597 FillChar(NMHdr{%H-}, SizeOf(NMHdr), 0);
4598 NMHdr.code := TCN_SELCHANGE;
4599 NMHdr.hwndFrom := HWND(TGtk3Widget(Data));
4600 LCLPageIndex := NotebookPageRealToLCLIndex(TCustomTabControl(TGtk3Widget(Data).LCLObject), pagenum); //use this to set pageindex to the correct page.
4601 NMHdr.idFrom := LCLPageIndex;
4602 Mess.NMHdr := @NMHdr;
4603 TGtk3Widget(Data).DeliverMessage(Mess);
4604 end;
4605
BackNoteBookSignalnull4606 function BackNoteBookSignal(AData: Pointer): gboolean; cdecl;
4607 var
4608 AWidget: PGtkNotebook;
4609 APageNum: PtrInt;
4610 ACurrentPage: gint;
4611 begin
4612 Result := False;
4613 AWidget := AData;
4614 if not Gtk3IsWidget(AWidget) then
4615 exit;
4616 if g_object_get_data(AWidget,'switch-page-signal-stopped') <> nil then
4617 begin
4618 Result := True;
4619 APageNum := {%H-}PtrInt(g_object_get_data(AWidget,'switch-page-signal-stopped'));
4620 ACurrentPage := AWidget^.get_current_page;
4621 g_object_set_data(AWidget,'switch-page-signal-stopped', nil);
4622 DebugLn('BackNoteBookSignal back notebook switch-page signal currpage=',dbgs(AWidget^.get_current_page),' blockedPage ',dbgs(APageNum));
4623 if ACurrentPage<0 then ;
4624 // must hook into notebook^.priv to unlock APageNum
4625 // AWidget^.set_current_page(AWidget^.get_current_page);
4626 // g_object_thaw_notify(AWidget^.get_nth_page(AWidget^.get_current_page));
4627 // PGtkFixed(AWidget^.get_nth_page(AWidget^.get_current_page))^.
4628 // g_signal_emit_by_name(AWidget,'switch-page',[AWidget^.get_nth_page(APageNum), APageNum, gPointer(HwndFromGtkWidget(AWidget)), nil{AWidget, True, gPointer(HwndFromGtkWidget(AWidget))}]);
4629 // AWidget^.notify('page');
4630 // g_signal_stop_emission_by_name(AWidget, 'switch-page');
4631 // 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))]);
4632 end;
4633 g_idle_remove_by_data(AData);
4634 end;
4635
4636 procedure GtkNotebookSwitchPage(widget: PGtkWidget; {%H-}page: PGtkWidget; pagenum: integer; data: gPointer); cdecl;
4637 var
4638 Mess: TLMNotify;
4639 NMHdr: tagNMHDR;
4640 c1,c2:integer;
4641 begin
4642 if TGtk3Widget(Data).InUpdate then
4643 exit;
4644
4645 DebugLn('GtkNotebookSwitchPage Data ',dbgHex({%H-}PtrUInt(Data)),' Realized ',dbgs(Widget^.get_realized),' pageNum=',dbgs(pageNum));
4646
4647 {page is deleted}
4648 { c1:=TGtk3NoteBook(Data).getPagesCount;
4649 c2:=TCustomTabControl(TGtk3NoteBook(Data).LCLObject).PageCount;
4650 if c1 < c2 then
4651 begin
4652 DebugLn('GtkNotebookSwitchPage PageIsDeleted ');
4653 exit;
4654 end;}
4655
4656 FillChar(Mess{%H-}, SizeOf(Mess), 0);
4657 Mess.Msg := LM_NOTIFY;
4658 FillChar(NMHdr{%H-}, SizeOf(NMHdr), 0);
4659 NMHdr.code := TCN_SELCHANGING;
4660 NMHdr.hwndFrom := HWND(TGtk3Widget(Data));
4661 NMHdr.idFrom := NotebookPageRealToLCLIndex(TCustomTabControl(TGtk3Widget(Data).LCLObject), pagenum); //use this to set pageindex to the correct page.
4662 // DebugLn('LCLObject ',dbgsName(TGtk3Widget(Data).LCLObject),' IdFrom ',dbgs(NMHdr.idFrom));
4663 Mess.NMHdr := @NMHdr;
4664 Mess.Result := 0;
4665 // DebugLn('LCLObject ',dbgsName(TGtk3Widget(Data).LCLObject),' sending message ....');
4666 TGtk3Widget(Data).DeliverMessage(Mess);
4667 if Mess.Result <> 0 then
4668 begin
4669 g_object_set_data(Widget,'switch-page-signal-stopped', {%H-}GPointer(pageNum));
4670 g_signal_stop_emission_by_name(PGObject(Widget), 'switch-page');
4671 // GtkNotebookAfterSwitchPage(Widget, page, pagenum, data);
4672 g_idle_add(@BackNoteBookSignal, Widget);
4673 Exit;
4674 end;
4675 end;
4676
GtkNotebookSelectPagenull4677 function GtkNotebookSelectPage(ANoteBook: PGtkNotebook; p1: gboolean; Data: gPointer): GBoolean; cdecl;
4678 begin
4679 // does not trigger for some reason
4680 if ANoteBook=nil then ;
4681 if p1 then ;
4682 if Data=nil then ;
4683 DebugLn('GtkNotebookSelectPage ');
4684 Result:=true;
4685 end;
4686
CreateWidgetnull4687 function TGtk3NoteBook.CreateWidget(const Params: TCreateParams): PGtkWidget;
4688 begin
4689 FWidgetType := FWidgetType + [wtNotebook];
4690 Result := TGtkEventBox.new;
4691 PGtkEventBox(Result)^.set_has_window(True);
4692 FCentralWidget := TGtkNotebook.new;
4693 PGtkEventBox(Result)^.add(FCentralWidget);
4694 PGtkNoteBook(FCentralWidget)^.set_scrollable(True);
4695 if (nboHidePageListPopup in TCustomTabControl(LCLObject).Options) then
4696 PGtkNoteBook(FCentralWidget)^.popup_disable;
4697 PGtkNoteBook(FCentralWidget)^.show;
4698
4699 g_signal_connect_data(FCentralWidget,'switch-page', TGCallback(@GtkNotebookSwitchPage), Self, nil, 0);
4700 // this one triggers after above switch-page
4701 g_signal_connect_data(FCentralWidget,'switch-page', TGCallback(@GtkNotebookAfterSwitchPage), Self, nil, 0);
4702
4703 // those signals doesn't trigger with gtk3-3.6
4704 // g_signal_connect_data(FCentralWidget,'change-current-page', TGCallback(@GtkNotebookAfterSwitchPage), Self, nil, 0);
4705 // g_signal_connect_data(FCentralWidget,'select-page', TGCallback(@GtkNotebookSelectPage), Self, nil, 0);
4706 end;
4707
4708 procedure TGtk3NoteBook.InitializeWidget;
4709 begin
4710 inherited;
4711 SetTabPosition(TCustomTabControl(LCLObject).TabPosition);
4712 end;
4713
getClientRectnull4714 function TGtk3NoteBook.getClientRect: TRect;
4715 var
4716 AAlloc: TGtkAllocation;
4717 ACurrentPage: gint;
4718 APage: PGtkWidget;
4719 begin
4720 Result := Rect(0, 0, 0, 0);
4721 if PGtkNoteBook(GetContainerWidget)^.get_n_pages = 0 then
4722 begin
4723 GetContainerWidget^.get_allocation(@AAlloc);
4724 Result := RectFromGtkAllocation(AAlloc);
4725 OffsetRect(Result, -Result.Left, -Result.Top);
4726 end else
4727 begin
4728 ACurrentPage := PGtkNoteBook(GetContainerWidget)^.get_current_page;
4729 if (ACurrentPage >= 0) then
4730 begin
4731 APage := PGtkNoteBook(GetContainerWidget)^.get_nth_page(ACurrentPage);
4732 if APage^.get_realized then
4733 APage^.get_allocation(@AAlloc)
4734 else
4735 GetContainerWidget^.get_allocation(@AAlloc);
4736 Result := RectFromGtkAllocation(AAlloc);
4737 OffsetRect(Result, -Result.Left, -Result.Top);
4738 end;
4739 end;
4740 // DebugLn('TGtk3NoteBook.getClientRect Result ',dbgs(Result));
4741 end;
4742
getPagesCountnull4743 function TGtk3NoteBook.getPagesCount: integer;
4744 begin
4745 Result := 0;
4746 if IsWidgetOk then
4747 Result := PGtkNoteBook(GetContainerWidget)^.get_n_pages;
4748 end;
4749
4750 procedure EnumerateChildren(ANotebook: PGtkNoteBook);
4751 var
4752 AList: PGList;
4753 i: Integer;
4754 AWidget: PGtkWidget;
4755 AMinimumH, ANaturalH, ANaturalW, AMinimumW: gint;
4756 begin
4757 AList := ANoteBook^.get_children;
4758 for i := 0 to g_list_length(AList) - 1 do
4759 begin
4760 AWidget := PGtkWidget(g_list_nth_data(AList, I));
4761 AWidget^.get_preferred_height(@AMinimumH, @ANaturalH);
4762 AWidget^.get_preferred_width(@AMinimumW, @ANaturalW);
4763 DebugLn(Format('Child[%d] MinH %d NatH %d MinW %d NatW %d ALLOCW %d ALLOCH %d child_type %s',
4764 [I, AMinimumH, ANaturalH, AMinimumW, ANaturalW,
4765 AWidget^.get_allocated_width, AWidget^.get_allocated_height, g_type_name(ANotebook^.child_type)]));
4766 end;
4767 g_list_free(AList);
4768 end;
4769
4770 procedure TGtk3NoteBook.InsertPage(ACustomPage: TCustomPage; AIndex: Integer);
4771 var
4772 Gtk3Page: TGtk3Page;
4773 AMinSize, ANaturalSize: gint;
4774 begin
4775 if IsWidgetOK then
4776 begin
4777 Gtk3Page := TGtk3Page(ACustomPage.Handle);
4778 PGtkNoteBook(GetContainerWidget)^.insert_page(Gtk3Page.Widget, Gtk3Page.FPageLabel, AIndex);
4779 PGtkNoteBook(GetContainerWidget)^.get_preferred_width(@AMinSize, @ANaturalSize);
4780 PGtkNoteBook(GetContainerWidget)^.get_preferred_height(@AMinSize, @ANaturalSize);
4781 if gtk_notebook_get_n_pages(PGtkNoteBook(GetContainerWidget)) > 1 then
4782 PGtkNoteBook(GetContainerWidget)^.resize_children;
4783 end;
4784 end;
4785
4786 procedure TGtk3NoteBook.MovePage(ACustomPage: TCustomPage; ANewIndex: Integer);
4787 begin
4788 if IsWidgetOK then
4789 PGtkNoteBook(GetContainerWidget)^.reorder_child(TGtk3Widget(ACustomPage.Handle).Widget, ANewIndex);
4790 end;
4791
4792 procedure TGtk3NoteBook.RemovePage(AIndex: Integer);
4793 var
4794 AMinSizeW, AMinSizeH, ANaturalSizeW, ANaturalSizeH: gint;
4795 begin
4796 if IsWidgetOK then
4797 begin
4798 PGtkNotebook(GetContainerWidget)^.remove_page(AIndex);
4799 PGtkNoteBook(GetContainerWidget)^.get_preferred_width(@AMinSizeW, @ANaturalSizeW);
4800 PGtkNoteBook(GetContainerWidget)^.get_preferred_height(@AMinSizeH, @ANaturalSizeH);
4801 PGtkNoteBook(GetContainerWidget)^.resize_children;
4802 end;
4803 end;
4804
4805 procedure TGtk3NoteBook.SetPageIndex(AIndex: Integer);
4806 begin
4807 if IsWidgetOK then
4808 begin
4809 PGtkNotebook(GetContainerWidget)^.set_current_page(AIndex);
4810 end;
4811 end;
4812
4813 procedure TGtk3NoteBook.SetShowTabs(const AShowTabs: Boolean);
4814 begin
4815 if IsWidgetOK then
4816 PGtkNoteBook(GetContainerWidget)^.set_show_tabs(AShowTabs);
4817 end;
4818
4819 procedure TGtk3NoteBook.SetTabPosition(const ATabPosition: TTabPosition);
4820 const
4821 GtkPositionTypeMap: array[TTabPosition] of TGtkPositionType =
4822 (
4823 { tpTop } GTK_POS_TOP,
4824 { tpBottom } GTK_POS_BOTTOM,
4825 { tpLeft } GTK_POS_LEFT,
4826 { tpRight } GTK_POS_RIGHT
4827 );
4828 begin
4829 if IsWidgetOK then
4830 PGtkNoteBook(GetContainerWidget)^.set_tab_pos(GtkPositionTypeMap[ATabPosition]);
4831 end;
4832
4833 procedure TGtk3NoteBook.SetTabLabelText(AChild: TCustomPage; const AText: String);
4834 begin
4835 if IsWidgetOK then
4836 TGtk3Widget(AChild.Handle).setText(AText);
4837 end;
4838
GetTabLabelTextnull4839 function TGtk3NoteBook.GetTabLabelText(AChild: TCustomPage): String;
4840 begin
4841 if IsWidgetOK then
4842 Result := TGtk3Widget(AChild.Handle).getText
4843 else
4844 Result := '';
4845 end;
4846
4847 { TGtk3MenuShell }
4848
4849 procedure TGtk3MenuShell.Insert(AMenuShell: PGtkMenuShell; APosition: Integer);
4850 begin
4851 if IsWidgetOK then
4852 PGtkMenuShell(Widget)^.insert(AMenuShell, APosition);
4853 end;
4854
4855 constructor TGtk3MenuShell.Create(const AMenu: TMenu; AMenuBar: PGtkMenuBar);
4856 begin
4857 inherited Create;
4858 MenuObject := AMenu;
4859 FContext := 0;
4860 FHasPaint := False;
4861 FWidget := nil;
4862 FOwner := nil;
4863 FCentralWidget := nil;
4864 if AMenuBar <> nil then
4865 begin
4866 FOwnWidget := False;
4867 FWidget := AMenuBar;
4868 end else
4869 FOwnWidget := True;
4870 // Initializes the properties
4871 FProps := nil;
4872 LCLObject := nil;
4873 // FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE];
4874 // FHasPaint := False;
4875
4876 // FParams := AParams;
4877 InitializeWidget;
4878 end;
4879
4880 procedure TGtk3MenuShell.InitializeWidget;
4881 begin
4882 FCentralWidget := nil;
4883 FCairoContext := nil;
4884 FContext := 0;
4885 FEnterLeaveTime := 0;
4886 if FOwnWidget then
4887 FWidget := CreateWidget(FParams);
4888
4889 LCLIntf.SetProp(HWND(Self),'lclwidget',Self);
4890 end;
4891
4892
4893 { TGtk3MenuBar }
4894
CreateWidgetnull4895 function TGtk3MenuBar.CreateWidget(const Params: TCreateParams): PGtkWidget;
4896 begin
4897 FWidgetType := [wtWidget, wtMenuBar];
4898 Result := TGtkMenuBar.new;
4899 PGtkMenuBar(Result)^.set_pack_direction(MenuDirection[TMenu(MenuObject).UseRightToLeftAlignment]);
4900 end;
4901
4902 { TGtk3Menu }
4903
CreateWidgetnull4904 function TGtk3Menu.CreateWidget(const Params: TCreateParams): PGtkWidget;
4905 begin
4906 FWidgetType := [wtWidget, wtMenu];
4907 Result := TGtkMenu.new;
4908 end;
4909
4910 constructor TGtk3Menu.CreateFromMenuItem(const AMenuItem: TMenuItem);
4911 begin
4912 inherited Create(AMenuItem.GetParentMenu, nil);
4913 end;
4914
4915 { TGtk3MenuItem }
4916
GetCaptionnull4917 function TGtk3MenuItem.GetCaption: string;
4918 begin
4919 Result := '';
4920 if IsWidgetOK then
4921 Result := PGtkMenuItem(FWidget)^.get_label;
4922 end;
4923
4924 procedure TGtk3MenuItem.SetCaption(const AValue: string);
4925 begin
4926 if IsWidgetOK then
4927 PGtkMenuItem(FWidget)^.set_label(PgChar(AValue));
4928 end;
4929
CreateWidgetnull4930 function TGtk3MenuItem.CreateWidget(const Params: TCreateParams): PGtkWidget;
4931 var
4932 ndx:integer;
4933 pl:PGsList;
4934 parentMenu:TMenuItem;
4935 picon:PGtkImage;
4936 pmenu:PGtkMenuItem;
4937 pimgmenu:PgtkImageMenuItem absolute pmenu;
4938 img:TGtk3Image;
4939 begin
4940 Result:=nil;
4941 FWidgetType := [wtWidget, wtMenuItem];
4942 if MenuItem.Caption = cLineCaption then
4943 Result := TGtkSeparatorMenuItem.new
4944 else
4945 if (MenuItem.HasIcon) then
4946 begin
4947 pimgmenu := TGtkImageMenuItem.new();
4948 MenuItem.UpdateImage(true);
4949 img:=Tgtk3Image(MenuItem.Bitmap.Handle);
4950 picon := TGtkImage.new_from_pixbuf(img.Handle);
4951 pimgmenu^.set_image(picon);
4952 pimgmenu^.set_always_show_image(true);
4953 Result:=pimgmenu;
4954 end else
4955 if MenuItem.RadioItem and not MenuItem.HasIcon then
4956 begin
4957 Result := TGtkRadioMenuItem.new(nil);
4958 if Assigned(menuItem.Parent) then
4959 begin
4960 ndx:=menuItem.Parent.IndexOf(MenuItem);
4961 if (ndx>0) then
4962 begin
4963 ParentMenu:=menuItem.Parent.Items[ndx-1];
4964 if (ParentMenu.GroupIndex=MenuItem.GroupIndex) then
4965 begin
4966 pl:=PGtkRadioMenuItem(TGtk3MenuItem(ParentMenu.Handle).Widget)^.get_group;
4967 PGtkRadioMenuItem(Result)^.set_group(pl);
4968 end;
4969 end;
4970 end;
4971 //PGtkRadioMenuItem(Result)^.set_active(MenuItem.Checked);
4972 end
4973 else
4974 if MenuItem.IsCheckItem and not MenuItem.HasIcon then
4975 begin
4976 Result := TGtkCheckMenuItem.new;
4977 PGtkCheckMenuItem(Result)^.set_active(MenuItem.Checked);
4978 end
4979 else
4980 Result := TGtkMenuItem.new;
4981
4982 if Assigned(Result) and (MenuItem.Caption <> cLineCaption) {and not MenuItem.HasIcon} then
4983 begin
4984 PGtkMenuItem(Result)^.use_underline := True;
4985 PGtkMenuItem(Result)^.set_label(PgChar(ReplaceAmpersandsWithUnderscores(MenuItem.Caption)));
4986 PGtkMenuItem(Result)^.set_sensitive(MenuItem.Enabled);
4987 end;
4988
4989
4990 end;
4991
4992 constructor TGtk3MenuItem.Create(const AMenuItem: TMenuItem);
4993 begin
4994 inherited Create;
4995 MenuItem := AMenuItem;
4996 FContext := 0;
4997 FHasPaint := False;
4998 FWidget := nil;
4999 FOwner := nil;
5000 FCentralWidget := nil;
5001 FOwnWidget := True;
5002 // Initializes the properties
5003 FProps := nil;
5004 LCLObject := nil;
5005 // FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE];
5006 // FHasPaint := False;
5007
5008 // FParams := AParams;
5009 InitializeWidget;
5010 end;
5011
5012 procedure Gtk3MenuItemActivated({%H-}AItem: PGtkMenuItem; AData: GPointer); cdecl;
5013 var
5014 Msg: TLMessage;
5015 begin
5016 // DebugLn('Gtk3MenuItemActivated ',dbgsName(TGtk3MenuItem(Adata)));
5017 if Assigned(TGtk3MenuItem(AData).MenuItem) and (TGtk3MenuItem(AData).Lock=0) then
5018 begin
5019 inc(TGtk3MenuItem(AData).Lock);
5020 try
5021 FillChar(Msg{%H-}, SizeOf(Msg), #0);
5022 Msg.Msg := LM_ACTIVATE;
5023 TGtk3MenuItem(AData).MenuItem.Dispatch(Msg);
5024 finally
5025 dec(TGtk3MenuItem(AData).Lock);
5026 end;
5027 end;
5028 end;
5029
5030 procedure TGtk3MenuItem.InitializeWidget;
5031 begin
5032 FCentralWidget := nil;
5033 FCairoContext := nil;
5034 FContext := 0;
5035 FEnterLeaveTime := 0;
5036
5037 FWidget := CreateWidget(FParams);
5038 LCLIntf.SetProp(HWND(Self),'lclwidget',Self);
5039
5040 // move signal connections into attach events
5041 FWidget^.set_events(GDK_DEFAULT_EVENTS_MASK);
5042 g_signal_connect_data(FWidget, 'event', TGCallback(@Gtk3MenuItemEvent), Self, nil, 0);
5043 g_signal_connect_data(FWidget,'activate',TGCallBack(@Gtk3MenuItemActivated), Self, nil, 0);
5044 // must hide all by default
5045 // FWidget^.hide;
5046 end;
5047
5048 procedure TGtk3MenuItem.SetCheck(ACheck: boolean);
5049 begin
5050 if Self.IsValidHandle and (lock=0) then
5051 PGtkCheckMenuItem(fWidget)^.active:=ACheck;
5052 end;
5053
5054
5055 { TGtk3ScrollableWin}
5056
GetHScrollBarPolicynull5057 function TGtk3ScrollableWin.GetHScrollBarPolicy: TGtkPolicyType;
5058 var
5059 AScrollWin: PGtkScrolledWindow;
5060 APolicy: TGtkPolicyType;
5061 begin
5062 Result := GTK_POLICY_AUTOMATIC;
5063 AScrollWin := getScrolledWindow;
5064 if not Gtk3IsScrolledWindow(AScrollWin) then
5065 exit;
5066 AScrollWin^.get_policy(@Result, @APolicy);
5067 end;
5068
GetVScrollBarPolicynull5069 function TGtk3ScrollableWin.GetVScrollBarPolicy: TGtkPolicyType;
5070 var
5071 AScrollWin: PGtkScrolledWindow;
5072 APolicy: TGtkPolicyType;
5073 begin
5074 Result := GTK_POLICY_AUTOMATIC;
5075 AScrollWin := getScrolledWindow;
5076 if not Gtk3IsScrolledWindow(AScrollWin) then
5077 exit;
5078 AScrollWin^.get_policy(@APolicy, @Result);
5079 end;
5080
5081 procedure TGtk3ScrollableWin.SetBorderStyle(AValue: TBorderStyle);
5082 begin
5083 if FBorderStyle=AValue then Exit;
5084 FBorderStyle:=AValue;
5085 if IsWidgetOK then
5086 begin
5087 if AValue = bsNone then
5088 getScrolledWindow^.set_shadow_type(GTK_SHADOW_NONE)
5089 else
5090 getScrolledWindow^.set_shadow_type(GTK_SHADOW_ETCHED_IN);
5091 end;
5092 end;
5093
5094 procedure TGtk3ScrollableWin.SetHScrollBarPolicy(AValue: TGtkPolicyType);
5095 var
5096 AScrollWin: PGtkScrolledWindow;
5097 APolicyH, APolicyV: TGtkPolicyType;
5098 begin
5099 AScrollWin := getScrolledWindow;
5100 if not Gtk3IsScrolledWindow(AScrollWin) then
5101 exit;
5102 AScrollWin^.get_policy(@APolicyH, @APolicyV);
5103 AScrollWin^.set_policy(AValue, APolicyV);
5104 end;
5105
5106 procedure TGtk3ScrollableWin.SetVScrollBarPolicy(AValue: TGtkPolicyType);
5107 var
5108 AScrollWin: PGtkScrolledWindow;
5109 APolicyH, APolicyV: TGtkPolicyType;
5110 begin
5111 AScrollWin := getScrolledWindow;
5112 if not Gtk3IsScrolledWindow(AScrollWin) then
5113 exit;
5114 AScrollWin^.get_policy(@APolicyH, @APolicyV);
5115 AScrollWin^.set_policy(APolicyH, AValue);
5116 end;
5117
5118 function Gtk3RangeScrollCB(ARange: PGtkRange; AScrollType: TGtkScrollType;
5119 AValue: gdouble; AData: TGtk3Widget): gboolean; cdecl;
5120 var
5121 Msg: TLMVScroll;
5122 MaxValue: gdouble;
5123 Widget: PGtkWidget;
5124 begin
5125 Result := False;
5126
5127 Widget := PGTKWidget(ARange);
5128 {$IFDEF SYNSCROLLDEBUG}
5129 DebugLn(Format('Trace:[Gtk3RangeScrollCB] Value: %d', [RoundToInt(AValue)]),' IsHScrollBar ',dbgs(PGtkOrientable(ARange)^.get_orientation = GTK_ORIENTATION_HORIZONTAL));
5130 {$ENDIF}
5131 if PGtkOrientable(ARange)^.get_orientation = GTK_ORIENTATION_HORIZONTAL then
5132 Msg.Msg := LM_HSCROLL
5133 else
5134 Msg.Msg := LM_VSCROLL;
5135
5136 if ARange^.adjustment^.page_size > 0 then
5137 MaxValue := ARange^.adjustment^.upper - ARange^.adjustment^.page_size
5138 else
5139 MaxValue := ARange^.adjustment^.upper;
5140
5141 if (AValue > MaxValue) then
5142 AValue := MaxValue
5143 else if (AValue < ARange^.adjustment^.lower) then
5144 AValue := ARange^.adjustment^.lower;
5145
5146 with Msg do
5147 begin
5148 Pos := Round(AValue);
5149 if Pos < High(SmallPos) then
5150 SmallPos := Pos
5151 else
5152 SmallPos := High(SmallPos);
5153 {$note to get this correct we must use TQtWidget.CreateFrom() for scrollbars}
5154 ScrollBar := HWND(AData); // HWND({%H-}PtrUInt(ARange));
5155 ScrollCode := Gtk3ScrollTypeToScrollCode(AScrollType);
5156 end;
5157 DeliverMessage(AData.LCLObject, Msg);
5158
5159 if Msg.Scrollcode = SB_THUMBTRACK then
5160 begin
5161 if Widget^.get_state_flags = GTK_STATE_NORMAL then
5162 begin
5163 Msg.ScrollCode := SB_THUMBPOSITION;
5164 DeliverMessage(AData.LCLObject, Msg);
5165 Msg.ScrollCode := SB_ENDSCROLL;
5166 DeliverMessage(AData.LCLObject, Msg);
5167 end;
5168 end else
5169 Widget^.set_state_flags(GTK_STATE_FLAG_ACTIVE, True);
5170
5171 if (AData.LCLObject is TScrollingWinControl) and
5172 ((Msg.ScrollCode=SB_LINEUP) or (Msg.ScrollCode=SB_LINEDOWN)) then
5173 Result:=True;
5174 end;
5175
5176 procedure TGtk3ScrollableWin.SetScrollBarsSignalHandlers;
5177 begin
5178 {TODO: create real instances for scrollbars via TGtk3Widget.CreateFrom() ?}
5179 FBorderStyle := bsNone;
5180 g_signal_connect_data(getHorizontalScrollbar, 'change-value',
5181 TGCallback(@Gtk3RangeScrollCB), Self, nil, 0);
5182 g_signal_connect_data(getVerticalScrollbar, 'change-value',
5183 TGCallback(@Gtk3RangeScrollCB), Self, nil, 0);
5184 end;
5185
getClientBoundsnull5186 function TGtk3ScrollableWin.getClientBounds: TRect;
5187 var
5188 Allocation: TGtkAllocation;
5189 begin
5190 Result := Rect(0, 0, 0, 0);
5191 if IsWidgetOK then
5192 begin
5193 getContainerWidget^.get_allocation(@Allocation);
5194 Result := RectFromGtkAllocation(Allocation);
5195 end;
5196 // DebugLn('TGtk3ScrollableWin.getClientBounds result ',dbgs(Result));
5197 end;
5198
5199 { TGtk3Memo }
5200
CreateWidgetnull5201 function TGtk3Memo.CreateWidget(const Params: TCreateParams): PGtkWidget;
5202 var
5203 AMemo: TCustomMemo;
5204 ABuffer: PGtkTextBuffer;
5205 AScrollStyle: TPoint;
5206 begin
5207 FScrollX := 0;
5208 FScrollY := 0;
5209
5210 FKeysToEat := [];
5211 AMemo := TCustomMemo(LCLObject);
5212
5213 FWidgetType := FWidgetType + [wtMemo, wtScrollingWin];
5214 Result := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil));
5215
5216 FCentralWidget := PGtkTextView(TGtkTextView.new);
5217
5218 FCentralWidget^.set_has_window(True);
5219
5220 if AMemo.WordWrap then
5221 PGtkTextView(FCentralWidget)^.set_wrap_mode(GTK_WRAP_WORD)
5222 else
5223 PGtkTextView(FCentralWidget)^.set_wrap_mode(GTK_WRAP_NONE);
5224
5225 ABuffer := PGtkTextBuffer^.new(PGtkTextTagTable^.new);
5226 ABuffer^.set_text(PgChar(AMemo.Text), -1);
5227 PGtkTextView(FCentralWidget)^.set_buffer(ABuffer);
5228
5229 PGtkScrolledWindow(Result)^.add(FCentralWidget);
5230
5231 // PGtkScrolledWindow(Result)^.set_focus_child(FCentralWidget);
5232
5233 AScrollStyle := Gtk3TranslateScrollStyle(AMemo.ScrollBars);
5234
5235 // Gtk3 GtkTextView is weird. When scrollbars policy is GTK_POLICY_NONE
5236 // then GtkTextView resizes itself (resizes parent) while adding text,
5237 // so our TMemo size grows.
5238 // http://stackoverflow.com/questions/2695843/gtktextview-automatically-resizing/16881764#16881764
5239 // http://stackoverflow.com/questions/15534475/how-can-i-create-a-fixed-size-gtk-textview-in-gtk3
5240 // https://bugzilla.gnome.org/show_bug.cgi?id=690099
5241 // seem to be fixed in 3.8.2
5242
5243
5244 if (gtk_get_major_version = 3) and (gtk_get_minor_version <= 8) then
5245 begin
5246 if AScrollStyle.X = GTK_POLICY_NEVER then
5247 AScrollStyle.X := GTK_POLICY_AUTOMATIC;
5248 if AScrollStyle.Y = GTK_POLICY_NEVER then
5249 AScrollStyle.Y := GTK_POLICY_AUTOMATIC;
5250 end;
5251
5252
5253 PGtkScrolledWindow(Result)^.set_policy(AScrollStyle.X, AScrollStyle.Y);
5254
5255 PGtkScrolledWindow(Result)^.set_shadow_type(BorderStyleShadowMap[AMemo.BorderStyle]);
5256 PGtkScrolledWindow(Result)^.get_vscrollbar^.set_can_focus(False);
5257 PGtkScrolledWindow(Result)^.get_hscrollbar^.set_can_focus(False);
5258
5259 FCentralWidget^.set_can_focus(True);
5260 PGtkScrolledWindow(Result)^.set_can_focus(False);
5261 end;
5262
EatArrowKeysnull5263 function TGtk3Memo.EatArrowKeys(const AKey: Word): Boolean;
5264 begin
5265 Result := False;
5266 end;
5267
getHorizontalScrollbarnull5268 function TGtk3Memo.getHorizontalScrollbar: PGtkScrollbar;
5269 begin
5270 Result := nil;
5271 if not IsWidgetOk then
5272 exit;
5273 Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_hscrollbar);
5274 end;
5275
getVerticalScrollbarnull5276 function TGtk3Memo.getVerticalScrollbar: PGtkScrollbar;
5277 begin
5278 Result := nil;
5279 if not IsWidgetOk then
5280 exit;
5281 Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_vscrollbar);
5282 end;
5283
GetScrolledWindownull5284 function TGtk3Memo.GetScrolledWindow: PGtkScrolledWindow;
5285 begin
5286 if IsWidgetOK then
5287 Result := PGtkScrolledWindow(Widget)
5288 else
5289 Result := nil;
5290 end;
5291
GetAlignmentnull5292 function TGtk3Memo.GetAlignment: TAlignment;
5293 var
5294 AJustification: TGtkJustification;
5295 begin
5296 Result := taLeftJustify;
5297 if IsWidgetOk then
5298 begin
5299 AJustification := PGtkTextView(GetContainerWidget)^.get_justification;
5300 if AJustification = GTK_JUSTIFY_RIGHT then
5301 Result := taRightJustify
5302 else
5303 if AJustification = GTK_JUSTIFY_CENTER then
5304 Result := taCenter;
5305 end;
5306 end;
5307
GetReadOnlynull5308 function TGtk3Memo.GetReadOnly: Boolean;
5309 begin
5310 Result := True;
5311 if IsWidgetOk then
5312 Result := not PGtkTextView(GetContainerWidget)^.get_editable;
5313 end;
5314
GetWantTabsnull5315 function TGtk3Memo.GetWantTabs: Boolean;
5316 begin
5317 Result := False;
5318 if IsWidgetOK then
5319 Result := PGtkTextView(GetContainerWidget)^.get_accepts_tab;
5320 end;
5321
GetWordWrapnull5322 function TGtk3Memo.GetWordWrap: Boolean;
5323 begin
5324 Result := True;
5325 if IsWidgetOk then
5326 Result := PGtkTextView(GetContainerWidget)^.get_wrap_mode = GTK_WRAP_WORD;
5327 end;
5328
5329 procedure TGtk3Memo.SetAlignment(AValue: TAlignment);
5330 begin
5331 if IsWidgetOk then
5332 PGtkTextView(GetContainerWidget)^.set_justification(AGtkJustification[AValue]);
5333 end;
5334
5335 procedure TGtk3Memo.SetReadOnly(AValue: Boolean);
5336 begin
5337 if IsWidgetOk then
5338 PGtkTextView(GetContainerWidget)^.set_editable(not AValue);
5339 end;
5340
5341 procedure TGtk3Memo.SetWantTabs(AValue: Boolean);
5342 begin
5343 if IsWidgetOK then
5344 PGtkTextView(GetContainerWidget)^.set_accepts_tab(AValue);
5345 end;
5346
5347 procedure TGtk3Memo.SetWordWrap(AValue: Boolean);
5348 begin
5349 if IsWidgetOk then
5350 begin
5351 if AValue then
5352 PGtkTextView(GetContainerWidget)^.set_wrap_mode(GTK_WRAP_WORD)
5353 else
5354 PGtkTextView(GetContainerWidget)^.set_wrap_mode(GTK_WRAP_NONE);
5355 end;
5356 end;
5357
getTextnull5358 function TGtk3Memo.getText: String;
5359 var
5360 ABuffer: PGtkTextBuffer;
5361 AIter: TGtkTextIter;
5362 ALastIter: TGtkTextIter;
5363 begin
5364 Result := '';
5365 if IsWidgetOk then
5366 begin
5367 ABuffer := PGtkTextView(FCentralWidget)^.get_buffer;
5368 ABuffer^.get_start_iter(@AIter);
5369 ABuffer^.get_end_iter(@ALastIter);
5370 Result := ABuffer^.get_text(@AIter, @ALastIter, False);
5371 end;
5372 // DebugLn('TGtk3Memo.getText Result=',Result);
5373 end;
5374
5375 procedure TGtk3Memo.setText(const AValue: String);
5376 var
5377 ABuffer: PGtkTextBuffer;
5378 AIter: PGtkTextIter;
5379 begin
5380 // DebugLn('TGtk3Memo.setText AValue=',AValue);
5381 if IsWidgetOk then
5382 begin
5383 ABuffer := PGtkTextView(FCentralWidget)^.get_buffer;
5384 ABuffer^.set_text(PgChar(AValue), -1);
5385 AIter:=nil;
5386 ABuffer^.get_start_iter(AIter);
5387 ABuffer^.place_cursor(AIter);
5388 end;
5389 end;
5390
5391 { TGtk3ListBox }
5392
5393 procedure Gtk3ListBoxSelectionChanged({%H-}ASelection: PGtkTreeSelection; AData: GPointer); cdecl;
5394 var
5395 Msg: TLMessage;
5396 begin
5397 // DebugLn('Gtk3ListBoxSelectionChanged ');
5398 FillChar(Msg{%H-}, SizeOf(Msg), #0);
5399 Msg.Msg := LM_SELCHANGE;
5400 if not TGtk3Widget(AData).InUpdate then
5401 TGtk3Widget(AData).DeliverMessage(Msg, False);
5402 end;
5403
CreateWidgetnull5404 function TGtk3ListBox.CreateWidget(const Params: TCreateParams): PGtkWidget;
5405 var
5406 AListBox: TCustomListBox;
5407 ListStore: PGtkListStore;
5408 ItemList: TGtkListStoreStringList;
5409 AColumn: PGtkTreeViewColumn;
5410 Renderer : PGtkCellRenderer;
5411 begin
5412 FScrollX := 0;
5413 FScrollY := 0;
5414 FListBoxStyle := lbStandard;
5415
5416 FWidgetType := FWidgetType + [wtTreeModel, wtListBox, wtScrollingWin];
5417 AListBox := TCustomListBox(LCLObject);
5418
5419
5420 Result := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil));
5421 Result^.show;
5422
5423 ListStore := gtk_list_store_new (2, [G_TYPE_STRING, G_TYPE_POINTER, nil]);
5424 FCentralWidget := TGtkTreeView.new_with_model(PGtkTreeModel(ListStore));
5425 PGtkTreeView(FCentralWidget)^.set_headers_visible(False);
5426 g_object_unref (liststore);
5427
5428 ItemList := TGtkListStoreStringList.Create(PGtkListStore(PGtkTreeView(FCentralWidget)^.get_model), 0, LCLObject);
5429 g_object_set_data(PGObject(FCentralWidget),GtkListItemLCLListTag, ItemList);
5430
5431 Renderer := LCLIntfCellRenderer_New();
5432
5433 g_object_set_data(PGObject(renderer), 'lclwidget', Self);
5434
5435 AColumn := gtk_tree_view_column_new_with_attributes ('LISTITEMS', renderer,
5436 ['text', 0, nil]);
5437
5438 g_object_set_data(PGObject(AColumn), 'lclwidget', Self);
5439
5440 // maybe create GtkCellLayout class with our implementation and set that layout
5441 // to AColumn
5442 // PGtkCellLayout(AColumn)^.set_cell_data_func()
5443 // PGtkCellLayout(AColumn)^.set_cell_data_func(renderer, @LCLIntfRenderer_GtkCellLayoutDataFunc, Self, nil);
5444 AColumn^.set_cell_data_func(renderer, @LCLIntfRenderer_ColumnCellDataFunc, Self, nil);
5445
5446 PGtkTreeView(FCentralWidget)^.append_column(AColumn);
5447
5448 AColumn^.set_clickable(True);
5449
5450 // AColumn^set_cell_data_func(AColumn, renderer, @LCLIntfRenderer_ColumnCellDataFunc, Self, nil);
5451
5452 PGtkScrolledWindow(Result)^.add(FCentralWidget);
5453
5454 PGtkScrolledWindow(Result)^.get_vscrollbar^.set_can_focus(False);
5455 PGtkScrolledWindow(Result)^.get_hscrollbar^.set_can_focus(False);
5456 PGtkScrolledWindow(Result)^.set_policy(GTK_POLICY_NEVER, GTK_POLICY_AUTOMATIC);
5457 FListBoxStyle := AListBox.Style;
5458 if FListBoxStyle <> lbOwnerDrawVariable then
5459 begin
5460 AColumn^.set_sizing(GTK_TREE_VIEW_COLUMN_FIXED);
5461 PGtkTreeView(FCentralWidget)^.set_fixed_height_mode(True);
5462 end;
5463
5464 end;
5465
EatArrowKeysnull5466 function TGtk3ListBox.EatArrowKeys(const AKey: Word): Boolean;
5467 begin
5468 Result := False;
5469 end;
5470
5471 procedure TGtk3ListBox.InitializeWidget;
5472 begin
5473 inherited InitializeWidget;
5474 g_signal_connect_data(GetSelection, 'changed', TGCallback(@Gtk3ListBoxSelectionChanged), Self, nil, 0);
5475 end;
5476
getHorizontalScrollbarnull5477 function TGtk3ListBox.getHorizontalScrollbar: PGtkScrollbar;
5478 begin
5479 Result := nil;
5480 if not IsWidgetOk then
5481 exit;
5482 Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_hscrollbar);
5483 end;
5484
getVerticalScrollbarnull5485 function TGtk3ListBox.getVerticalScrollbar: PGtkScrollbar;
5486 begin
5487 Result := nil;
5488 if not IsWidgetOk then
5489 exit;
5490 Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_vscrollbar);
5491 end;
5492
GetScrolledWindownull5493 function TGtk3ListBox.GetScrolledWindow: PGtkScrolledWindow;
5494 begin
5495 if IsWidgetOK then
5496 Result := PGtkScrolledWindow(Widget)
5497 else
5498 Result := nil;
5499 end;
5500
GetItemIndexnull5501 function TGtk3ListBox.GetItemIndex: Integer;
5502 var
5503 TreeView: PGtkTreeView;
5504 Path: PGtkTreePath;
5505 Column: PGtkTreeViewColumn;
5506 Selection: PGtkTreeSelection;
5507 begin
5508 Result := -1;
5509 if Gtk3IsWidget(FWidget) then
5510 begin
5511 Path := nil;
5512 Column := nil;
5513 TreeView := PGtkTreeView(GetContainerWidget);
5514 TreeView^.get_cursor(@Path, @Column);
5515 if Path <> nil then
5516 begin
5517 Result := gtk_tree_path_get_indices(Path)^;
5518 if Result = 0 then
5519 begin
5520 Selection := TreeView^.get_selection;
5521 if not Selection^.path_is_selected(Path) then
5522 Result := -1;
5523 end;
5524 end;
5525 end;
5526 end;
5527
GetMultiSelectnull5528 function TGtk3ListBox.GetMultiSelect: Boolean;
5529 var
5530 Selection: PGtkTreeSelection;
5531 begin
5532 if IsWidgetOk then
5533 begin
5534 Selection := GetSelection;
5535 if Selection <> nil then
5536 Result := Selection^.get_mode <> GTK_SELECTION_SINGLE;
5537 end;
5538 end;
5539
5540 procedure TGtk3ListBox.SetItemIndex(AValue: Integer);
5541 var
5542 TreeView: PGtkTreeView;
5543 Selection: PGtkTreeSelection;
5544 Path: PGtkTreePath;
5545 begin
5546 if Gtk3IsWidget(FWidget) then
5547 begin
5548 TreeView := PGtkTreeView(GetContainerWidget);
5549 Selection := GetSelection;
5550 if (AValue < 0) then
5551 Path := nil
5552 else
5553 Path := gtk_tree_path_new_from_indices(AValue, [-1]);
5554
5555 // if singleselection mode then selection = itemindex
5556 if Path <> nil then
5557 begin
5558 gtk_tree_view_set_cursor(TreeView, Path, nil, False);
5559 end else
5560 begin
5561 Path := gtk_tree_path_new_from_indices(0, [-1]);
5562 gtk_tree_view_set_cursor(TreeView, Path, nil, False);
5563 gtk_tree_selection_unselect_all(Selection);
5564 end;
5565
5566 if Path <> nil then
5567 gtk_tree_path_free(Path);
5568 end;
5569 end;
5570
5571 procedure TGtk3ListBox.SetListBoxStyle(AValue: TListBoxStyle);
5572 begin
5573 if FListBoxStyle=AValue then Exit;
5574 FListBoxStyle:=AValue;
5575 end;
5576
5577 procedure TGtk3ListBox.SetMultiSelect(AValue: Boolean);
5578 var
5579 Selection: PGtkTreeSelection;
5580 begin
5581 if IsWidgetOk then
5582 begin
5583 Selection := GetSelection;
5584 if Selection <> nil then
5585 begin
5586 if AValue then
5587 Selection^.set_mode(GTK_SELECTION_MULTIPLE)
5588 else
5589 Selection^.set_mode(GTK_SELECTION_SINGLE);
5590 end;
5591 end;
5592 end;
5593
GetSelCountnull5594 function TGtk3ListBox.GetSelCount: Integer;
5595 var
5596 Selection: PGtkTreeSelection;
5597 Rows: PGList;
5598 ListStoreModel: PGtkTreeModel;
5599 begin
5600 Result := 0;
5601 if not Gtk3IsWidget(FWidget) then
5602 exit;
5603 Selection := GetSelection;
5604 if Selection = nil then
5605 exit;
5606 Rows := Selection^.get_selected_rows(@ListStoreModel);
5607 Result := g_list_length(Rows);
5608 g_list_free(Rows);
5609 end;
5610
GetSelectionnull5611 function TGtk3ListBox.GetSelection: PGtkTreeSelection;
5612 begin
5613 if not IsWidgetOk then
5614 exit(nil);
5615 Result := PGtkTreeView(GetContainerWidget)^.get_selection;
5616 end;
5617
GetItemSelectednull5618 function TGtk3ListBox.GetItemSelected(const AIndex: Integer): Boolean;
5619 var
5620 ASelection: PGtkTreeSelection;
5621 AModel: PGtkTreeModel;
5622 Item: TGtkTreeIter;
5623 begin
5624 Result := False;
5625
5626 if not IsWidgetOK then
5627 exit;
5628
5629 AModel := PGtkTreeView(GetContainerWidget)^.model;
5630
5631 if AModel = nil then
5632 exit;
5633
5634 ASelection := GetSelection;
5635
5636 if ASelection = nil then
5637 exit;
5638
5639 if AModel^.iter_nth_child(@Item, nil, AIndex) then
5640 Result := ASelection^.iter_is_selected(@Item);
5641 end;
5642
5643 procedure TGtk3ListBox.SelectItem(const AIndex: Integer; ASelected: Boolean);
5644 var
5645 ASelection: PGtkTreeSelection;
5646 AModel: PGtkTreeModel;
5647 Iter: TGtkTreeIter;
5648 begin
5649 if not IsWidgetOK then
5650 exit;
5651
5652 AModel := PGtkTreeView(getContainerWidget)^.model;
5653
5654 if AModel = nil then
5655 exit;
5656
5657 ASelection := GetSelection;
5658
5659 if AModel^.iter_nth_child(@Iter, nil, AIndex) then
5660 begin
5661 case ASelected of
5662 True:
5663 if not ASelection^.iter_is_selected(@Iter) then
5664 ASelection^.select_iter(@Iter);
5665 False:
5666 if ASelection^.iter_is_selected(@Iter) then
5667 ASelection^.unselect_iter(@Iter);
5668 end;
5669 end;
5670 end;
5671
5672 procedure TGtk3ListBox.SetTopIndex(const AIndex: Integer);
5673 var
5674 AModel: PGtkTreeModel;
5675 Iter: TGtkTreeIter;
5676 APath: PGtkTreePath;
5677 begin
5678 AModel := PGtkTreeView(getContainerWidget)^.model;
5679
5680 if not AModel^.iter_nth_child(@Iter, nil, AIndex) then
5681 exit;
5682 APath := AModel^.get_path(@Iter);
5683 PGtkTreeView(getContainerWidget)^.scroll_to_cell(APath, nil, False, 0.0, 0.0);
5684 APath^.free;
5685 end;
5686
5687 { TGtk3CheckListBox }
5688
5689 procedure Gtk3WS_CheckListBoxDataFunc({%H-}tree_column: PGtkTreeViewColumn;
5690 cell: PGtkCellRenderer; tree_model: PGtkTreeModel; iter: PGtkTreeIter; {%H-}data: Pointer); cdecl;
5691 var
5692 b: byte;
5693 ADisabled: gboolean;
5694 AValue: TCheckBoxState;
5695 begin
5696 B := 0;
5697 ADisabled := False;
5698 gtk_tree_model_get(tree_model, iter, [gtk3CLBState, @b, -1]);
5699 gtk_tree_model_get(tree_model, iter, [gtk3CLBDisabled, @ADisabled, -1]);
5700 AValue := TCheckBoxState(b); // TCheckBoxState is 4 byte
5701 g_object_set(cell, 'inconsistent', [gboolean(AValue = cbGrayed), nil]);
5702 if AValue <> cbGrayed then
5703 gtk_cell_renderer_toggle_set_active(PGtkCellRendererToggle(cell), AValue = cbChecked);
5704
5705 g_object_set(cell, 'activatable', [gboolean(not ADisabled), nil]);
5706 end;
5707
5708 procedure Gtk3WS_CheckListBoxToggle({%H-}cellrenderertoggle : PGtkCellRendererToggle;
5709 arg1 : PGChar; AData: GPointer); cdecl;
5710 var
5711 Mess: TLMessage;
5712 Param: PtrInt;
5713 Iter : TGtkTreeIter;
5714 TreeView: PGtkTreeView;
5715 ListStore: PGtkTreeModel;
5716 Path: PGtkTreePath;
5717 AState: TCheckBoxState;
5718 begin
5719 Val(arg1, Param);
5720
5721 TreeView := PGtkTreeView(TGtk3CheckListBox(AData).GetContainerWidget);
5722 ListStore := gtk_tree_view_get_model(TreeView);
5723 if gtk_tree_model_iter_nth_child(ListStore, @Iter, nil, Param) then
5724 begin
5725 TCustomCheckListBox(TGtk3Widget(AData).LCLObject).Toggle(Param);
5726 AState := TCustomCheckListBox(TGtk3Widget(AData).LCLObject).State[Param];
5727 gtk_list_store_set(PGtkListStore(ListStore), @Iter, [gtk3CLBState,
5728 Byte(AState), -1]);
5729 end;
5730
5731
5732 Path := gtk_tree_path_new_from_indices(Param, [-1]);
5733 if Path <> nil then
5734 begin
5735 gtk_tree_view_set_cursor(TreeView, Path, nil, False);
5736 gtk_tree_path_free(Path);
5737 end;
5738
5739 FillChar(Mess{%H-}, SizeOf(Mess), #0);
5740 Mess.Msg := LM_CHANGED;
5741
5742 Mess.Result := 0;
5743 Mess.WParam := Param;
5744 DeliverMessage(TGtk3Widget(AData).LCLObject, Mess);
5745
5746 end;
5747
CreateWidgetnull5748 function TGtk3CheckListBox.CreateWidget(const Params: TCreateParams
5749 ): PGtkWidget;
5750 var
5751 ACheckListBox: TCustomCheckListBox;
5752 ListStore: PGtkListStore;
5753 ItemList: TGtkListStoreStringList;
5754 AColumn: PGtkTreeViewColumn;
5755 Toggle: PGtkCellRendererToggle;
5756 Renderer : PGtkCellRenderer;
5757 begin
5758 FScrollX := 0;
5759 FScrollY := 0;
5760 FWidgetType := FWidgetType + [wtTreeModel, wtListBox, wtCheckListBox, wtScrollingWin];
5761 ACheckListBox := TCustomCheckListBox(LCLObject);
5762 FListBoxStyle := lbStandard;
5763
5764 Result := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil));
5765 Result^.show;
5766
5767 ListStore := gtk_list_store_new (4, [G_TYPE_UCHAR, G_TYPE_STRING, G_TYPE_POINTER, G_TYPE_BOOLEAN, nil]);
5768 FCentralWidget := TGtkTreeView.new_with_model(PGtkTreeModel(ListStore));
5769 PGtkTreeView(FCentralWidget)^.set_headers_visible(False);
5770 g_object_unref (liststore);
5771
5772 AColumn := gtk_tree_view_column_new;
5773
5774 // checkable column
5775 Toggle := gtk_cell_renderer_toggle_new;
5776 g_object_set_data(PGObject(Toggle), 'lclwidget', Self);
5777
5778 AColumn^.set_title('CHECKBINS');
5779 AColumn^.pack_start(Toggle, True);
5780 AColumn^.set_cell_data_func(Toggle, @Gtk3WS_CheckListBoxDataFunc, Self, nil);
5781 Toggle^.set_active(True);
5782 PGtkTreeView(FCentralWidget)^.append_column(AColumn);
5783 AColumn^.set_clickable(True);
5784
5785 g_signal_connect_data(Toggle, 'toggled', TGCallback(@Gtk3WS_CheckListBoxToggle), Self, nil, 0);
5786
5787 Renderer := LCLIntfCellRenderer_New(); // gtk_cell_renderer_text_new;
5788
5789 g_object_set_data(PGObject(Renderer), 'lclwidget', Self);
5790
5791 AColumn := gtk_tree_view_column_new_with_attributes ('LISTITEMS', Renderer,
5792 ['text', 1, nil]);
5793
5794 g_object_set_data(PGObject(AColumn), 'lclwidget', Self);
5795
5796 // AColumn^.pack_start(Renderer, True);
5797
5798 AColumn^.set_cell_data_func(Renderer, @LCLIntfRenderer_ColumnCellDataFunc, Self, nil);
5799
5800 PGtkTreeView(FCentralWidget)^.append_column(AColumn);
5801
5802 ItemList := TGtkListStoreStringList.Create(PGtkListStore(PGtkTreeView(FCentralWidget)^.get_model), 1, LCLObject);
5803 g_object_set_data(PGObject(FCentralWidget),GtkListItemLCLListTag, ItemList);
5804
5805
5806 AColumn^.set_clickable(True);
5807
5808 // AColumn^set_cell_data_func(AColumn, renderer, @LCLIntfRenderer_ColumnCellDataFunc, Self, nil);
5809
5810 PGtkScrolledWindow(Result)^.add(FCentralWidget);
5811
5812
5813 PGtkScrolledWindow(Result)^.get_vscrollbar^.set_can_focus(False);
5814 PGtkScrolledWindow(Result)^.get_hscrollbar^.set_can_focus(False);
5815 PGtkScrolledWindow(Result)^.set_policy(GTK_POLICY_NEVER, GTK_POLICY_AUTOMATIC);
5816 FListBoxStyle := ACheckListBox.Style;
5817 if ACheckListBox.MultiSelect then
5818 PGtkTreeView(FCentralWidget)^.get_selection^.set_mode(GTK_SELECTION_MULTIPLE)
5819 else
5820 PGtkTreeView(FCentralWidget)^.get_selection^.set_mode(GTK_SELECTION_SINGLE);
5821 // AListBox.Style;
5822 if FListBoxStyle <> lbOwnerDrawVariable then
5823 begin
5824 //AColumn^.set_sizing(GTK_TREE_VIEW_COLUMN_FIXED);
5825 //PGtkTreeView(FCentralWidget)^.set_fixed_height_mode(True);
5826 end;
5827
5828 end;
5829
5830 { TGtk3ListView }
5831
5832 function Gtk3WS_ListViewItemPreSelected({%H-}selection: PGtkTreeSelection; {%H-}model: PGtkTreeModel;
5833 path: PGtkTreePath; path_is_currently_selected: GBoolean; AData: GPointer): GBoolean; cdecl;
5834 begin
5835 if path_is_currently_selected then ;
5836 // DebugLn('Gtk3WS_ListViewItemSelected ,path selected ',dbgs(path_is_currently_selected));
5837 // this function is called *before* the item is selected
5838 // The result should be True to allow the Item to change selection
5839 Result := True;
5840
5841 if (AData = nil) or TGtk3Widget(AData).InUpdate then
5842 exit;
5843
5844 if not Assigned(TGtk3ListView(AData).FPreselectedIndices) then
5845 TGtk3ListView(AData).FPreselectedIndices := TFPList.Create;
5846
5847 if TGtk3ListView(AData).FPreselectedIndices.IndexOf({%H-}Pointer(PtrInt(gtk_tree_path_get_indices(path)^))) = -1 then
5848 TGtk3ListView(AData).FPreselectedIndices.Add({%H-}Pointer(PtrInt(gtk_tree_path_get_indices(path)^)));
5849 end;
5850
5851 procedure Gtk3WS_ListViewItemSelected(ASelection: PGtkTreeSelection; AData: GPointer); cdecl;
5852 var
5853 AList: PGList;
5854 Msg: TLMNotify;
5855 NM: TNMListView;
5856 Path: PGtkTreePath;
5857 Indices: Integer;
5858 i, j: Integer;
5859 B: Boolean;
5860 begin
5861 if (AData = nil) or TGtk3Widget(AData).InUpdate then
5862 exit;
5863 if not Assigned(TGtk3ListView(AData).FPreselectedIndices) then
5864 exit;
5865 //ATreeView := gtk_tree_selection_get_tree_view(ASelection);
5866 AList := gtk_tree_selection_get_selected_rows(ASelection, nil);
5867 TGtk3Widget(AData).BeginUpdate; // dissalow entering Gtk3WS_ListViewItemPreSelected
5868 try
5869 for i := 0 to TGtk3ListView(AData).FPreselectedIndices.Count - 1 do
5870 begin
5871 FillChar(Msg{%H-}, SizeOf(Msg), 0);
5872 Msg.Msg := CN_NOTIFY;
5873 FillChar(NM{%H-}, SizeOf(NM), 0);
5874 NM.hdr.hwndfrom := HWND(TGtk3Widget(AData));
5875 NM.hdr.code := LVN_ITEMCHANGED;
5876 NM.iItem := {%H-}PtrInt(TGtk3ListView(AData).FPreselectedIndices.Items[i]);
5877 NM.iSubItem := 0;
5878 B := False;
5879 for j := 0 to g_list_length(AList) - 1 do
5880 begin
5881 Path := g_list_nth_data(AList, guint(j));
5882 if Path <> nil then
5883 begin
5884 Indices := gtk_tree_path_get_indices(Path)^;
5885 B := Indices = {%H-}PtrInt(TGtk3ListView(AData).FPreselectedIndices.Items[i]);
5886 if B then
5887 break;
5888 end;
5889 end;
5890 if not B then
5891 NM.uOldState := LVIS_SELECTED
5892 else
5893 NM.uNewState := LVIS_SELECTED;
5894 NM.uChanged := LVIF_STATE;
5895 Msg.NMHdr := @NM.hdr;
5896 DeliverMessage(TGtk3Widget(AData).LCLObject, Msg);
5897 end;
5898 finally
5899 FreeAndNil(TGtk3ListView(AData).FPreselectedIndices);
5900 if AList <> nil then
5901 g_list_free(AList);
5902 TGtk3Widget(AData).EndUpdate;
5903 end;
5904 end;
5905
CreateWidgetnull5906 function TGtk3ListView.CreateWidget(const Params: TCreateParams): PGtkWidget;
5907 var
5908 AListView: TCustomListView;
5909 AScrollStyle: TPoint;
5910 PtrType: GType;
5911 TreeModel: PGtkTreeModel;
5912 iter:TGtkTreeIter;
5913 pxb:PGdkPixbuf;
5914 err:gint;
5915 begin
5916 FImages := nil;
5917 FScrollX := 0;
5918 FScrollY := 0;
5919 FPreselectedIndices := nil;
5920 FWidgetType := FWidgetType + [wtTreeModel, wtListView, wtScrollingWin];
5921 AListView := TCustomListView(LCLObject);
5922 Result := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil));
5923
5924 PtrType := G_TYPE_POINTER;
5925
5926
5927
5928 if TListView(AListView).ViewStyle in [vsIcon,vsSmallIcon] then
5929 begin
5930 TreeModel := PGtkTreeModel(gtk_list_store_new(3, [
5931 G_TYPE_POINTER, // ListItem pointer
5932 G_TYPE_STRING, // text
5933 gdk_pixbuf_get_type() // pixbuf
5934 ]));
5935 FCentralWidget := TGtkIconView.new_with_model(TreeModel);
5936 PGtkIconView(FCentralWidget)^.set_text_column(1);
5937 PGtkIconView(FCentralWidget)^.set_pixbuf_column(2);
5938 PGtkIconView(FCentralWidget)^.selection_mode:=GTK_SELECTION_SINGLE;
5939 end
5940 else
5941 begin
5942 TreeModel := PGtkTreeModel(gtk_list_store_newv(1, @PtrType));
5943 FCentralWidget := TGtkTreeView.new_with_model(TreeModel);
5944 end;
5945
5946 FIsTreeView := not (TListView(AListView).ViewStyle in [vsIcon,vsSmallIcon]);
5947
5948 FCentralWidget^.set_has_window(True);
5949 FCentralWidget^.show;
5950
5951 PGtkScrolledWindow(Result)^.add(FCentralWidget);
5952 //PGtkScrolledWindow(Result)^.set_focus_child(FCentralWidget);
5953
5954 AScrollStyle := Gtk3TranslateScrollStyle(TListView(AListView).ScrollBars);
5955 // gtk3 scrolled window hates GTK_POLICY_NONE
5956 PGtkScrolledWindow(Result)^.set_policy(AScrollStyle.X, AScrollStyle.Y);
5957 PGtkScrolledWindow(Result)^.set_shadow_type(BorderStyleShadowMap[AListView.BorderStyle]);
5958 PGtkScrolledWindow(Result)^.get_vscrollbar^.set_can_focus(False);
5959 PGtkScrolledWindow(Result)^.get_hscrollbar^.set_can_focus(False);
5960 g_object_unref (PGObject(TreeModel));
5961 PGtkScrolledWindow(Result)^.set_can_focus(False);
5962 PGtkTreeView(FCentralWidget)^.set_can_focus(True);
5963 if FIsTreeView then
5964 begin
5965 gtk_tree_selection_set_select_function(PGtkTreeView(FCentralWidget)^.get_selection, TGtkTreeSelectionFunc(@Gtk3WS_ListViewItemPreSelected),
5966 Self, nil);
5967 g_signal_connect_data(PGtkTreeView(FCentralWidget)^.get_selection, 'changed', TGCallback(@Gtk3WS_ListViewItemSelected), Self, nil, 0);
5968 end else
5969 begin
5970 g_signal_connect_data (PGtkIconView(FCentralWidget), 'selection-changed',
5971 TGCallback(@Tgtk3ListView.selection_changed), Self, nil, 0);
5972 end;
5973 // if FIsTreeView then
5974 // PGtkTreeView(FCentralWidget)^.set_search_column(0);
5975 end;
5976
5977 class function TGtk3ListView.selection_changed(ctl:TGtk3ListView):gboolean;cdecl;
5978 var
5979 pl:PGList;
5980 pndx:PGint;
5981 i,cnt:gint;
5982 lv:TListView;
5983 Msg: TLMNotify;
5984 NM: TNMListView;
5985 begin
5986 pl:=PGtkIconView(ctl.FCentralWidget)^.get_selected_items();
5987 if Assigned(pl) then
5988 begin
5989 pndx:=PGtkTreePath(pl^.data)^.get_indices_with_depth(@cnt);
5990 lv:=TListView(ctl.LCLObject);
5991 ctl.BeginUpdate;
5992 try
5993 for i:=0 to cnt-1 do
5994 begin
5995 FillChar(Msg{%H-}, SizeOf(Msg), 0);
5996 Msg.Msg := CN_NOTIFY;
5997 FillChar(NM{%H-}, SizeOf(NM), 0);
5998 NM.hdr.hwndfrom := HWND(ctl);
5999 NM.hdr.code := LVN_ITEMCHANGED;
6000 NM.iItem := {%H-}PtrInt(pndx^);
6001 NM.iSubItem := 0;
6002 NM.uNewState := LVIS_SELECTED;
6003 NM.uChanged := LVIF_STATE;
6004 Msg.NMHdr := @NM.hdr;
6005 ctl.DeliverMessage(Msg);
6006 inc(pndx);
6007 end;
6008 finally
6009 ctl.EndUpdate;
6010 end;
6011 end;
6012
6013 end;
6014
EatArrowKeysnull6015 function TGtk3ListView.EatArrowKeys(const AKey: Word): Boolean;
6016 begin
6017 Result := False;
6018 end;
6019
6020 destructor TGtk3ListView.Destroy;
6021 begin
6022 ClearImages;
6023 FreeAndNil(FImages);
6024 FreeAndNil(FPreselectedIndices);
6025 inherited Destroy;
6026 end;
6027
getHorizontalScrollbarnull6028 function TGtk3ListView.getHorizontalScrollbar: PGtkScrollbar;
6029 begin
6030 Result := nil;
6031 if not IsWidgetOk then
6032 exit;
6033 Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_hscrollbar);
6034 end;
6035
getVerticalScrollbarnull6036 function TGtk3ListView.getVerticalScrollbar: PGtkScrollbar;
6037 begin
6038 Result := nil;
6039 if not IsWidgetOk then
6040 exit;
6041 Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_vscrollbar);
6042 end;
6043
GetScrolledWindownull6044 function TGtk3ListView.GetScrolledWindow: PGtkScrolledWindow;
6045 begin
6046 if IsWidgetOK then
6047 Result := PGtkScrolledWindow(Widget)
6048 else
6049 Result := nil;
6050 end;
6051
6052 procedure TGtk3ListView.ClearImages;
6053 var
6054 i: Integer;
6055 begin
6056 if Assigned(FImages) then
6057 begin
6058 for i := FImages.Count - 1 downto 0 do
6059 if FImages[i] <> nil then
6060 TGtk3Object(FImages[i]).Free;
6061 FImages.Clear;
6062 end;
6063 end;
6064
6065 procedure TGtk3ListView.ColumnDelete(AIndex: Integer);
6066 var
6067 AColumn: PGtkTreeViewColumn;
6068 begin
6069 if IsWidgetOK and IsTreeView then
6070 begin
6071 AColumn := PGtkTreeView(GetContainerWidget)^.get_column(AIndex);
6072 if (AColumn<>nil) then
6073 PGtkTreeView(GetContainerWidget)^.remove_column(AColumn);
6074 end;
6075 end;
6076
ColumnGetWidthnull6077 function TGtk3ListView.ColumnGetWidth(AIndex: Integer): Integer;
6078 var
6079 AColumn: PGtkTreeViewColumn;
6080 begin
6081 Result := 0;
6082 if IsWidgetOK and IsTreeView then
6083 begin
6084 AColumn := PGtkTreeView(GetContainerWidget)^.get_column(AIndex);
6085 if (AColumn<>nil) then
6086 Result := AColumn^.get_width;
6087 end;
6088 end;
6089
6090 procedure Gtk3WSLV_ListViewGetPixbufDataFuncForColumn(tree_column: PGtkTreeViewColumn;
6091 {%H-}cell: PGtkCellRenderer; tree_model: PGtkTreeModel; iter: PGtkTreeIter; AData: GPointer); cdecl;
6092 var
6093 ListItem: TListItem;
6094 Images: TFPList;
6095 // Widgets: PTVWidgets;
6096 ListColumn: TListColumn;
6097 ImageIndex: Integer;
6098 ColumnIndex: Integer;
6099 APath: PGtkTreePath;
6100 gv:TGValue;
6101 pb:PgdkPixbuf;
6102 begin
6103 fillchar(gv,sizeof(gv),0);
6104 gv.init(G_TYPE_OBJECT);
6105 gv.set_instance(nil);
6106 PGtkCellRendererPixbuf(cell)^.set_property('pixbuf',@gv);
6107
6108 gtk_tree_model_get(tree_model, iter, [0, @ListItem, -1]);
6109
6110 ListColumn := TListColumn(g_object_get_data(tree_column, 'TListColumn'));
6111 if ListColumn = nil then
6112 Exit;
6113 ColumnIndex := ListColumn.Index;
6114 Images := TGtk3ListView(AData).Images;
6115 if Images = nil then
6116 Exit;
6117 ImageIndex := -1;
6118
6119 if (ListItem = nil) and TCustomListView(TGtk3Widget(AData).LCLObject).OwnerData then
6120 begin
6121 APath := gtk_tree_model_get_path(tree_model,iter);
6122 ListItem := TCustomListView(TGtk3Widget(AData).LCLObject).Items[gtk_tree_path_get_indices(APath)^];
6123 gtk_tree_path_free(APath);
6124 end;
6125
6126 if ListItem = nil then
6127 Exit;
6128
6129 if ColumnIndex = 0 then
6130 ImageIndex := ListItem.ImageIndex
6131 else
6132 if ColumnIndex -1 <= ListItem.SubItems.Count-1 then
6133 ImageIndex := ListItem.SubItemImages[ColumnIndex-1];
6134
6135 if (ImageIndex > -1) and (ImageIndex <= Images.Count-1) then
6136 pb:=TGtk3Image(TBitmap(Images.Items[ImageIndex]).Handle).Handle
6137 else
6138 pb:=nil;
6139
6140 gv.set_instance(pb);
6141 PGtkCellRendererPixbuf(cell)^.set_property('pixbuf',@gv)
6142
6143 end;
6144
6145 procedure Gtk3WS_ListViewColumnClicked(column: PGtkTreeViewColumn; AData: GPointer); cdecl;
6146 var
6147 AColumn: TListColumn;
6148 Msg: TLMNotify;
6149 NM: TNMListView;
6150 begin
6151 AColumn := TListColumn(g_object_get_data(PGObject(column), 'TListColumn'));
6152
6153 if (AColumn = nil) or (AData = nil) then
6154 exit;
6155
6156 FillChar(Msg{%H-}, SizeOf(Msg), 0);
6157 Msg.Msg := CN_NOTIFY;
6158
6159 FillChar(NM{%H-}, SizeOf(NM), 0);
6160 NM.hdr.hwndfrom := {%H-}PtrUInt(AData);
6161 NM.hdr.code := LVN_COLUMNCLICK;
6162 NM.iItem := -1;
6163 NM.iSubItem := AColumn.Index;
6164 Msg.NMHdr := @NM.hdr;
6165 DeliverMessage(TGtk3Widget(AData).LCLObject, Msg);
6166 end;
6167
6168 procedure TGtk3ListView.ColumnInsert(AIndex: Integer; AColumn: TListColumn);
6169 var
6170 AGtkColumn: PGtkTreeViewColumn;
6171 PixRenderer,
6172 TextRenderer: PGtkCellRenderer;
6173 begin
6174 if not IsWidgetOK or not IsTreeView then
6175 exit;
6176 AGtkColumn := TGtkTreeViewColumn.new;
6177
6178 PixRenderer := gtk_cell_renderer_pixbuf_new();
6179 TextRenderer := LCLIntfCellRenderer_New;
6180
6181 AGtkColumn^.pack_start(PixRenderer, False);
6182 AGtkColumn^.pack_start(TextRenderer, True);
6183
6184 // gtk_tree_view_column_set_cell_data_func(column, pixrenderer, TGtkTreeCellDataFunc(@Gtk2WSLV_ListViewGetPixbufDataFuncForColumn), WidgetInfo, nil);
6185 // gtk_tree_view_column_set_cell_data_func(column, textrenderer, TGtkTreeCellDataFunc(@LCLIntfCellRenderer_CellDataFunc), Self, nil);
6186 AGtkColumn^.set_cell_data_func(PixRenderer, @Gtk3WSLV_ListViewGetPixbufDataFuncForColumn, Self, nil);
6187
6188
6189 AGtkColumn^.set_cell_data_func(PGtkCellRenderer(TextRenderer), TGtkTreeCellDataFunc(@LCLIntfCellRenderer_CellDataFunc), Self, nil);
6190
6191 //store the TColumn in the column data for callbacks
6192 g_object_set_data(AGtkColumn, PgChar('TListColumn'), gpointer(AColumn));
6193
6194 g_signal_connect_data(AGtkColumn,'clicked', TGCallback(@Gtk3WS_ListViewColumnClicked), Self, nil, 0);
6195 PGtkTreeView(GetContainerWidget)^.insert_column(AGtkColumn, AIndex);
6196 AGtkColumn^.set_clickable(True);
6197
6198 end;
6199
6200 procedure TGtk3ListView.SetAlignment(AIndex: Integer; AColumn: TListColumn;
6201 AAlignment: TAlignment);
6202 var
6203 AGtkColumn: PGtkTreeViewColumn;
6204 AFloat: Double;
6205 AList: PGList;
6206 textrenderer: PGtkCellRenderer;
6207 Value: TGValue;
6208 begin
6209 if not IsWidgetOK or not IsTreeView then
6210 exit;
6211 AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex);
6212 if AGtkColumn = nil then
6213 exit;
6214
6215 AFloat := 0;
6216 case AAlignment of
6217 taRightJustify: AFloat := 1;
6218 taCenter: AFloat := 0.5;
6219 end;
6220
6221
6222 AList := PGtkCellLayout(AGtkColumn)^.get_cells;
6223 // AList := gtk_tree_view_column_get_cell_renderers(AColumn);
6224 textrenderer := PGtkCellRenderer(g_list_last(AList)^.data);
6225 g_list_free(AList);
6226
6227 Value.g_type := G_TYPE_FLOAT;
6228 Value.set_float(AFloat);
6229 g_object_set_property(textrenderer, PChar('xalign'), @Value);
6230
6231 {now we call set alignment because it calls update over visible rows in col}
6232 AGtkColumn^.set_alignment(AFloat);
6233 end;
6234
6235 procedure TGtk3ListView.SetColumnAutoSize(AIndex: Integer;
6236 AColumn: TListColumn; AAutoSize: Boolean);
6237 const
6238 SizingMap: array[Boolean] of TGtkTreeViewColumnSizing = (
6239 2 {GTK_TREE_VIEW_COLUMN_FIXED},
6240 1 {GTK_TREE_VIEW_COLUMN_AUTOSIZE}
6241 );
6242 var
6243 AGtkColumn: PGtkTreeViewColumn;
6244 begin
6245 if not IsWidgetOK or not IsTreeView then
6246 exit;
6247 AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex);
6248 if AGtkColumn <> nil then
6249 begin
6250 AGtkColumn^.set_resizable(True);
6251 AGtkColumn^.set_sizing(SizingMap[AAutoSize]);
6252 end;
6253 end;
6254
6255 procedure TGtk3ListView.SetColumnCaption(AIndex: Integer; AColumn: TListColumn;
6256 const ACaption: String);
6257 var
6258 AGtkColumn: PGtkTreeViewColumn;
6259 begin
6260 if not IsWidgetOK or not IsTreeView then
6261 exit;
6262 AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex);
6263 if AGtkColumn <> nil then
6264 begin
6265 AGtkColumn^.set_title(PgChar(ACaption));
6266 end;
6267 end;
6268
6269 procedure TGtk3ListView.SetColumnMaxWidth(AIndex: Integer;
6270 AColumn: TListColumn; AMaxWidth: Integer);
6271 var
6272 AGtkColumn: PGtkTreeViewColumn;
6273 begin
6274 if not IsWidgetOK or not IsTreeView then
6275 exit;
6276 AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex);
6277 if AGtkColumn <> nil then
6278 begin
6279 if AMaxWidth <= 0 then
6280 AGtkColumn^.set_max_width(10000)
6281 else
6282 AGtkColumn^.set_max_width(AMaxWidth);
6283 end;
6284 end;
6285
6286 procedure TGtk3ListView.SetColumnMinWidth(AIndex: Integer;
6287 AColumn: TListColumn; AMinWidth: Integer);
6288 var
6289 AGtkColumn: PGtkTreeViewColumn;
6290 begin
6291 if not IsWidgetOK or not IsTreeView then
6292 exit;
6293 AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex);
6294 if AGtkColumn <> nil then
6295 AGtkColumn^.set_min_width(AMinWidth);
6296 end;
6297
6298 procedure TGtk3ListView.SetColumnWidth(AIndex: Integer; AColumn: TListColumn;
6299 AWidth: Integer);
6300 var
6301 AGtkColumn: PGtkTreeViewColumn;
6302 begin
6303 if not IsWidgetOK or not IsTreeView then
6304 exit;
6305 AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex);
6306 if AGtkColumn <> nil then
6307 begin
6308 AGtkColumn^.set_fixed_width(AWidth + Ord(AWidth < 1));
6309 end;
6310 // AGtkColumn^.set_widget();
6311 end;
6312
6313 procedure TGtk3ListView.SetColumnVisible(AIndex: Integer; AColumn: TListColumn;
6314 AVisible: Boolean);
6315 var
6316 AGtkColumn: PGtkTreeViewColumn;
6317 begin
6318 if not IsWidgetOK or not IsTreeView then
6319 exit;
6320 AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex);
6321 if AGtkColumn <> nil then
6322 begin
6323 AGtkColumn^.set_visible(AVisible and (TListView(LCLObject).ViewStyle in [vsList, vsReport]));
6324 end;
6325 end;
6326
6327 procedure TGtk3ListView.ColumnSetSortIndicator(const AIndex: Integer;
6328 const AColumn: TListColumn; const ASortIndicator: TSortIndicator);
6329 const
6330 GtkOrder : array [ TSortIndicator] of TGtkSortType = (0, {GTK_SORT_ASCENDING}0, {GTK_SORT_DESCENDING}1);
6331 var
6332 AGtkColumn: PGtkTreeViewColumn;
6333 begin
6334 AGtkColumn := PGtkTreeView(getContainerWidget)^.get_column(AIndex);
6335
6336 if AGtkColumn <> nil then
6337 begin
6338 if ASortIndicator = siNone then
6339 AGtkColumn^.set_sort_indicator(false)
6340 else
6341 begin
6342 AGtkColumn^.set_sort_indicator(true);
6343 AgtkColumn^.set_sort_order(GtkOrder[ASortIndicator]);
6344 end;
6345 end;
6346 end;
6347
6348 procedure TGtk3ListView.ItemDelete(AIndex: Integer);
6349 var
6350 AModel: PGtkTreeModel;
6351 Iter: TGtkTreeIter;
6352 begin
6353 if IsTreeView then
6354 AModel := PGtkTreeView(getContainerWidget)^.get_model
6355 else
6356 AModel := PGtkIconView(getContainerWidget)^.get_model;
6357 if gtk_tree_model_iter_nth_child(AModel, @Iter, nil, AIndex) then
6358 gtk_list_store_remove(PGtkListStore(AModel), @Iter);
6359 end;
6360
6361 procedure TGtk3ListView.ItemInsert(AIndex: Integer; AItem: TListItem);
6362 var
6363 AModel: PGtkTreeModel;
6364 Iter: TGtkTreeIter;
6365 NewIndex: Integer;
6366 bmp:TBitmap;
6367 pxb:PGdkPixbuf;
6368 begin
6369 if not IsWidgetOK then
6370 exit;
6371 if IsTreeView then
6372 AModel := PGtkTreeView(getContainerWidget)^.get_model
6373 else
6374 AModel := PGtkIconView(getContainerWidget)^.get_model;
6375
6376 if AIndex = -1 then
6377 NewIndex := AModel^.iter_n_children(nil)
6378 else
6379 NewIndex := AIndex;
6380
6381 if IsTreeView then
6382 gtk_list_store_insert_with_values(PGtkListStore(AModel), @Iter, NewIndex,
6383 [0, Pointer(AItem), -1])
6384 else
6385 begin
6386 bmp:=TBitmap.Create;
6387 TListView(LCLObject).LargeImages.GetBitmap(AIndex,bmp);
6388 pxb:=TGtk3Image(bmp.Handle).Handle;
6389 gtk_list_store_insert_with_values(PGtkListStore(AModel), @Iter, NewIndex,
6390 [0, Pointer(AItem),
6391 1, PChar(AItem.Caption),
6392 2, pxb, -1] );
6393 fImages.Add(bmp);
6394 end;
6395
6396 end;
6397
6398 procedure TGtk3ListView.UpdateItem(AIndex:integer;AItem: TListItem);
6399 var
6400 Path: PGtkTreePath;
6401 ItemRect: TGdkRectangle;
6402 AModel: PGtkTreeModel;
6403 Iter: TGtkTreeIter;
6404 bmp:TBitmap;
6405 pxb:PGdkPixbuf;
6406 begin
6407 if IsTreeView then
6408 begin
6409 Path := gtk_tree_path_new_from_indices(AIndex, [-1]);
6410 PGtkTreeView(GetContainerWidget)^.get_cell_area(Path, nil, @ItemRect);
6411 gtk_tree_path_free(Path);
6412 end else
6413 begin
6414 Path := gtk_tree_path_new_from_indices(AIndex, [-1]);
6415 AModel:=PGtkIconView(GetContainerWidget)^.get_model;
6416 AModel^.get_iter(@iter,path);
6417
6418 bmp:=TBitmap.Create;
6419 TListView(LCLObject).LargeImages.GetBitmap(AItem.ImageIndex,bmp);
6420 pxb:=TGtk3Image(bmp.Handle).Handle;
6421 gtk_list_store_set(PGtkListStore(AModel), @Iter,
6422 [0, Pointer(AItem),
6423 1, PChar(AItem.Caption),
6424 2, pxb, -1] );
6425 fImages.Add(bmp);
6426
6427 gtk_tree_path_free(Path);
6428 end;
6429 end;
6430
6431 procedure TGtk3ListView.ItemSetText(AIndex, ASubIndex: Integer;
6432 AItem: TListItem; const AText: String);
6433 var
6434 Path: PGtkTreePath;
6435 ItemRect: TGdkRectangle;
6436 AModel: PGtkTreeModel;
6437 Iter: TGtkTreeIter;
6438 begin
6439 if not IsWidgetOK then
6440 exit;
6441
6442 if IsTreeView then
6443 begin
6444 Path := gtk_tree_path_new_from_indices(AIndex, [-1]);
6445 if GetContainerWidget^.get_realized then
6446 begin
6447 PGtkTreeView(GetContainerWidget)^.get_cell_area(Path, nil, @ItemRect);
6448 // here may be optimization
6449 end;
6450 gtk_tree_path_free(Path);
6451 end else
6452 begin
6453 UpdateItem(AIndex,AItem);
6454 end;
6455 if GetContainerWidget^.get_visible and (ItemRect.height <> 0) then // item is visible
6456 GetContainerWidget^.queue_draw;
6457 end;
6458
6459 procedure TGtk3ListView.ItemSetImage(AIndex, ASubIndex: Integer; AItem: TListItem);
6460 var
6461 Path: PGtkTreePath;
6462 ItemRect: TGdkRectangle;
6463 AModel: PGtkTreeModel;
6464 Iter: TGtkTreeIter;
6465 begin
6466 if not IsWidgetOK then
6467 exit;
6468
6469 if IsTreeView then
6470 begin
6471 Path := gtk_tree_path_new_from_indices(AIndex, [-1]);
6472 if GetContainerWidget^.get_realized then
6473 begin
6474 PGtkTreeView(GetContainerWidget)^.get_cell_area(Path, nil, @ItemRect);
6475 // here may be optimization
6476 end;
6477 gtk_tree_path_free(Path);
6478 end else
6479 begin
6480 UpdateItem(AIndex,AItem);
6481 end;
6482 if GetContainerWidget^.get_visible and (ItemRect.height <> 0) then // item is visible
6483 GetContainerWidget^.queue_draw;
6484 end;
6485
6486 procedure TGtk3ListView.ItemSetState(const AIndex: Integer;
6487 const AItem: TListItem; const AState: TListItemState; const AIsSet: Boolean);
6488 var
6489 Path: PGtkTreePath;
6490 ATreeSelection: PGtkTreeSelection;
6491 begin
6492 if not IsWidgetOK then
6493 exit;
6494
6495 case AState of
6496 lisCut,
6497 lisDropTarget:
6498 begin
6499 //TODO: do something with the rowcolor ?
6500 end;
6501
6502 lisFocused:
6503 begin
6504 Path := gtk_tree_path_new_from_string(PgChar(IntToStr(AIndex)));
6505 if IsTreeView then
6506 begin
6507 if AIsSet then
6508 PGtkTreeView(getContainerWidget)^.set_cursor(Path, nil, False)
6509 else
6510 PGtkTreeView(GetContainerWidget)^.set_cursor(Path, nil, False);
6511 end else
6512 PGtkIconView(GetContainerWidget)^.set_cursor(Path, nil, False);
6513 if Path <> nil then
6514 gtk_tree_path_free(Path);
6515 end;
6516
6517 lisSelected:
6518 begin
6519 Path := gtk_tree_path_new_from_string(PgChar(IntToStr(AIndex)));
6520 if IsTreeView then
6521 begin
6522 ATreeSelection := PGtkTreeView(GetContainerWidget)^.get_selection;
6523 if AIsSet and not ATreeSelection^.path_is_selected(Path) then
6524 begin
6525 ATreeSelection^.select_path(Path);
6526 // BroadcastMsg := True;
6527 end else
6528 if not AIsSet and ATreeSelection^.path_is_selected(Path) then
6529 begin
6530 ATreeSelection^.unselect_path(Path);
6531 // BroadcastMsg := True;
6532 end;
6533 end else
6534 begin
6535 if AIsSet and not PGtkIconView(GetContainerWidget)^.path_is_selected(Path) then
6536 begin
6537 PGtkIconView(GetContainerWidget)^.select_path(Path);
6538 // BroadCastMsg := True;
6539 end else
6540 if not AIsSet and PGtkIconView(GetContainerWidget)^.path_is_selected(Path) then
6541 begin
6542 PGtkIconView(GetContainerWidget)^.unselect_path(Path);
6543 // BroadCastMsg := True;
6544 end;
6545 end;
6546 if Path <> nil then
6547 gtk_tree_path_free(Path);
6548 // if BroadcastMsg then
6549 // BroadCastListSelection(ALV, {%H-}PtrUInt(MainView), AIndex, not AIsSet);
6550 end;
6551 end;
6552
6553 end;
6554
ItemGetStatenull6555 function TGtk3ListView.ItemGetState(const AIndex: Integer;
6556 const AItem: TListItem; const AState: TListItemState; out AIsSet: Boolean
6557 ): Boolean;
6558 var
6559 Path: PGtkTreePath;
6560 Column: PPGtkTreeViewColumn;
6561 Cell: PPGtkCellRenderer;
6562 APath: PGtkTreePath;
6563 AStr: PChar;
6564 begin
6565 Result := False;
6566 AIsSet := False;
6567 if not IsWidgetOK then
6568 exit;
6569 case AState of
6570 lisCut,
6571 lisDropTarget:
6572 begin
6573 //TODO: do something with the rowcolor ?
6574 end;
6575 lisFocused:
6576 begin
6577 Path := nil;
6578 Column := nil;
6579 Cell := nil;
6580 if IsTreeView then
6581 PGtkTreeView(GetContainerWidget)^.get_cursor(@Path, Column)
6582 else
6583 PGtkIconView(GetContainerWidget)^.get_cursor(@Path, Cell);
6584 if Assigned(Path) then
6585 begin
6586 AStr := gtk_tree_path_to_string(Path);
6587 AIsSet := (StrToIntDef(AStr,-1) = AIndex);
6588 if AStr <> nil then
6589 g_free(AStr);
6590 gtk_tree_path_free(Path);
6591 Result := True;
6592 end;
6593 end;
6594
6595 lisSelected:
6596 begin
6597 APath := gtk_tree_path_new_from_string(PChar(IntToStr(AIndex)));
6598 if IsTreeView then
6599 AIsSet := PGtkTreeView(GetContainerWidget)^.get_selection^.path_is_selected(APath)
6600 else
6601 AIsSet := PGtkIconView(GetContainerWidget)^.path_is_selected(APath);
6602
6603 if APath <> nil then
6604 gtk_tree_path_free(APath);
6605 Result := True;
6606 end;
6607 end;
6608 end;
6609
6610 procedure TGtk3ListView.UpdateImageCellsSize;
6611 begin
6612 // must get renderer via property
6613 // gtk_tree_view_column_get_cell_renderers
6614 end;
6615
6616 { TGtk3ComboBox }
6617
GetItemIndexnull6618 function TGtk3ComboBox.GetItemIndex: Integer;
6619 begin
6620 Result := -1;
6621 if Assigned(FWidget) and Gtk3IsComboBox(GetContainerWidget) then
6622 Result := PGtkComboBox(GetContainerWidget)^.get_active;
6623 end;
6624
6625 procedure TGtk3ComboBox.SetDroppedDown(AValue: boolean);
6626 begin
6627 if Assigned(FWidget) and Gtk3IsComboBox(GetContainerWidget) then
6628 begin
6629 if AValue then
6630 PGtkComboBox(GetContainerWidget)^.popup
6631 else
6632 PGtkComboBox(GetContainerWidget)^.popdown;
6633 end;
6634 end;
6635
6636 procedure TGtk3ComboBox.SetItemIndex(AValue: Integer);
6637 begin
6638 if IsWidgetOK and Gtk3IsComboBox(GetContainerWidget) then
6639 PGtkComboBox(GetContainerWidget)^.set_active(AValue);
6640 end;
6641
GetCellViewnull6642 function TGtk3ComboBox.GetCellView: PGtkCellView;
6643 var
6644 AList: PGList;
6645 i: Integer;
6646 begin
6647 if FCellView = nil then
6648 begin
6649 AList := PGtkComboBox(getContainerWidget)^.get_children;
6650 for i := 0 to g_list_length(AList) -1 do
6651 begin
6652 if Gtk3IsCellView(g_list_nth(AList, i)^.data) then
6653 begin
6654 FCellView := PGtkCellView(g_list_first(AList)^.data);
6655 break;
6656 end;
6657 end;
6658 g_list_free(AList);
6659 end;
6660 Result := FCellView;
6661 end;
6662
GetPopupWidgetnull6663 function TGtk3ComboBox.GetPopupWidget: PGtkWidget;
6664 begin
6665 Result := nil;
6666 if not IsWidgetOk then
6667 exit;
6668 if PGtkComboBox(GetContainerWidget)^.priv3^.popup_widget <> nil then
6669 Result := PGtkComboBox(GetContainerWidget)^.priv3^.popup_widget
6670 else
6671 if PGtkComboBox(GetContainerWidget)^.priv3^.tree_view <> nil then
6672 Result := PGtkComboBox(GetContainerWidget)^.priv3^.tree_view;
6673 end;
6674
GetButtonWidgetnull6675 function TGtk3ComboBox.GetButtonWidget: PGtkWidget;
6676 begin
6677 Result := nil;
6678 if not IsWidgetOk then
6679 exit;
6680 if PGtkComboBox(GetContainerWidget)^.priv3^.button <> nil then
6681 Result := PGtkComboBox(GetContainerWidget)^.priv3^.button;
6682 end;
6683
GetCellViewFramenull6684 function TGtk3ComboBox.GetCellViewFrame: PGtkWidget;
6685 begin
6686 Result := nil;
6687 if not IsWidgetOk then
6688 exit;
6689 if PGtkComboBox(GetContainerWidget)^.priv3^.cell_view_frame <> nil then
6690 Result := PGtkComboBox(GetContainerWidget)^.priv3^.cell_view_frame;
6691 end;
6692
CreateWidgetnull6693 function TGtk3ComboBox.CreateWidget(const Params: TCreateParams): PGtkWidget;
6694 var
6695 ACombo: TCustomComboBox;
6696 ListStore: PGtkListStore;
6697 ItemList: TGtkListStoreStringList;
6698 Renderer: PGtkCellRenderer;
6699 bs: string;
6700 pos: gint;
6701 begin
6702 FWidgetType := FWidgetType + [wtTreeModel, wtComboBox];
6703 ACombo := TCustomComboBox(LCLObject);
6704 ListStore := gtk_list_store_new (2, [G_TYPE_STRING, G_TYPE_POINTER, nil]);
6705 if ACombo.Style.HasEditBox then
6706 Result := PGtkWidget(TGtkComboBox.new_with_model_and_entry(PGtkTreeModel(ListStore)))
6707 else
6708 Result := PGtkWidget(TGtkComboBox.new_with_model(PGtkTreeModel(ListStore)));
6709
6710 if ACombo.Style.HasEditBox then
6711 begin
6712 ItemList := TGtkListStoreStringList.Create(PGtkListStore(PGtkComboBox(Result)^.get_model), 0, LCLObject);
6713 g_object_set_data(PGObject(Result), GtkListItemLCLListTag, ItemList);
6714
6715 PGtkComboBox(Result)^.set_entry_text_column(0);
6716 // do not allow combo button to get focus, entry should take focus
6717 if PGtkComboBox(Result)^.priv3^.button <> nil then
6718 PGtkComboBox(Result)^.priv3^.button^.set_can_focus(False);
6719
6720 bs := Self.LCLObject.Caption;
6721 pos := 0;
6722 PGtkEditable(PGtkComboBox(Result)^.get_child)^.insert_text(pgChar(PChar(bs)),length(bs),@pos);
6723
6724 // set lclwidget data to entry
6725 g_object_set_data(PGtkComboBox(Result)^.get_child, 'lclwidget', Self);
6726 // when we scroll with mouse wheel over entry our scrollevent doesn't catch entry
6727 // but parent control with window (eg. form), so we are settint all events mask to
6728 // catch all mouse events on gtkentry.
6729 PGtkEntry(PGtkComboBox(Result)^.get_child)^.set_events(GDK_DEFAULT_EVENTS_MASK);
6730 end else
6731 begin
6732 // FCentralWidget := PGtkWidget(TGtkComboBox.new_with_model(PGtkTreeModel(ListStore)));
6733 FCentralWidget := Result;
6734
6735 ItemList := TGtkListStoreStringList.Create(PGtkListStore(PGtkComboBox(FCentralWidget)^.get_model), 0, LCLObject);
6736 g_object_set_data(PGObject(FCentralWidget), GtkListItemLCLListTag, ItemList);
6737
6738 renderer := LCLIntfCellRenderer_New();
6739 g_object_set_data(PGObject(renderer), 'lclwidget', Self);
6740
6741 gtk_cell_layout_clear(PGtkCellLayout(FCentralWidget));
6742 gtk_cell_layout_pack_start(PGtkCellLayout(FCentralWidget), renderer, True);
6743 if not ACombo.Style.IsOwnerDrawn then
6744 gtk_cell_layout_set_attributes(PGtkCellLayout(FCentralWidget), renderer, ['text', 0, nil]);
6745 gtk_cell_layout_set_cell_data_func(PGtkCellLayout(FCentralWidget), renderer,
6746 @LCLIntfCellRenderer_CellDataFunc, Self, nil);
6747
6748 FCentralWidget := nil; //FWidget will be returned from getContainerWidget
6749 // we need cell renderer, but we need f***g GtkEventBox too
6750 // maybe an workaround is possible for csDropDownList (use entry with readonly param).
6751 // if we have GtkEventBox, then ComboBox becomes FCentralWidget.
6752 // Maybe the best thing would be to organize complete combo around GtkEntry
6753 // Anyway , I dont see any mouse button event in this case, only when entry_set_above_child is used.
6754 // FCentralWidget := PGtkComboBox(TGtkComboBox.new_with_model(PGtkTreeModel(ListStore)));
6755 // PGtkEventBox(Result)^.add(FCentralWidget);
6756 // ItemList := TGtkListStoreStringList.Create(PGtkListStore(PGtkComboBox(FCentralWidget)^.get_model), 0, LCLObject);
6757 // g_object_set_data(PGObject(FCentralWidget), GtkListItemLCLListTag, ItemList);
6758 // PGtkEventBox(Result)^.set_visible_window(True);
6759 end;
6760 g_object_unref(ListStore);
6761
6762 end;
6763
EatArrowKeysnull6764 function TGtk3ComboBox.EatArrowKeys(const AKey: Word): Boolean;
6765 begin
6766 Result := AKey in [VK_UP, VK_DOWN];
6767 end;
6768
getTextnull6769 function TGtk3ComboBox.getText: String;
6770 begin
6771 Result := inherited getText;
6772 if Gtk3IsComboBox(GetContainerWidget) then
6773 Result := StrPas(PGtkComboBox(GetContainerWidget)^.get_title);
6774 end;
6775
6776 procedure TGtk3ComboBox.setText(const AValue: String);
6777 begin
6778 if Gtk3IsComboBox(FWidget) then
6779 PGtkComboBox(GetContainerWidget)^.set_title(PgChar(AValue));
6780 end;
6781
6782 procedure TGtk3ComboBox.DumpPrivateStructValues(const ADbgEvent: String);
6783 var
6784 AComboWidget: PGtkComboBox;
6785 APrivate: PGtkComboBoxPrivate;
6786 begin
6787 exit;
6788 AComboWidget := PGtkComboBox(GetContainerWidget);
6789 APrivate := PGtkComboBoxPrivate(AComboWidget^.priv3);
6790 DebugLn('** COMBO DUMP OF PGtkComboBoxPrivate struct EVENT=',ADbgEvent);
6791 DebugLn('BUTTON=',dbgHex({%H-}PtrUInt(APrivate^.button)),' ARROW=',dbgHex({%H-}PtrUInt(APrivate^.arrow)),
6792 ' SCROLLEDWINDOW=',dbgHex({%H-}PtrUInt(APrivate^.scrolled_window)),
6793 ' CELLVIEW=',dbgHex({%H-}PtrUInt(APrivate^.cell_view)),
6794 ' CELLAREA=',dbgHex({%H-}PtrUInt(APrivate^.area)));
6795 DebugLn(' PrivatePopupW ',dbgHex({%H-}PtrUInt(APrivate^.popup_widget)),
6796 ' PrivatePopupWin ',dbgHex({%H-}PtrUInt(APrivate^.popup_window)),' TreeView ',dbgHex({%H-}PtrUInt(APrivate^.tree_view)));
6797 if Gtk3IsWidget(APrivate^.popup_widget) then
6798 begin
6799 DebugLn('POPUPWIDGET VISIBLE ',dbgs(APrivate^.popup_widget^.get_visible),
6800 ' PopupInProgress=',dbgs(APrivate^.popup_in_progress),' POPUPSHOWN=',
6801 dbgs(APrivate^.popup_shown),' POPUPIDLE_ID=',dbgs(APrivate^.popup_idle_id));
6802 if Gtk3IsMenu(APrivate^.popup_widget) then
6803 DebugLn('POPUPWIDGET IS MENU ')
6804 else
6805 if Gtk3IsMenuItem(APrivate^.popup_widget) then
6806 DebugLn('POPUPWIDGET IS MENUITEM ');
6807 end;
6808 end;
6809
CanFocusnull6810 function TGtk3ComboBox.CanFocus: Boolean;
6811 begin
6812 Result := False;
6813 if IsWidgetOK then
6814 begin
6815 if PGtkComboBox(FWidget)^.has_entry then
6816 Result := PGtkComboBox(FWidget)^.get_child^.can_focus
6817 else
6818 if GetButtonWidget <> nil then
6819 Result := GetButtonWidget^.can_focus;
6820 end;
6821 end;
6822
6823 procedure TGtk3ComboBox.SetFocus;
6824 begin
6825 {$IFDEF GTK3DEBUGFOCUS}
6826 DebugLn('TGtk3ComboBox.SetFocus LCLObject ',dbgsName(LCLObject),' WidgetOK ',dbgs(IsWidgetOK),
6827 ' FWidget <> GetContainerWidget ',dbgs(FWidget <> GetContainerWidget));
6828 {$ENDIF}
6829 if Assigned(LCLObject) then
6830 begin
6831 if IsWidgetOK then // and (FWidget <> GetContainerWidget) then
6832 begin
6833 if PGtkComboBox(FWidget)^.has_entry then
6834 FWidget^.grab_focus
6835 else
6836 if GetButtonWidget <> nil then
6837 GetButtonWidget^.grab_focus;
6838 end else
6839 inherited SetFocus;
6840 end else
6841 inherited SetFocus;
6842 end;
6843
6844 procedure Gtk3ComboBoxChanged({%H-}ACombo: PGtkComboBox; AData: gpointer); cdecl;
6845 var
6846 Msg: TLMessage;
6847 begin
6848 if AData <> nil then
6849 begin
6850 if TGtk3Widget(AData).InUpdate then
6851 Exit;
6852 FillChar(Msg{%H-}, SizeOf(Msg), #0);
6853 Msg.Msg := LM_CHANGED;
6854 TGtk3Widget(AData).DeliverMessage(Msg);
6855 end;
6856 end;
6857
GtkPopupCloseUpnull6858 function GtkPopupCloseUp(AData: Pointer): gboolean; cdecl;
6859 begin
6860 LCLSendCloseUpMsg(TGtk3Widget(AData).LCLObject);
6861 Result := False;// stop the timer
6862 end;
6863
6864 procedure GtkNotifyCombo(AObject: PGObject; pspec: PGParamSpec; AData: GPointer); cdecl;
6865 var
6866 AValue: TGValue;
6867 ComboBox: TCustomComboBox;
6868 begin
6869 if pspec^.name = 'popup-shown' then
6870 begin
6871 ComboBox := TCustomComboBox(TGtk3Widget(AData).LCLObject);
6872 AValue.g_type := G_TYPE_BOOLEAN;
6873 g_object_get_property(AObject, pspec^.name, @AValue); // get property value
6874 if AValue.data[0].v_int = 0 then // if 0 = False then it is close up
6875 g_timeout_add(0,@GtkPopupCloseUp, AData)
6876 else // in other case it is drop down
6877 begin
6878 ComboBox.IntfGetItems;
6879 LCLSendDropDownMsg(ComboBox);
6880 end;
6881 end;
6882 end;
6883
6884 procedure Gtk3ComboMenuRealized({%H-}AWidget: PGtkWidget; AData: gPointer); cdecl;
6885 begin
6886 DebugLn('Gtk3ComboMenuRealized *****',dbgsName(TGtk3ComboBox(AData).LCLObject));
6887 end;
6888
6889 procedure TGtk3ComboBox.InitializeWidget;
6890 begin
6891 inherited InitializeWidget;
6892 // appears-as-list make it appear as list ... no way, its read only property.
6893 //OnChange
6894 g_signal_connect_data(GetContainerWidget, 'changed', TGCallback(@Gtk3ComboBoxChanged), Self, nil, 0);
6895 //OnCloseUp
6896 g_signal_connect_data(GetContainerWidget, 'notify', TGCallback(@GtkNotifyCombo), Self, nil, 0);
6897
6898 //TODO: if we have an entry then use CreateFrom() to create TGtk3Entry
6899 if Gtk3IsEntry(PGtkComboBox(FWidget)^.get_child) then
6900 begin
6901 g_object_set_data(PGtkComboBox(FWidget)^.get_child, 'lclwidget', Self);
6902 g_signal_connect_data(PGtkComboBox(FWidget)^.get_child, 'event', TGCallback(@Gtk3WidgetEvent), Self, nil, 0);
6903 end;
6904 if GetCellView <> nil then
6905 begin
6906 gtk_widget_set_events(FCellView, GDK_DEFAULT_EVENTS_MASK);
6907 g_object_set_data(FCellView, 'lclwidget', Self);
6908 g_signal_connect_data(FCellView, 'event', TGCallback(@Gtk3WidgetEvent), Self, nil, 0);
6909 end;
6910 // set to all combo widgets lclwidget data, so we will easy find TGtk3ComboBox in events.
6911 if PGtkComboBox(GetContainerWidget)^.priv3^.button <> nil then
6912 begin
6913 g_object_set_data(PGObject(PGtkComboBox(GetContainerWidget)^.priv3^.button), 'lclwidget', Self);
6914 g_signal_connect_data(PGObject(PGtkComboBox(GetContainerWidget)^.priv3^.button), 'event', TGCallback(@Gtk3WidgetEvent), Self, nil, 0);
6915 end;
6916 if PGtkComboBox(GetContainerWidget)^.priv3^.popup_widget <> nil then
6917 begin
6918 g_object_set_data(PGObject(PGtkComboBox(GetContainerWidget)^.priv3^.popup_widget), 'lclwidget', Self);
6919 g_signal_connect_data(PGObject(PGtkComboBox(GetContainerWidget)^.priv3^.popup_widget), 'event', TGCallback(@Gtk3WidgetEvent), Self, nil, 0);
6920 PGtkComboBox(GetContainerWidget)^.priv3^.popup_widget^.set_has_window(True);
6921 PGtkComboBox(GetContainerWidget)^.priv3^.popup_widget^.set_can_focus(True);
6922 // g_signal_connect_data(PGObject(PGtkComboBox(GetContainerWidget)^.priv3^.popup_widget), 'map', TGCallback(@Gtk3ComboMenuRealized), Self, nil, 0);
6923 end;
6924 if PGtkComboBox(GetContainerWidget)^.priv3^.area <> nil then
6925 g_object_set_data(PGObject(PGtkComboBox(GetContainerWidget)^.priv3^.area), 'lclwidget', Self);
6926 // if combo doesnt use menu
6927 if PGtkComboBox(GetContainerWidget)^.priv3^.tree_view <> nil then
6928 g_object_set_data(PGObject(PGtkComboBox(GetContainerWidget)^.priv3^.tree_view), 'lclwidget', Self);
6929 end;
6930
GetDroppedDownnull6931 function TGtk3ComboBox.GetDroppedDown: boolean;
6932 var
6933 AValue: TGValue;
6934 begin
6935 Result := False;
6936 if Assigned(FWidget) and Gtk3IsComboBox(GetContainerWidget) then
6937 begin
6938 AValue.g_type := G_TYPE_BOOLEAN;
6939 g_object_get_property(PGObject(GetContainerWidget), 'popup-shown', @AValue);
6940 Result := AValue.data[0].v_int <> 0;
6941 end;
6942 end;
6943
6944 { TGtk3Button }
6945
getLayoutnull6946 function TGtk3Button.getLayout: Integer;
6947 begin
6948 Result := FLayout;
6949 // PGtkButton(FWidget)^.get_image_position;
6950 end;
6951
getMarginnull6952 function TGtk3Button.getMargin: Integer;
6953 begin
6954 Result := FMargin;
6955 end;
6956
6957 procedure TGtk3Button.SetLayout(AValue: Integer);
6958 begin
6959 FLayout := AValue;
6960 if IsWidgetOk then
6961 begin
6962 PGtkButton(FWidget)^.set_image_position(TGtkPositionType(AValue));
6963 // set margin and spacing when layout is changed
6964 SetMargin(FMargin);
6965 end;
6966 end;
6967
6968 procedure TGtk3Button.SetMargin(AValue: Integer);
6969 begin
6970 FMargin := AValue;
6971 if not IsWidgetOK then
6972 exit;
6973 if FMargin = -1 then
6974 PGtkButton(FWidget)^.set_alignment(0.5, 0.5)
6975 else
6976 begin
6977 case FLayout of
6978 0 {GTK_POS_LEFT}: PGtkButton(FWidget)^.set_alignment(0, 0.5);
6979 1 {GTK_POS_RIGHT}: PGtkButton(FWidget)^.set_alignment(1.0, 0.5);
6980 2 {GTK_POS_TOP}: PGtkButton(FWidget)^.set_alignment(0.5, 0);
6981 3 {GTK_POS_BOTTOM}: PGtkButton(FWidget)^.set_alignment(0.5, 1);
6982 end;
6983 end;
6984 end;
6985
6986 procedure TGtk3Button.SetSpacing(AValue: Integer);
6987 var
6988 ATGValue: TGValue;
6989 AImage: PGtkWidget;
6990 begin
6991 // if FSpacing=AValue then Exit;
6992 FSpacing:=AValue;
6993 if AValue < 0 then
6994 FSpacing := 2;
6995 ATGValue.g_type := G_TYPE_INT;
6996 ATGValue.set_int(AValue);
6997
6998 // no way under gtk3 ... we cannot set style property image-spacing
6999 // so we are using cheat
7000 AImage := PGtkButton(FWidget)^.get_image;
7001 if AImage <> nil then
7002 begin
7003 if AValue < 0 then
7004 AVAlue := 0;
7005 //TODO: margin depends on layout ! This is ok for left (default) layout
7006 PGtkImage(AImage)^.set_margin_right(AValue);
7007 end;
7008 end;
7009
7010 procedure TGtk3Button.ButtonClicked(pData: pointer); cdecl;
7011 begin
7012 if TObject(pdata) is TCustomButton then
7013 TCustomButton(pdata).Click;
7014 end;
7015
7016 procedure TGtk3Button.SetImage(AImage: TBitmap);
7017 begin
7018 if Assigned(fImage) then
7019 fImage.free;
7020 fImage:=AImage;
7021 end;
7022
getTextnull7023 function TGtk3Button.getText: String;
7024 begin
7025 if IsWidgetOK then
7026 Result := PGtkButton(FWidget)^.get_label
7027 else
7028 Result := '';
7029 end;
7030
7031 procedure TGtk3Button.setText(const AValue: String);
7032 begin
7033 if IsWidgetOk then
7034 begin
7035 PGtkButton(FWidget)^.set_label(PgChar(ReplaceAmpersandsWithUnderscores(AValue)));
7036 end;
7037 end;
7038
TGtk3Button.CreateWidgetnull7039 function TGtk3Button.CreateWidget(const Params: TCreateParams): PGtkWidget;
7040 var
7041 btn:PGtkButton absolute Result;
7042 begin
7043 Result := PGtkWidget(TGtkButton.new);
7044
7045 btn^.set_use_underline(true);
7046
7047 g_signal_connect_data(btn,'clicked',
7048 TGCallback(@TGtk3Button.ButtonClicked), LCLObject, nil, 0);
7049
7050 LCLObject.ControlStyle:=LCLObject.ControlStyle+[csClickEvents];
7051
7052 FMargin := -1;
7053 FLayout := ord(GTK_POS_LEFT);
7054 FSpacing := 2; // default gtk3 spacing is 2
7055 end;
7056
7057 destructor TGtk3Button.Destroy;
7058 begin
7059 SetImage(nil);
7060 inherited Destroy;
7061 end;
7062
TGtk3Button.IsWidgetOknull7063 function TGtk3Button.IsWidgetOk: Boolean;
7064 begin
7065 Result := (FWidget <> nil) and Gtk3IsButton(FWidget);
7066 end;
7067
7068 procedure TGtk3Button.SetDefault(const ADefault: Boolean);
7069 begin
7070 if IsWidgetOk then
7071 GetContainerWidget^.set_can_default(ADefault);
7072 end;
7073
7074 { TGtk3ToggleButton }
7075 procedure Gtk3Toggled({%H-}AWidget: PGtkToggleButton; AData: gPointer); cdecl;
7076 var
7077 Msg: TLMessage;
7078 begin
7079 FillChar(Msg{%H-}, SizeOf(Msg), 0);
7080 Msg.Msg := LM_CHANGED;
7081 if (TGtk3Widget(AData).LCLObject <> nil) and not TGtk3Widget(AData).InUpdate then
7082 TGtk3Widget(AData).DeliverMessage(Msg, False);
7083 end;
7084
7085 procedure TGtk3ToggleButton.InitializeWidget;
7086 begin
7087 inherited InitializeWidget;
7088 g_signal_connect_data(FWidget, 'toggled', TGCallback(@Gtk3Toggled), Self, nil, 0);
7089 end;
7090
TGtk3ToggleButton.CreateWidgetnull7091 function TGtk3ToggleButton.CreateWidget(const Params: TCreateParams): PGtkWidget;
7092 var
7093 btn: PGtkToggleButton;
7094 begin
7095 btn := TGtkToggleButton.new;
7096 btn^.use_underline := True;
7097 Result := PGtkWidget(btn);
7098 end;
7099
7100 { TGtk3CheckBox }
7101
TGtk3CheckBox.GetStatenull7102 function TGtk3CheckBox.GetState: TCheckBoxState;
7103 begin
7104 Result := cbUnchecked;
7105 if IsWidgetOk then
7106 begin
7107 if PGtkCheckButton(FWidget)^.get_inconsistent then
7108 Result := cbGrayed
7109 else
7110 if PGtkCheckButton(FWidget)^.get_active then
7111 Result := cbChecked;
7112 end;
7113 end;
7114
7115 procedure TGtk3CheckBox.SetState(AValue: TCheckBoxState);
7116 begin
7117 if IsWidgetOK then
7118 begin
7119 if AValue = cbGrayed then
7120 PGtkCheckButton(FWidget)^.set_inconsistent(True)
7121 else
7122 PGtkCheckButton(FWidget)^.set_active(AValue = cbChecked);
7123 end;
7124 end;
7125
CreateWidgetnull7126 function TGtk3CheckBox.CreateWidget(const Params: TCreateParams): PGtkWidget;
7127 var
7128 check: PGtkCheckButton;
7129 begin
7130 check := TGtkCheckButton.new;
7131 Result := PGtkWidget(check);
7132 check^.set_use_underline(True);
7133 {fWidgetRGBA[0].G:=0.8;
7134 fWidgetRGBA[0].Alpha:=1;
7135 check^.override_color(GTK_STATE_FLAG_NORMAL,@Self.FWidgetRGBA[0]);}
7136 (*fWidgetRGBA[0].G:=0.8;
7137 fWidgetRGBA[0].B:=0.9;
7138 fWidgetRGBA[0].Alpha:=0.9;
7139 check^.override_color(GTK_STATE_FLAG_ACTIVE,@Self.FWidgetRGBA[0]); *)
7140 // nil resets color to gtk default
7141 { FWidget^.override_color(GTK_STATE_FLAG_NORMAL, nil);
7142 FWidget^.override_background_color(GTK_STATE_FLAG_NORMAL, nil);}
7143 end;
7144
7145 { TGtk3RadioButton }
7146
TGtk3RadioButton.CreateWidgetnull7147 function TGtk3RadioButton.CreateWidget(const Params: TCreateParams): PGtkWidget;
7148 var
7149 btn: PGtkRadioButton;
7150 w: PGtkWidget;
7151 ctl, Parent: TWinControl;
7152 rb: TRadioButton;
7153 //pl: PGsList;
7154 i: Integer;
7155 begin
7156 if Self.LCLObject.Name='HiddenRadioButton' then
7157 exit;
7158 btn := TGtkRadioButton.new(nil);
7159 btn^.use_underline := True;
7160 Result := PGtkWidget(btn);
7161 ctl := Self.LCLObject;
7162 if Assigned(ctl) then
7163 begin
7164 Parent := ctl.Parent;
7165 if (Parent is TRadioGroup) then
7166 begin
7167 if (TRadioGroup(Parent).Items.Count>0) then
7168 begin
7169 rb := TRadioButton(Parent.Controls[0]);
7170 if rb<>ctl then
7171 begin
7172 w := TGtk3RadioButton(rb.Handle).Widget;
7173 //pl := PGtkRadioButton(w)^.get_group;
7174 //PGtkRadioButton(Result)^.set_group(pl);
7175 PGtkRadioButton(Result)^.join_group(PGtkRadioButton(w));
7176 end;
7177 end
7178 end
7179 else
7180 begin
7181 for i := 0 to Parent.ControlCount - 1 do
7182 if (Parent.Controls[i] is TRadioButton) and
7183 TWinControl(Parent.Controls[i]).HandleAllocated then
7184 begin
7185 rb := TRadioButton(Parent.Controls[i]);
7186 w := TGtk3RadioButton(rb.Handle).Widget;
7187 //pl := PGtkRadioButton(w)^.get_group;
7188 //PGtkRadioButton(Result)^.set_group(pl);
7189 PGtkRadioButton(Result)^.join_group(PGtkRadioButton(w));
7190 Break;
7191 end;
7192 end;
7193 end;
7194 end;
7195
7196 procedure TGtk3RadioButton.InitializeWidget;
7197 begin
7198 if Self.LCLObject.Name='HiddenRadioButton' then
7199 begin
7200 exit;
7201 { PGtkRadioButton(Self.Widget)^.set_group(nil);
7202 // PGtkRadioButton(Self.Widget)^.set_inconsistent(true);
7203 PGtkRadioButton(Self.Widget)^.set_visible(false);}
7204 end;
7205 inherited InitializeWidget;
7206 end;
7207
7208 { TGtk3CustomControl }
7209
TGtk3CustomControl.CreateWidgetnull7210 function TGtk3CustomControl.CreateWidget(const Params: TCreateParams): PGtkWidget;
7211 var
7212 FUseLayout: Boolean;
7213 begin
7214 FScrollX := 0;
7215 FScrollY := 0;
7216 FHasPaint := True;
7217 FUseLayout := False;
7218 if FUseLayout then
7219 FWidgetType := [wtWidget, wtLayout, wtScrollingWin, wtCustomControl]
7220 else
7221 FWidgetType := [wtWidget, wtContainer, wtTabControl, wtScrollingWin, wtCustomControl];
7222 Result := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil));
7223
7224 if FUseLayout then
7225 FCentralWidget := TGtkLayout.new(nil, nil)
7226 else
7227 FCentralWidget := TGtkFixed.new;
7228
7229 FCentralWidget^.set_has_window(True);
7230
7231 // this is deprecated since 3.8 .add() should be used
7232 // in this case viewport should be blocked somehow.....
7233 //if FUseLayout or (gtk_get_major_version > 3 or gtk_get_minor_version >=8 )then
7234 // PGtkScrolledWindow(Result)^.add(FCentralWidget)
7235 //else
7236 // PGtkScrolledWindow(Result)^.add_with_viewport(FCentralWidget);
7237
7238 // gtk_container_add() will now automatically add a GtkViewport if the child doesn't implement GtkScrollable.
7239
7240 PGtkScrolledWindow(Result)^.add(FCentralWidget);
7241
7242 // PGtkViewport(PGtkScrolledWindow(Result)^.get_child)^.;
7243 // also works fine with 3.6 but raises asserts
7244 // PGtkScrolledWindow(Result)^.add(FCentralWidget);
7245 Result^.set_can_focus(False);
7246 FCentralWidget^.set_can_focus(True);
7247 end;
7248
EatArrowKeysnull7249 function TGtk3CustomControl.EatArrowKeys(const AKey: Word): Boolean;
7250 begin
7251 Result := False;
7252 end;
7253
7254 procedure TGtk3CustomControl.InitializeWidget;
7255 begin
7256 inherited InitializeWidget;
7257 SetScrollBarsSignalHandlers;
7258 g_signal_connect_data(GetScrolledWindow,'scroll-event', TGCallback(@Gtk3ScrolledWindowScrollEvent), Self, nil, 0);
7259 end;
7260
getClientRectnull7261 function TGtk3CustomControl.getClientRect: TRect;
7262 var
7263 Allocation: TGtkAllocation;
7264 R: TRect;
7265 w: gint;
7266 h: gint;
7267 x: gint;
7268 y: gint;
7269 AViewPort: PGtkViewport;
7270 begin
7271 // Result := inherited getClientRect;
7272 AViewPort := PGtkViewPort(FCentralWidget^.get_parent);
7273 if Gtk3IsViewPort(AViewPort) and Gtk3IsGdkWindow(AViewPort^.get_view_window) then
7274 begin
7275 AViewPort^.get_view_window^.get_geometry(@x, @y, @w, @h);
7276 Result := Rect(0, 0, AViewPort^.get_view_window^.get_width, AViewPort^.get_view_window^.get_height);
7277 // DebugLn('TGtk3CustomControl.GetClientRect via Viewport ',dbgsName(LCLObject),' Result ',dbgs(Result),' X=',dbgs(X),' Y=',dbgs(Y));
7278 exit;
7279 end else
7280 FCentralWidget^.get_allocation(@Allocation);
7281
7282 with Allocation do
7283 R := Rect(x, y, width + x, height + y);
7284
7285 if IsRectEmpty(R) then
7286 R := Rect(0, 0, 0, 0);
7287
7288 Result := R;
7289 // DebugLn('TGtk3CustomControl.GetClientRect normal ',dbgsName(LCLObject),' Result ',dbgs(Result));
7290 OffsetRect(Result, -Result.Left, -Result.Top);
7291 end;
7292
getHorizontalScrollbarnull7293 function TGtk3CustomControl.getHorizontalScrollbar: PGtkScrollbar;
7294 begin
7295 Result := nil;
7296 if not IsWidgetOk then
7297 exit;
7298 Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_hscrollbar);
7299 g_object_set_data(Result,'lclwidget',Self);
7300 end;
7301
getVerticalScrollbarnull7302 function TGtk3CustomControl.getVerticalScrollbar: PGtkScrollbar;
7303 begin
7304 Result := nil;
7305 if not IsWidgetOk then
7306 exit;
7307 Result := PGtkScrollBar(PGtkScrolledWindow(Widget)^.get_vscrollbar);
7308 g_object_set_data(Result,'lclwidget',Self);
7309 end;
7310
GetScrolledWindownull7311 function TGtk3CustomControl.GetScrolledWindow: PGtkScrolledWindow;
7312 begin
7313 if IsWidgetOK then
7314 Result := PGtkScrolledWindow(Widget)
7315 else
7316 Result := nil;
7317 end;
7318
7319 { TGtk3ScrollingWinControl }
7320
CreateWidgetnull7321 function TGtk3ScrollingWinControl.CreateWidget(const Params: TCreateParams
7322 ): PGtkWidget;
7323 begin
7324 FHasPaint := True;
7325 FScrollX := 0;
7326 FScrollY := 0;
7327 // layout is crap under gtk3
7328 (*
7329 FWidgetType := [wtWidget, wtLayout, wtScrollingWin];
7330 Result := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil));
7331 FCentralWidget := TGtkLayout.new(nil, nil);
7332 FCentralWidget^.set_has_window(True);
7333 FCentralWidget^.show;
7334
7335 PGtkScrolledWindow(Result)^.add(FCentralWidget);
7336 *)
7337 FWidgetType := [wtWidget, wtContainer, wtScrollingWin, wtScrollingWinControl];
7338 Result := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil));
7339 FCentralWidget := TGtkFixed.new;
7340 FCentralWidget^.set_has_window(True);
7341 FCentralWidget^.show;
7342
7343 PGtkScrolledWindow(Result)^.add_with_viewport(FCentralWidget);
7344 // PGtkScrolledWindow(Result)^.add(FCentralWidget);
7345
7346 PGtkViewport(PGtkScrolledWindow(Result)^.get_child)^.set_shadow_type(BorderStyleShadowMap[bsNone]);
7347 PGtkScrolledWindow(Result)^.set_shadow_type(BorderStyleShadowMap[TScrollingWinControl(LCLObject).BorderStyle]);
7348 PGtkScrolledWindow(Result)^.get_vscrollbar^.set_can_focus(False);
7349 PGtkScrolledWindow(Result)^.get_hscrollbar^.set_can_focus(False);
7350 PGtkScrolledWindow(Result)^.set_policy(GTK_POLICY_NEVER, GTK_POLICY_NEVER);
7351
7352 // this is very important
7353 PGtkScrolledWindow(Result)^.set_can_focus(False);
7354 FCentralWidget^.set_can_focus(True);
7355 end;
7356
7357 { TGtk3Window }
7358
GetTitlenull7359 function TGtk3Window.GetTitle: String;
7360 begin
7361 if Gtk3IsGtkWindow(fWidget) then
7362 Result:=PGtkWindow(fWidget)^.get_title()
7363 {else
7364 if Gtk3IsWIdget(fWidget) then
7365 Result:='widget'}
7366 else
7367 Result:=''
7368 end;
7369
7370 procedure TGtk3Window.SetIcon(AValue: PGdkPixBuf);
7371 begin
7372 // if FIcon=AValue then Exit;
7373 if Assigned(FIcon) then
7374 begin
7375 FIcon^.unref;
7376 FIcon := nil;
7377 end;
7378 if Gtk3IsGdkPixbuf(AValue) then
7379 FIcon := PGdkPixbuf(AValue)^.copy
7380 else
7381 FIcon := nil;
7382 // DebugLn('Setting icon ',dbgHex(PtrUInt(FIcon)),' AppIcon ',dbgHex(PtrUInt(GTK3WidgetSet.AppIcon)));
7383 PGtkWindow(Widget)^.set_icon(FIcon);
7384 end;
7385
GetSkipTaskBarHintnull7386 function TGtk3Window.GetSkipTaskBarHint: Boolean;
7387 begin
7388 Result := False;
7389 if IsWidgetOK then
7390 Result := PGtkWindow(Widget)^.get_skip_taskbar_hint;
7391 end;
7392
7393 procedure TGtk3Window.SetSkipTaskBarHint(AValue: Boolean);
7394 begin
7395 if IsWidgetOK then
7396 PGtkWindow(Widget)^.set_skip_taskbar_hint(AValue);
7397 end;
7398
7399 procedure TGtk3Window.SetTitle(const AValue: String);
7400 begin
7401 if Gtk3IsGtkWindow(fWidget) then
7402 PGtkWindow(FWidget)^.set_title(PGChar(AValue))
7403 end;
7404
7405 function Gtk3WindowState(AWidget: PGtkWidget; AEvent: PGdkEvent; AData: gPointer): GBoolean; cdecl;
7406 var
7407 Msg: TLMSize;
7408 AState: TGdkWindowState;
7409 //AScreen: PGdkScreen;
7410 msk:integer;
7411 begin
7412 Result := False;
7413 FillChar(Msg{%H-}, SizeOf(Msg), #0);
7414
7415 (*
7416 AScreen := AWidget^.window^.get_screen;
7417 ActiveWindow := AScreen^.get_active_window;
7418 if ActiveWindow <> AWidget^.window then
7419 TGtk3Window(AData).Gtk3ActivateWindow(nil)
7420 else
7421 TGtk3Window(AData).Gtk3ActivateWindow(AEvent);
7422 *)
7423 // window state isn't changed on activate/deactivate, so must provide another solution
7424 // DebugLn('Gtk3WindowState ',dbgsName(TGtk3Widget(AData).LCLObject),' changedmask=',dbgs(AEvent^.window_state.changed_mask),
7425 // ' newstate ',dbgs(AEvent^.window_state.new_window_state),' currentState ', dbgs(TGtk3Window(AData).GetWindowState),
7426 // ' WITHDRAWN ? ',dbgs(TGtk3Window(AData).getWindowState and GDK_WINDOW_STATE_WITHDRAWN));
7427
7428 Msg.Msg := LM_SIZE;
7429 Msg.SizeType := SIZE_RESTORED;
7430
7431 msk:=AEvent^.window_state.changed_mask;
7432 AState:=AEvent^.window_state.new_window_state;
7433
7434 if msk and GDK_WINDOW_STATE_ICONIFIED<>0 then
7435 begin
7436 if AState and GDK_WINDOW_STATE_ICONIFIED<>0 then
7437 Msg.SizeType := SIZE_MINIMIZED
7438 end else
7439 if msk and GDK_WINDOW_STATE_MAXIMIZED<>0 then
7440 begin
7441 if AState and GDK_WINDOW_STATE_MAXIMIZED<>0 then
7442 Msg.SizeType := SIZE_MAXIMIZED
7443 end else
7444 if msk and GDK_WINDOW_STATE_FULLSCREEN<>0 then
7445 begin
7446 if AState and GDK_WINDOW_STATE_FULLSCREEN<>0 then
7447 Msg.SizeType := SIZE_FULLSCREEN
7448 end else
7449 if msk and GDK_WINDOW_STATE_FOCUSED<>0 then
7450 begin
7451 if AState and GDK_WINDOW_STATE_FOCUSED<>0 then
7452 writeln('Focused')
7453 else
7454 writeln('Defocused');
7455 exit;
7456 end else
7457 if msk and GDK_WINDOW_STATE_WITHDRAWN<>0 then
7458 begin
7459 if AState and GDK_WINDOW_STATE_WITHDRAWN<>0 then
7460 writeln('Shown')
7461 else
7462 writeln('Hidden');
7463 exit;
7464 end else
7465 begin
7466 writeln(format('other changes state=%.08x mask=%.08x',[AState,msk]));
7467 exit;
7468 end;
7469
7470 Msg.SizeType := Msg.SizeType or Size_SourceIsInterface;
7471
7472 Msg.Width := Word(AWidget^.window^.get_width);
7473 Msg.Height := Word(AWidget^.window^.get_height);
7474 DebugLn('GetWindowState SizeType=',dbgs(Msg.SizeType),' realized ',dbgs(AWidget^.get_realized));
7475 TGtk3Window(AData).DeliverMessage(Msg);
7476 // DeliverMessage(Msg);
7477 end;
7478
TGtk3Window.decoration_flagsnull7479 class function TGtk3Window.decoration_flags(Aform:TCustomForm):longint;
7480 var
7481 icns:TBorderIcons;
7482 bs:TFormBorderStyle;
7483 begin
7484 result:=0;
7485 icns:=AForm.BorderIcons;
7486 bs:=AForm.BorderStyle;
7487
7488 case bs of
7489 bsSingle: result:=result or GDK_DECOR_TITLE{GDK_DECOR_BORDER};
7490 bsDialog:
7491 result:=result or GDK_DECOR_BORDER or GDK_DECOR_TITLE;
7492 bsSizeable:
7493 begin
7494 if biMaximize in icns then
7495 result:=result or GDK_DECOR_MAXIMIZE;
7496 if biMinimize in icns then
7497 result:=result or GDK_DECOR_MINIMIZE;
7498 Result:=result or GDK_DECOR_BORDER or GDK_DECOR_RESIZEH or GDK_DECOR_TITLE;
7499 end;
7500 bsSizeToolWin:
7501 Result:=result or GDK_DECOR_BORDER or GDK_DECOR_RESIZEH or GDK_DECOR_TITLE;
7502 bsToolWindow:
7503 Result:=result or GDK_DECOR_BORDER;
7504 bsNone: result:=0;
7505 end;
7506
7507 if result and GDK_DECOR_TITLE <> 0 then
7508 if biSystemMenu in icns then
7509 result:=result or GDK_DECOR_MENU;
7510 end;
7511
ShowStatenull7512 function TGtk3Window.ShowState(nstate:integer):boolean; // winapi ShowWindow
7513 var
7514 AState:integer;
7515 begin
7516 case nstate of
7517 SW_SHOWNORMAL:
7518 begin
7519 AState:=fWidget^.window^.get_state;
7520 if AState and GDK_WINDOW_STATE_ICONIFIED<>0 then
7521 PgtkWindow(fWidget)^.deiconify
7522 else if AState and GDK_WINDOW_STATE_MAXIMIZED<>0 then
7523 PgtkWindow(fWidget)^.unmaximize
7524 else if AState and GDK_WINDOW_STATE_FULLSCREEN<>0 then
7525 PgtkWindow(fWidget)^.unfullscreen
7526 else
7527 PgtkWindow(fWidget)^.show;
7528 end;
7529 SW_SHOWMAXIMIZED: PgtkWindow(fWidget)^.maximize;
7530 SW_MINIMIZE: PgtkWindow(fWidget)^.iconify;
7531 SW_SHOWFULLSCREEN: PgtkWindow(fWidget)^.fullscreen;
7532 else
7533 PgtkWindow(fWidget)^.show;
7534 end;
7535 Result:=true
7536 end;
7537
7538 procedure TGtk3Window.UpdateWindowState; // LCL WindowState
7539 const
7540 ShowCommands: array[TWindowState] of Integer =
7541 (SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED, SW_SHOWFULLSCREEN);
7542 begin
7543 ShowState(ShowCommands[TCustomForm(LCLObject).WindowState]);
7544 end;
7545
CreateWidgetnull7546 function TGtk3Window.CreateWidget(const Params: TCreateParams): PGtkWidget;
7547 var
7548 AForm: TCustomForm;
7549 decor:longint;
7550 begin
7551 FIcon := nil;
7552 FScrollX := 0;
7553 FScrollY := 0;
7554
7555 FHasPaint := True;
7556 AForm := TCustomForm(LCLObject);
7557
7558 if not Assigned(LCLObject.Parent) then
7559 begin
7560 Result := TGtkWindow.new(GTK_WINDOW_TOPLEVEL);
7561 FWidget:=Result;
7562 //Result^.set_size_request(0,0);
7563 FWidget^.set_events(GDK_DEFAULT_EVENTS_MASK);
7564 gtk_widget_realize(Result);
7565 decor:=decoration_flags(AForm);
7566 gdk_window_set_decorations(Result^.window, decor);
7567 if AForm.AlphaBlend then
7568 gtk_widget_set_opacity(Result, TForm(LCLObject).AlphaBlendValue/255);
7569
7570 FWidgetType := [wtWidget, wtLayout, wtScrollingWin, wtWindow];
7571 end else
7572 begin
7573 Result := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil));
7574 gtk_widget_realize(Result);
7575 FWidgetType := [wtWidget, wtLayout, wtScrollingWin, wtCustomControl]
7576 end;
7577
7578 FBox := TGtkVBox.new(GTK_ORIENTATION_VERTICAL, 0);
7579
7580 //TODO: when menu is added dynamically to the form create FMenuBar
7581 if (AForm.Menu <> nil) then
7582 begin
7583 FMenuBar := TGtkMenuBar.new; // our menubar (needed for main menu)
7584 // MenuBar
7585 // -> Menu Menu2
7586 // Item 1 Item 3
7587 // Item 2
7588 g_object_set_data(Result,'lclmenubar',GPointer(1));
7589 FBox^.pack_start(FMenuBar, False, False, 0);
7590 end;
7591
7592 FScrollWin := PGtkScrolledWindow(TGtkScrolledWindow.new(nil, nil));
7593 g_object_set_data(FScrollWin,'lclscrollingwindow',GPointer(1));
7594 g_object_set_data(PGObject(FScrollWin), 'lclwidget', Self);
7595
7596
7597 FCentralWidget := TGtkLayout.new(nil, nil);
7598 FCentralWidget^.set_has_window(True);
7599
7600 if AForm.AutoScroll then
7601 FScrollWin^.add(FCentralWidget)
7602 else
7603 FScrollWin^.add_with_viewport(FCentralWidget);
7604
7605 FScrollWin^.show;
7606 FBox^.pack_end(FScrollWin, True, True, 0);
7607 FBox^.show;
7608
7609 FScrollWin^.get_vscrollbar^.set_can_focus(False);
7610 FScrollWin^.get_hscrollbar^.set_can_focus(False);
7611 FScrollWin^.set_policy(GTK_POLICY_NEVER, GTK_POLICY_NEVER);
7612 PGtkContainer(Result)^.add(FBox);
7613 g_signal_connect_data(Result,'window-state-event', TGCallback(@Gtk3WindowState), Self, nil, 0);
7614
7615
7616 if not (csDesigning in AForm.ComponentState) then
7617 UpdateWindowState;
7618
7619
7620 //REMOVE THIS, USED TO TRACK MOUSE MOVE OVER WIDGET TO SEE SIZE OF FIXED !
7621 //g_object_set_data(PGObject(FScrollWin), 'lcldebugscrollwin', Self);
7622 //g_object_set_data(PGObject(FCentralWidget), 'lcldebugfixed', Self);
7623 //g_object_set_data(PGObject(Result), 'lcldebugwindow', Self);
7624 end;
7625
EatArrowKeysnull7626 function TGtk3Window.EatArrowKeys(const AKey: Word): Boolean;
7627 begin
7628 Result := False;
7629 end;
7630
TGtk3Window.getTextnull7631 function TGtk3Window.getText: String;
7632 begin
7633 Result := Title;
7634 end;
7635
7636 procedure TGtk3Window.setText(const AValue: String);
7637 begin
7638 Title := AValue;
7639 end;
7640
getClientRectnull7641 function TGtk3Window.getClientRect: TRect;
7642 var
7643 Allocation: TGtkAllocation;
7644 R: TRect;
7645 w: gint;
7646 h: gint;
7647 x: gint;
7648 y: gint;
7649 AViewPort: PGtkViewport;
7650 begin
7651 AViewPort := PGtkViewPort(FCentralWidget^.get_parent);
7652 if Gtk3IsViewPort(AViewPort) and Gtk3IsGdkWindow(AViewPort^.get_view_window) then
7653 begin
7654 AViewPort^.get_view_window^.get_geometry(@x, @y, @w, @h);
7655 Result := Rect(0, 0, AViewPort^.get_view_window^.get_width, AViewPort^.get_view_window^.get_height);
7656 // DebugLn('GetClientRect via Viewport ',dbgsName(LCLObject),' Result ',dbgs(Result));
7657 exit;
7658 end else
7659 FCentralWidget^.get_allocation(@Allocation);
7660
7661 with Allocation do
7662 R := Rect(x, y, width + x, height + y);
7663
7664 if IsRectEmpty(R) then
7665 R := Rect(0, 0, 0, 0);
7666
7667 Result := R;
7668 OffsetRect(Result, -Result.Left, -Result.Top);
7669
7670 // DebugLn('GetClientRect ',dbgsName(LCLObject),' Result ',dbgs(Result));
7671 end;
7672
7673 procedure TGtk3Window.SetBounds(ALeft,ATop,AWidth,AHeight:integer);
7674 var
7675 ARect: TGdkRectangle;
7676 Geometry: TGdkGeometry;
7677 AHints: TGdkWindowHints;
7678 AFixedWidthHeight: Boolean;
7679 AForm: TCustomForm;
7680 AMinSize, ANaturalSize: gint;
7681 begin
7682 AForm := TCustomForm(LCLObject);
7683 BeginUpdate;
7684 ARect.x := ALeft;
7685 ARect.y := ATop;
7686 ARect.width := AWidth;
7687 ARect.Height := AHeight;
7688 try
7689 {fixes gtk3 assertion}
7690 Widget^.get_preferred_width(@AMinSize, @ANaturalSize);
7691 Widget^.get_preferred_height(@AMinSize, @ANaturalSize);
7692
7693 Widget^.size_allocate(@ARect);
7694 if not (csDesigning in AForm.ComponentState) {and (AForm.Parent = nil) and (AForm.ParentWindow = 0)} then
7695 begin
7696 AFixedWidthHeight := AForm.BorderStyle in [bsDialog, bsSingle, bsToolWindow];
7697 with Geometry do
7698 begin
7699 if not AFixedWidthHeight and (AForm.Constraints.MinWidth > 0) then
7700 min_width := AForm.Constraints.MinWidth
7701 else
7702 min_width := AForm.Width;
7703 if not AFixedWidthHeight and (AForm.Constraints.MaxWidth > 0) then
7704 max_width := AForm.Constraints.MaxWidth
7705 else
7706 max_width := AForm.Width;
7707 if not AFixedWidthHeight and (AForm.Constraints.MinHeight > 0) then
7708 min_height := AForm.Constraints.MinHeight
7709 else
7710 min_height := AForm.Height;
7711 if not AFixedWidthHeight and (AForm.Constraints.MaxHeight > 0) then
7712 max_height := AForm.Constraints.MaxHeight
7713 else
7714 max_height := AForm.Height;
7715
7716 base_width := AForm.Width;
7717 base_height := AForm.Height;
7718 width_inc := 1;
7719 height_inc := 1;
7720 min_aspect := 0;
7721 max_aspect := 1;
7722 win_gravity := PGtkWindow(Widget)^.get_gravity;
7723 end;
7724
7725 if AFixedWidthHeight then
7726 PGtkWindow(Widget)^.set_geometry_hints(nil, @Geometry,
7727 GDK_HINT_POS or GDK_HINT_MIN_SIZE or GDK_HINT_MAX_SIZE)
7728 else
7729 begin
7730 if AForm.BorderStyle <> bsNone then
7731 begin
7732 AHints := GDK_HINT_POS or GDK_HINT_BASE_SIZE;
7733 if (AForm.Constraints.MinHeight > 0) or (AForm.Constraints.MinWidth > 0) then
7734 AHints := AHints or GDK_HINT_MIN_SIZE;
7735 if (AForm.Constraints.MaxHeight > 0) or (AForm.Constraints.MaxWidth > 0) then
7736 AHints := AHints or GDK_HINT_MAX_SIZE;
7737
7738 PGtkWindow(Widget)^.set_geometry_hints(nil, @Geometry, AHints);
7739 end;
7740 end;
7741 end;
7742 PGtkWindow(Widget)^.resize(AWidth, AHeight);
7743 PGtkWindow(Widget)^.move(ALeft, ATop);
7744 finally
7745 EndUpdate;
7746 end;
7747 end;
7748
7749
TGtk3Window.getHorizontalScrollbarnull7750 function TGtk3Window.getHorizontalScrollbar: PGtkScrollbar;
7751 begin
7752 Result := nil;
7753 if not IsWidgetOk then
7754 exit;
7755 Result := PGtkScrollBar(FScrollWin^.get_hscrollbar);
7756 end;
7757
TGtk3Window.getVerticalScrollbarnull7758 function TGtk3Window.getVerticalScrollbar: PGtkScrollbar;
7759 begin
7760 Result := nil;
7761 if not IsWidgetOk then
7762 exit;
7763 Result := PGtkScrollBar(FScrollWin^.get_vscrollbar);
7764 end;
7765
TGtk3Window.GetScrolledWindownull7766 function TGtk3Window.GetScrolledWindow: PGtkScrolledWindow;
7767 begin
7768 if IsWidgetOK then
7769 Result := FScrollWin
7770 else
7771 Result := nil;
7772 end;
7773
7774 destructor TGtk3Window.Destroy;
7775 begin
7776 // DebugLn('TGtk3Window.Destroy AWidget ',dbgs(IsWidgetOK));
7777 if Gtk3IsGdkPixbuf(FIcon) then
7778 begin
7779 FIcon^.unref;
7780 FIcon := nil;
7781 end;
7782 inherited Destroy;
7783 end;
7784
7785 procedure TGtk3Window.Activate;
7786 begin
7787 if IsWidgetOk then
7788 begin
7789 if Gtk3IsGdkWindow(PGtkWindow(FWidget)^.window) then
7790 begin
7791 PGtkWindow(FWidget)^.window^.raise_;
7792 PGtkWindow(FWidget)^.present;
7793 PGtkWindow(FWidget)^.activate;
7794 end;
7795 end;
7796 end;
7797
7798 procedure TGtk3Window.Gtk3ActivateWindow(AEvent: PGdkEvent);
7799 var
7800 MsgActivate: TLMActivate;
7801 FIsActivated: Boolean;
7802 begin
7803 //gtk3 does not handle activate/deactivate at all
7804 //even cannot catch it via GDK_FOCUS event ?!?
7805 FillChar(MsgActivate{%H-}, SizeOf(MsgActivate), #0);
7806 MsgActivate.Msg := LM_ACTIVATE;
7807
7808 if (AEvent <> nil) and PGtkWindow(Widget)^.is_active then
7809 MsgActivate.Active := WA_ACTIVE
7810 else
7811 MsgActivate.Active := WA_INACTIVE;
7812 MsgActivate.ActiveWindow := HWND(Self);
7813
7814 // DebugLn('TGtk3Window.Gtk3ActivateWindow ',dbgsName(LCLObject),' Active ',dbgs(PGtkWindow(Widget)^.is_active),
7815 // ' CustomFormActive ',dbgs(TCustomForm(LCLObject).Active));
7816 FIsActivated := TCustomForm(LCLObject).Active;
7817 {do not send activate if form is already activated,
7818 also do not send activate if TCustomForm.Parent is assigned
7819 since it's form embedded into another control or form}
7820 if (Boolean(MsgActivate.Active) = FIsActivated) or (LCLObject.Parent <> nil) then
7821 else
7822 begin
7823 // DebugLn('TGtk3Window.Gtk3ActivateWindow Active ',dbgs(MsgActivate.Active = WA_ACTIVE),
7824 // ' Message delivery to lcl ',dbgs(MsgActivate.Active));
7825 DeliverMessage(MsgActivate);
7826 end;
7827 end;
7828
Gtk3CloseQuerynull7829 function TGtk3Window.Gtk3CloseQuery: Boolean;
7830 var
7831 Msg : TLMessage;
7832 begin
7833 {$IFDEF GTK3DEBUGCORE}
7834 DebugLn('TGtk3Window.Gtk3CloseQuery');
7835 {$ENDIF}
7836 FillChar(Msg{%H-}, SizeOf(Msg), 0);
7837
7838 Msg.Msg := LM_CLOSEQUERY;
7839
7840 DeliverMessage(Msg);
7841
7842 Result := False;
7843 end;
7844
TGtk3Window.GetWindownull7845 function TGtk3Window.GetWindow: PGdkWindow;
7846 begin
7847 Result := FWidget^.window;
7848 end;
7849
TGtk3Window.GetMenuBarnull7850 function TGtk3Window.GetMenuBar: PGtkMenuBar;
7851 begin
7852 Result := FMenuBar;
7853 end;
7854
GetBoxnull7855 function TGtk3Window.GetBox: PGtkBox;
7856 begin
7857 Result := FBox;
7858 end;
7859
GetWindowStatenull7860 function TGtk3Window.GetWindowState: TGdkWindowState;
7861 begin
7862 Result := 0;
7863 if IsWidgetOK and (FWidget^.get_realized) then
7864 Result := FWidget^.window^.get_state;
7865 end;
7866
7867 { TGtk3HintWindow }
7868
TGtk3HintWindow.CreateWidgetnull7869 function TGtk3HintWindow.CreateWidget(const Params: TCreateParams): PGtkWidget;
7870 var
7871 AForm: THintWindow;
7872 begin
7873 FText := '';
7874 FHasPaint := True;
7875 AForm := THintWindow(LCLObject);
7876
7877 FWidgetType := [wtWidget, wtContainer, wtWindow, wtHintWindow];
7878
7879 Result := TGtkWindow.new(GTK_WINDOW_POPUP);
7880
7881 FBox := TGtkVBox.new(GTK_ORIENTATION_VERTICAL, 0);
7882 PGtkContainer(Result)^.add(FBox);
7883
7884 FCentralWidget := TGtkFixed.new;
7885
7886 FCentralWidget^.set_size_request(AForm.Width,AForm.Height+1);
7887
7888 fBox^.pack_start(fCentralWidget, true, true, 0);
7889
7890 PGtkWindow(Result)^.set_can_focus(false);
7891
7892 end;
7893
7894 { TGtk3Dialog }
7895
7896 procedure TGtk3Dialog.SetCallbacks;
7897 begin
7898 // common callbacks for all kind of dialogs
7899 g_signal_connect_data(fWidget,
7900 'destroy', TGCallback(@TGtk3Dialog.DestroyCB), Self, nil, 0);
7901 g_signal_connect_data(fWidget,
7902 'delete-event', TGCallback(@TGtk3Dialog.CloseQueryCB), Self, nil, 0);
7903
7904 g_signal_connect_data(fWidget,
7905 'response', TGCallback(@Tgtk3DIalog.ResponseCB), Self, nil, 0);
7906
7907 g_signal_connect_data(fWidget,
7908 'close', TGCallback(@Tgtk3DIalog.CloseCB), Self, nil, 0);
7909
7910
7911 (* g_signal_connect_data(fWidget,
7912 'key-press-event', TGCallback(@GTKDialogKeyUpDownCB), Self, nil, 0);
7913 g_signal_connect_data(fWidget,
7914 'key-release-event', TGCallback(@GTKDialogKeyUpDownCB), Self, nil, 0);*)
7915
7916 g_signal_connect_data(fWidget,
7917 'realize', TGCallback(@Tgtk3Dialog.RealizeCB), Self, nil, 0);
7918 end;
7919
Tgtk3Dialog.RealizeCBnull7920 class function Tgtk3Dialog.RealizeCB(dlg: TGtk3Dialog): GBoolean; cdecl;
7921 begin
7922 Result := False;
7923 if (dlg=nil) then exit;
7924 // actually key intercepion is not required
7925 {if dlg.FWidget^.get_has_window and Gtk3IsGdkWindow(dlg.FWidget^.window) then
7926 begin
7927 gdk_window_set_events(dlg.FWidget^.window,
7928 gdk_window_get_events(dlg.FWidget^.window)
7929 or GDK_KEY_RELEASE_MASK or GDK_KEY_PRESS_MASK);
7930
7931 end;}
7932 if (wtDialog in dlg.WidgetType) then
7933 begin
7934 if Assigned(dlg.CommonDialog) then
7935 TCommonDialog(dlg.CommonDialog).DoShow;
7936 end;
7937 Result := True;
7938 end;
7939
7940
TGtk3Dialog.DestroyCBnull7941 class function TGtk3Dialog.DestroyCB(dlg:TGtk3Dialog): GBoolean; cdecl;
7942 begin
7943 Result := True;
7944 // if (AWidget=nil) then ;
7945 if not Assigned(dlg) then exit;
7946 dlg.CommonDialog.UserChoice := mrCancel;
7947 dlg.CommonDialog.Close;
7948 end;
7949
TGtk3Dialog.ResponseCBnull7950 class function TGtk3Dialog.ResponseCB(response_id:gint; dlg: TGtk3Dialog): GBoolean; cdecl;
7951 begin
7952 if Assigned(dlg) then
7953 Result:=dlg.response_handler(response_id)
7954 else
7955 Result:= false;
7956 end;
7957
response_handlernull7958 function TGtk3Dialog.response_handler(response_id:gint):boolean;
7959 begin
7960 (* case response_id of
7961 GTK_RESPONSE_NONE:;
7962 GTK_RESPONSE_REJECT: ;
7963 GTK_RESPONSE_ACCEPT:;
7964 GTK_RESPONSE_DELETE_EVENT:;
7965 GTK_RESPONSE_OK:;
7966 GTK_RESPONSE_CANCEL:;
7967 GTK_RESPONSE_CLOSE:;
7968 GTK_RESPONSE_YES:;
7969 GTK_RESPONSE_NO:;
7970 GTK_RESPONSE_APPLY:;
7971 GTK_RESPONSE_HELP:;
7972 end;*)
7973 if response_id=GTK_RESPONSE_YES then
7974 begin
7975 Self.CommonDialog.UserChoice:=mrYes;
7976 end else
7977 if response_id=GTK_RESPONSE_NO then
7978 begin
7979 Self.CommonDialog.UserChoice:=mrNo;
7980 end else
7981 if response_id=GTK_RESPONSE_OK then
7982 begin
7983 Self.CommonDialog.UserChoice:=mrOk;
7984 end else
7985 if response_id=GTK_RESPONSE_CANCEL then
7986 begin
7987 Self.CommonDialog.UserChoice:=mrCancel;
7988 end else
7989 if response_id=GTK_RESPONSE_CLOSE then
7990 begin
7991 Self.CommonDialog.UserChoice:=mrClose;
7992 end;
7993 Result:=false;
7994 end;
7995
TGtk3Dialog.close_handlernull7996 function TGtk3Dialog.close_handler(): boolean;
7997 begin
7998 Result:=false;
7999 end;
8000
TGtk3Dialog.CloseCBnull8001 class function TGtk3Dialog.CloseCB(dlg: TGtk3Dialog): GBoolean;
8002 cdecl;
8003 begin
8004 if Assigned(dlg) then
8005 Result:=dlg.close_handler()
8006 else
8007 Result:= true;
8008 end;
8009
TGtk3Dialog.CloseQueryCBnull8010 class function TGtk3Dialog.CloseQueryCB(w:PGtkWidget;dlg:TGtk3Dialog): GBoolean;
8011 cdecl;
8012 var
8013 theDialog : TCommonDialog;
8014 CanClose: boolean;
8015 //AHandle: HWND;
8016 begin
8017 Result := False; // true = do nothing, false = destroy or hide window
8018 if (dlg=nil) then exit;
8019 // data is not the commondialog. Get it manually.
8020 // AHandle := HwndFromGtkWidget(AWidget);
8021 if (dlg <> nil) and (wtDialog in TGtk3Widget(dlg).WidgetType) then
8022 begin
8023 theDialog := dlg.CommonDialog;
8024 if theDialog = nil then exit;
8025 if theDialog.OnCanClose<>nil then
8026 begin
8027 CanClose:=True;
8028 theDialog.DoCanClose(CanClose);
8029 Result := not CanClose;
8030 end;
8031 end;
8032 end;
8033
8034
8035
TGtk3Dialog.CreateWidgetnull8036 function TGtk3Dialog.CreateWidget(const Params: TCreateParams): PGtkWidget;
8037 begin
8038 FWidgetType := [wtWidget, wtDialog];
8039 Result := TGtkDialog.new;
8040 DebugLn('WARNING: TGtk3Dialog.CreateWidget should be used in real dialog constructor .');
8041 end;
8042
8043 procedure TGtk3Dialog.InitializeWidget;
8044 begin
8045 g_object_set_data(FWidget,'lclwidget', Self);
8046 end;
8047
8048 procedure TGtk3Dialog.CloseDialog;
8049 begin
8050 if fWidget<>nil then
8051 fWidget^.destroy_;
8052 end;
8053
8054
8055 { TGtk3FileDialog }
8056
CreateWidgetnull8057 function TGtk3FileDialog.CreateWidget(const Params: TCreateParams): PGtkWidget;
8058 begin
8059 DebugLn('ERROR: TGtk3FileDialog.CreateWidget error.');
8060 // Result := nil;
8061 Result := TGtkFileChooserDialog.new;
8062 // gtk_file_chooser_dialog_new();
8063 end;
8064
8065 constructor TGtk3FileDialog.Create(const ACommonDialog: TCommonDialog);
8066
8067 var
8068 FileDialog: TFileDialog absolute ACommonDialog;
8069 Action: TGtkFileChooserAction;
8070 Button1: String;
8071 AFileDialog: PGtkFileChooserDialog;
8072 begin
8073 inherited Create;
8074 FContext := 0;
8075 FHasPaint := False;
8076 FWidget := nil;
8077 FOwner := nil;
8078 FCentralWidget := nil;
8079 FOwnWidget := True;
8080 // Initializes the properties
8081 FProps := nil;
8082 LCLObject := nil;
8083 FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE];
8084 FWidgetType := [wtWidget, wtDialog];
8085
8086 // FHasPaint := False;
8087 CommonDialog := ACommonDialog;
8088 // Defines an action for the dialog and creates it
8089 Action := GTK_FILE_CHOOSER_ACTION_OPEN;
8090 Button1 := GTK_STOCK_OPEN;
8091
8092 if (FileDialog is TSaveDialog) or (FileDialog is TSavePictureDialog) then
8093 begin
8094 Action := GTK_FILE_CHOOSER_ACTION_SAVE;
8095 Button1 := GTK_STOCK_SAVE;
8096 end
8097 else
8098 if FileDialog is TSelectDirectoryDialog then
8099 Action := GTK_FILE_CHOOSER_ACTION_SELECT_FOLDER;
8100
8101 FWidget := gtk_file_chooser_dialog_new(PgChar(FileDialog.Title), nil,
8102 Action, PChar(GTK_STOCK_CANCEL),
8103 [GTK_RESPONSE_CANCEL, PChar(Button1), GTK_RESPONSE_OK, nil]);
8104
8105 AFileDialog := PGtkFileChooserDialog(FWidget);
8106 if FileDialog is TSaveDialog then
8107 begin
8108 gtk_file_chooser_set_do_overwrite_confirmation(PGtkFileChooser(AFileDialog),
8109 ofOverwritePrompt in TOpenDialog(FileDialog).Options);
8110 end;
8111
8112 if FileDialog.InitialDir <> '' then
8113 gtk_file_chooser_set_current_folder(PGtkFileChooser(AFileDialog), Pgchar(FileDialog.InitialDir));
8114
8115 if gtk_file_chooser_get_action(PGtkFileChooser(AFileDialog)) in
8116 [GTK_FILE_CHOOSER_ACTION_SAVE, GTK_FILE_CHOOSER_ACTION_CREATE_FOLDER]
8117 then
8118 gtk_file_chooser_set_current_name(PGtkFileChooser(AFileDialog), Pgchar(FileDialog.FileName));
8119
8120 InitializeWidget;
8121 end;
8122
8123 { TGtk3FontSelectionDialog }
8124
8125 procedure TGtk3FontSelectionDialog.InitializeWidget;
8126 begin
8127 fWidget:=TGtkFontChooserDialog.new(PChar(CommonDialog.Title),nil);
8128 inherited InitializeWidget;
8129 end;
8130
response_handlernull8131 function TGtk3FontSelectionDialog.response_handler(resp_id: gint): boolean;
8132 var
8133 fnt:TFont;
8134 pch:PgtkFontChooser;
8135 pfc:PPangoFontFace;
8136 pfd:PPangoFontDescription;
8137 sz:integer;
8138 sface,sfamily:string;
8139 fnts:TfontStyles;
8140 begin
8141 if resp_id=GTK_RESPONSE_OK then
8142 begin
8143 fnt:=TFontDialog(CommonDialog).Font;
8144 pch:=PGtkFontChooser(fWidget);
8145 pfc:=pch^.get_font_face();
8146 pfd:=pfc^.describe;
8147 { this stuff is implemened in gtk3objects.Tgtk3Font.UpdateLogFont
8148 so this is backward mapping of properties }
8149 sfamily:=pfd^.get_family();
8150 sface:=lowercase(pch^.get_font_face()^.get_face_name());
8151
8152 sz:=pch^.get_font_size() div PANGO_SCALE;
8153 fnt.Name:=sfamily;
8154 fnt.Size:=sz;
8155 fnts:=[];
8156 if (pos('bold',sface)>0) then
8157 include(fnts,fsBold);
8158
8159 if (pos('italic',sface)>0) then
8160 include(fnts,fsItalic);
8161 fnt.Style:=fnts;
8162
8163 end;
8164 Result:=inherited response_handler(resp_id);
8165 end;
8166
8167 constructor TGtk3FontSelectionDialog.Create(const ACommonDialog: TCommonDialog);
8168 begin
8169 inherited Create;
8170 FContext := 0;
8171 FHasPaint := False;
8172 FWidget := nil;
8173 FOwner := nil;
8174 FCentralWidget := nil;
8175 FOwnWidget := True;
8176 // Initializes the properties
8177 FProps := nil;
8178 LCLObject := nil;
8179 FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE];
8180 FWidgetType := [wtWidget, wtDialog];
8181
8182 // FHasPaint := False;
8183 CommonDialog := ACommonDialog;
8184 InitializeWidget;
8185 Self.SetCallbacks;
8186 end;
8187
8188 { TGtk3ColorSelectionDialog }
8189
8190 procedure TGtk3ColorSelectionDialog.InitializeWidget;
8191 var
8192 clr:TColor;
8193 rgba:TGdkRGBA;
8194 begin
8195 fWidget := TGtkColorSelectionDialog.new(PChar(Self.CommonDialog.Title));
8196 clr:=ColorToRgb(TColorDialog(Self.CommonDialog).Color);
8197 rgba.red:=Red(clr)/255;
8198 rgba.blue:=Blue(clr)/255;
8199 rgba.green:=Green(clr)/255;
8200 rgba.alpha:=(clr shl 24)/255;
8201 gtk_color_selection_set_current_rgba (
8202 PgtkColorSelection(PGtkColorSelectionDialog(fWidget)^.color_selection),
8203 @rgba);
8204 end;
8205
8206 constructor TGtk3ColorSelectionDialog.Create(const ACommonDialog: TCommonDialog
8207 );
8208 begin
8209 inherited Create;
8210 FContext := 0;
8211 FHasPaint := False;
8212 FWidget := nil;
8213 FOwner := nil;
8214 FCentralWidget := nil;
8215 FOwnWidget := True;
8216 // Initializes the properties
8217 FProps := nil;
8218 LCLObject := nil;
8219 FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE];
8220 FWidgetType := [wtWidget, wtDialog];
8221
8222 // FHasPaint := False;
8223 CommonDialog := ACommonDialog;
8224 TGtk3Widget(Self).InitializeWidget;
8225 Self.SetCallbacks;
8226 end;
8227
8228
8229 { TGtk3newColorSelectionDialog }
8230
8231 procedure TGtk3newColorSelectionDialog.InitializeWidget;
8232 var
8233 rgba:TGdkRGBA;
8234 begin
8235 fWidget:= TGtkColorChooserDialog.new(PChar(Self.CommonDialog.Title),nil);
8236 self.color_to_rgba(TColorDialog(Self.CommonDialog).Color,rgba);
8237 PGtkColorChooser(fWidget)^.use_alpha:=false;
8238 PGtkColorChooser(fWidget)^.set_rgba(@rgba);
8239 inherited;
8240 end;
8241
response_handlernull8242 function TGtk3newColorSelectionDialog.response_handler(resp_id: gint): boolean;
8243 var
8244 clr:TColor;
8245 rgba:TGdkRGBA;
8246 begin
8247 if resp_id=GTK_RESPONSE_OK then
8248 begin
8249 PGtkColorChooser(fWidget)^.get_rgba(@rgba);
8250 clr:=self.rgba_to_color(rgba);
8251 TColorDialog(Self.CommonDialog).Color:=clr;
8252 end;
8253 Result:=inherited response_handler(resp_id);
8254 end;
8255
8256 constructor TGtk3newColorSelectionDialog.Create(const ACommonDialog: TCommonDialog
8257 );
8258 begin
8259 inherited Create;
8260 FContext := 0;
8261 FHasPaint := False;
8262 FWidget := nil;
8263 FOwner := nil;
8264 FCentralWidget := nil;
8265 FOwnWidget := True;
8266 // Initializes the properties
8267 FProps := nil;
8268 LCLObject := nil;
8269 FKeysToEat := [VK_TAB, VK_RETURN, VK_ESCAPE];
8270 FWidgetType := [wtWidget, wtDialog];
8271
8272 // FHasPaint := False;
8273 CommonDialog := ACommonDialog;
8274 TGtk3Widget(Self).InitializeWidget;
8275 Self.SetCallbacks;
8276 end;
8277
8278 class procedure TGtk3newColorSelectionDialog.color_to_rgba(clr: TColor; out
8279 rgba: TgdkRGBA);
8280 begin
8281 clr:=ColorToRgb(clr);
8282 rgba.red:=Red(clr)/255;
8283 rgba.blue:=Blue(clr)/255;
8284 rgba.green:=Green(clr)/255;
8285 rgba.alpha:=(clr shl 24)/255;
8286 end;
8287
TGtk3newColorSelectionDialog.rgba_to_colornull8288 class function TGtk3newColorSelectionDialog.rgba_to_color(const rgba: TgdkRGBA
8289 ): TColor;
8290 var
8291 q:array[0..3] of byte absolute Result;
8292 begin
8293 q[0]:= round(255*rgba.red);
8294 q[1]:= round(255*rgba.green);
8295 q[2]:= round(255*rgba.blue);
8296 q[3]:= round(255*rgba.alpha);
8297 end;
8298
8299
8300 { TGtk3GLArea }
8301
8302 procedure TGtk3GLArea.Update(ARect: PRect);
8303 begin
8304 if IsWidgetOK then
8305 PGtkGLArea(Widget)^.queue_render;
8306 end;
8307
CreateWidgetnull8308 function TGtk3GLArea.CreateWidget(const Params: TCreateParams): PGtkWidget;
8309 begin
8310 FWidgetType := [wtWidget, wtGLArea];
8311 Result := TGtkGLArea.new;
8312 end;
8313
8314 end.
8315
8316