File: spinex.pp

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 214,460 kB
  • sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (382 lines) | stat: -rw-r--r-- 12,624 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
{
 /***************************************************************************
                                  SpinEx.pp
                                 -----------

  Provides a T(Float)SpinEdit like control that allows to have a NullValue and
  a text indicating the control does not have a valid Value whenever the
  control looses focus.

  Initial implementation 2016 by Bart Broersma

 ***************************************************************************/

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}

{ ----------------------------------------------------------------------------

  ++++++++++  Notes for developers  ++++++++++

  1. Why yet another (Float)SpinEdit control?
     (Which problems does it solve?)

  The standard T(Float)SpinEdit does not support a NullValue mechanism.
  Also, it's impelementation is widgetset dependant. While this provides a
  control that, on widgetsets that have a native implementation of such a
  control, has the look and feel as users of this widgetset are acustomed to,
  the downside is that it's behaviour may also depend on the widgetset.
  This is especially the case if the text inside the control becomes invalid
  (empty or otherwise not a number).
  In such a case, when querying the control for it's Value, the results
  are not cross-platform consistent.
  This difference in behaviour across widgetsets also prevents the implementation
  of a NullValue, especially the possibility to leave the control empty
  or display an informative text inside it in such a case.

  SpinEditEx handles Int64 values, whereas TSpinEdit is limited to LongInt values,
  this is because TSpinEdit inherites from TCustomFloatSpinEdit and the internal
  FValue is stored as Double: this has not enough significant digits to handle
  the total range of Int64.

  FloatSpinEditEx can set DecimalSeparator independent of DefaultFormatSettings.DecimalSeparator.

  Note: unlike T(Float)SpinEdit GetValue is always derived from the actual
  text in the control.
  This is by design, and it should not be altered.


  2. Why not simply associate a TUpDown with a TEdit instead?

  This has several disadvantages:
  * It does not allow floating point values
  * It's range is limited to the range of SmallInt
  * It does not properly anchor and align

  So, whilst the new implementation of T(Float)SpinEditEx uses a TUpDown
  control, it does not use it's Associate property.
  The 2 controls (an edit and an updown) are embedded in a TCustomControl
  (like TEditButton is) in order to have proper align- and anchororing behaviour.

  ---------------------------------------------------------------------------- }

unit SpinEx;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Math,
  // LCL
  LCLType, LCLProc, Controls, ClipBrd, ComCtrls, GroupedEdit;


{.$define debugspinex}

type
  { TSpinEditExBase }

  TNullValueBehaviour = (
    //This applies when the Text in the control is not a number.
    //If the Text is a number then it will be bound by Min/MaxValue
    nvbShowTextHint,       // Value becomes NullValue, Text becomes empty, TextHint will show when focus is lost
    nvbLimitedNullValue,   // Value becomes GetLimitedValue(NullValue), Text becomes Value
    nvbMinValue,           // Value becomes MinValue, Text becomes Value  NOTE: Default, since this is how Delphi seems to work
    nvbMaxValue,           // Value becomes MaxValue, Text becomes Value
    nvbInitialValue        // Value becomes InitialValue (OnEnter), Text becomes Value
    );



  { TSpinEditExBase }

  generic TSpinEditExBase<T> = class(TCustomAbstractGroupedEdit)
  private const
    DefIncrement = 1;
    DefMaxValue = 100;
    DefMinRepeatValue = 100;
  private
    FArrowKeys: Boolean;
    FIncrement: T;
    FMaxValue: T;
    FMinValue: T;
    FInitialValue: T;
    FMinRepeatValue: Byte;
    FNullValue: T;
    FNullValueBehaviour: TNullValueBehaviour;
    FValue: T;
    FUpdatePending: Boolean;
    FSettingValue: Boolean;
    function GetEdit: TGEEdit;
    procedure SetMinRepeatValue(AValue: Byte);
    procedure SpinUpDown(Up: Boolean);
    function GetNullValue: T;
    function GetUpDown: TUpDown;
    function GetValue: T;
    function IsLimited: Boolean;
    function IsOutOfLimits(AValue: T): Boolean;
    procedure UpdateControl;
    procedure UpDownChangingEx(Sender: TObject; var {%H-}AllowChange: Boolean;
                               {%H-}NewValue: SmallInt; Direction: TUpDownDirection);
    procedure UpDownClick(Sender: TObject; {%H-}Button: TUDBtnType);
    function IncrementStored: Boolean;
    function MaxValueStored: Boolean;
  protected
    function GetBuddyClassType: TControlClass; override;
    procedure DoEnter; override;
    function RealGetText: TCaption; override;
    procedure Reset; override;
    procedure EditChange; override;
    procedure EditKeyDown(var Key: word; Shift: TShiftState); override;
    procedure EditMouseWheelUp(Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); override;
    procedure EditMouseWheelDown(Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); override;
    function SafeInc(AValue: T): T; virtual; abstract;
    function SafeDec(AValue: T): T; virtual abstract;
    procedure SetValue(const AValue: T); virtual;
    procedure SetNullValue(AValue: T); virtual;
    procedure SetMaxValue(const AValue: T); virtual;
    procedure SetMinValue(const AValue: T); virtual;
    procedure SetIncrement(const AIncrement: T); virtual;
    function TextIsNumber(const S: String; out ANumber: T): Boolean; virtual; abstract;
    procedure InitializeWnd; override;
    procedure FinalizeWnd; override;
    procedure Loaded; override;

    property ArrowKeys: Boolean read FArrowKeys write FArrowKeys default True;
    property Edit: TGEEdit read GetEdit;
    property UpDown: TUpDown read GetUpDown;
    property UpDownVisible: Boolean read GetBuddyVisible write SetBuddyVisible default True;
    property MinRepeatValue: Byte read FMinRepeatValue write SetMinRepeatValue default DefMinRepeatValue;
  public
    constructor Create(TheOwner: TComponent); override;
    function GetLimitedValue(const AValue: T): T; virtual;
    function ValueToStr(const AValue: T): String; virtual; abstract;
    function StrToValue(const S: String): T; virtual; abstract;
    procedure EditEditingDone; override;
  public
    property Increment: T read FIncrement write SetIncrement stored IncrementStored nodefault;
    property MinValue: T read FMinValue write SetMinValue;
    property MaxValue: T read FMaxValue write SetMaxValue stored MaxValueStored nodefault;
    property NullValue: T read GetNullValue write SetNullValue;
    property NullValueBehaviour: TNullValueBehaviour read FNullValueBehaviour write FNullValueBehaviour default nvbMinValue;
    property Value: T read GetValue write SetValue;
  end;

  { TCustomFloatSpinEditEx }

  TCustomFloatSpinEditEx = class(specialize TSpinEditExBase<Double>)
  private const
    DefDecimals = 2;
    DefDecimalSeparator = '.';
  private
    FDecimals: Integer;
    FFS: TFormatSettings;
    function GetDecimalSeparator: Char;
    procedure SetDecimalSeparator(AValue: Char);
  protected
    procedure EditKeyPress(var Key: char); override;
    function TextIsNumber(const S: String; out ANumber: Double): Boolean; override;
    function SafeInc(AValue: Double): Double; override;
    function SafeDec(AValue: Double): Double; override;
    procedure SetDecimals(ADecimals: Integer); virtual;
  public
    function ValueToStr(const AValue: Double): String; override;
    function StrToValue(const S: String): Double; override;
    constructor Create(TheOwner: TComponent); override;
    property DecimalSeparator: Char read GetDecimalSeparator write SetDecimalSeparator default DefDecimalSeparator;
    property DecimalPlaces: Integer read FDecimals write SetDecimals default DefDecimals;
  end;


  { TFloatSpinEdit }

  TFloatSpinEditEx = class(TCustomFloatSpinEditEx)
  public
    property AutoSelected;
  published
    //From TCustomEdit
    property AutoSelect;
    property AutoSizeHeightIsEditHeight;
    property AutoSize default True;
    property Action;
    property Align;
    property Alignment default taRightJustify;
    property Anchors;
    property BiDiMode;
    property BorderSpacing;
    property BorderStyle default bsNone;
    property CharCase;
    property Color;
    property Constraints;
    property Cursor;
    property DirectInput;
    property EchoMode;
    property Enabled;
    property FocusOnBuddyClick;
    property Font;
    property Hint;
    property Layout;
    property MaxLength;
    property NumbersOnly;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property TextHint;
    property Visible;

    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnContextPopup;
    property OnEditingDone;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnStartDrag;
    property OnUTF8KeyPress;

    //From TCustomFloatSpinEditEx
    property ArrowKeys;
    property DecimalSeparator;
    property DecimalPlaces;
    property Increment;
    property MaxValue;
    property MinValue;
    property MinRepeatValue;
    property NullValue;
    property NullValueBehaviour;
    property Spacing;
    property UpDownVisible;
    property Value;
  end;


  { TCustomSpinEditEx }

  TCustomSpinEditEx = class(specialize TSpinEditExBase<Int64>)
  protected
    procedure EditKeyPress(var Key: char); override;
    function SafeInc(AValue: Int64): Int64; override;
    function SafeDec(AValue: Int64): Int64; override;
    function TextIsNumber(const S: String; out ANumber: Int64): Boolean; override;
  public
    function ValueToStr(const AValue: Int64): String; override;
    function StrToValue(const S: String): Int64; override;
  public
    property Increment default 1;
  end;


  { TSpinEdit }

  TSpinEditEx = class(TCustomSpinEditEx)
  public
    property AutoSelected;
  published
    //From TCustomEdit
    property AutoSelect;
    property AutoSizeHeightIsEditHeight;
    property AutoSize default True;
    property Action;
    property Align;
    property Alignment default taRightJustify;
    property Anchors;
    property BiDiMode;
    property BorderSpacing;
    property BorderStyle default bsNone;
    property CharCase;
    property Color;
    property Constraints;
    property Cursor;
    property DirectInput;
    property EchoMode;
    property Enabled;
    property FocusOnBuddyClick;
    property Font;
    property Hint;
    property Layout;
    property MaxLength;
    property NumbersOnly;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property TextHint;
    property Visible;

    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnContextPopup;
    property OnEditingDone;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnStartDrag;
    property OnUTF8KeyPress;

    //From TCustomFloatSpinEditEx
    property ArrowKeys;
    property Increment;
    property MaxValue;
    property MinValue;
    property MinRepeatValue;
    property NullValue;
    property NullValueBehaviour;
    property Spacing;
    property UpDownVisible;
    property Value;
  end;

function DbgS(ANvb: TNullValueBehaviour): String; overload;


implementation

{$I spinex.inc}

end.