← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/interfaces/gtk2/gtk2wscomctrls.pp

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lcl/interfaces/gtk2/gtk2wscomctrls.pp
1
 
{ $Id: gtk2wscomctrls.pp 29520 2011-02-13 12:57:08Z vincents $}
2
1
{
3
2
 *****************************************************************************
4
3
 *                             Gtk2WSComCtrls.pp                             * 
31
30
  // libs
32
31
  GLib2, Gtk2, Gdk2, Gdk2pixbuf,
33
32
  // RTL, FCL, LCL
34
 
  ComCtrls, Classes, FPCAdds, LCLType, LMessages, Controls, Graphics,
35
 
  StdCtrls, LCLProc, ImgList, Math, Sysutils, InterfaceBase,
 
33
  ComCtrls, Classes, LCLType, LMessages, Controls, Graphics,
 
34
  StdCtrls, Forms, LCLProc, LCLIntf, ImgList, Math, Sysutils, InterfaceBase,
36
35
  // widgetset
37
36
  WSComCtrls, WSLCLClasses, WSControls, WSProc,
38
37
  // GtkWidgetset
53
52
    //this is created and destroyed as needed
54
53
    //it only holds items which are about to be changed the list is emptied in Gtk2_ItemSelectionChanged
55
54
    ItemCache: TStringList;
 
55
    OldTreeSelection: PGList; // needed only by gtk < 2.10 ! issue #19820
56
56
    Images: TList;
57
57
  end;
58
58
 
59
59
type
 
60
  { TGtk2WSCustomPage }
 
61
 
 
62
  TGtk2WSCustomPage = class(TWSCustomPage)
 
63
  protected
 
64
    class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
 
65
  published
 
66
    class function  CreateHandle(const AWinControl: TWinControl;
 
67
      const AParams: TCreateParams): TLCLIntfHandle; override;
 
68
    class procedure UpdateProperties(const ACustomPage: TCustomPage); override;
 
69
    class procedure SetBounds(const {%H-}AWinControl: TWinControl; const {%H-}ALeft, {%H-}ATop, {%H-}AWidth, {%H-}AHeight: Integer); override;
 
70
    class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
 
71
    class procedure ShowHide(const AWinControl: TWinControl); override;
 
72
    class function GetDefaultClientRect(const AWinControl: TWinControl;
 
73
             const {%H-}aLeft, {%H-}aTop, {%H-}aWidth, {%H-}aHeight: integer; var aClientRect: TRect
 
74
             ): boolean; override;
 
75
  end;
 
76
 
 
77
  { TGtk2WSCustomTabControl }
 
78
 
 
79
  TGtk2WSCustomTabControl = class(TWSCustomTabControl)
 
80
  private
 
81
    class function CreateTTabControlHandle(const AWinControl: TWinControl;
 
82
      const AParams: TCreateParams): HWND;
 
83
  protected
 
84
    class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
 
85
  published
 
86
    class function CreateHandle(const AWinControl: TWinControl;
 
87
                                const AParams: TCreateParams): HWND; override;
 
88
    class function GetDefaultClientRect(const AWinControl: TWinControl;
 
89
             const {%H-}aLeft, {%H-}aTop, aWidth, aHeight: integer; var aClientRect: TRect
 
90
             ): boolean; override;
 
91
    class procedure AddPage(const ATabControl: TCustomTabControl;
 
92
      const AChild: TCustomPage; const AIndex: integer); override;
 
93
    class procedure MovePage(const ATabControl: TCustomTabControl;
 
94
      const AChild: TCustomPage; const NewIndex: integer); override;
 
95
 
 
96
    class function GetCapabilities: TCTabControlCapabilities; override;
 
97
    class function GetNotebookMinTabHeight(const AWinControl: TWinControl): integer; override;
 
98
    class function GetNotebookMinTabWidth(const AWinControl: TWinControl): integer; override;
 
99
    class function GetTabIndexAtPos(const ATabControl: TCustomTabControl; const AClientPos: TPoint): integer; override;
 
100
    class function GetTabRect(const ATabControl: TCustomTabControl; const AIndex: Integer): TRect; override;
 
101
    class procedure SetPageIndex(const ATabControl: TCustomTabControl; const AIndex: integer); override;
 
102
    class procedure SetTabPosition(const ATabControl: TCustomTabControl; const ATabPosition: TTabPosition); override;
 
103
    class procedure ShowTabs(const ATabControl: TCustomTabControl; AShowTabs: boolean); override;
 
104
    class procedure UpdateProperties(const ATabControl: TCustomTabControl); override;
 
105
  end;
60
106
 
61
107
  { TGtk2WSStatusBar }
62
108
 
68
114
    class procedure PanelUpdate(const AStatusBar: TStatusBar; PanelIndex: integer); override;
69
115
    class procedure SetPanelText(const AStatusBar: TStatusBar; PanelIndex: integer); override;
70
116
    class procedure Update(const AStatusBar: TStatusBar); override;
71
 
    class procedure GetPreferredSize(const AWinControl: TWinControl;
72
 
                        var PreferredWidth, PreferredHeight: integer;
73
 
                        WithThemeSpace: Boolean); override;
 
117
    class procedure GetPreferredSize(const {%H-}AWinControl: TWinControl;
 
118
                        var {%H-}PreferredWidth, PreferredHeight: integer;
 
119
                        {%H-}WithThemeSpace: Boolean); override;
74
120
 
75
 
    class procedure SetSizeGrip(const AStatusBar: TStatusBar; SizeGrip: Boolean); override;
 
121
    class procedure SetSizeGrip(const AStatusBar: TStatusBar; {%H-}SizeGrip: Boolean); override;
76
122
  end;
77
123
 
78
124
  { TGtk2WSTabSheet }
96
142
    class procedure AddRemoveCheckboxRenderer(const ALV: TCustomListView; const WidgetInfo: PWidgetInfo; const Add: Boolean);
97
143
    class function GetViewModel(const AView: PGtkWidget): PGtkTreeModel;
98
144
  protected
99
 
    class procedure SetCallbacks(const AScrollWidget: PGtkWidget; const Widgets: PTVWidgets; const AWidgetInfo: PWidgetInfo); virtual;
 
145
    class procedure SetListCallbacks(const AScrollWidget: PGtkWidget; const Widgets: PTVWidgets; const AWidgetInfo: PWidgetInfo);
100
146
  published
101
147
    // columns
102
148
    class procedure ColumnDelete(const ALV: TCustomListView; const AIndex: Integer); override;
103
 
    class function  ColumnGetWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn): Integer; override;
 
149
    class function  ColumnGetWidth(const ALV: TCustomListView; const {%H-}AIndex: Integer; const AColumn: TListColumn): Integer; override;
104
150
    class procedure ColumnInsert(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn); override;
105
 
    class procedure ColumnMove(const ALV: TCustomListView; const AOldIndex, ANewIndex: Integer; const AColumn: TListColumn); override;
106
 
    class procedure ColumnSetAlignment(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AAlignment: TAlignment); override;
107
 
    class procedure ColumnSetAutoSize(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AAutoSize: Boolean); override;
108
 
    class procedure ColumnSetCaption(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const ACaption: String); override;
109
 
    class procedure ColumnSetImage(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AImageIndex: Integer); override;
110
 
    class procedure ColumnSetMaxWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AMaxWidth: Integer); override;
111
 
    class procedure ColumnSetMinWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AMinWidth: integer); override;
112
 
    class procedure ColumnSetWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AWidth: Integer); override;
113
 
    class procedure ColumnSetVisible(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AVisible: Boolean); override;
 
151
    class procedure ColumnMove(const ALV: TCustomListView; const AOldIndex, ANewIndex: Integer; const {%H-}AColumn: TListColumn); override;
 
152
    class procedure ColumnSetAlignment(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AColumn: TListColumn; const AAlignment: TAlignment); override;
 
153
    class procedure ColumnSetAutoSize(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AColumn: TListColumn; const AAutoSize: Boolean); override;
 
154
    class procedure ColumnSetCaption(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AColumn: TListColumn; const ACaption: String); override;
 
155
    class procedure ColumnSetImage(const ALV: TCustomListView; const {%H-}AIndex: Integer; const {%H-}AColumn: TListColumn; const {%H-}AImageIndex: Integer); override;
 
156
    class procedure ColumnSetMaxWidth(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AColumn: TListColumn; const AMaxWidth: Integer); override;
 
157
    class procedure ColumnSetMinWidth(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AColumn: TListColumn; const AMinWidth: integer); override;
 
158
    class procedure ColumnSetWidth(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AColumn: TListColumn; const AWidth: Integer); override;
 
159
    class procedure ColumnSetVisible(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AColumn: TListColumn; const AVisible: Boolean); override;
114
160
 
115
161
    // items
116
162
    class procedure ItemDelete(const ALV: TCustomListView; const AIndex: Integer); override;
117
 
    class function  ItemDisplayRect(const ALV: TCustomListView; const AIndex, ASubItem: Integer; ACode: TDisplayCode): TRect; override;
118
 
    class function  ItemGetChecked(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem): Boolean; override;
119
 
    class function  ItemGetState(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const AState: TListItemState; out AIsSet: Boolean): Boolean; override; // returns True if supported
120
 
    class procedure ItemInsert(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem); override;
121
 
    class procedure ItemSetChecked(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const AChecked: Boolean); override;
122
 
    class procedure ItemSetImage(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const ASubIndex, AImageIndex: Integer); override;
123
 
    class procedure ItemSetState(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const AState: TListItemState; const AIsSet: Boolean); override;
124
 
    class procedure ItemSetText(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const ASubIndex: Integer; const AText: String); override;
125
 
    class procedure ItemShow(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const PartialOK: Boolean); override;
 
163
    class function  ItemDisplayRect(const ALV: TCustomListView; const AIndex, ASubItem: Integer; {%H-}ACode: TDisplayCode): TRect; override;
 
164
    class procedure ItemExchange(const ALV: TCustomListView; {%H-}AItem: TListItem; const AIndex1, AIndex2: Integer); override;
 
165
    class procedure ItemMove(const ALV: TCustomListView; {%H-}AItem: TListItem; const AFromIndex, AToIndex: Integer); override;
 
166
    class function  ItemGetChecked(const {%H-}ALV: TCustomListView; const {%H-}AIndex: Integer; const AItem: TListItem): Boolean; override;
 
167
    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
 
168
    class procedure ItemInsert(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AItem: TListItem); override;
 
169
    class procedure ItemSetChecked(const ALV: TCustomListView; const {%H-}AIndex: Integer; const {%H-}AItem: TListItem; const {%H-}AChecked: Boolean); override;
 
170
    class procedure ItemSetImage(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AItem: TListItem; const {%H-}ASubIndex, AImageIndex: Integer); override;
 
171
    class procedure ItemSetState(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AItem: TListItem; const AState: TListItemState; const AIsSet: Boolean); override;
 
172
    class procedure ItemSetText(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AItem: TListItem; const {%H-}ASubIndex: Integer; const {%H-}AText: String); override;
 
173
    class procedure ItemShow(const ALV: TCustomListView; const AIndex: Integer; const {%H-}AItem: TListItem; const {%H-}PartialOK: Boolean); override;
126
174
    class function  ItemGetPosition(const ALV: TCustomListView; const AIndex: Integer): TPoint; override;
127
 
    class procedure ItemUpdate(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem); override;
 
175
    class procedure ItemUpdate(const ALV: TCustomListView; const {%H-}AIndex: Integer; const {%H-}AItem: TListItem); override;
128
176
 
129
177
    // lv
130
178
    class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override;
144
192
    class function GetViewOrigin(const ALV: TCustomListView): TPoint; override;
145
193
    class function GetVisibleRowCount(const ALV: TCustomListView): Integer; override;
146
194
 
147
 
    class procedure SetAllocBy(const ALV: TCustomListView; const AValue: Integer); override;
 
195
    class procedure SetAllocBy(const ALV: TCustomListView; const {%H-}AValue: Integer); override;
148
196
    class procedure SetColor(const AWinControl: TWinControl); override;
149
 
    class procedure SetDefaultItemHeight(const ALV: TCustomListView; const AValue: Integer); override;
 
197
    class procedure SetDefaultItemHeight(const ALV: TCustomListView; const {%H-}AValue: Integer); override;
150
198
    class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
151
 
    class procedure SetHotTrackStyles(const ALV: TCustomListView; const AValue: TListHotTrackStyles); override;
152
 
    class procedure SetHoverTime(const ALV: TCustomListView; const AValue: Integer); 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;
153
201
//    class procedure SetIconOptions(const ALV: TCustomListView; const AValue: TIconOptions); override;
154
202
    class procedure SetImageList(const ALV: TCustomListView; const AList: TListViewImageList; const AValue: TCustomImageList); override;
155
 
    class procedure SetItemsCount(const ALV: TCustomListView; const Avalue: Integer); override;
 
203
    class procedure SetItemsCount(const ALV: TCustomListView; const {%H-}Avalue: Integer); override;
156
204
    class procedure SetProperty(const ALV: TCustomListView; const AProp: TListViewProperty; const AIsSet: Boolean); override;
157
205
    class procedure SetProperties(const ALV: TCustomListView; const AProps: TListViewProperties); override;
158
206
    class procedure SetScrollBars(const ALV: TCustomListView; const AValue: TScrollStyle); override;
159
 
    class procedure SetSort(const ALV: TCustomListView; const AType: TSortType; const AColumn: Integer); override;
 
207
    class procedure SetSort(const ALV: TCustomListView; const {%H-}AType: TSortType; const {%H-}AColumn: Integer;
 
208
      const {%H-}ASortDirection: TSortDirection); override;
160
209
    class procedure SetViewOrigin(const ALV: TCustomListView; const AValue: TPoint); override;
161
210
    class procedure SetViewStyle(const ALV: TCustomListView; const AValue: TViewStyle); override;
162
211
  end;
217
266
    class procedure ApplyChanges(const ATrackBar: TCustomTrackBar); override;
218
267
    class function  GetPosition(const ATrackBar: TCustomTrackBar): integer; override;
219
268
    class procedure SetPosition(const ATrackBar: TCustomTrackBar; const NewPosition: integer); override;
 
269
    class procedure SetOrientation(const ATrackBar: TCustomTrackBar; const {%H-}AOrientation: TTrackBarOrientation); override;
220
270
  end;
221
271
 
222
272
  { TGtk2WSCustomTreeView }
236
286
 
237
287
uses Gtk2CellRenderer, Gtk2Extra{$IFNDEF USEORIGTREEMODEL}, Gtk2ListViewTreeModel{$ENDIF};
238
288
 
 
289
{$I gtk2pagecontrol.inc}
 
290
 
239
291
// Will be used commonly for ListViews and TreeViews
240
292
procedure GetCommonTreeViewWidgets(ATreeViewHandle: PGtkWidget;
241
 
  var TVWidgets: PTVWidgets);
 
293
  out TVWidgets: PTVWidgets);
242
294
var
243
295
  WidgetInfo: PWidgetInfo;
244
296
begin
248
300
 
249
301
{$I gtk2wscustomlistview.inc}
250
302
 
251
 
procedure GtkWSTrackBar_Changed(AWidget: PGtkWidget; AInfo: PWidgetInfo); cdecl;
 
303
procedure GtkWSTrackBar_Changed({%H-}AWidget: PGtkWidget; AInfo: PWidgetInfo); cdecl;
252
304
var
253
305
  Msg: TLMessage;
254
306
begin
285
337
    gtk_range_set_inverted(PGtkRange(Widget), Reversed);
286
338
    gtk_scale_set_digits(PGtkScale(Widget), 0);
287
339
  end;
288
 
  Result := TLCLIntfHandle(PtrUInt(Widget));
 
340
  Result := TLCLIntfHandle({%H-}PtrUInt(Widget));
289
341
  {$IFDEF DebugLCLComponents}
290
342
  DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
291
343
  {$ENDIF}
292
 
  WidgetInfo := CreateWidgetInfo(Pointer(Result), AWinControl, AParams);
 
344
  WidgetInfo := CreateWidgetInfo({%H-}Pointer(Result), AWinControl, AParams);
293
345
  Set_RC_Name(AWinControl, Widget);
294
346
  SetCallbacks(Widget, WidgetInfo);
295
347
end;
313
365
  with ATrackBar do
314
366
  begin
315
367
    wHandle := Handle;
316
 
    if gtk_range_get_inverted(PGtkRange(wHandle)) <> Reversed then
317
 
      gtk_range_set_inverted(PGtkRange(wHandle), Reversed);
 
368
    if gtk_range_get_inverted({%H-}PGtkRange(wHandle)) <> Reversed then
 
369
      gtk_range_set_inverted({%H-}PGtkRange(wHandle), Reversed);
318
370
 
319
 
    Adjustment := gtk_range_get_adjustment(GTK_RANGE(Pointer(wHandle)));
 
371
    Adjustment := gtk_range_get_adjustment(GTK_RANGE({%H-}Pointer(wHandle)));
320
372
    // min >= max causes crash
321
373
    Adjustment^.lower := Min;
322
374
    if Min < Max then
323
375
    begin
324
376
      Adjustment^.upper := Max;
325
 
      gtk_widget_set_sensitive(PgtkWidget(wHandle), ATrackBar.Enabled);
 
377
      gtk_widget_set_sensitive({%H-}PgtkWidget(wHandle), ATrackBar.Enabled);
326
378
    end
327
379
    else
328
380
    begin
329
381
      Adjustment^.upper := Min + 1;
330
 
      gtk_widget_set_sensitive(PgtkWidget(wHandle), False);
 
382
      gtk_widget_set_sensitive({%H-}PgtkWidget(wHandle), False);
331
383
    end;
332
384
    Adjustment^.step_increment := LineSize;
333
385
    Adjustment^.page_increment := PageSize;
335
387
    { now do some of the more sophisticated features }
336
388
    { Hint: For some unknown reason we have to disable the draw_value first,
337
389
      otherwise it's set always to true }
338
 
    gtk_scale_set_draw_value (GTK_SCALE (Pointer(wHandle)), false);
 
390
    gtk_scale_set_draw_value (GTK_SCALE ({%H-}Pointer(wHandle)), false);
339
391
 
340
392
    if (TickStyle <> tsNone) then
341
393
    begin
342
 
      gtk_scale_set_draw_value (GTK_SCALE (Pointer(wHandle)), true);
343
 
      gtk_scale_set_value_pos (GTK_SCALE (Pointer(wHandle)), ValuePositionMap[ScalePos]);
 
394
      gtk_scale_set_draw_value (GTK_SCALE ({%H-}Pointer(wHandle)), true);
 
395
      gtk_scale_set_value_pos (GTK_SCALE ({%H-}Pointer(wHandle)), ValuePositionMap[ScalePos]);
344
396
    end;
345
397
    //Not here (Delphi compatibility):  gtk_signal_emit_by_name (GTK_Object (Adjustment), 'value_changed');
346
398
  end;
355
407
  if not WSCheckHandleAllocated(ATrackBar, 'GetPosition') then
356
408
    Exit;
357
409
 
358
 
  Range := PGtkRange(ATrackBar.Handle);
 
410
  Range := {%H-}PGtkRange(ATrackBar.Handle);
359
411
  Result := Trunc(gtk_range_get_value(Range));
360
412
end;
361
413
 
367
419
begin
368
420
  if not WSCheckHandleAllocated(ATrackBar, 'SetPosition') then
369
421
    Exit;
370
 
  Range := PGtkRange(ATrackBar.Handle);
 
422
  Range := {%H-}PGtkRange(ATrackBar.Handle);
371
423
  WidgetInfo := GetWidgetInfo(Range);
372
424
  // lock Range, so that no OnChange event is not fired
373
425
  Inc(WidgetInfo^.ChangeLock);
376
428
  Dec(WidgetInfo^.ChangeLock);
377
429
end;
378
430
 
 
431
class procedure TGtk2WSTrackBar.SetOrientation(
 
432
  const ATrackBar: TCustomTrackBar; const AOrientation: TTrackBarOrientation);
 
433
var
 
434
  B: Boolean;
 
435
begin
 
436
  if not WSCheckHandleAllocated(ATrackBar, 'SetOrientation') then
 
437
    Exit;
 
438
  B := ATrackBar.Visible;
 
439
  if B then
 
440
    ATrackBar.Hide;
 
441
  try
 
442
    RecreateWnd(ATrackBar);
 
443
  finally
 
444
    if B then
 
445
      ATrackBar.Show;
 
446
  end;
 
447
end;
 
448
 
379
449
{ TGtk2WSProgressBar }
380
450
 
381
451
class procedure TGtk2WSProgressBar.UpdateProgressBarText(const AProgressBar: TCustomProgressBar);
387
457
    if BarShowText then
388
458
    begin
389
459
       wText := Format('%d from [%d-%d] (%%p%%%%)', [Position, Min, Max]);
390
 
       gtk_progress_set_format_string(PGtkProgress(Handle), PChar(wText));
 
460
       gtk_progress_set_format_string({%H-}PGtkProgress(Handle), PChar(wText));
391
461
    end;
392
 
    gtk_progress_set_show_text(PGtkProgress(Handle), BarShowText);
 
462
    gtk_progress_set_show_text({%H-}PGtkProgress(Handle), BarShowText);
393
463
  end;
394
464
end;
395
465
 
397
467
var
398
468
  AProgressBar: PGtkProgressBar absolute data;
399
469
begin
400
 
  Result := PtrUInt(g_object_get_data(data, 'ProgressStyle')) = 1;
 
470
  Result := {%H-}PtrUInt(g_object_get_data(data, 'ProgressStyle')) = 1;
401
471
  if Result then
402
472
    gtk_progress_bar_pulse(AProgressBar);
403
473
end;
404
474
 
405
475
procedure ProgressDestroy(data: gpointer); cdecl;
406
476
begin
407
 
  g_source_remove(PtrUInt(data));
 
477
  g_source_remove({%H-}PtrUInt(data));
408
478
end;
409
479
 
410
480
class procedure TGtk2WSProgressBar.InternalSetStyle(
411
481
  AProgressBar: PGtkProgressBar; AStyle: TProgressBarStyle);
412
482
begin
413
 
  g_object_set_data(PGObject(AProgressBar), 'ProgressStyle', Pointer(PtrUInt(Ord(AStyle))));
 
483
  g_object_set_data(PGObject(AProgressBar), 'ProgressStyle', {%H-}Pointer(PtrUInt(Ord(AStyle))));
414
484
  if AStyle = pbstMarquee then
415
485
  begin
416
486
    g_object_set_data_full(PGObject(AProgressBar), 'timeout',
417
 
      Pointer(PtrUInt(g_timeout_add(100, @ProgressPulseTimeout, AProgressBar))), @ProgressDestroy);
 
487
      {%H-}Pointer(PtrUInt(g_timeout_add(100, @ProgressPulseTimeout, AProgressBar))), @ProgressDestroy);
418
488
    gtk_progress_bar_pulse(AProgressBar);
419
489
  end;
420
490
end;
426
496
  WidgetInfo: PWidgetInfo;
427
497
begin
428
498
  Widget := gtk_progress_bar_new;
429
 
  Result := TLCLIntfHandle(PtrUInt(Widget));
430
 
  WidgetInfo := CreateWidgetInfo(Pointer(Result), AWinControl, AParams);
 
499
  Result := TLCLIntfHandle({%H-}PtrUInt(Widget));
 
500
  WidgetInfo := CreateWidgetInfo({%H-}Pointer(Result), AWinControl, AParams);
431
501
  Set_RC_Name(AWinControl, Widget);
432
502
 
433
503
  InternalSetStyle(PGtkProgressBar(Widget), TCustomProgressBar(AWinControl).Style);
456
526
begin
457
527
  if not WSCheckHandleAllocated(AProgressBar, 'TGtk2WSProgressBar.ApplyChanges') then
458
528
    Exit;
459
 
  Progress := PGtkProgressBar(AProgressBar.Handle);
 
529
  Progress := {%H-}PGtkProgressBar(AProgressBar.Handle);
460
530
 
461
531
  with AProgressBar do
462
532
  begin
485
555
  else
486
556
    fraction:=0;
487
557
 
488
 
  gtk_progress_bar_set_fraction(PGtkProgressBar(AProgressBar.Handle), fraction);
 
558
  gtk_progress_bar_set_fraction({%H-}PGtkProgressBar(AProgressBar.Handle), fraction);
489
559
 
490
560
  UpdateProgressBarText(AProgressBar);
491
561
end;
495
565
begin
496
566
  if not WSCheckHandleAllocated(AProgressBar, 'SetStyle') then
497
567
    Exit;
498
 
  InternalSetStyle(PGtkProgressBar(AProgressBar.Handle), NewStyle);
 
568
  InternalSetStyle({%H-}PGtkProgressBar(AProgressBar.Handle), NewStyle);
499
569
  if NewStyle = pbstNormal then
500
570
    SetPosition(AProgressBar, AProgressBar.Position);
501
571
end;
519
589
  gtk_container_add(PGtkContainer(EventBox), HBox);
520
590
  gtk_widget_show(HBox);
521
591
  UpdateStatusBarPanels(AWinControl, HBox);
522
 
  Result := TLCLIntfHandle(PtrUInt(EventBox));
 
592
  Result := TLCLIntfHandle({%H-}PtrUInt(EventBox));
523
593
  {$IFDEF DebugLCLComponents}
524
594
  DebugGtkWidgets.MarkCreated(EventBox, dbgsName(AWinControl));
525
595
  {$ENDIF}
526
 
  WidgetInfo := CreateWidgetInfo(Pointer(Result), AWinControl, AParams);
 
596
  WidgetInfo := CreateWidgetInfo({%H-}Pointer(Result), AWinControl, AParams);
527
597
  Set_RC_Name(AWinControl, EventBox);
528
598
  SetCallbacks(EventBox, WidgetInfo);
529
599
end;
536
606
  BoxChild: PGtkBoxChild;
537
607
begin
538
608
  //DebugLn('TGtkWidgetSet.StatusBarPanelUpdate ',DbgS(AStatusBar),' PanelIndex=',dbgs(PanelIndex));
539
 
  HBox := PGtkBin(AStatusBar.Handle)^.child;
 
609
  HBox := {%H-}PGtkBin(AStatusBar.Handle)^.child;
540
610
  if PanelIndex >= 0 then
541
611
  begin
542
612
    // update one
561
631
class procedure TGtk2WSStatusBar.Update(const AStatusBar: TStatusBar);
562
632
begin
563
633
  //DebugLn('TGtkWidgetSet.StatusBarUpdate ',DbgS(AStatusBar));
564
 
  UpdateStatusBarPanels(AStatusBar, PGtkBin(AStatusBar.Handle)^.child);
 
634
  UpdateStatusBarPanels(AStatusBar, {%H-}PGtkBin(AStatusBar.Handle)^.child);
565
635
end;
566
636
 
567
637
class procedure TGtk2WSStatusBar.GetPreferredSize(
587
657
begin
588
658
  if not WSCheckHandleAllocated(AStatusBar, 'SetSizeGrip') then
589
659
    Exit;
590
 
  HBox := PGtkBin(AStatusBar.Handle)^.child;
 
660
  HBox := {%H-}PGtkBin(AStatusBar.Handle)^.child;
591
661
  LastWidget := PGtkBoxChild(g_list_last(PGtkBox(HBox)^.children)^.data)^.widget;
592
662
  gtk_statusbar_set_has_resize_grip(PGtkStatusBar(LastWidget), AStatusBar.SizeGrip and AStatusBar.SizeGripEnabled);
593
663
end;
611
681
  ClientWidget := CreateFixedClientWidget;
612
682
  gtk_container_add(GTK_CONTAINER(Widget), ClientWidget);
613
683
 
614
 
  Result := TLCLIntfHandle(PtrUInt(Widget));
 
684
  Result := TLCLIntfHandle({%H-}PtrUInt(Widget));
615
685
  WidgetInfo := CreateWidgetInfo(Widget, AWinControl, AParams);
616
686
 
617
687
  {$IFDEF DebugLCLComponents}