1{ $Id: gtk2wsspin.pp 57581 2018-03-31 13:53:03Z juha $}
2{
3 *****************************************************************************
4 *                               Gtk2WSSpin.pp                               *
5 *                               -------------                               *
6 *                                                                           *
7 *                                                                           *
8 *****************************************************************************
9
10 *****************************************************************************
11  This file is part of the Lazarus Component Library (LCL)
12
13  See the file COPYING.modifiedLGPL.txt, included in this distribution,
14  for details about the license.
15 *****************************************************************************
16}
17unit Gtk2WSSpin;
18
19{$mode objfpc}{$H+}
20
21interface
22
23uses
24  // RTL
25  glib2, gtk2, SysUtils, Classes, Math,
26  // LCL
27  Controls, LCLType, LCLProc, LMessages, LazUTF8, Spin, StdCtrls,
28  // Widgetset
29  Gtk2Extra, Gtk2Def, Gtk2WSStdCtrls,
30  Gtk2Proc, WSLCLClasses, WSProc, WSSpin;
31
32type
33
34  { TGtk2WSCustomFloatSpinEdit }
35
36  TGtk2WSCustomFloatSpinEdit = class(TWSCustomFloatSpinEdit)
37  protected
38    class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
39  published
40    class function GetSelStart(const ACustomEdit: TCustomEdit): integer; override;
41    class function GetSelLength(const ACustomEdit: TCustomEdit): integer; override;
42    class function GetValue(const ACustomFloatSpinEdit: TCustomFloatSpinEdit): Double; override;
43
44    class procedure SetSelStart(const ACustomEdit: TCustomEdit; NewStart: integer); override;
45    class procedure SetSelLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
46    class procedure SetReadOnly(const ACustomEdit: TCustomEdit; ReadOnly: boolean); override;
47
48    class procedure UpdateControl(const ACustomFloatSpinEdit: TCustomFloatSpinEdit); override;
49    class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
50  end;
51
52implementation
53
54function GetGtkFloatSpinEditable(Spin: PGtkSpinButton): PGtkEntry;
55begin
56  Result:=PGtkEntry(@(Spin^.entry));
57end;
58
59function GetSpinGtkEditable(const Spin: TWinControl): PGtkEntry;
60begin
61  Result:=GetGtkFloatSpinEditable({%H-}PGtkSpinButton(Spin.Handle));
62end;
63
64{ TGtk2WSCustomFloatSpinEdit }
65
66class procedure TGtk2WSCustomFloatSpinEdit.SetCallbacks(
67  const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
68begin
69  TGtk2WSCustomEdit.SetCallbacks(AWidget, AWidgetInfo);
70end;
71
72class function TGtk2WSCustomFloatSpinEdit.GetSelStart(const ACustomEdit: TCustomEdit): integer;
73var
74  Entry: PGtkEntry;
75begin
76  if not WSCheckHandleAllocated(ACustomEdit, 'GetSelStart') then
77    Exit(0);
78  Entry := @{%H-}PGtkSpinButton(ACustomEdit.Handle)^.entry;
79  Result := Min(Entry^.current_pos, Entry^.selection_bound)
80end;
81
82class function TGtk2WSCustomFloatSpinEdit.GetSelLength(const ACustomEdit: TCustomEdit): integer;
83var
84  AStart, AEnd: gint;
85begin
86  Result := 0;
87  if not WSCheckHandleAllocated(ACustomEdit, 'GetSelLength') then
88    Exit;
89  if gtk_editable_get_selection_bounds(PGtkEditable(GetSpinGtkEditable(ACustomEdit)), @AStart, @AEnd) then
90    Result := Abs(AEnd-AStart);
91end;
92
93class function TGtk2WSCustomFloatSpinEdit.GetValue(
94  const ACustomFloatSpinEdit: TCustomFloatSpinEdit): Double;
95var
96  StrValue: String;
97  DecSeparator: Char;
98begin
99  if not WSCheckHandleAllocated(ACustomFloatSpinEdit, 'GetValue') then
100    Exit(0);
101
102  // gtk2 have different meaning of value vs text in GtkSpinBox when
103  // we are dealing with real FloatSpinEdit. #18679.
104  StrValue := StrPas(gtk_entry_get_text({%H-}PGtkEntry(ACustomFloatSpinEdit.Handle)));
105  DecSeparator := DefaultFormatSettings.DecimalSeparator;
106  if DecSeparator <> '.' then
107    StrValue := UTF8StringReplace(StrValue, '.', DecSeparator, [rfReplaceAll]);
108  if DecSeparator <> ',' then
109    StrValue := UTF8StringReplace(StrValue, ',', DecSeparator, [rfReplaceAll]);
110  Result := ACustomFloatSpinEdit.StrToValue(StrValue);
111end;
112
113class procedure TGtk2WSCustomFloatSpinEdit.SetSelStart(const ACustomEdit: TCustomEdit;
114  NewStart: integer);
115begin
116  if not WSCheckHandleAllocated(ACustomEdit, 'SetSelStart') then
117    Exit;
118  gtk_editable_set_position(GetSpinGtkEditable(ACustomEdit), NewStart);
119end;
120
121class procedure TGtk2WSCustomFloatSpinEdit.SetSelLength(const ACustomEdit: TCustomEdit;
122  NewLength: integer);
123var
124  Entry: PGtkEntry;
125  SelStart: Integer;
126begin
127  if not WSCheckHandleAllocated(ACustomEdit, 'SetSelLength') then
128    Exit;
129  Entry := @{%H-}PGtkSpinButton(ACustomEdit.Handle)^.entry;
130  SelStart := GetSelStart(ACustomEdit);
131  gtk_entry_select_region(Entry,
132    SelStart,
133    SelStart + NewLength);
134end;
135
136class procedure TGtk2WSCustomFloatSpinEdit.SetReadOnly(const ACustomEdit: TCustomEdit; ReadOnly: boolean);
137var
138  Widget: PGtkWidget;
139  AnAdjustment: PGtkAdjustment;
140begin
141  if not WSCheckHandleAllocated(ACustomEdit, 'SetReadOnly') then
142    Exit;
143  Widget := {%H-}PGtkWidget(ACustomEdit.Handle);
144  if GTK_IS_EDITABLE(Widget) then
145    gtk_editable_set_editable(PGtkEditable(Widget), not ReadOnly);
146
147  AnAdjustment:=gtk_spin_button_get_adjustment(GTK_SPIN_BUTTON(Widget));
148  if ReadOnly then
149  begin
150    AnAdjustment^.lower := TCustomFloatSpinEdit(ACustomEdit).Value;
151    AnAdjustment^.upper := TCustomFloatSpinEdit(ACustomEdit).Value;
152  end
153  else
154  begin
155    if (TCustomFloatSpinEdit(ACustomEdit).MaxValue > TCustomFloatSpinEdit(ACustomEdit).MinValue) then
156    begin
157      AnAdjustment^.lower := TCustomFloatSpinEdit(ACustomEdit).MinValue;
158      AnAdjustment^.upper := TCustomFloatSpinEdit(ACustomEdit).MaxValue;
159    end
160    else
161    begin
162      AnAdjustment^.lower := -MaxDouble;
163      AnAdjustment^.upper := MaxDouble;
164    end;
165  end;
166
167  LockOnChange(PgtkObject(Widget), +1);
168  try
169    gtk_spin_button_update(GTK_SPIN_BUTTON(Widget));
170  finally
171    LockOnChange(PgtkObject(Widget), -1);
172  end;
173end;
174
175class procedure TGtk2WSCustomFloatSpinEdit.UpdateControl(
176  const ACustomFloatSpinEdit: TCustomFloatSpinEdit);
177var
178  AnAdjustment: PGtkAdjustment;
179  wHandle: HWND;
180  SpinWidget: PGtkSpinButton;
181  AMin, AMax: Double;
182  Mess: TLMessage;
183begin
184  //DebugLn(['TGtkWSCustomFloatSpinEdit.UpdateControl ',dbgsName(ACustomFloatSpinEdit)]);
185  if not WSCheckHandleAllocated(ACustomFloatSpinEdit, 'UpdateControl') then
186    Exit;
187  wHandle := ACustomFloatSpinEdit.Handle;
188  SpinWidget:=GTK_SPIN_BUTTON({%H-}Pointer(wHandle));
189
190  if ACustomFloatSpinEdit.MaxValue > ACustomFloatSpinEdit.MinValue then
191  begin
192    AMin := ACustomFloatSpinEdit.MinValue;
193    AMax := ACustomFloatSpinEdit.MaxValue;
194  end else
195  begin
196    AMin := -MaxDouble;
197    AMax := MaxDouble;
198  end;
199
200  AnAdjustment:=gtk_spin_button_get_adjustment(SpinWidget);
201  if (AnAdjustment^.lower <> AMin)
202  or (AnAdjustment^.upper <> AMax) then
203  begin
204    AnAdjustment^.lower := AMin;
205    AnAdjustment^.upper := AMax;
206    gtk_adjustment_changed(AnAdjustment);
207  end;
208
209  LockOnChange(PgtkObject(SpinWidget), +1);
210  try
211    gtk_spin_button_set_digits(SpinWidget, ACustomFloatSpinEdit.DecimalPlaces);
212    gtk_spin_button_set_value(SpinWidget,ACustomFloatSpinEdit.Value);
213    AnAdjustment^.step_increment := ACustomFloatSpinEdit.Increment;
214  finally
215    LockOnChange(PgtkObject(SpinWidget), -1);
216  end;
217
218  SetReadOnly(TCustomEdit(ACustomFloatSpinEdit), ACustomFloatSpinEdit.ReadOnly);
219
220  FillByte(Mess{%H-},SizeOf(Mess),0);
221  Mess.Msg := CM_TEXTCHANGED;
222  DeliverMessage(ACustomFloatSpinEdit, Mess);
223end;
224
225class function TGtk2WSCustomFloatSpinEdit.CreateHandle(
226  const AWinControl: TWinControl; const AParams: TCreateParams
227  ): TLCLIntfHandle;
228var
229  Adjustment: PGtkAdjustment;
230  Widget: PGtkWidget;
231  WidgetInfo: PWidgetInfo;
232  Entry: PGtkEntry;
233begin
234  Adjustment := PGtkAdjustment(gtk_adjustment_new(1, 1, 100, 1, 0,0));
235  Widget := gtk_spin_button_new(Adjustment, 1, 0);
236  gtk_widget_show_all(Widget);
237
238  {$IFDEF DebugLCLComponents}
239  DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
240  {$ENDIF}
241  Result := TLCLIntfHandle({%H-}PtrUInt(Widget));
242
243  WidgetInfo := CreateWidgetInfo(Widget, AWinControl, AParams);
244  Set_RC_Name(AWinControl, Widget);
245  if not AWinControl.HandleObjectShouldBeVisible and not (csDesigning in AWinControl.ComponentState) then
246    gtk_widget_hide(Widget);
247  SetCallbacks(Widget, WidgetInfo);
248  if Result <> 0 then
249  begin
250    Entry := GTK_ENTRY(Widget);
251    // PGtkEntry(@PGtkSpinButton(Result)^.entry);
252    g_object_set(gtk_widget_get_settings(PGtkWidget(Entry)),
253      'gtk-entry-select-on-focus', [0, nil]);
254  end;
255end;
256
257end.
258