1{
2 *****************************************************************************
3 *                             Gtk2WSComCtrls.pp                             *
4 *                             -----------------                             *
5 *                                                                           *
6 *                                                                           *
7 *****************************************************************************
8
9 *****************************************************************************
10  This file is part of the Lazarus Component Library (LCL)
11
12  See the file COPYING.modifiedLGPL.txt, included in this distribution,
13  for details about the license.
14 *****************************************************************************
15}
16unit Gtk2WSComCtrls;
17
18{$mode objfpc}{$H+}
19{$I gtk2defines.inc}
20
21interface
22
23uses
24  // RTL, FCL, libs
25  Math, Sysutils, Classes, GLib2, Gtk2, Gdk2, Gdk2pixbuf,
26  // LazUtils
27  LazTracer,
28  // LCL
29  LCLType, LCLIntf, LMessages, Controls, Graphics, ComCtrls, StdCtrls, Forms,
30  ImgList, InterfaceBase,
31  // widgetset
32  WSComCtrls, WSLCLClasses, WSControls, WSProc,
33  // GtkWidgetset
34  Gtk2Def, Gtk2Globals, Gtk2Proc,
35  // Gtk2Widgetset
36  Gtk2WSControls, Gtk2Int;
37
38type
39  // For simplified manipulation
40  // Use GetCommonTreeViewWidgets(PGtkTreeView, var TTVWidgets)
41  PTVWidgets = ^TTVWidgets;
42  TTVWidgets = record
43    ScrollingData: TBaseScrollingWinControlData;
44    MainView: PGtkWidget; // can be a GtkTreeView or GtkIconView. You have been Warned! :)
45    TreeModel: PGtkTreeModel;
46    TreeSelection: PGtkTreeSelection;
47    WidgetInfo: PWidgetInfo;
48    //this is created and destroyed as needed
49    //it only holds items which are about to be changed the list is emptied in Gtk2_ItemSelectionChanged
50    ItemCache: TStringList;
51    OldTreeSelection: PGList; // needed only by gtk < 2.10 ! issue #19820
52    Images: TList;
53  end;
54
55type
56  { TGtk2WSCustomPage }
57
58  TGtk2WSCustomPage = class(TWSCustomPage)
59  protected
60    class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
61  published
62    class function  CreateHandle(const AWinControl: TWinControl;
63      const AParams: TCreateParams): TLCLIntfHandle; override;
64    class procedure UpdateProperties(const ACustomPage: TCustomPage); override;
65    class procedure SetBounds(const {%H-}AWinControl: TWinControl; const {%H-}ALeft, {%H-}ATop, {%H-}AWidth, {%H-}AHeight: Integer); override;
66    class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
67    class procedure ShowHide(const AWinControl: TWinControl); override;
68    class function GetDefaultClientRect(const AWinControl: TWinControl;
69             const {%H-}aLeft, {%H-}aTop, {%H-}aWidth, {%H-}aHeight: integer; var aClientRect: TRect
70             ): boolean; override;
71  end;
72
73  { TGtk2WSCustomTabControl }
74
75  TGtk2WSCustomTabControl = class(TWSCustomTabControl)
76  private
77    class function CreateTTabControlHandle(const AWinControl: TWinControl;
78      const AParams: TCreateParams): HWND;
79  protected
80    class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
81  published
82    class function CreateHandle(const AWinControl: TWinControl;
83                                const AParams: TCreateParams): HWND; override;
84    class function GetDefaultClientRect(const AWinControl: TWinControl;
85             const {%H-}aLeft, {%H-}aTop, aWidth, aHeight: integer; var aClientRect: TRect
86             ): boolean; override;
87    class procedure AddPage(const ATabControl: TCustomTabControl;
88      const AChild: TCustomPage; const AIndex: integer); override;
89    class procedure MovePage(const ATabControl: TCustomTabControl;
90      const AChild: TCustomPage; const NewIndex: integer); override;
91
92    class function GetCapabilities: TCTabControlCapabilities; override;
93    class function GetNotebookMinTabHeight(const AWinControl: TWinControl): integer; override;
94    class function GetNotebookMinTabWidth(const AWinControl: TWinControl): integer; override;
95    class function GetTabIndexAtPos(const ATabControl: TCustomTabControl; const AClientPos: TPoint): integer; override;
96    class function GetTabRect(const ATabControl: TCustomTabControl; const AIndex: Integer): TRect; override;
97    class procedure SetPageIndex(const ATabControl: TCustomTabControl; const AIndex: integer); override;
98    class procedure SetTabPosition(const ATabControl: TCustomTabControl; const ATabPosition: TTabPosition); override;
99    class procedure ShowTabs(const ATabControl: TCustomTabControl; AShowTabs: boolean); override;
100    class procedure UpdateProperties(const ATabControl: TCustomTabControl); override;
101  end;
102
103  { TGtk2WSStatusBar }
104
105  TGtk2WSStatusBar = class(TWSStatusBar)
106  protected
107    class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
108  published
109    class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
110    class procedure PanelUpdate(const AStatusBar: TStatusBar; PanelIndex: integer); override;
111    class procedure SetPanelText(const AStatusBar: TStatusBar; PanelIndex: integer); override;
112    class procedure Update(const AStatusBar: TStatusBar); override;
113    class procedure GetPreferredSize(const {%H-}AWinControl: TWinControl;
114                        var {%H-}PreferredWidth, PreferredHeight: integer;
115                        {%H-}WithThemeSpace: Boolean); override;
116
117    class procedure SetSizeGrip(const AStatusBar: TStatusBar; {%H-}SizeGrip: Boolean); override;
118  end;
119
120  { TGtk2WSTabSheet }
121
122  TGtk2WSTabSheet = class(TWSTabSheet)
123  published
124  end;
125
126  { TGtk2WSPageControl }
127
128  TGtk2WSPageControl = class(TWSPageControl)
129  published
130  end;
131
132  { TGtk2WSCustomListView }
133
134  TGtk2WSCustomListView = class(TWSCustomListView)
135  private
136    class procedure SetPropertyInternal(const ALV: TCustomListView; const Widgets: PTVWidgets; const AProp: TListViewProperty; const AIsSet: Boolean);
137    class procedure SetNeedDefaultColumn(const ALV: TCustomListView; const AValue: Boolean);
138    class procedure AddRemoveCheckboxRenderer(const ALV: TCustomListView; const WidgetInfo: PWidgetInfo; const Add: Boolean);
139    class function GetViewModel(const AView: PGtkWidget): PGtkTreeModel;
140  protected
141    class procedure SetListCallbacks(const AScrollWidget: PGtkWidget; const Widgets: PTVWidgets; const AWidgetInfo: PWidgetInfo);
142  published
143    // columns
144    class procedure ColumnDelete(const ALV: TCustomListView; const AIndex: Integer); override;
145    class function  ColumnGetWidth(const ALV: TCustomListView; const {%H-}AIndex: Integer; const {%H-}AColumn: TListColumn): Integer; override;
146    class procedure ColumnInsert(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn); override;
147    class procedure ColumnMove(const ALV: TCustomListView; const AOldIndex, ANewIndex: Integer; const {%H-}AColumn: TListColumn); override;
148    class procedure ColumnSetAlignment(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AColumn: TListColumn; const AAlignment: TAlignment); override;
149    class procedure ColumnSetAutoSize(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AColumn: TListColumn; const AAutoSize: Boolean); override;
150    class procedure ColumnSetCaption(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AColumn: TListColumn; const ACaption: String); override;
151    class procedure ColumnSetImage(const ALV: TCustomListView; const {%H-}AIndex: Integer; const {%H-}AColumn: TListColumn; const {%H-}AImageIndex: Integer); override;
152    class procedure ColumnSetMaxWidth(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AColumn: TListColumn; const AMaxWidth: Integer); override;
153    class procedure ColumnSetMinWidth(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AColumn: TListColumn; const AMinWidth: integer); override;
154    class procedure ColumnSetWidth(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AColumn: TListColumn; const AWidth: Integer); override;
155    class procedure ColumnSetVisible(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AColumn: TListColumn; const AVisible: Boolean); override;
156    class procedure ColumnSetSortIndicator(const ALV: TCustomListView; const AIndex: Integer;
157      const {%H-}AColumn: TListColumn; const ASortIndicator: TSortIndicator);
158      override;
159
160    // items
161    class procedure ItemDelete(const ALV: TCustomListView; const AIndex: Integer); override;
162    class function  ItemDisplayRect(const ALV: TCustomListView; const AIndex, ASubItem: Integer; {%H-}ACode: TDisplayCode): TRect; override;
163    class procedure ItemExchange(const ALV: TCustomListView; {%H-}AItem: TListItem; const AIndex1, AIndex2: Integer); override;
164    class procedure ItemMove(const ALV: TCustomListView; {%H-}AItem: TListItem; const AFromIndex, AToIndex: Integer); override;
165    class function  ItemGetChecked(const {%H-}ALV: TCustomListView; const {%H-}AIndex: Integer; const AItem: TListItem): Boolean; override;
166    class function  ItemGetState(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AItem: TListItem; const AState: TListItemState; out AIsSet: Boolean): Boolean; override; // returns True if supported
167    class procedure ItemInsert(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AItem: TListItem); override;
168    class procedure ItemSetChecked(const ALV: TCustomListView; const {%H-}AIndex: Integer; const {%H-}AItem: TListItem; const {%H-}AChecked: Boolean); override;
169    class procedure ItemSetImage(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AItem: TListItem; const {%H-}ASubIndex, AImageIndex: Integer); override;
170    class procedure ItemSetState(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AItem: TListItem; const AState: TListItemState; const AIsSet: Boolean); override;
171    class procedure ItemSetText(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AItem: TListItem; const {%H-}ASubIndex: Integer; const {%H-}AText: String); override;
172    class procedure ItemShow(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AItem: TListItem; const {%H-}PartialOK: Boolean); override;
173    class function  ItemGetPosition(const ALV: TCustomListView; const AIndex: Integer): TPoint; override;
174    class procedure ItemUpdate(const ALV: TCustomListView; const {%H-}AIndex: Integer; const {%H-}AItem: TListItem); override;
175
176    // lv
177    class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override;
178    class procedure DestroyHandle(const AWinControl: TWinControl); override;
179
180    class procedure BeginUpdate(const ALV: TCustomListView); override;
181    class procedure EndUpdate(const ALV: TCustomListView); override;
182
183    class function GetBoundingRect(const ALV: TCustomListView): TRect; override;
184    class function GetDropTarget(const ALV: TCustomListView): Integer; override;
185    class function GetFocused(const ALV: TCustomListView): Integer; override;
186    class function GetHoverTime(const ALV: TCustomListView): Integer; override;
187    class function GetItemAt(const ALV: TCustomListView; x,y: integer): Integer; override;
188    class function GetSelCount(const ALV: TCustomListView): Integer; override;
189    class function GetSelection(const ALV: TCustomListView): Integer; override;
190    class function GetTopItem(const ALV: TCustomListView): Integer; override;
191    class function GetViewOrigin(const ALV: TCustomListView): TPoint; override;
192    class function GetVisibleRowCount(const ALV: TCustomListView): Integer; override;
193
194    class procedure SelectAll(const ALV: TCustomListView; const AIsSet: Boolean); override;
195    class procedure SetAllocBy(const ALV: TCustomListView; const {%H-}AValue: Integer); override;
196    class procedure SetColor(const AWinControl: TWinControl); override;
197    class procedure SetDefaultItemHeight(const ALV: TCustomListView; const {%H-}AValue: Integer); override;
198    class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
199    class procedure SetHotTrackStyles(const ALV: TCustomListView; const {%H-}AValue: TListHotTrackStyles); override;
200//    class procedure SetHoverTime(const ALV: TCustomListView; const {%H-}AValue: Integer); override;
201//    class procedure SetIconOptions(const ALV: TCustomListView; const AValue: TIconOptions); override;
202    class procedure SetImageList(const ALV: TCustomListView; const AList: TListViewImageList; const AValue: TCustomImageListResolution); override;
203    class procedure SetItemsCount(const ALV: TCustomListView; const {%H-}Avalue: Integer); override;
204    class procedure SetProperty(const ALV: TCustomListView; const AProp: TListViewProperty; const AIsSet: Boolean); override;
205    class procedure SetProperties(const ALV: TCustomListView; const AProps: TListViewProperties); override;
206    class procedure SetScrollBars(const ALV: TCustomListView; const AValue: TScrollStyle); override;
207    class procedure SetSort(const ALV: TCustomListView; const {%H-}AType: TSortType; const {%H-}AColumn: Integer;
208      const {%H-}ASortDirection: TSortDirection); override;
209    class procedure SetViewOrigin(const ALV: TCustomListView; const AValue: TPoint); override;
210    class procedure SetViewStyle(const ALV: TCustomListView; const AValue: TViewStyle); override;
211  end;
212
213  { TGtk2WSListView }
214
215  TGtk2WSListView = class(TWSListView)
216  published
217  end;
218
219  { TGtk2WSProgressBar }
220
221  TGtk2WSProgressBar = class(TWSProgressBar)
222  private
223    class procedure UpdateProgressBarText(const AProgressBar: TCustomProgressBar); virtual;
224    class procedure InternalSetStyle(AProgressBar: PGtkProgressBar; AStyle: TProgressBarStyle);
225  published
226    class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
227    class procedure ApplyChanges(const AProgressBar: TCustomProgressBar); override;
228    class procedure SetPosition(const AProgressBar: TCustomProgressBar; const NewPosition: integer); override;
229    class procedure SetStyle(const AProgressBar: TCustomProgressBar; const NewStyle: TProgressBarStyle); override;
230  end;
231
232  { TGtk2WSCustomUpDown }
233
234  TGtk2WSCustomUpDown = class(TWSCustomUpDown)
235  published
236  end;
237
238  { TGtk2WSUpDown }
239
240  TGtk2WSUpDown = class(TWSUpDown)
241  published
242  end;
243
244  { TGtk2WSToolButton }
245
246  TGtk2WSToolButton = class(TWSToolButton)
247  published
248  end;
249
250  { TGtk2WSToolBar }
251
252  TGtk2WSToolBar = class(TWSToolBar)
253  protected
254    class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
255  published
256    class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
257  end;
258
259  { TGtk2WSTrackBar }
260
261  TGtk2WSTrackBar = class(TWSTrackBar)
262  protected
263    class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
264  published
265    class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
266    class procedure ApplyChanges(const ATrackBar: TCustomTrackBar); override;
267    class function  GetPosition(const ATrackBar: TCustomTrackBar): integer; override;
268    class procedure SetPosition(const ATrackBar: TCustomTrackBar; const NewPosition: integer); override;
269    class procedure GetPreferredSize(const {%H-}AWinControl: TWinControl;
270                        var {%H-}PreferredWidth, PreferredHeight: integer;
271                        {%H-}WithThemeSpace: Boolean); override;
272  end;
273
274  { TGtk2WSCustomTreeView }
275
276  TGtk2WSCustomTreeView = class(TWSCustomTreeView)
277  published
278  end;
279
280  { TGtk2WSTreeView }
281
282  TGtk2WSTreeView = class(TWSTreeView)
283  published
284  end;
285
286
287implementation
288
289uses Gtk2CellRenderer, Gtk2Extra{$IFNDEF USEORIGTREEMODEL}, Gtk2ListViewTreeModel{$ENDIF};
290
291{$I gtk2pagecontrol.inc}
292
293// Will be used commonly for ListViews and TreeViews
294procedure GetCommonTreeViewWidgets(ATreeViewHandle: PGtkWidget;
295  out TVWidgets: PTVWidgets);
296var
297  WidgetInfo: PWidgetInfo;
298begin
299  WidgetInfo := GetWidgetInfo(ATreeViewHandle);
300  TVWidgets := PTVWidgets(WidgetInfo^.UserData);
301end;
302
303{$I gtk2wscustomlistview.inc}
304
305procedure GtkWSTrackBar_Changed({%H-}AWidget: PGtkWidget; AInfo: PWidgetInfo); cdecl;
306var
307  Msg: TLMessage;
308begin
309  if AInfo^.ChangeLock > 0 then Exit;
310  Msg.Msg := LM_CHANGED;
311  DeliverMessage(AInfo^.LCLObject, Msg);
312end;
313
314{ TGtk2WSTrackBar }
315
316class procedure TGtk2WSTrackBar.SetCallbacks(const AWidget: PGtkWidget;
317  const AWidgetInfo: PWidgetInfo);
318begin
319  TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject));
320  SignalConnect(AWidget, 'value_changed', @GtkWSTrackBar_Changed, AWidgetInfo);
321end;
322
323class function TGtk2WSTrackBar.CreateHandle(const AWinControl: TWinControl;
324  const AParams: TCreateParams): TLCLIntfHandle;
325var
326  Adjustment: PGtkAdjustment;
327  Widget: PGtkWidget;
328  WidgetInfo: PWidgetInfo;
329begin
330  with TCustomTrackBar(AWinControl) do
331  begin
332    Adjustment := PGtkAdjustment(gtk_adjustment_new (Position, Min, Max,
333                                                  linesize, pagesize, 0));
334    if (Orientation = trHorizontal) then
335      Widget := gtk_hscale_new(Adjustment)
336    else
337      Widget := gtk_vscale_new(Adjustment);
338
339    gtk_range_set_inverted(PGtkRange(Widget), Reversed);
340    gtk_scale_set_digits(PGtkScale(Widget), 0);
341  end;
342  Result := TLCLIntfHandle({%H-}PtrUInt(Widget));
343  {$IFDEF DebugLCLComponents}
344  DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
345  {$ENDIF}
346  WidgetInfo := CreateWidgetInfo({%H-}Pointer(Result), AWinControl, AParams);
347  Set_RC_Name(AWinControl, Widget);
348  SetCallbacks(Widget, WidgetInfo);
349end;
350
351class procedure TGtk2WSTrackBar.ApplyChanges(const ATrackBar: TCustomTrackBar);
352const
353  ValuePositionMap: array[TTrackBarScalePos] of TGtkPositionType =
354  (
355 { trLeft   } GTK_POS_LEFT,
356 { trRight  } GTK_POS_RIGHT,
357 { trTop    } GTK_POS_TOP,
358 { trBottom } GTK_POS_BOTTOM
359  );
360var
361  wHandle: HWND;
362  Adjustment: PGtkAdjustment;
363begin
364  if not WSCheckHandleAllocated(ATrackBar, 'ApplyChanges') then
365    Exit;
366
367  with ATrackBar do
368  begin
369    wHandle := Handle;
370    if gtk_range_get_inverted({%H-}PGtkRange(wHandle)) <> Reversed then
371      gtk_range_set_inverted({%H-}PGtkRange(wHandle), Reversed);
372
373    Adjustment := gtk_range_get_adjustment(GTK_RANGE({%H-}Pointer(wHandle)));
374    // min >= max causes crash
375    Adjustment^.lower := Min;
376    if Min < Max then
377    begin
378      Adjustment^.upper := Max;
379      gtk_widget_set_sensitive({%H-}PgtkWidget(wHandle), ATrackBar.Enabled);
380    end
381    else
382    begin
383      Adjustment^.upper := Min + 1;
384      gtk_widget_set_sensitive({%H-}PgtkWidget(wHandle), False);
385    end;
386    Adjustment^.step_increment := LineSize;
387    Adjustment^.page_increment := PageSize;
388    Adjustment^.value := Position;
389    { now do some of the more sophisticated features }
390    { Hint: For some unknown reason we have to disable the draw_value first,
391      otherwise it's set always to true }
392    gtk_scale_set_draw_value (GTK_SCALE ({%H-}Pointer(wHandle)), false);
393
394    if (TickStyle <> tsNone) then
395    begin
396      gtk_scale_set_draw_value (GTK_SCALE ({%H-}Pointer(wHandle)), true);
397      gtk_scale_set_value_pos (GTK_SCALE ({%H-}Pointer(wHandle)), ValuePositionMap[ScalePos]);
398    end;
399    //Not here (Delphi compatibility):  gtk_signal_emit_by_name (GTK_Object (Adjustment), 'value_changed');
400  end;
401end;
402
403class function TGtk2WSTrackBar.GetPosition(const ATrackBar: TCustomTrackBar
404  ): integer;
405var
406  Range: PGtkRange;
407begin
408  Result := 0;
409  if not WSCheckHandleAllocated(ATrackBar, 'GetPosition') then
410    Exit;
411
412  Range := {%H-}PGtkRange(ATrackBar.Handle);
413  Result := Trunc(gtk_range_get_value(Range));
414end;
415
416class procedure TGtk2WSTrackBar.SetPosition(const ATrackBar: TCustomTrackBar;
417  const NewPosition: integer);
418var
419  Range: PGtkRange;
420  WidgetInfo: PWidgetInfo;
421begin
422  if not WSCheckHandleAllocated(ATrackBar, 'SetPosition') then
423    Exit;
424  Range := {%H-}PGtkRange(ATrackBar.Handle);
425  WidgetInfo := GetWidgetInfo(Range);
426  // lock Range, so that no OnChange event is not fired
427  Inc(WidgetInfo^.ChangeLock);
428  gtk_range_set_value(Range, NewPosition);
429  // unlock Range
430  Dec(WidgetInfo^.ChangeLock);
431end;
432
433
434class procedure TGtk2WSTrackBar.GetPreferredSize(
435  const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer;
436  WithThemeSpace: Boolean);
437var
438  TrackBarWidget: PGtkWidget;
439  Requisition: TGtkRequisition;
440begin
441  TrackBarWidget := {%H-}PGtkWidget(AWinControl.Handle);
442  // if vertical, measure width without ticks
443  if TCustomTrackBar(AWinControl).Orientation = trVertical then
444    gtk_scale_set_draw_value(PGtkScale(TrackBarWidget), False);
445  // set size to default
446  gtk_widget_set_size_request(TrackBarWidget, -1, -1);
447  // ask default size
448  gtk_widget_size_request(TrackBarWidget, @Requisition);
449  if TCustomTrackBar(AWinControl).Orientation = trHorizontal then
450    PreferredHeight := Requisition.Height
451  else
452    begin
453      // gtk_widget_size_request() always returns size of a HScale,
454      // so we use the height for the width
455      PreferredWidth := Requisition.Height;
456      // restore TickStyle
457      gtk_scale_set_draw_value(PGtkScale(TrackBarWidget),
458                               TCustomTrackBar(AWinControl).TickStyle <> tsNone);
459    end;
460end;
461
462{ TGtk2WSProgressBar }
463
464class procedure TGtk2WSProgressBar.UpdateProgressBarText(const AProgressBar: TCustomProgressBar);
465var
466  wText: String;
467begin
468  with AProgressBar do
469  begin
470    if BarShowText then
471    begin
472       wText := Format('%d from [%d-%d] (%%p%%%%)', [Position, Min, Max]);
473       gtk_progress_set_format_string({%H-}PGtkProgress(Handle), PChar(wText));
474    end;
475    gtk_progress_set_show_text({%H-}PGtkProgress(Handle), BarShowText);
476  end;
477end;
478
479function ProgressPulseTimeout(data: gpointer): gboolean; cdecl;
480var
481  AProgressBar: PGtkProgressBar absolute data;
482begin
483  Result := {%H-}PtrUInt(g_object_get_data(data, 'ProgressStyle')) = 1;
484  if Result then
485    gtk_progress_bar_pulse(AProgressBar);
486end;
487
488procedure ProgressDestroy(data: gpointer); cdecl;
489begin
490  g_source_remove({%H-}PtrUInt(data));
491end;
492
493class procedure TGtk2WSProgressBar.InternalSetStyle(
494  AProgressBar: PGtkProgressBar; AStyle: TProgressBarStyle);
495begin
496  g_object_set_data(PGObject(AProgressBar), 'ProgressStyle', {%H-}Pointer(PtrUInt(Ord(AStyle))));
497  if AStyle = pbstMarquee then
498  begin
499    g_object_set_data_full(PGObject(AProgressBar), 'timeout',
500      {%H-}Pointer(PtrUInt(g_timeout_add(100, @ProgressPulseTimeout, AProgressBar))), @ProgressDestroy);
501    gtk_progress_bar_pulse(AProgressBar);
502  end;
503end;
504
505class function TGtk2WSProgressBar.CreateHandle(const AWinControl: TWinControl;
506  const AParams: TCreateParams): TLCLIntfHandle;
507var
508  Widget: PGtkWidget;
509  WidgetInfo: PWidgetInfo;
510begin
511  Widget := gtk_progress_bar_new;
512  Result := TLCLIntfHandle({%H-}PtrUInt(Widget));
513  WidgetInfo := CreateWidgetInfo({%H-}Pointer(Result), AWinControl, AParams);
514  Set_RC_Name(AWinControl, Widget);
515
516  GTK_WIDGET_SET_FLAGS(Widget, GTK_CAN_FOCUS);
517  InternalSetStyle(PGtkProgressBar(Widget), TCustomProgressBar(AWinControl).Style);
518
519  TGtk2WSWinControl.SetCallbacks(PGtkObject(Widget), TComponent(WidgetInfo^.LCLObject));
520end;
521
522class procedure TGtk2WSProgressBar.ApplyChanges(const AProgressBar: TCustomProgressBar);
523const
524  OrientationMap: array[TProgressBarOrientation] of TGtkProgressBarOrientation =
525  (
526{ pbHorizontal  } GTK_PROGRESS_LEFT_TO_RIGHT,
527{ pbVertical,   } GTK_PROGRESS_BOTTOM_TO_TOP,
528{ pbRightToLeft } GTK_PROGRESS_RIGHT_TO_LEFT,
529{ pbTopDown     } GTK_PROGRESS_TOP_TO_BOTTOM
530  );
531
532  SmoothMap: array[Boolean] of TGtkProgressBarStyle =
533  (
534{ False } GTK_PROGRESS_DISCRETE,
535{ True  } GTK_PROGRESS_CONTINUOUS
536  );
537
538var
539  Progress: PGtkProgressBar;
540begin
541  if not WSCheckHandleAllocated(AProgressBar, 'TGtk2WSProgressBar.ApplyChanges') then
542    Exit;
543  Progress := {%H-}PGtkProgressBar(AProgressBar.Handle);
544
545  with AProgressBar do
546  begin
547    gtk_progress_bar_set_bar_style(Progress, SmoothMap[Smooth]);
548    gtk_progress_bar_set_orientation(Progress, OrientationMap[Orientation]);
549  end;
550
551  // The posision also needs to be updated at ApplyChanges
552  SetPosition(AProgressBar, AProgressBar.Position);
553end;
554
555class procedure TGtk2WSProgressBar.SetPosition(
556  const AProgressBar: TCustomProgressBar; const NewPosition: integer);
557var
558  fraction:gdouble;
559begin
560  if not WSCheckHandleAllocated(AProgressBar, 'TGtk2WSProgressBar.SetPosition') then
561    Exit;
562
563  // Gtk2 wishes the position in a floating-point value between
564  // 0.0 and 1.0, and we calculate that with:
565  // (Pos - Min) / (Max - Min)
566  // regardless if any of them is negative the result is correct
567  if ((AProgressBar.Max - AProgressBar.Min) <> 0) then
568    fraction:=(NewPosition - AProgressBar.Min) / (AProgressBar.Max - AProgressBar.Min)
569  else
570    fraction:=0;
571
572  gtk_progress_bar_set_fraction({%H-}PGtkProgressBar(AProgressBar.Handle), fraction);
573
574  UpdateProgressBarText(AProgressBar);
575end;
576
577class procedure TGtk2WSProgressBar.SetStyle(
578  const AProgressBar: TCustomProgressBar; const NewStyle: TProgressBarStyle);
579begin
580  if not WSCheckHandleAllocated(AProgressBar, 'SetStyle') then
581    Exit;
582  InternalSetStyle({%H-}PGtkProgressBar(AProgressBar.Handle), NewStyle);
583  if NewStyle = pbstNormal then
584    SetPosition(AProgressBar, AProgressBar.Position);
585end;
586
587{ TGtk2WSStatusBar }
588
589class procedure TGtk2WSStatusBar.SetCallbacks(const AWidget: PGtkWidget;
590  const AWidgetInfo: PWidgetInfo);
591begin
592  TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject));
593end;
594
595class function TGtk2WSStatusBar.CreateHandle(const AWinControl: TWinControl;
596  const AParams: TCreateParams): TLCLIntfHandle;
597var
598  EventBox, HBox: PGtkWidget;
599  WidgetInfo: PWidgetInfo;
600begin
601  EventBox := gtk_event_box_new;
602  HBox := gtk_hbox_new(False, 0);
603  gtk_container_add(PGtkContainer(EventBox), HBox);
604  gtk_widget_show(HBox);
605  UpdateStatusBarPanels(AWinControl, HBox);
606  Result := TLCLIntfHandle({%H-}PtrUInt(EventBox));
607  {$IFDEF DebugLCLComponents}
608  DebugGtkWidgets.MarkCreated(EventBox, dbgsName(AWinControl));
609  {$ENDIF}
610  WidgetInfo := CreateWidgetInfo({%H-}Pointer(Result), AWinControl, AParams);
611  Set_RC_Name(AWinControl, EventBox);
612  SetCallbacks(EventBox, WidgetInfo);
613end;
614
615class procedure TGtk2WSStatusBar.PanelUpdate(const AStatusBar: TStatusBar;
616  PanelIndex: integer);
617var
618  HBox: PGtkWidget;
619  StatusPanelWidget: PGtkWidget;
620  BoxChild: PGtkBoxChild;
621begin
622  //DebugLn('TGtkWidgetSet.StatusBarPanelUpdate ',DbgS(AStatusBar),' PanelIndex=',dbgs(PanelIndex));
623  HBox := {%H-}PGtkBin(AStatusBar.Handle)^.child;
624  if PanelIndex >= 0 then
625  begin
626    // update one
627    BoxChild := PGtkBoxChild(g_list_nth_data(PGtkBox(HBox)^.children, PanelIndex));
628    if BoxChild = nil then
629      RaiseGDBException('TGtkWidgetSet.StatusBarPanelUpdate Index out of bounds');
630    StatusPanelWidget := BoxChild^.Widget;
631    UpdateStatusBarPanel(AStatusBar, PanelIndex, StatusPanelWidget);
632  end else
633  begin
634    // update all
635    UpdateStatusBarPanels(AStatusBar, HBox);
636  end;
637end;
638
639class procedure TGtk2WSStatusBar.SetPanelText(const AStatusBar: TStatusBar;
640  PanelIndex: integer);
641begin
642  PanelUpdate(AStatusBar, PanelIndex);
643end;
644
645class procedure TGtk2WSStatusBar.Update(const AStatusBar: TStatusBar);
646begin
647  //DebugLn('TGtkWidgetSet.StatusBarUpdate ',DbgS(AStatusBar));
648  UpdateStatusBarPanels(AStatusBar, {%H-}PGtkBin(AStatusBar.Handle)^.child);
649end;
650
651class procedure TGtk2WSStatusBar.GetPreferredSize(
652  const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer;
653  WithThemeSpace: Boolean);
654var
655  StatusBarWidget: PGtkWidget;
656  Requisition: TGtkRequisition;
657begin
658  StatusBarWidget := GetStyleWidget(lgsStatusBar);
659  // set size to default
660  gtk_widget_set_size_request(StatusBarWidget, -1, -1);
661  // ask default size
662  gtk_widget_size_request(StatusBarWidget, @Requisition);
663  PreferredHeight := Requisition.height;
664  //debugln('TGtkWSStatusBar.GetPreferredSize END ',dbgs(PreferredHeight));
665end;
666
667class procedure TGtk2WSStatusBar.SetSizeGrip(const AStatusBar: TStatusBar;
668  SizeGrip: Boolean);
669var
670  LastWidget, HBox: PGtkWidget;
671begin
672  if not WSCheckHandleAllocated(AStatusBar, 'SetSizeGrip') then
673    Exit;
674  HBox := {%H-}PGtkBin(AStatusBar.Handle)^.child;
675  LastWidget := PGtkBoxChild(g_list_last(PGtkBox(HBox)^.children)^.data)^.widget;
676  gtk_statusbar_set_has_resize_grip(PGtkStatusBar(LastWidget), AStatusBar.SizeGrip and AStatusBar.SizeGripEnabled);
677end;
678
679{ TGtk2WSToolBar }
680
681class procedure TGtk2WSToolBar.SetCallbacks(const AWidget: PGtkWidget;
682  const AWidgetInfo: PWidgetInfo);
683begin
684  TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject));
685end;
686
687class function TGtk2WSToolBar.CreateHandle(const AWinControl: TWinControl;
688  const AParams: TCreateParams): TLCLIntfHandle;
689var
690  Widget, ClientWidget: PGtkWidget;
691  WidgetInfo: PWidgetInfo;
692begin
693  // Creates the widget
694  Widget:= gtk_hbox_new(false,0);
695  ClientWidget := CreateFixedClientWidget;
696  gtk_container_add(GTK_CONTAINER(Widget), ClientWidget);
697
698  Result := TLCLIntfHandle({%H-}PtrUInt(Widget));
699  WidgetInfo := CreateWidgetInfo(Widget, AWinControl, AParams);
700
701  {$IFDEF DebugLCLComponents}
702  DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
703  {$ENDIF}
704
705  gtk_widget_show(ClientWidget);
706  SetFixedWidget(Widget, ClientWidget);
707  SetMainWidget(Widget, ClientWidget);
708  gtk_widget_show(Widget);
709
710  Set_RC_Name(AWinControl, Widget);
711  SetCallbacks(Widget, WidgetInfo);
712end;
713
714end.
715