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