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

« back to all changes in this revision

Viewing changes to lcl/customdrawncontrols.pas

  • 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
[ 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:
 
1
{
 
2
  Copyright (C) 2011 Felipe Monteiro de Carvalho
 
3
 
 
4
  License: The same modifying LGPL with static linking exception as the LCL
 
5
 
 
6
  This unit should be a repository for various custom drawn components,
 
7
  such as a custom drawn version of TButton, of TEdit, of TPageControl, etc,
 
8
  eventually forming a full set of custom drawn components.
 
9
}
 
10
unit customdrawncontrols;
 
11
 
 
12
{$mode objfpc}{$H+}
 
13
 
 
14
{$if defined(Windows)} // LCL defines like LCLWin32 don't reach the LCL
 
15
  {$define CDControlsDoDoubleBuffer}
 
16
{$endif}
 
17
 
 
18
interface
 
19
 
 
20
uses
 
21
  // FPC
 
22
  Classes, SysUtils, contnrs, Math, types,
 
23
  // LazUtils
 
24
  lazutf8,
 
25
  // LCL -> Use only TForm, TWinControl, TCanvas, TLazIntfImage
 
26
  Graphics, Controls, LCLType, LCLIntf, LCLMessageGlue,
 
27
  LMessages, Messages, LCLProc, Forms,
 
28
  // Other LCL units are only for types
 
29
  StdCtrls, ExtCtrls, ComCtrls,
 
30
  //
 
31
  customdrawndrawers;
 
32
 
 
33
type
 
34
  { TCDControl }
 
35
 
 
36
  TCDControl = class(TCustomControl)
 
37
  protected
 
38
    FDrawStyle: TCDDrawStyle;
 
39
    FDrawer: TCDDrawer;
 
40
    FState: TCDControlState;
 
41
    FStateEx: TCDControlStateEx;
 
42
    procedure CalculatePreferredSize(var PreferredWidth,
 
43
      PreferredHeight: integer; WithThemeSpace: Boolean); override;
 
44
    procedure SetState(const AValue: TCDControlState); virtual;
 
45
    procedure PrepareCurrentDrawer(); virtual;
 
46
    procedure SetDrawStyle(const AValue: TCDDrawStyle); virtual;
 
47
    function GetClientRect: TRect; override;
 
48
    function GetControlId: TCDControlID; virtual;
 
49
    procedure CreateControlStateEx; virtual;
 
50
    procedure PrepareControlState; virtual;
 
51
    procedure PrepareControlStateEx; virtual;
 
52
    // keyboard
 
53
    procedure DoEnter; override;
 
54
    procedure DoExit; override;
 
55
    // mouse
 
56
    procedure MouseEnter; override;
 
57
    procedure MouseLeave; override;
 
58
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
 
59
      X, Y: integer); override;
 
60
    //
 
61
    property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle;
 
62
  public
 
63
    constructor Create(AOwner: TComponent); override;
 
64
    destructor Destroy; override;
 
65
    procedure LCLWSCalculatePreferredSize(var PreferredWidth,
 
66
      PreferredHeight: integer; WithThemeSpace, AAutoSize: Boolean);
 
67
    procedure EraseBackground(DC: HDC); override;
 
68
    procedure Paint; override;
 
69
    // Methods for use by LCL-CustomDrawn
 
70
    procedure DrawToCanvas(ACanvas: TCanvas);
 
71
  end;
 
72
  TCDControlClass = class of TCDControl;
 
73
 
 
74
  TCDScrollBar = class;
 
75
 
 
76
  { TCDScrollableControl }
 
77
 
 
78
  TCDScrollableControl = class(TCDControl)
 
79
  private
 
80
    FRightScrollBar, FBottomScrollBar: TCDScrollBar;
 
81
    FSpacer: TCDControl;
 
82
    FScrollBars: TScrollStyle;
 
83
    procedure SetScrollBars(AValue: TScrollStyle);
 
84
  public
 
85
    constructor Create(AOwner: TComponent); override;
 
86
    destructor Destroy; override;
 
87
    property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars;
 
88
  end;
 
89
 
 
90
  // ===================================
 
91
  // Standard Tab
 
92
  // ===================================
 
93
 
 
94
  { TCDButtonControl }
 
95
 
 
96
  TCDButtonControl = class(TCDControl)
 
97
  protected
 
98
    // This fields are set by descendents
 
99
    FHasOnOffStates: Boolean;
 
100
    FIsGrouped: Boolean;
 
101
    FGroupIndex: Integer;
 
102
    FAllowGrayed: Boolean;
 
103
    // keyboard
 
104
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
 
105
    procedure KeyUp(var Key: word; Shift: TShiftState); override;
 
106
    // mouse
 
107
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
 
108
      X, Y: integer); override;
 
109
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
 
110
    procedure MouseEnter; override;
 
111
    procedure MouseLeave; override;
 
112
    // button state change
 
113
    procedure DoUncheckButton(); virtual;
 
114
    procedure DoCheckIfFirstButtonInGroup();
 
115
    procedure DoButtonDown(); virtual;
 
116
    procedure DoButtonUp(); virtual;
 
117
    procedure RealSetText(const Value: TCaption); override;
 
118
    function GetChecked: Boolean;
 
119
    procedure SetChecked(AValue: Boolean);
 
120
    function GetCheckedState: TCheckBoxState;
 
121
    procedure SetCheckedState(AValue: TCheckBoxState);
 
122
    // properties
 
123
    property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False;
 
124
    property Checked: Boolean read GetChecked write SetChecked default False;
 
125
    //property Down: Boolean read GetDown write SetDown;
 
126
    property State: TCheckBoxState read GetCheckedState write SetCheckedState default cbUnchecked;
 
127
  public
 
128
  end;
 
129
 
 
130
  { TCDButton }
 
131
 
 
132
  TCDButton = class(TCDButtonControl)
 
133
  private
 
134
    FGlyph: TBitmap;
 
135
    procedure SetGlyph(AValue: TBitmap);
 
136
  protected
 
137
    FBState: TCDButtonStateEx;
 
138
    function GetControlId: TCDControlID; override;
 
139
    procedure CreateControlStateEx; override;
 
140
    procedure PrepareControlStateEx; override;
 
141
  public
 
142
    constructor Create(AOwner: TComponent); override;
 
143
    destructor Destroy; override;
 
144
  published
 
145
    property Action;
 
146
    property Align;
 
147
    property Anchors;
 
148
    property AutoSize;
 
149
    property Caption;
 
150
    property Color;
 
151
    property Constraints;
 
152
    property DrawStyle;
 
153
    property Enabled;
 
154
    property Font;
 
155
    property Glyph: TBitmap read FGlyph write SetGlyph;
 
156
//    property IsToggleBox: Boolean read FGlyph write SetGlyph;
 
157
    property OnChangeBounds;
 
158
    property OnClick;
 
159
    property OnContextPopup;
 
160
    property OnDragDrop;
 
161
    property OnDragOver;
 
162
    property OnEndDrag;
 
163
    property OnEnter;
 
164
    property OnExit;
 
165
    property OnKeyDown;
 
166
    property OnKeyPress;
 
167
    property OnKeyUp;
 
168
    property OnMouseDown;
 
169
    property OnMouseEnter;
 
170
    property OnMouseLeave;
 
171
    property OnMouseMove;
 
172
    property OnMouseUp;
 
173
    property OnResize;
 
174
    property OnStartDrag;
 
175
    property OnUTF8KeyPress;
 
176
    property ParentFont;
 
177
    property ParentShowHint;
 
178
    property PopupMenu;
 
179
    property ShowHint;
 
180
    property TabOrder;
 
181
    property TabStop;
 
182
    property Visible;
 
183
  end;
 
184
 
 
185
  { TCDEdit }
 
186
 
 
187
  TCDEdit = class(TCDControl)
 
188
  private
 
189
    DragDropStarted: boolean;
 
190
    FCaretTimer: TTimer;
 
191
    FOnChange: TNotifyEvent;
 
192
    function GetLeftTextMargin: Integer;
 
193
    function GetRightTextMargin: Integer;
 
194
    procedure HandleCaretTimer(Sender: TObject);
 
195
    procedure DoDeleteSelection;
 
196
    procedure DoClearSelection;
 
197
    procedure DoManageVisibleTextStart;
 
198
    function GetText: string;
 
199
    procedure SetLeftTextMargin(AValue: Integer);
 
200
    procedure SetRightTextMargin(AValue: Integer);
 
201
    procedure SetText(AValue: string);
 
202
    function MousePosToCaretPos(X, Y: Integer): TPoint;
 
203
    function IsSomethingSelected: Boolean;
 
204
  protected
 
205
    FEditState: TCDEditStateEx; // Points to the same object as FStateEx, so don't Free!
 
206
    function GetControlId: TCDControlID; override;
 
207
    procedure CreateControlStateEx; override;
 
208
    // for descendents to override
 
209
    procedure DoChange; virtual;
 
210
    // keyboard
 
211
    procedure DoEnter; override;
 
212
    procedure DoExit; override;
 
213
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
 
214
    procedure KeyUp(var Key: word; Shift: TShiftState); override;
 
215
    procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
 
216
    // mouse
 
217
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
 
218
      X, Y: integer); override;
 
219
    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
 
220
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
 
221
    procedure MouseEnter; override;
 
222
    procedure MouseLeave; override;
 
223
  public
 
224
    constructor Create(AOwner: TComponent); override;
 
225
    destructor Destroy; override;
 
226
    property LeftTextMargin: Integer read GetLeftTextMargin write SetLeftTextMargin;
 
227
    property RightTextMargin: Integer read GetRightTextMargin write SetRightTextMargin;
 
228
  published
 
229
    property Align;
 
230
    property Anchors;
 
231
    property AutoSize;
 
232
    property Color;
 
233
    property DrawStyle;
 
234
    property Enabled;
 
235
    property TabStop default True;
 
236
    property Text: string read GetText write SetText;
 
237
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
 
238
  end;
 
239
 
 
240
  { TCDCheckBox }
 
241
 
 
242
  TCDCheckBox = class(TCDButtonControl)
 
243
  protected
 
244
    function GetControlId: TCDControlID; override;
 
245
  public
 
246
    constructor Create(AOwner: TComponent); override;
 
247
    destructor Destroy; override;
 
248
  published
 
249
    property AllowGrayed default False;
 
250
    property Checked;
 
251
    property DrawStyle;
 
252
    property Caption;
 
253
    property Enabled;
 
254
    property TabStop default True;
 
255
    property State;
 
256
  end;
 
257
 
 
258
  { TCDRadioButton }
 
259
 
 
260
  TCDRadioButton = class(TCDButtonControl)
 
261
  protected
 
262
    function GetControlId: TCDControlID; override;
 
263
  public
 
264
    constructor Create(AOwner: TComponent); override;
 
265
    destructor Destroy; override;
 
266
  published
 
267
    property Caption;
 
268
    property Checked;
 
269
    property DrawStyle;
 
270
    property Enabled;
 
271
    property TabStop default True;
 
272
  end;
 
273
 
 
274
  TKeyboardInputBehavior = (kibAutomatic, kibRequires, kibDoesntRequire);
 
275
 
 
276
  { TCDComboBox }
 
277
 
 
278
  TCDComboBox = class(TCDEdit)
 
279
  private
 
280
    FIsClickingButton: Boolean;
 
281
    FItemIndex: Integer;
 
282
    FItems: TStringList;
 
283
    FKeyboardInputBehavior: TKeyboardInputBehavior;
 
284
    function GetItems: TStrings;
 
285
    procedure OnShowSelectItemDialogResult(ASelectedItem: Integer);
 
286
    procedure SetItemIndex(AValue: Integer);
 
287
    procedure SetKeyboardInputBehavior(AValue: TKeyboardInputBehavior);
 
288
  protected
 
289
    function GetControlId: TCDControlID; override;
 
290
    // mouse
 
291
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
 
292
      X, Y: integer); override;
 
293
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
 
294
  public
 
295
    constructor Create(AOwner: TComponent); override;
 
296
    destructor Destroy; override;
 
297
  published
 
298
    property Items: TStrings read GetItems;
 
299
    property ItemIndex: Integer read FItemIndex write SetItemIndex;
 
300
    // This allows controlling the virtual keyboard behavior, mostly for Android
 
301
    property KeyboardInputBehavior: TKeyboardInputBehavior read FKeyboardInputBehavior write SetKeyboardInputBehavior;
 
302
  end;
 
303
 
 
304
  { TCDPositionedControl }
 
305
 
 
306
  TCDPositionedControl = class(TCDControl)
 
307
  private
 
308
    DragDropStarted: boolean;
 
309
    FLastMouseDownPos: TPoint;
 
310
    FPositionAtMouseDown: Integer;
 
311
    FButton: TCDControlState; // the button currently being clicked
 
312
    FBtnClickTimer: TTimer;
 
313
    // fields
 
314
    FMax: Integer;
 
315
    FMin: Integer;
 
316
    FOnChange, FOnChangeByUser: TNotifyEvent;
 
317
    FPageSize: Integer;
 
318
    FPosition: Integer;
 
319
    procedure SetMax(AValue: Integer);
 
320
    procedure SetMin(AValue: Integer);
 
321
    procedure SetPageSize(AValue: Integer);
 
322
    procedure SetPosition(AValue: Integer);
 
323
    procedure DoClickButton(AButton: TCDControlState; ALargeChange: Boolean);
 
324
    procedure HandleBtnClickTimer(ASender: TObject);
 
325
  protected
 
326
    FSmallChange, FLargeChange: Integer;
 
327
    FPCState: TCDPositionedCStateEx;
 
328
    // One can either move by dragging the slider
 
329
    // or by putting the slider where the mouse is
 
330
    FMoveByDragging: Boolean;
 
331
    function GetPositionFromMousePosWithMargins(X, Y, ALeftMargin, ARightMargin: Integer;
 
332
       AIsHorizontal, AAcceptMouseOutsideStrictArea: Boolean): integer;
 
333
    function GetPositionFromMousePos(X, Y: Integer): integer; virtual; abstract;
 
334
    function GetPositionDisplacementWithMargins(AOldMousePos, ANewMousePos: TPoint;
 
335
      ALeftMargin, ARightMargin: Integer; AIsHorizontal: Boolean): Integer;
 
336
    function GetPositionDisplacement(AOldMousePos, ANewMousePos: TPoint): Integer; virtual; abstract;
 
337
    function GetButtonFromMousePos(X, Y: Integer): TCDControlState; virtual;
 
338
    procedure CreateControlStateEx; override;
 
339
    procedure PrepareControlStateEx; override;
 
340
    // keyboard
 
341
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
 
342
    // mouse
 
343
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
 
344
      X, Y: integer); override;
 
345
    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
 
346
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
 
347
    //
 
348
    property PageSize: Integer read FPageSize write SetPageSize;
 
349
  public
 
350
    constructor Create(AOwner: TComponent); override;
 
351
    destructor Destroy; override;
 
352
  published
 
353
    property Max: Integer read FMax write SetMax;
 
354
    property Min: Integer read FMin write SetMin;
 
355
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
 
356
    property OnChangeByUser: TNotifyEvent read FOnChangeByUser write FOnChangeByUser;
 
357
    property Position: Integer read FPosition write SetPosition;
 
358
  end;
 
359
 
 
360
  { TCDScrollBar }
 
361
 
 
362
  TCDScrollBar = class(TCDPositionedControl)
 
363
  private
 
364
    FKind: TScrollBarKind;
 
365
    procedure SetKind(AValue: TScrollBarKind);
 
366
  protected
 
367
    function GetPositionFromMousePos(X, Y: Integer): integer; override;
 
368
    function GetButtonFromMousePos(X, Y: Integer): TCDControlState; override;
 
369
    function GetPositionDisplacement(AOldMousePos, ANewMousePos: TPoint): Integer; override;
 
370
    function GetControlId: TCDControlID; override;
 
371
    procedure PrepareControlState; override;
 
372
  public
 
373
    constructor Create(AOwner: TComponent); override;
 
374
    destructor Destroy; override;
 
375
  published
 
376
    property DrawStyle;
 
377
    property Enabled;
 
378
    property Kind: TScrollBarKind read FKind write SetKind;
 
379
    property PageSize;
 
380
    property TabStop default True;
 
381
  end;
 
382
 
 
383
  {@@
 
384
    TCDGroupBox is a custom-drawn group box control
 
385
  }
 
386
 
 
387
  { TCDGroupBox }
 
388
 
 
389
  TCDGroupBox = class(TCDControl)
 
390
  private
 
391
    function GetControlId: TCDControlID; override;
 
392
  protected
 
393
    procedure RealSetText(const Value: TCaption); override; // to update on caption changes
 
394
  public
 
395
    constructor Create(AOwner: TComponent); override;
 
396
    destructor Destroy; override;
 
397
  published
 
398
    property AutoSize;
 
399
    property Caption;
 
400
    property DrawStyle;
 
401
    property Enabled;
 
402
    property TabStop default False;
 
403
  end;
 
404
 
 
405
  { TCDPanel }
 
406
 
 
407
  TCDPanel = class(TCDControl)
 
408
  private
 
409
    FBevelInner: TPanelBevel;
 
410
    FBevelOuter: TPanelBevel;
 
411
    FBevelWidth: TBevelWidth;
 
412
    procedure SetBevelInner(AValue: TPanelBevel);
 
413
    procedure SetBevelOuter(AValue: TPanelBevel);
 
414
    procedure SetBevelWidth(AValue: TBevelWidth);
 
415
  protected
 
416
    FPState: TCDPanelStateEx;
 
417
    function GetControlId: TCDControlID; override;
 
418
    procedure CreateControlStateEx; override;
 
419
    procedure PrepareControlStateEx; override;
 
420
    procedure RealSetText(const Value: TCaption); override; // to update on caption changes
 
421
  public
 
422
    constructor Create(AOwner: TComponent); override;
 
423
    destructor Destroy; override;
 
424
  published
 
425
    //property AutoSize;
 
426
    property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone;
 
427
    property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvRaised;
 
428
    property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1;
 
429
    property Caption;
 
430
    property DrawStyle;
 
431
    property Enabled;
 
432
    property TabStop default False;
 
433
  end;
 
434
 
 
435
  // ===================================
 
436
  // Additional Tab
 
437
  // ===================================
 
438
 
 
439
  { TCDStaticText }
 
440
 
 
441
  TCDStaticText = class(TCDControl)
 
442
  private
 
443
    function GetControlId: TCDControlID; override;
 
444
  protected
 
445
    procedure RealSetText(const Value: TCaption); override; // to update on caption changes
 
446
  public
 
447
    constructor Create(AOwner: TComponent); override;
 
448
    destructor Destroy; override;
 
449
  published
 
450
    property Caption;
 
451
    property DrawStyle;
 
452
    property Enabled;
 
453
    property TabStop default False;
 
454
  end;
 
455
 
 
456
  // ===================================
 
457
  // Common Controls Tab
 
458
  // ===================================
 
459
 
 
460
  {@@
 
461
    TCDTrackBar is a custom-drawn trackbar control
 
462
  }
 
463
 
 
464
  { TCDTrackBar }
 
465
 
 
466
  TCDTrackBar = class(TCDPositionedControl)
 
467
  private
 
468
    FOrientation: TTrackBarOrientation;
 
469
    procedure SetOrientation(AValue: TTrackBarOrientation);
 
470
  protected
 
471
    function GetPositionFromMousePos(X, Y: Integer): integer; override;
 
472
    function GetPositionDisplacement(AOldMousePos, ANewMousePos: TPoint): Integer; override;
 
473
    function GetControlId: TCDControlID; override;
 
474
    procedure PrepareControlState; override;
 
475
  public
 
476
    constructor Create(AOwner: TComponent); override;
 
477
    destructor Destroy; override;
 
478
    //procedure Paint; override;
 
479
  published
 
480
    property Align;
 
481
    property Color;
 
482
    property DrawStyle;
 
483
    property Enabled;
 
484
    property Orientation: TTrackBarOrientation read FOrientation write SetOrientation default trHorizontal;
 
485
    property TabStop default True;
 
486
  end;
 
487
 
 
488
  { TCDProgressBar }
 
489
 
 
490
  TCDProgressBar = class(TCDControl)
 
491
  private
 
492
    DragDropStarted: boolean;
 
493
    FBarShowText: Boolean;
 
494
    // fields
 
495
    FMin: integer;
 
496
    FMax: integer;
 
497
    FOrientation: TProgressBarOrientation;
 
498
    FPosition: integer;
 
499
    FOnChange: TNotifyEvent;
 
500
    FSmooth: Boolean;
 
501
    FStyle: TProgressBarStyle;
 
502
    procedure SetBarShowText(AValue: Boolean);
 
503
    procedure SetMax(AValue: integer);
 
504
    procedure SetMin(AValue: integer);
 
505
    procedure SetOrientation(AValue: TProgressBarOrientation);
 
506
    procedure SetPosition(AValue: integer);
 
507
    procedure SetSmooth(AValue: Boolean);
 
508
    procedure SetStyle(AValue: TProgressBarStyle);
 
509
  protected
 
510
    FPBState: TCDProgressBarStateEx;
 
511
    function GetControlId: TCDControlID; override;
 
512
    procedure CreateControlStateEx; override;
 
513
    procedure PrepareControlStateEx; override;
 
514
  public
 
515
    constructor Create(AOwner: TComponent); override;
 
516
    destructor Destroy; override;
 
517
  published
 
518
    property BarShowText: Boolean read FBarShowText write SetBarShowText;
 
519
    property Color;
 
520
    property DrawStyle;
 
521
    property Enabled;
 
522
    property Max: integer read FMax write SetMax default 10;
 
523
    property Min: integer read FMin write SetMin default 0;
 
524
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
 
525
    property Orientation: TProgressBarOrientation read FOrientation write SetOrientation;// default prHorizontal;
 
526
    property Position: integer read FPosition write SetPosition;
 
527
    property Smooth: Boolean read FSmooth write SetSmooth;
 
528
    property Style: TProgressBarStyle read FStyle write SetStyle;
 
529
  end;
 
530
 
 
531
  { TCDListView }
 
532
 
 
533
  TCDListView = class(TCDScrollableControl)
 
534
  private
 
535
    DragDropStarted: boolean;
 
536
    // fields
 
537
    FColumns: TListColumns;
 
538
    FIconOptions: TIconOptions;
 
539
    FListItems: TCDListItems;
 
540
    FProperties: TListViewProperties;
 
541
    FShowColumnHeader: Boolean;
 
542
    FViewStyle: TViewStyle;
 
543
    function GetProperty(AIndex: Integer): Boolean;
 
544
    procedure SetColumns(AValue: TListColumns);
 
545
    procedure SetProperty(AIndex: Integer; AValue: Boolean);
 
546
    procedure SetShowColumnHeader(AValue: Boolean);
 
547
    procedure SetViewStyle(AValue: TViewStyle);
 
548
  protected
 
549
{    // keyboard
 
550
    procedure DoEnter; override;
 
551
    procedure DoExit; override;
 
552
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
 
553
    procedure KeyUp(var Key: word; Shift: TShiftState); override;
 
554
    // mouse
 
555
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
 
556
      X, Y: integer); override;
 
557
    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
 
558
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
 
559
    procedure MouseEnter; override;
 
560
    procedure MouseLeave; override;}
 
561
  protected
 
562
    FLVState: TCDListViewStateEx;
 
563
    function GetControlId: TCDControlID; override;
 
564
    procedure CreateControlStateEx; override;
 
565
    procedure PrepareControlStateEx; override;
 
566
  public
 
567
    constructor Create(AOwner: TComponent); override;
 
568
    destructor Destroy; override;
 
569
  published
 
570
    property Color;
 
571
    property TabStop default True;
 
572
    property Columns: TListColumns read FColumns write SetColumns;
 
573
    property Enabled;
 
574
    //property GridLines: Boolean index Ord(lvpGridLines) read GetProperty write SetProperty default False;
 
575
    property Items: TCDListItems read FListItems;
 
576
    property ScrollBars;
 
577
    property ShowColumnHeader: Boolean read FShowColumnHeader write SetShowColumnHeader default True;
 
578
    property ViewStyle: TViewStyle read FViewStyle write SetViewStyle default vsList;
 
579
  end;
 
580
 
 
581
  { TCDTabControl }
 
582
 
 
583
  { TCDCustomTabControl }
 
584
 
 
585
  TCDCustomTabControl = class;
 
586
 
 
587
  { TCDTabSheet }
 
588
 
 
589
  TCDTabSheet = class(TCustomControl)
 
590
  private
 
591
    CDTabControl: TCDCustomTabControl;
 
592
    FTabVisible: Boolean;
 
593
  protected
 
594
    procedure RealSetText(const Value: TCaption); override; // to update on caption changes
 
595
    procedure SetParent(NewParent: TWinControl); override; // For being created by the LCL resource reader
 
596
  public
 
597
    constructor Create(AOwner: TComponent); override;
 
598
    destructor Destroy; override;
 
599
    procedure EraseBackground(DC: HDC); override;
 
600
    procedure Paint; override;
 
601
  published
 
602
    property Caption;
 
603
    property Color;
 
604
    property Font;
 
605
    property TabVisible: Boolean read FTabVisible write FTabVisible;
 
606
  end;
 
607
 
 
608
  // If the sender is a TCDPageControl, APage will contain the page,
 
609
  // but if it is a TCDTabControl APage will be nil
 
610
  TOnUserAddedPage = procedure (Sender: TObject; APage: TCDTabSheet) of object;
 
611
 
 
612
  TCDCustomTabControl = class(TCDControl)
 
613
  private
 
614
    FOnUserAddedPage: TOnUserAddedPage;
 
615
    FTabIndex: Integer;
 
616
    FTabs: TStringList;
 
617
    FOnChanging: TNotifyEvent;
 
618
    FOnChange: TNotifyEvent;
 
619
    FOptions: TCTabControlOptions;
 
620
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
 
621
    //procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
 
622
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
 
623
    procedure SetOptions(AValue: TCTabControlOptions);
 
624
    //procedure MouseEnter; override;
 
625
    //procedure MouseLeave; override;
 
626
    procedure SetTabIndex(AValue: Integer); virtual;
 
627
    procedure SetTabs(AValue: TStringList);
 
628
    function MousePosToTabIndex(X, Y: Integer): Integer;
 
629
  protected
 
630
    FTabCState: TCDCTabControlStateEx;
 
631
    function GetControlId: TCDControlID; override;
 
632
    procedure CreateControlStateEx; override;
 
633
    procedure PrepareControlStateEx; override;
 
634
    procedure CorrectTabIndex();
 
635
    property Options: TCTabControlOptions read FOptions write SetOptions;
 
636
  public
 
637
    constructor Create(AOwner: TComponent); override;
 
638
    destructor Destroy; override;
 
639
    function GetTabCount: Integer;
 
640
    property Tabs: TStringList read FTabs write SetTabs;
 
641
    property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
 
642
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
 
643
    property OnUserAddedPage: TOnUserAddedPage read FOnUserAddedPage write FOnUserAddedPage;
 
644
    property TabIndex: integer read FTabIndex write SetTabIndex;
 
645
  end;
 
646
 
 
647
//  TTabSelectedEvent = procedure(Sender: TObject; ATab: TTabItem;
 
648
//    ASelected: boolean) of object;
 
649
 
 
650
  TCDTabControl = class(TCDCustomTabControl)
 
651
  published
 
652
    property Color;
 
653
    property Enabled;
 
654
    property Font;
 
655
    property Tabs;
 
656
    property TabIndex;
 
657
    property OnChanging;
 
658
    property OnChange;
 
659
    property OnUserAddedPage;
 
660
  end;
 
661
 
 
662
  { TCDPageControl }
 
663
 
 
664
  TCDPageControl = class(TCDCustomTabControl)
 
665
  private
 
666
    function GetActivePage: TCDTabSheet;
 
667
    function GetPageCount: integer;
 
668
    function GetPageIndex: integer;
 
669
    procedure SetActivePage(Value: TCDTabSheet);
 
670
    procedure SetPageIndex(Value: integer);
 
671
    procedure UpdateAllDesignerFlags;
 
672
    procedure UpdateDesignerFlags(APageIndex: integer);
 
673
    procedure PositionTabSheet(ATabSheet: TCDTabSheet);
 
674
  public
 
675
    constructor Create(AOwner: TComponent); override;
 
676
    destructor Destroy; override;
 
677
    function InsertPage(aIndex: integer; S: string): TCDTabSheet;
 
678
    procedure RemovePage(aIndex: integer);
 
679
    function AddPage(S: string): TCDTabSheet; overload;
 
680
    procedure AddPage(APage: TCDTabSheet); overload;
 
681
    function GetPage(aIndex: integer): TCDTabSheet;
 
682
    property PageCount: integer read GetPageCount;
 
683
    // Used by the property editor in customdrawnextras
 
684
    function FindNextPage(CurPage: TCDTabSheet;
 
685
      GoForward, CheckTabVisible: boolean): TCDTabSheet;
 
686
    procedure SelectNextPage(GoForward: boolean; CheckTabVisible: boolean = True);
 
687
  published
 
688
    property Align;
 
689
    property ActivePage: TCDTabSheet read GetActivePage write SetActivePage;
 
690
    property DrawStyle;
 
691
    property Caption;
 
692
    property Color;
 
693
    property Enabled;
 
694
    property Font;
 
695
    property PageIndex: integer read GetPageIndex write SetPageIndex;
 
696
    property Options;
 
697
    property ParentColor;
 
698
    property ParentFont;
 
699
    property TabStop default True;
 
700
    property TabIndex;
 
701
    property OnChanging;
 
702
    property OnChange;
 
703
    property OnUserAddedPage;
 
704
  end;
 
705
 
 
706
  // ===================================
 
707
  // Misc Tab
 
708
  // ===================================
 
709
 
 
710
  { TCDSpinEdit }
 
711
 
 
712
  TCDSpinEdit = class(TCDEdit)
 
713
  private
 
714
    FDecimalPlaces: Byte;
 
715
    FIncrement: Double;
 
716
    FMaxValue: Double;
 
717
    FMinValue: Double;
 
718
    FValue: Double;
 
719
    FUpDown: TUpDown;
 
720
    procedure SetDecimalPlaces(AValue: Byte);
 
721
    procedure SetIncrement(AValue: Double);
 
722
    procedure SetMaxValue(AValue: Double);
 
723
    procedure SetMinValue(AValue: Double);
 
724
    procedure UpDownChanging(Sender: TObject; var AllowChange: Boolean);
 
725
    procedure SetValue(AValue: Double);
 
726
    procedure DoUpdateText;
 
727
    procedure DoUpdateUpDown;
 
728
  protected
 
729
    procedure DoChange; override;
 
730
  public
 
731
    constructor Create(AOwner: TComponent); override;
 
732
    destructor Destroy; override;
 
733
  published
 
734
    property DecimalPlaces: Byte read FDecimalPlaces write SetDecimalPlaces default 0;
 
735
    property Increment: Double read FIncrement write SetIncrement;
 
736
    property MinValue: Double read FMinValue write SetMinValue;
 
737
    property MaxValue: Double read FMaxValue write SetMaxValue;
 
738
    property Value: Double read FValue write SetValue;
 
739
  end;
 
740
 
 
741
implementation
 
742
 
 
743
const
 
744
  sTABSHEET_DEFAULT_NAME = 'CTabSheet';
 
745
 
 
746
{ TCDControl }
 
747
 
 
748
procedure TCDControl.CalculatePreferredSize(var PreferredWidth,
 
749
  PreferredHeight: integer; WithThemeSpace: Boolean);
 
750
begin
 
751
  PrepareControlState;
 
752
  PrepareControlStateEx;
 
753
  FDrawer.CalculatePreferredSize(Canvas, GetControlId(), FState, FStateEx,
 
754
    PreferredWidth, PreferredHeight, WithThemeSpace);
 
755
end;
 
756
 
 
757
procedure TCDControl.SetState(const AValue: TCDControlState);
 
758
begin
 
759
  if AValue <> FState then
 
760
  begin
 
761
    FState := AValue;
 
762
    Invalidate;
 
763
  end;
 
764
end;
 
765
 
 
766
procedure TCDControl.PrepareCurrentDrawer;
 
767
var
 
768
  OldDrawer: TCDDrawer;
 
769
begin
 
770
  OldDrawer := FDrawer;
 
771
  FDrawer := GetDrawer(FDrawStyle);
 
772
  if FDrawer = nil then FDrawer := GetDrawer(dsCommon); // avoid exceptions in the object inspector if an invalid drawer is selected
 
773
  if FDrawer = nil then raise Exception.Create('[TCDControl.PrepareCurrentDrawer] No registered drawers were found. Please add the unit customdrawn_common to your uses clause and also the units of any other utilized drawers.');
 
774
  if OldDrawer <> FDrawer then FDrawer.LoadPalette();
 
775
end;
 
776
 
 
777
procedure TCDControl.SetDrawStyle(const AValue: TCDDrawStyle);
 
778
begin
 
779
  if FDrawStyle = AValue then exit;
 
780
  FDrawStyle := AValue;
 
781
  Invalidate;
 
782
  PrepareCurrentDrawer();
 
783
 
 
784
  //FCurrentDrawer.SetClientRectPos(Self);
 
785
end;
 
786
 
 
787
function TCDControl.GetClientRect: TRect;
 
788
begin
 
789
  // Disable this, since although it works in Win32, it doesn't seam to work in LCL-Carbon
 
790
  //if (FCurrentDrawer = nil) then
 
791
    Result := inherited GetClientRect()
 
792
  //else
 
793
    //Result := FCurrentDrawer.GetClientRect(Self);
 
794
end;
 
795
 
 
796
function TCDControl.GetControlId: TCDControlID;
 
797
begin
 
798
  Result := cidControl;
 
799
end;
 
800
 
 
801
procedure TCDControl.CreateControlStateEx;
 
802
begin
 
803
  FStateEx := TCDControlStateEx.Create;
 
804
end;
 
805
 
 
806
procedure TCDControl.PrepareControlState;
 
807
begin
 
808
  if Focused then FState := FState + [csfHasFocus]
 
809
  else FState := FState - [csfHasFocus];
 
810
 
 
811
  if Enabled then FState := FState + [csfEnabled]
 
812
  else FState := FState - [csfEnabled];
 
813
end;
 
814
 
 
815
procedure TCDControl.PrepareControlStateEx;
 
816
begin
 
817
  if Parent <> nil then FStateEx.ParentRGBColor := Parent.GetRGBColorResolvingParent
 
818
  else FStateEx.ParentRGBColor := clSilver;
 
819
  FStateEx.FPParentRGBColor := TColorToFPColor(FStateEx.ParentRGBColor);
 
820
 
 
821
  if Color = clDefault then FStateEx.RGBColor := FDrawer.GetControlDefaultColor(GetControlId())
 
822
  else FStateEx.RGBColor := GetRGBColorResolvingParent;
 
823
  FStateEx.FPRGBColor := TColorToFPColor(FStateEx.RGBColor);
 
824
 
 
825
  FStateEx.Caption := Caption;
 
826
  FStateEx.Font := Font;
 
827
  FStateEx.AutoSize := AutoSize;
 
828
end;
 
829
 
 
830
procedure TCDControl.DoEnter;
 
831
begin
 
832
  Invalidate;
 
833
  inherited DoEnter;
 
834
end;
 
835
 
 
836
procedure TCDControl.DoExit;
 
837
begin
 
838
  Invalidate;
 
839
  inherited DoExit;
 
840
end;
 
841
 
 
842
procedure TCDControl.EraseBackground(DC: HDC);
 
843
begin
 
844
 
 
845
end;
 
846
 
 
847
procedure TCDControl.Paint;
 
848
var
 
849
  ABmp: TBitmap;
 
850
begin
 
851
  inherited Paint;
 
852
 
 
853
  DrawToCanvas(Canvas);
 
854
end;
 
855
 
 
856
procedure TCDControl.DrawToCanvas(ACanvas: TCanvas);
 
857
var
 
858
  lSize: TSize;
 
859
  lControlId: TCDControlID;
 
860
begin
 
861
  PrepareCurrentDrawer();
 
862
 
 
863
  lSize := Size(Width, Height);
 
864
  lControlId := GetControlId();
 
865
  PrepareControlState;
 
866
  PrepareControlStateEx;
 
867
  FDrawer.DrawControl(ACanvas, lSize, lControlId, FState, FStateEx);
 
868
end;
 
869
 
 
870
procedure TCDControl.MouseEnter;
 
871
begin
 
872
  FState := FState + [csfMouseOver];
 
873
  inherited MouseEnter;
 
874
end;
 
875
 
 
876
procedure TCDControl.MouseLeave;
 
877
begin
 
878
  FState := FState - [csfMouseOver];
 
879
  inherited MouseLeave;
 
880
end;
 
881
 
 
882
procedure TCDControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
 
883
  Y: integer);
 
884
begin
 
885
  inherited MouseDown(Button, Shift, X, Y);
 
886
  SetFocus();
 
887
end;
 
888
 
 
889
constructor TCDControl.Create(AOwner: TComponent);
 
890
begin
 
891
  inherited Create(AOwner);
 
892
  CreateControlStateEx;
 
893
  PrepareCurrentDrawer();
 
894
  {$ifdef CDControlsDoDoubleBuffer}
 
895
  DoubleBuffered := True;
 
896
  {$endif}
 
897
end;
 
898
 
 
899
destructor TCDControl.Destroy;
 
900
begin
 
901
  FStateEx.Free;
 
902
  inherited Destroy;
 
903
end;
 
904
 
 
905
// A CalculatePreferredSize which is utilized by LCL-CustomDrawn
 
906
procedure TCDControl.LCLWSCalculatePreferredSize(var PreferredWidth,
 
907
  PreferredHeight: integer; WithThemeSpace, AAutoSize: Boolean);
 
908
begin
 
909
  PrepareControlState;
 
910
  PrepareControlStateEx;
 
911
  FStateEx.AutoSize := AAutoSize;
 
912
  FDrawer.CalculatePreferredSize(Canvas, GetControlId(), FState, FStateEx,
 
913
    PreferredWidth, PreferredHeight, WithThemeSpace);
 
914
end;
 
915
 
 
916
{ TCDComboBox }
 
917
 
 
918
function TCDComboBox.GetItems: TStrings;
 
919
begin
 
920
  Result := FItems;
 
921
end;
 
922
 
 
923
procedure TCDComboBox.OnShowSelectItemDialogResult(ASelectedItem: Integer);
 
924
begin
 
925
  SetItemIndex(ASelectedItem);
 
926
end;
 
927
 
 
928
procedure TCDComboBox.SetItemIndex(AValue: Integer);
 
929
var
 
930
  lValue: Integer;
 
931
begin
 
932
  lValue := AValue;
 
933
 
 
934
  // First basic check
 
935
  if lValue > FItems.Count then lValue := FItems.Count;
 
936
  if lValue < -1 then lValue := -1;
 
937
 
 
938
  if FItemIndex=lValue then Exit;
 
939
  FItemIndex:=lValue;
 
940
  if lValue >= 0 then Text := FItems.Strings[lValue];
 
941
end;
 
942
 
 
943
procedure TCDComboBox.SetKeyboardInputBehavior(AValue: TKeyboardInputBehavior);
 
944
begin
 
945
  if FKeyboardInputBehavior=AValue then Exit;
 
946
  FKeyboardInputBehavior:=AValue;
 
947
  if AValue = kibRequires then ControlStyle := ControlStyle + [csRequiresKeyboardInput]
 
948
  else ControlStyle := ControlStyle + [csRequiresKeyboardInput];
 
949
end;
 
950
 
 
951
function TCDComboBox.GetControlId: TCDControlID;
 
952
begin
 
953
  Result := cidComboBox;
 
954
end;
 
955
 
 
956
procedure TCDComboBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
 
957
  Y: integer);
 
958
begin
 
959
  if (X > Width - Height) then
 
960
  begin
 
961
    FIsClickingButton := True;
 
962
    FEditState.ExtraButtonState := FEditState.ExtraButtonState + [csfSunken];
 
963
    Invalidate;
 
964
    Exit;
 
965
  end;
 
966
 
 
967
  inherited MouseDown(Button, Shift, X, Y);
 
968
end;
 
969
 
 
970
procedure TCDComboBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
 
971
  Y: integer);
 
972
begin
 
973
  if FIsClickingButton then
 
974
  begin
 
975
    FIsClickingButton := False;
 
976
    FEditState.ExtraButtonState := FEditState.ExtraButtonState - [csfSunken];
 
977
    Invalidate;
 
978
    if (X > Width - Height) then
 
979
    begin
 
980
      // Call the combobox dialog
 
981
      LCLIntf.OnShowSelectItemDialogResult := @OnShowSelectItemDialogResult;
 
982
      LCLIntf.ShowSelectItemDialog(FItems);
 
983
 
 
984
      Exit;
 
985
    end;
 
986
  end;
 
987
 
 
988
  inherited MouseUp(Button, Shift, X, Y);
 
989
end;
 
990
 
 
991
constructor TCDComboBox.Create(AOwner: TComponent);
 
992
begin
 
993
  inherited Create(AOwner);
 
994
 
 
995
  // The keyboard input is mostly an annoyance in the combobox in Android,
 
996
  // but we offer the property RequiresKeyboardInput to override this setting
 
997
  ControlStyle := ControlStyle - [csRequiresKeyboardInput];
 
998
 
 
999
  FItems := TStringList.Create;
 
1000
end;
 
1001
 
 
1002
destructor TCDComboBox.Destroy;
 
1003
begin
 
1004
  FItems.Free;
 
1005
  inherited Destroy;
 
1006
end;
 
1007
 
 
1008
{ TCDPanel }
 
1009
 
 
1010
function TCDPanel.GetControlId: TCDControlID;
 
1011
begin
 
1012
  Result := cidPanel;
 
1013
end;
 
1014
 
 
1015
procedure TCDPanel.CreateControlStateEx;
 
1016
begin
 
1017
  FPState := TCDPanelStateEx.Create;
 
1018
  FStateEx := FPState;
 
1019
end;
 
1020
 
 
1021
procedure TCDPanel.PrepareControlStateEx;
 
1022
begin
 
1023
  inherited PrepareControlStateEx;
 
1024
  FPState.BevelInner := FBevelInner;
 
1025
  FPState.BevelOuter := FBevelOuter;
 
1026
  FPState.BevelWidth := FBevelWidth;
 
1027
end;
 
1028
 
 
1029
procedure TCDPanel.SetBevelInner(AValue: TPanelBevel);
 
1030
begin
 
1031
  if FBevelInner=AValue then Exit;
 
1032
  FBevelInner:=AValue;
 
1033
  if not (csLoading in ComponentState) then Invalidate;
 
1034
end;
 
1035
 
 
1036
procedure TCDPanel.SetBevelOuter(AValue: TPanelBevel);
 
1037
begin
 
1038
  if FBevelOuter=AValue then Exit;
 
1039
  FBevelOuter:=AValue;
 
1040
  if not (csLoading in ComponentState) then Invalidate;
 
1041
end;
 
1042
 
 
1043
procedure TCDPanel.SetBevelWidth(AValue: TBevelWidth);
 
1044
begin
 
1045
  if FBevelWidth=AValue then Exit;
 
1046
  FBevelWidth:=AValue;
 
1047
  if not (csLoading in ComponentState) then Invalidate;
 
1048
end;
 
1049
 
 
1050
procedure TCDPanel.RealSetText(const Value: TCaption);
 
1051
begin
 
1052
  inherited RealSetText(Value);
 
1053
  if not (csLoading in ComponentState) then Invalidate;
 
1054
end;
 
1055
 
 
1056
constructor TCDPanel.Create(AOwner: TComponent);
 
1057
begin
 
1058
  inherited Create(AOwner);
 
1059
  Width := 170;
 
1060
  Height := 50;
 
1061
  TabStop := False;
 
1062
  AutoSize := False;
 
1063
end;
 
1064
 
 
1065
destructor TCDPanel.Destroy;
 
1066
begin
 
1067
  inherited Destroy;
 
1068
end;
 
1069
 
 
1070
{ TCDScrollableControl }
 
1071
 
 
1072
procedure TCDScrollableControl.SetScrollBars(AValue: TScrollStyle);
 
1073
begin
 
1074
  if FScrollBars=AValue then Exit;
 
1075
  FScrollBars:=AValue;
 
1076
 
 
1077
  if AValue = ssNone then
 
1078
  begin
 
1079
    FSpacer.Visible := False;
 
1080
    FRightScrollBar.Visible := False;
 
1081
    FBottomScrollBar.Visible := False;
 
1082
  end
 
1083
  else if AValue in [ssHorizontal, ssAutoHorizontal] then
 
1084
  begin
 
1085
    FSpacer.Visible := False;
 
1086
    FRightScrollBar.Visible := False;
 
1087
    FBottomScrollBar.BorderSpacing.Bottom := 0;
 
1088
    FBottomScrollBar.Align := alRight;
 
1089
    FBottomScrollBar.Visible := True;
 
1090
  end
 
1091
  else if AValue in [ssVertical, ssAutoVertical] then
 
1092
  begin
 
1093
    FSpacer.Visible := False;
 
1094
    FRightScrollBar.BorderSpacing.Bottom := 0;
 
1095
    FRightScrollBar.Align := alRight;
 
1096
    FRightScrollBar.Visible := True;
 
1097
    FBottomScrollBar.Visible := False;
 
1098
  end
 
1099
  else // ssBoth, ssAutoBoth
 
1100
  begin
 
1101
    FSpacer.Visible := True;
 
1102
 
 
1103
    // alRight and alBottom seam to work differently, so here we don't need the spacing
 
1104
    FRightScrollBar.BorderSpacing.Bottom := 0;
 
1105
    FRightScrollBar.Align := alRight;
 
1106
    FRightScrollBar.Visible := True;
 
1107
 
 
1108
    // Enough spacing to fit the FSpacer
 
1109
    FBottomScrollBar.BorderSpacing.Right := FBottomScrollBar.Height;
 
1110
    FBottomScrollBar.Align := alBottom;
 
1111
    FBottomScrollBar.Visible := True;
 
1112
  end;
 
1113
end;
 
1114
 
 
1115
constructor TCDScrollableControl.Create(AOwner: TComponent);
 
1116
var
 
1117
  lWidth: Integer;
 
1118
begin
 
1119
  inherited Create(AOwner);
 
1120
 
 
1121
  FRightScrollBar := TCDScrollBar.Create(nil);
 
1122
  FRightScrollBar.Kind := sbVertical;
 
1123
  FRightScrollBar.Visible := False;
 
1124
  FRightScrollBar.Parent := Self;
 
1125
  // Invert the dimensions because they are not automatically inverted in Loading state
 
1126
  lWidth := FRightScrollBar.Width;
 
1127
  FRightScrollBar.Width := FRightScrollBar.Height;
 
1128
  FRightScrollBar.Height := lWidth;
 
1129
 
 
1130
  FBottomScrollBar := TCDScrollBar.Create(nil);
 
1131
  FBottomScrollBar.Kind := sbHorizontal;
 
1132
  FBottomScrollBar.Visible := False;
 
1133
  FBottomScrollBar.Parent := Self;
 
1134
 
 
1135
  FSpacer := TCDControl.Create(nil);
 
1136
  FSpacer.Color := FDrawer.Palette.BtnFace;
 
1137
  FSpacer.Visible := False;
 
1138
  FSpacer.Parent := Self;
 
1139
  FSpacer.Width := FRightScrollBar.Width;
 
1140
  FSpacer.Height := FBottomScrollBar.Height;
 
1141
  FSpacer.AnchorSide[akRight].Control := Self;
 
1142
  FSpacer.AnchorSide[akRight].Side := asrBottom;
 
1143
  FSpacer.AnchorSide[akBottom].Control := Self;
 
1144
  FSpacer.AnchorSide[akBottom].Side := asrBottom;
 
1145
  FSpacer.Anchors := [akRight, akBottom];
 
1146
end;
 
1147
 
 
1148
destructor TCDScrollableControl.Destroy;
 
1149
begin
 
1150
  FRightScrollBar.Free;
 
1151
  FBottomScrollBar.Free;
 
1152
  FSpacer.Free;
 
1153
  inherited Destroy;
 
1154
end;
 
1155
 
 
1156
{ TCDButtonDrawer }
 
1157
 
 
1158
procedure TCDButtonControl.KeyDown(var Key: word; Shift: TShiftState);
 
1159
begin
 
1160
  inherited KeyDown(Key, Shift);
 
1161
 
 
1162
  if (Key = VK_SPACE) or (Key = VK_RETURN) then
 
1163
    DoButtonDown();
 
1164
end;
 
1165
 
 
1166
procedure TCDButtonControl.KeyUp(var Key: word; Shift: TShiftState);
 
1167
begin
 
1168
  if (Key = VK_SPACE) or (Key = VK_RETURN) then
 
1169
  begin
 
1170
    DoButtonUp();
 
1171
    Self.Click; // TCustomControl does not respond to LM_CLICKED
 
1172
  end;
 
1173
 
 
1174
  inherited KeyUp(Key, Shift);
 
1175
end;
 
1176
 
 
1177
procedure TCDButtonControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
 
1178
begin
 
1179
  DoButtonDown();
 
1180
 
 
1181
  inherited MouseDown(Button, Shift, X, Y);
 
1182
end;
 
1183
 
 
1184
procedure TCDButtonControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
 
1185
begin
 
1186
  DoButtonUp();
 
1187
 
 
1188
  inherited MouseUp(Button, Shift, X, Y);
 
1189
end;
 
1190
 
 
1191
procedure TCDButtonControl.MouseEnter;
 
1192
begin
 
1193
  Invalidate;
 
1194
  inherited MouseEnter;
 
1195
end;
 
1196
 
 
1197
procedure TCDButtonControl.MouseLeave;
 
1198
begin
 
1199
  Invalidate;
 
1200
  inherited MouseLeave;
 
1201
end;
 
1202
 
 
1203
procedure TCDButtonControl.DoUncheckButton;
 
1204
var
 
1205
  NewState: TCDControlState;
 
1206
begin
 
1207
  NewState := FState + [csfOff] - [csfOn, csfPartiallyOn];
 
1208
  SetState(NewState);
 
1209
end;
 
1210
 
 
1211
procedure TCDButtonControl.DoCheckIfFirstButtonInGroup;
 
1212
var
 
1213
  NewState: TCDControlState;
 
1214
  i: Integer;
 
1215
  lControl: TControl;
 
1216
begin
 
1217
  // Start with the checked value
 
1218
  NewState := FState + [csfOn] - [csfOff, csfPartiallyOn];
 
1219
 
 
1220
  // Search for other buttons in the group in the same parent
 
1221
  if Parent <> nil then
 
1222
  begin
 
1223
    for i := 0 to Parent.ControlCount - 1 do
 
1224
    begin
 
1225
      lControl := Parent.Controls[i];
 
1226
      if (lControl is TCDButtonControl) and
 
1227
        (lControl <> Self) and
 
1228
        (TCDButtonControl(lControl).FGroupIndex = FGroupIndex) then
 
1229
      begin
 
1230
        NewState := FState + [csfOff] - [csfOn, csfPartiallyOn];
 
1231
        Break;
 
1232
      end;
 
1233
    end;
 
1234
  end;
 
1235
 
 
1236
  SetState(NewState);
 
1237
end;
 
1238
 
 
1239
procedure TCDButtonControl.DoButtonDown();
 
1240
var
 
1241
  NewState: TCDControlState;
 
1242
begin
 
1243
  NewState := FState;
 
1244
  if not (csfSunken in FState) then NewState := FState + [csfSunken];
 
1245
  SetState(NewState);
 
1246
end;
 
1247
 
 
1248
procedure TCDButtonControl.DoButtonUp();
 
1249
var
 
1250
  i: Integer;
 
1251
  lControl: TControl;
 
1252
  NewState: TCDControlState;
 
1253
begin
 
1254
  NewState := FState;
 
1255
  if csfSunken in FState then NewState := NewState - [csfSunken];
 
1256
 
 
1257
  // For grouped buttons, call DoButtonUp for all other buttons on the same parent
 
1258
  if FIsGrouped then
 
1259
  begin
 
1260
    NewState := NewState + [csfOn] - [csfOff, csfPartiallyOn];
 
1261
    if Parent <> nil then
 
1262
    begin
 
1263
      for i := 0 to Parent.ControlCount - 1 do
 
1264
      begin
 
1265
        lControl := Parent.Controls[i];
 
1266
        if (lControl is TCDButtonControl) and
 
1267
          (lControl <> Self) and
 
1268
          (TCDButtonControl(lControl).FGroupIndex = FGroupIndex) then
 
1269
          TCDButtonControl(lControl).DoUncheckButton();
 
1270
      end;
 
1271
    end;
 
1272
  end
 
1273
  // Only for buttons with checked/down states
 
1274
  // TCDCheckbox, TCDRadiobutton, TCDButton configured as TToggleButton
 
1275
  else if FHasOnOffStates then
 
1276
  begin
 
1277
    if FAllowGrayed then
 
1278
    begin
 
1279
      if csfOn in FState then
 
1280
        NewState := NewState + [csfOff] - [csfOn, csfPartiallyOn]
 
1281
      else if csfPartiallyOn in FState then
 
1282
        NewState := NewState + [csfOn] - [csfOff, csfPartiallyOn]
 
1283
      else
 
1284
        NewState := NewState + [csfPartiallyOn] - [csfOn, csfOff];
 
1285
    end
 
1286
    else
 
1287
    begin
 
1288
      if csfOn in FState then
 
1289
        NewState := NewState + [csfOff] - [csfOn]
 
1290
      else
 
1291
        NewState := NewState + [csfOn] - [csfOff];
 
1292
    end;
 
1293
  end;
 
1294
 
 
1295
  SetState(NewState);
 
1296
end;
 
1297
 
 
1298
procedure TCDButtonControl.RealSetText(const Value: TCaption);
 
1299
begin
 
1300
  inherited RealSetText(Value);
 
1301
  Invalidate;
 
1302
end;
 
1303
 
 
1304
function TCDButtonControl.GetChecked: Boolean;
 
1305
begin
 
1306
  Result := csfOn in FState;
 
1307
end;
 
1308
 
 
1309
procedure TCDButtonControl.SetChecked(AValue: Boolean);
 
1310
var
 
1311
  NewState: TCDControlState;
 
1312
begin
 
1313
  // In grouped elements when setting to true we do the full group sequence
 
1314
  // but when setting to false we just uncheck the element
 
1315
  if FIsGrouped and AValue then DoButtonUp()
 
1316
  else
 
1317
  begin
 
1318
    if AValue then NewState := FState + [csfOn] - [csfOff, csfPartiallyOn]
 
1319
    else NewState := FState + [csfOff] - [csfOn, csfPartiallyOn];
 
1320
    SetState(NewState);
 
1321
  end;
 
1322
end;
 
1323
 
 
1324
function TCDButtonControl.GetCheckedState: TCheckBoxState;
 
1325
begin
 
1326
  if csfOn in FState then Result := cbChecked
 
1327
  else if csfPartiallyOn in FState then
 
1328
  begin
 
1329
    if FAllowGrayed then
 
1330
      Result := cbGrayed
 
1331
    else
 
1332
      Result := cbChecked;
 
1333
  end
 
1334
  else Result := cbUnchecked;
 
1335
end;
 
1336
 
 
1337
procedure TCDButtonControl.SetCheckedState(AValue: TCheckBoxState);
 
1338
var
 
1339
  NewState: TCDControlState;
 
1340
begin
 
1341
  case AValue of
 
1342
    cbUnchecked:  NewState := FState + [csfOff] - [csfOn, csfPartiallyOn];
 
1343
    cbChecked:    NewState := FState + [csfOn] - [csfOff, csfPartiallyOn];
 
1344
    cbGrayed:
 
1345
    begin
 
1346
      if FAllowGrayed then
 
1347
        NewState := FState + [csfPartiallyOn] - [csfOn, csfOff]
 
1348
      else
 
1349
        NewState := FState + [csfOn] - [csfOff, csfPartiallyOn];
 
1350
    end;
 
1351
  end;
 
1352
  SetState(NewState);
 
1353
end;
 
1354
 
 
1355
{ TCDEdit }
 
1356
 
 
1357
function TCDEdit.GetText: string;
 
1358
begin
 
1359
  Result := Caption;
 
1360
end;
 
1361
 
 
1362
procedure TCDEdit.SetLeftTextMargin(AValue: Integer);
 
1363
begin
 
1364
  if FEditState.LeftTextMargin = AValue then Exit;
 
1365
  FEditState.LeftTextMargin := AValue;
 
1366
  Invalidate;
 
1367
end;
 
1368
 
 
1369
procedure TCDEdit.SetRightTextMargin(AValue: Integer);
 
1370
begin
 
1371
  if FEditState.RightTextMargin = AValue then Exit;
 
1372
  FEditState.RightTextMargin := AValue;
 
1373
  Invalidate;
 
1374
end;
 
1375
 
 
1376
function TCDEdit.GetControlId: TCDControlID;
 
1377
begin
 
1378
  Result := cidEdit;
 
1379
end;
 
1380
 
 
1381
procedure TCDEdit.CreateControlStateEx;
 
1382
begin
 
1383
  FEditState := TCDEditStateEx.Create;
 
1384
  FStateEx := FEditState;
 
1385
end;
 
1386
 
 
1387
procedure TCDEdit.DoChange;
 
1388
begin
 
1389
  if Assigned(FOnChange) then FOnChange(Self);
 
1390
end;
 
1391
 
 
1392
procedure TCDEdit.HandleCaretTimer(Sender: TObject);
 
1393
begin
 
1394
  if FEditState.EventArrived then
 
1395
  begin
 
1396
    FEditState.CaretIsVisible := True;
 
1397
    FEditState.EventArrived := False;
 
1398
  end
 
1399
  else FEditState.CaretIsVisible := not FEditState.CaretIsVisible;
 
1400
 
 
1401
  Invalidate;
 
1402
end;
 
1403
 
 
1404
function TCDEdit.GetLeftTextMargin: Integer;
 
1405
begin
 
1406
  Result := FEditState.LeftTextMargin;
 
1407
end;
 
1408
 
 
1409
function TCDEdit.GetRightTextMargin: Integer;
 
1410
begin
 
1411
  Result := FEditState.RightTextMargin;
 
1412
end;
 
1413
 
 
1414
procedure TCDEdit.DoDeleteSelection;
 
1415
var
 
1416
  lSelLeftPos, lSelRightPos, lSelLength: Integer;
 
1417
  lControlText, lTextLeft, lTextRight: string;
 
1418
begin
 
1419
  if IsSomethingSelected then
 
1420
  begin
 
1421
    lSelLeftPos := FEditState.SelStart.X;
 
1422
    if FEditState.SelLength < 0 then lSelLeftPos := lSelLeftPos + FEditState.SelLength;
 
1423
    lSelRightPos := FEditState.SelStart.X;
 
1424
    if FEditState.SelLength > 0 then lSelRightPos := lSelRightPos + FEditState.SelLength;
 
1425
    lSelLength := FEditState.SelLength;
 
1426
    if lSelLength < 0 then lSelLength := lSelLength * -1;
 
1427
    lControlText := Text;
 
1428
 
 
1429
    // Text left of the selection
 
1430
    lTextLeft := UTF8Copy(lControlText, FEditState.VisibleTextStart.X, lSelLeftPos-FEditState.VisibleTextStart.X+1);
 
1431
 
 
1432
    // Text right of the selection
 
1433
    lTextRight := UTF8Copy(lControlText, lSelLeftPos+lSelLength+1, Length(lControlText));
 
1434
 
 
1435
    // Execute the deletion
 
1436
    Text := lTextLeft + lTextRight;
 
1437
 
 
1438
    // Correct the caret position
 
1439
    FEditState.CaretPos.X := Length(lTextLeft);
 
1440
  end;
 
1441
 
 
1442
  DoClearSelection;
 
1443
end;
 
1444
 
 
1445
procedure TCDEdit.DoClearSelection;
 
1446
begin
 
1447
  FEditState.SelStart.X := 1;
 
1448
  FEditState.SelLength := 0;
 
1449
end;
 
1450
 
 
1451
procedure TCDEdit.DoManageVisibleTextStart;
 
1452
var
 
1453
  lText: String;
 
1454
  lVisibleTextCharCount: Integer;
 
1455
  lAvailableWidth: Integer;
 
1456
begin
 
1457
  // Moved to the left and we need to adjust the text start
 
1458
  FEditState.VisibleTextStart.X := Min(FEditState.CaretPos.X+1, FEditState.VisibleTextStart.X);
 
1459
 
 
1460
  // Moved to the right and we need to adjust the text start
 
1461
  lText := UTF8Copy(Text, FEditState.VisibleTextStart.X, Length(Text));
 
1462
  lAvailableWidth := Width
 
1463
   - FDrawer.GetMeasures(TCDEDIT_LEFT_TEXT_SPACING)
 
1464
   - FDrawer.GetMeasures(TCDEDIT_RIGHT_TEXT_SPACING);
 
1465
  lVisibleTextCharCount := Canvas.TextFitInfo(lText, lAvailableWidth);
 
1466
  FEditState.VisibleTextStart.X := Max(FEditState.CaretPos.X-lVisibleTextCharCount+1, FEditState.VisibleTextStart.X);
 
1467
end;
 
1468
 
 
1469
procedure TCDEdit.SetText(AValue: string);
 
1470
var
 
1471
  OldCaption: TCaption;
 
1472
begin
 
1473
  OldCaption := Caption;
 
1474
  Caption := AValue;
 
1475
  if (AValue <> OldCaption) then DoChange;
 
1476
  Invalidate;
 
1477
end;
 
1478
 
 
1479
// Result.X -> returns a zero-based position of the caret
 
1480
function TCDEdit.MousePosToCaretPos(X, Y: Integer): TPoint;
 
1481
var
 
1482
  lStrLen, i: PtrInt;
 
1483
  lVisibleStr, lCurChar: String;
 
1484
  lPos, lCurCharLen: Integer;
 
1485
  lBestDiff: Cardinal = $FFFFFFFF;
 
1486
  lLastDiff: Cardinal = $FFFFFFFF;
 
1487
  lCurDiff, lBestMatch: Integer;
 
1488
begin
 
1489
  Canvas.Font := Font;
 
1490
  lVisibleStr := UTF8Copy(Text, FEditState.VisibleTextStart.X, Length(Text));
 
1491
  lStrLen := UTF8Length(lVisibleStr);
 
1492
  lPos := FDrawer.GetMeasures(TCDEDIT_LEFT_TEXT_SPACING);
 
1493
  for i := 0 to lStrLen do
 
1494
  begin
 
1495
    lCurDiff := X - lPos;
 
1496
    if lCurDiff < 0 then lCurDiff := lCurDiff * -1;
 
1497
 
 
1498
    if lCurDiff < lBestDiff then
 
1499
    begin
 
1500
      lBestDiff := lCurDiff;
 
1501
      lBestMatch := i;
 
1502
    end;
 
1503
 
 
1504
    // When the diff starts to grow we already found the caret pos, so exit
 
1505
    if lCurDiff > lLastDiff then Break
 
1506
    else lLastDiff := lCurDiff;
 
1507
 
 
1508
    if i <> lStrLen then
 
1509
    begin
 
1510
      lCurChar := UTF8Copy(lVisibleStr, i+1, 1);
 
1511
      lCurCharLen := Canvas.TextWidth(lCurChar);
 
1512
      lPos := lPos + lCurCharLen;
 
1513
    end;
 
1514
  end;
 
1515
 
 
1516
  Result.X := lBestMatch+(FEditState.VisibleTextStart.X-1);
 
1517
end;
 
1518
 
 
1519
function TCDEdit.IsSomethingSelected: Boolean;
 
1520
begin
 
1521
  Result := FEditState.SelLength <> 0;
 
1522
end;
 
1523
 
 
1524
procedure TCDEdit.DoEnter;
 
1525
begin
 
1526
  FCaretTimer.Enabled := True;
 
1527
  FEditState.CaretIsVisible := True;
 
1528
  inherited DoEnter;
 
1529
end;
 
1530
 
 
1531
procedure TCDEdit.DoExit;
 
1532
begin
 
1533
  FCaretTimer.Enabled := False;
 
1534
  FEditState.CaretIsVisible := False;
 
1535
  DoClearSelection();
 
1536
  inherited DoExit;
 
1537
end;
 
1538
 
 
1539
procedure TCDEdit.KeyDown(var Key: word; Shift: TShiftState);
 
1540
var
 
1541
  lLeftText, lRightText, lOldText: String;
 
1542
  lOldTextLength: PtrInt;
 
1543
  lKeyWasProcessed: Boolean = True;
 
1544
begin
 
1545
  inherited KeyDown(Key, Shift);
 
1546
 
 
1547
  lOldText := Text;
 
1548
  lOldTextLength := UTF8Length(Text);
 
1549
 
 
1550
  case Key of
 
1551
  // Backspace
 
1552
  VK_BACK:
 
1553
  begin
 
1554
    // Selection backspace
 
1555
    if IsSomethingSelected() then
 
1556
      DoDeleteSelection()
 
1557
    // Normal backspace
 
1558
    else if FEditState.CaretPos.X > 0 then
 
1559
    begin
 
1560
      lLeftText := UTF8Copy(lOldText, 1, FEditState.CaretPos.X-1);
 
1561
      lRightText := UTF8Copy(lOldText, FEditState.CaretPos.X+1, lOldTextLength);
 
1562
      Text := lLeftText + lRightText;
 
1563
      Dec(FEditState.CaretPos.X);
 
1564
      DoManageVisibleTextStart();
 
1565
      Invalidate;
 
1566
    end;
 
1567
  end;
 
1568
  // DEL
 
1569
  VK_DELETE:
 
1570
  begin
 
1571
    // Selection delete
 
1572
    if IsSomethingSelected() then
 
1573
      DoDeleteSelection()
 
1574
    // Normal delete
 
1575
    else if FEditState.CaretPos.X < lOldTextLength then
 
1576
    begin
 
1577
      lLeftText := UTF8Copy(lOldText, 1, FEditState.CaretPos.X);
 
1578
      lRightText := UTF8Copy(lOldText, FEditState.CaretPos.X+2, lOldTextLength);
 
1579
      Text := lLeftText + lRightText;
 
1580
      Invalidate;
 
1581
    end;
 
1582
  end;
 
1583
  VK_LEFT:
 
1584
  begin
 
1585
    if (FEditState.CaretPos.X > 0) then
 
1586
    begin
 
1587
      // Selecting to the left
 
1588
      if [ssShift] = Shift then
 
1589
      begin
 
1590
        if FEditState.SelLength = 0 then FEditState.SelStart.X := FEditState.CaretPos.X;
 
1591
        Dec(FEditState.SelLength);
 
1592
      end
 
1593
      // Normal move to the left
 
1594
      else FEditState.SelLength := 0;
 
1595
 
 
1596
      Dec(FEditState.CaretPos.X);
 
1597
      DoManageVisibleTextStart();
 
1598
      FEditState.CaretIsVisible := True;
 
1599
      Invalidate;
 
1600
    end
 
1601
    // if we are not moving, at least deselect
 
1602
    else if ([ssShift] <> Shift) then
 
1603
    begin
 
1604
      FEditState.SelLength := 0;
 
1605
      Invalidate;
 
1606
    end;
 
1607
  end;
 
1608
  VK_HOME:
 
1609
  begin
 
1610
    if (FEditState.CaretPos.X > 0) then
 
1611
    begin
 
1612
      // Selecting to the left
 
1613
      if [ssShift] = Shift then
 
1614
      begin
 
1615
        if FEditState.SelLength = 0 then
 
1616
        begin
 
1617
          FEditState.SelStart.X := FEditState.CaretPos.X;
 
1618
          FEditState.SelLength := -1 * FEditState.CaretPos.X;
 
1619
        end
 
1620
        else
 
1621
          FEditState.SelLength := -1 * FEditState.SelStart.X;
 
1622
      end
 
1623
      // Normal move to the left
 
1624
      else FEditState.SelLength := 0;
 
1625
 
 
1626
      FEditState.CaretPos.X := 0;
 
1627
      DoManageVisibleTextStart();
 
1628
      FEditState.CaretIsVisible := True;
 
1629
      Invalidate;
 
1630
    end
 
1631
    // if we are not moving, at least deselect
 
1632
    else if (FEditState.SelLength <> 0) and ([ssShift] <> Shift) then
 
1633
    begin
 
1634
      FEditState.SelLength := 0;
 
1635
      Invalidate;
 
1636
    end;
 
1637
  end;
 
1638
  VK_RIGHT:
 
1639
  begin
 
1640
    if FEditState.CaretPos.X < lOldTextLength then
 
1641
    begin
 
1642
      // Selecting to the right
 
1643
      if [ssShift] = Shift then
 
1644
      begin
 
1645
        if FEditState.SelLength = 0 then FEditState.SelStart.X := FEditState.CaretPos.X;
 
1646
        Inc(FEditState.SelLength);
 
1647
      end
 
1648
      // Normal move to the right
 
1649
      else FEditState.SelLength := 0;
 
1650
 
 
1651
      Inc(FEditState.CaretPos.X);
 
1652
      DoManageVisibleTextStart();
 
1653
      FEditState.CaretIsVisible := True;
 
1654
      Invalidate;
 
1655
    end
 
1656
    // if we are not moving, at least deselect
 
1657
    else if ([ssShift] <> Shift) then
 
1658
    begin
 
1659
      FEditState.SelLength := 0;
 
1660
      Invalidate;
 
1661
    end;
 
1662
  end;
 
1663
  VK_END:
 
1664
  begin
 
1665
    if FEditState.CaretPos.X < lOldTextLength then
 
1666
    begin
 
1667
      // Selecting to the right
 
1668
      if [ssShift] = Shift then
 
1669
      begin
 
1670
        if FEditState.SelLength = 0 then
 
1671
          FEditState.SelStart.X := FEditState.CaretPos.X;
 
1672
        FEditState.SelLength := lOldTextLength - FEditState.SelStart.X;
 
1673
      end
 
1674
      // Normal move to the right
 
1675
      else FEditState.SelLength := 0;
 
1676
 
 
1677
      FEditState.CaretPos.X := lOldTextLength;
 
1678
      DoManageVisibleTextStart();
 
1679
      FEditState.CaretIsVisible := True;
 
1680
      Invalidate;
 
1681
    end
 
1682
    // if we are not moving, at least deselect
 
1683
    else if (FEditState.SelLength <> 0) and ([ssShift] <> Shift) then
 
1684
    begin
 
1685
      FEditState.SelLength := 0;
 
1686
      Invalidate;
 
1687
    end;
 
1688
  end;
 
1689
 
 
1690
  else
 
1691
    lKeyWasProcessed := False;
 
1692
  end; // case
 
1693
 
 
1694
  if lKeyWasProcessed then FEditState.EventArrived := True;
 
1695
end;
 
1696
 
 
1697
procedure TCDEdit.KeyUp(var Key: word; Shift: TShiftState);
 
1698
begin
 
1699
  inherited KeyUp(Key, Shift);
 
1700
 
 
1701
  // copy, paste, cut, etc
 
1702
  if Shift = [ssCtrl] then
 
1703
  begin
 
1704
    case Key of
 
1705
    VK_C:
 
1706
    begin
 
1707
    end;
 
1708
    end;
 
1709
  end;
 
1710
end;
 
1711
 
 
1712
procedure TCDEdit.UTF8KeyPress(var UTF8Key: TUTF8Char);
 
1713
var
 
1714
  lLeftText, lRightText, lOldText: String;
 
1715
begin
 
1716
  inherited UTF8KeyPress(UTF8Key);
 
1717
 
 
1718
  // LCL-Carbon sends Backspace as a UTF-8 Char
 
1719
  // LCL-Qt sends arrow left,right,up,down (#28..#31), <enter>, ESC, etc
 
1720
  // Don't handle any non-char keys here because they are already handled in KeyDown
 
1721
  if (UTF8Key[1] in [#0..#$1F,#$7F]) or
 
1722
    ((UTF8Key[1]=#$c2) and (UTF8Key[2] in [#$80..#$9F])) then Exit;
 
1723
 
 
1724
  DoDeleteSelection;
 
1725
 
 
1726
  // Normal characters
 
1727
  lOldText := Text;
 
1728
  lLeftText := UTF8Copy(lOldText, 1, FEditState.CaretPos.X);
 
1729
  lRightText := UTF8Copy(lOldText, FEditState.CaretPos.X+1, UTF8Length(lOldText));
 
1730
  Text := lLeftText + UTF8Key + lRightText;
 
1731
  Inc(FEditState.CaretPos.X);
 
1732
  DoManageVisibleTextStart();
 
1733
  FEditState.EventArrived := True;
 
1734
  FEditState.CaretIsVisible := True;
 
1735
  Invalidate;
 
1736
end;
 
1737
 
 
1738
procedure TCDEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
 
1739
  Y: integer);
 
1740
begin
 
1741
  inherited MouseDown(Button, Shift, X, Y);
 
1742
  DragDropStarted := True;
 
1743
 
 
1744
  // Caret positioning
 
1745
  FEditState.CaretPos := MousePosToCaretPos(X, Y);
 
1746
  FEditState.SelLength := 0;
 
1747
  FEditState.SelStart.X := FEditState.CaretPos.X;
 
1748
  FEditState.EventArrived := True;
 
1749
  FEditState.CaretIsVisible := True;
 
1750
  Invalidate;
 
1751
end;
 
1752
 
 
1753
procedure TCDEdit.MouseMove(Shift: TShiftState; X, Y: integer);
 
1754
begin
 
1755
  inherited MouseMove(Shift, X, Y);
 
1756
 
 
1757
  // Mouse dragging selection
 
1758
  if DragDropStarted then
 
1759
  begin
 
1760
    FEditState.CaretPos := MousePosToCaretPos(X, Y);
 
1761
    FEditState.SelLength := FEditState.CaretPos.X - FEditState.SelStart.X;
 
1762
    FEditState.EventArrived := True;
 
1763
    FEditState.CaretIsVisible := True;
 
1764
    Invalidate;
 
1765
  end;
 
1766
end;
 
1767
 
 
1768
procedure TCDEdit.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
 
1769
  Y: integer);
 
1770
begin
 
1771
  inherited MouseUp(Button, Shift, X, Y);
 
1772
  DragDropStarted := False;
 
1773
end;
 
1774
 
 
1775
procedure TCDEdit.MouseEnter;
 
1776
begin
 
1777
  inherited MouseEnter;
 
1778
end;
 
1779
 
 
1780
procedure TCDEdit.MouseLeave;
 
1781
begin
 
1782
  inherited MouseLeave;
 
1783
end;
 
1784
 
 
1785
constructor TCDEdit.Create(AOwner: TComponent);
 
1786
begin
 
1787
  inherited Create(AOwner);
 
1788
  Width := 80;
 
1789
  Height := 25;
 
1790
  TabStop := True;
 
1791
  ControlStyle := ControlStyle - [csAcceptsControls] + [csRequiresKeyboardInput];
 
1792
 
 
1793
  // State information
 
1794
  FEditState.VisibleTextStart := Point(1, 1);
 
1795
 
 
1796
  // Caret code
 
1797
  FCaretTimer := TTimer.Create(Self);
 
1798
  FCaretTimer.OnTimer := @HandleCaretTimer;
 
1799
  FCaretTimer.Interval := 500;
 
1800
  FCaretTimer.Enabled := False;
 
1801
end;
 
1802
 
 
1803
destructor TCDEdit.Destroy;
 
1804
begin
 
1805
  inherited Destroy;
 
1806
end;
 
1807
 
 
1808
{ TCDCheckBox }
 
1809
 
 
1810
function TCDCheckBox.GetControlId: TCDControlID;
 
1811
begin
 
1812
  Result := cidCheckBox;
 
1813
end;
 
1814
 
 
1815
constructor TCDCheckBox.Create(AOwner: TComponent);
 
1816
begin
 
1817
  inherited Create(AOwner);
 
1818
  Width := 75;
 
1819
  Height := 17;
 
1820
  TabStop := True;
 
1821
  ControlStyle := ControlStyle - [csAcceptsControls];
 
1822
  AutoSize := True;
 
1823
  FHasOnOffStates := True;
 
1824
  FState := FState + [csfOff];
 
1825
end;
 
1826
 
 
1827
destructor TCDCheckBox.Destroy;
 
1828
begin
 
1829
  inherited Destroy;
 
1830
end;
 
1831
 
 
1832
{ TCDButton }
 
1833
 
 
1834
procedure TCDButton.SetGlyph(AValue: TBitmap);
 
1835
begin
 
1836
  if FGlyph=AValue then Exit;
 
1837
  FGlyph.Assign(AValue);
 
1838
  Invalidate;
 
1839
end;
 
1840
 
 
1841
function TCDButton.GetControlId: TCDControlID;
 
1842
begin
 
1843
  Result := cidButton;
 
1844
end;
 
1845
 
 
1846
procedure TCDButton.CreateControlStateEx;
 
1847
begin
 
1848
  FBState := TCDButtonStateEx.Create;
 
1849
  FStateEx := FBState;
 
1850
end;
 
1851
 
 
1852
procedure TCDButton.PrepareControlStateEx;
 
1853
begin
 
1854
  inherited PrepareControlStateEx;
 
1855
  FBState.Glyph := FGlyph;
 
1856
end;
 
1857
 
 
1858
constructor TCDButton.Create(AOwner: TComponent);
 
1859
begin
 
1860
  inherited Create(AOwner);
 
1861
  TabStop := True;
 
1862
  Width := 75;
 
1863
  Height := 25;
 
1864
  ParentFont := True;
 
1865
  FGlyph := TBitmap.Create;
 
1866
end;
 
1867
 
 
1868
destructor TCDButton.Destroy;
 
1869
begin
 
1870
  FGlyph.Free;
 
1871
  inherited Destroy;
 
1872
end;
 
1873
 
 
1874
{ TCDRadioButton }
 
1875
 
 
1876
function TCDRadioButton.GetControlId: TCDControlID;
 
1877
begin
 
1878
  Result := cidRadioButton;
 
1879
end;
 
1880
 
 
1881
constructor TCDRadioButton.Create(AOwner: TComponent);
 
1882
begin
 
1883
  inherited Create(AOwner);
 
1884
 
 
1885
  Width := 75;
 
1886
  Height := 17;
 
1887
  TabStop := True;
 
1888
  ControlStyle := ControlStyle - [csAcceptsControls];
 
1889
  AutoSize := True;
 
1890
  FHasOnOffStates := True;
 
1891
  FIsGrouped := True;
 
1892
  FGroupIndex := -2; // special value for TCDRadioButton
 
1893
  DoCheckIfFirstButtonInGroup();
 
1894
end;
 
1895
 
 
1896
destructor TCDRadioButton.Destroy;
 
1897
begin
 
1898
  inherited Destroy;
 
1899
end;
 
1900
 
 
1901
{ TCDPositionedControl }
 
1902
 
 
1903
procedure TCDPositionedControl.SetMax(AValue: Integer);
 
1904
begin
 
1905
  if FMax=AValue then Exit;
 
1906
  FMax:=AValue;
 
1907
 
 
1908
  if AValue < FMin then FMax := FMin
 
1909
  else FMax := AValue;
 
1910
 
 
1911
  if FPosition > FMax then FPosition := FMax;
 
1912
 
 
1913
  if not (csLoading in ComponentState) then Invalidate;
 
1914
end;
 
1915
 
 
1916
procedure TCDPositionedControl.SetMin(AValue: Integer);
 
1917
begin
 
1918
  if FMin=AValue then Exit;
 
1919
 
 
1920
  if AValue > FMax then FMin := FMax
 
1921
  else FMin:=AValue;
 
1922
 
 
1923
  if FPosition < FMin then FPosition := FMin;
 
1924
 
 
1925
  if not (csLoading in ComponentState) then Invalidate;
 
1926
end;
 
1927
 
 
1928
procedure TCDPositionedControl.SetPageSize(AValue: Integer);
 
1929
begin
 
1930
  if FPageSize=AValue then Exit;
 
1931
  FPageSize:=AValue;
 
1932
  if not (csLoading in ComponentState) then Invalidate;
 
1933
end;
 
1934
 
 
1935
procedure TCDPositionedControl.SetPosition(AValue: Integer);
 
1936
begin
 
1937
  if FPosition=AValue then Exit;
 
1938
  FPosition:=AValue;
 
1939
 
 
1940
  if FPosition > FMax then FPosition := FMax;
 
1941
  if FPosition < FMin then FPosition := FMin;
 
1942
 
 
1943
  // Don't do OnChange during loading
 
1944
  if not (csLoading in ComponentState) then
 
1945
  begin
 
1946
    if Assigned(OnChange) then OnChange(Self);
 
1947
    Invalidate;
 
1948
  end;
 
1949
end;
 
1950
 
 
1951
procedure TCDPositionedControl.DoClickButton(AButton: TCDControlState; ALargeChange: Boolean);
 
1952
var
 
1953
  lChange: Integer;
 
1954
  NewPosition: Integer = -1;
 
1955
begin
 
1956
  if ALargeChange then lChange := FLargeChange
 
1957
  else lChange := FSmallChange;
 
1958
  if csfLeftArrow in AButton then NewPosition := Position - lChange
 
1959
  else if csfRightArrow in AButton then NewPosition := Position + lChange;
 
1960
 
 
1961
  if (NewPosition >= 0) and (NewPosition <> Position) then
 
1962
  begin
 
1963
    Position := NewPosition;
 
1964
    if Assigned(FOnChangeByUser) then FOnChangeByUser(Self);
 
1965
  end;
 
1966
end;
 
1967
 
 
1968
procedure TCDPositionedControl.HandleBtnClickTimer(ASender: TObject);
 
1969
var
 
1970
  lButton: TCDControlState;
 
1971
  lMousePos: TPoint;
 
1972
begin
 
1973
  lMousePos := ScreenToClient(Mouse.CursorPos);
 
1974
  lButton := GetButtonFromMousePos(lMousePos.X, lMousePos.Y);
 
1975
  if lButton = FButton then DoClickButton(FButton, True);
 
1976
end;
 
1977
 
 
1978
function TCDPositionedControl.GetPositionFromMousePosWithMargins(X, Y,
 
1979
  ALeftMargin, ARightMargin: Integer; AIsHorizontal, AAcceptMouseOutsideStrictArea: Boolean): integer;
 
1980
var
 
1981
  lCoord, lSize: Integer;
 
1982
begin
 
1983
  Result := -1;
 
1984
 
 
1985
  if AIsHorizontal then
 
1986
  begin
 
1987
    lCoord := X;
 
1988
    lSize := Width;
 
1989
  end
 
1990
  else
 
1991
  begin
 
1992
    lCoord := Y;
 
1993
    lSize := Height;
 
1994
  end;
 
1995
 
 
1996
  if lCoord > lSize - ARightMargin then
 
1997
  begin
 
1998
    if AAcceptMouseOutsideStrictArea then Result := FMax;
 
1999
    Exit;
 
2000
  end
 
2001
  else if lCoord < ALeftMargin then
 
2002
  begin
 
2003
    if AAcceptMouseOutsideStrictArea then Result := FMin;
 
2004
    Exit;
 
2005
  end
 
2006
  else Result := FMin + (lCoord - ALeftMargin) * (FMax - FMin + 1) div (lSize - ARightMargin - ALeftMargin);
 
2007
 
 
2008
  // sanity check
 
2009
  if Result > FMax then Result := FMax;
 
2010
  if Result < FMin then Result := FMin;
 
2011
end;
 
2012
 
 
2013
function TCDPositionedControl.GetPositionDisplacementWithMargins(AOldMousePos,
 
2014
  ANewMousePos: TPoint; ALeftMargin, ARightMargin: Integer; AIsHorizontal: Boolean): Integer;
 
2015
var
 
2016
  lCoord, lSize: Integer;
 
2017
begin
 
2018
  if AIsHorizontal then
 
2019
  begin
 
2020
    lCoord := ANewMousePos.X-AOldMousePos.X;
 
2021
    lSize := Width;
 
2022
  end
 
2023
  else
 
2024
  begin
 
2025
    lCoord := ANewMousePos.Y-AOldMousePos.Y;
 
2026
    lSize := Height;
 
2027
  end;
 
2028
 
 
2029
  Result := FMin + (lCoord - ALeftMargin) * (FMax - FMin + 1) div (lSize - ARightMargin - ALeftMargin);
 
2030
  Result := FPositionAtMouseDown + Result;
 
2031
 
 
2032
  // sanity check
 
2033
  if Result > FMax then Result := FMax;
 
2034
  if Result < FMin then Result := FMin;
 
2035
end;
 
2036
 
 
2037
function TCDPositionedControl.GetButtonFromMousePos(X, Y: Integer): TCDControlState;
 
2038
begin
 
2039
  Result := [];
 
2040
end;
 
2041
 
 
2042
procedure TCDPositionedControl.CreateControlStateEx;
 
2043
begin
 
2044
  FPCState := TCDPositionedCStateEx.Create;
 
2045
  FStateEx := FPCState;
 
2046
end;
 
2047
 
 
2048
procedure TCDPositionedControl.PrepareControlStateEx;
 
2049
begin
 
2050
  inherited PrepareControlStateEx;
 
2051
 
 
2052
  if FMin < FMax then FPCState.FloatPos := FPosition / (FMax - FMin)
 
2053
  else FPCState.FloatPos := 0.0;
 
2054
 
 
2055
  FPCState.PosCount := FMax - FMin + 1;
 
2056
  FPCState.Position := FPosition - FMin;
 
2057
 
 
2058
  if FMin < FMax then FPCState.FloatPageSize := FPageSize / (FMax - FMin)
 
2059
  else FPCState.FloatPageSize := 1.0;
 
2060
end;
 
2061
 
 
2062
procedure TCDPositionedControl.KeyDown(var Key: word; Shift: TShiftState);
 
2063
var
 
2064
  NewPosition: Integer;
 
2065
begin
 
2066
  inherited KeyDown(Key, Shift);
 
2067
 
 
2068
  if (Key = VK_LEFT) or (Key = VK_DOWN) then
 
2069
    NewPosition := FPosition - FSmallChange;
 
2070
  if (Key = VK_UP) or (Key = VK_RIGHT) then
 
2071
    NewPosition := FPosition + FSmallChange;
 
2072
  if (Key = VK_PRIOR) then
 
2073
    NewPosition := FPosition - FLargeChange;
 
2074
  if (Key = VK_NEXT) then
 
2075
    NewPosition := FPosition + FLargeChange;
 
2076
 
 
2077
  // sanity check
 
2078
  if NewPosition >= 0 then
 
2079
  begin
 
2080
    if NewPosition > FMax then NewPosition := FMax;
 
2081
    if NewPosition < FMin then NewPosition := FMin;
 
2082
 
 
2083
    if (NewPosition <> Position) then
 
2084
    begin
 
2085
      Position := NewPosition;
 
2086
      if Assigned(FOnChangeByUser) then FOnChangeByUser(Self);
 
2087
    end;
 
2088
  end;
 
2089
end;
 
2090
 
 
2091
procedure TCDPositionedControl.MouseDown(Button: TMouseButton;
 
2092
  Shift: TShiftState; X, Y: integer);
 
2093
var
 
2094
  NewPosition: Integer;
 
2095
begin
 
2096
  SetFocus;
 
2097
  if FMoveByDragging then
 
2098
  begin
 
2099
    FLastMouseDownPos := Point(X, Y);
 
2100
    FPositionAtMouseDown := Position;
 
2101
    DragDropStarted := True;
 
2102
  end
 
2103
  else
 
2104
  begin
 
2105
    NewPosition := GetPositionFromMousePos(X, Y);
 
2106
    DragDropStarted := True;
 
2107
    if (NewPosition >= 0) and (NewPosition <> Position) then
 
2108
    begin
 
2109
      Position := NewPosition;
 
2110
      if Assigned(FOnChangeByUser) then FOnChangeByUser(Self);
 
2111
    end;
 
2112
  end;
 
2113
 
 
2114
  // Check if any buttons were clicked
 
2115
  FButton := GetButtonFromMousePos(X, Y);
 
2116
  FState := FState + FButton;
 
2117
  if FButton <> [] then
 
2118
  begin
 
2119
    DoClickButton(FButton, False);
 
2120
    FBtnClickTimer.Enabled := True;
 
2121
  end;
 
2122
 
 
2123
  inherited MouseDown(Button, Shift, X, Y);
 
2124
end;
 
2125
 
 
2126
procedure TCDPositionedControl.MouseMove(Shift: TShiftState; X, Y: integer);
 
2127
var
 
2128
  NewPosition: Integer;
 
2129
begin
 
2130
  if DragDropStarted then
 
2131
  begin
 
2132
    if FMoveByDragging then
 
2133
    begin
 
2134
      NewPosition := FPositionAtMouseDown + GetPositionDisplacement(FLastMouseDownPos, Point(X, Y));
 
2135
      if NewPosition <> Position then
 
2136
      begin
 
2137
        Position := NewPosition;
 
2138
        if Assigned(FOnChangeByUser) then FOnChangeByUser(Self);
 
2139
      end;
 
2140
    end
 
2141
    else
 
2142
    begin
 
2143
      NewPosition := GetPositionFromMousePos(X, Y);
 
2144
      if (NewPosition >= 0) and (NewPosition <> Position) then
 
2145
      begin
 
2146
        Position := NewPosition;
 
2147
        if Assigned(FOnChangeByUser) then FOnChangeByUser(Self);
 
2148
      end;
 
2149
    end;
 
2150
  end;
 
2151
  inherited MouseMove(Shift, X, Y);
 
2152
end;
 
2153
 
 
2154
procedure TCDPositionedControl.MouseUp(Button: TMouseButton;
 
2155
  Shift: TShiftState; X, Y: integer);
 
2156
begin
 
2157
  DragDropStarted := False;
 
2158
  FBtnClickTimer.Enabled := False;
 
2159
  FState := FState - [csfLeftArrow, csfRightArrow];
 
2160
  Invalidate;
 
2161
  inherited MouseUp(Button, Shift, X, Y);
 
2162
end;
 
2163
 
 
2164
constructor TCDPositionedControl.Create(AOwner: TComponent);
 
2165
begin
 
2166
  inherited Create(AOwner);
 
2167
  FSmallChange := 1;
 
2168
  FLargeChange := 5;
 
2169
  FMin := 0;
 
2170
  FMax := 10;
 
2171
  FPosition := 0;
 
2172
  FBtnClickTimer := TTimer.Create(nil);
 
2173
  FBtnClickTimer.Enabled := False;
 
2174
  FBtnClickTimer.Interval := 100;
 
2175
  FBtnClickTimer.OnTimer := @HandleBtnClickTimer;
 
2176
end;
 
2177
 
 
2178
destructor TCDPositionedControl.Destroy;
 
2179
begin
 
2180
  FBtnClickTimer.Free;
 
2181
  inherited Destroy;
 
2182
end;
 
2183
 
 
2184
{ TCDScrollBar }
 
2185
 
 
2186
procedure TCDScrollBar.SetKind(AValue: TScrollBarKind);
 
2187
begin
 
2188
  if FKind=AValue then Exit;
 
2189
  FKind:=AValue;
 
2190
 
 
2191
  if not (csLoading in ComponentState) then Invalidate;
 
2192
end;
 
2193
 
 
2194
function TCDScrollBar.GetPositionFromMousePos(X, Y: Integer): integer;
 
2195
var
 
2196
  lLeftBorder, lRightBorder: Integer;
 
2197
begin
 
2198
  lLeftBorder := FDrawer.GetMeasures(TCDSCROLLBAR_LEFT_SPACING);
 
2199
  lRightBorder := FDrawer.GetMeasures(TCDSCROLLBAR_RIGHT_SPACING);
 
2200
 
 
2201
  Result := GetPositionFromMousePosWithMargins(X, Y, lLeftBorder, lRightBorder, FKind = sbHorizontal, False);
 
2202
end;
 
2203
 
 
2204
function TCDScrollBar.GetButtonFromMousePos(X, Y: Integer): TCDControlState;
 
2205
var
 
2206
  lCoord, lLeftBtnPos, lRightBtnPos: Integer;
 
2207
begin
 
2208
  Result := [];
 
2209
  lLeftBtnPos := FDrawer.GetMeasures(TCDSCROLLBAR_LEFT_BUTTON_POS);
 
2210
  lRightBtnPos := FDrawer.GetMeasures(TCDSCROLLBAR_RIGHT_BUTTON_POS);
 
2211
  if FKind = sbHorizontal then
 
2212
  begin
 
2213
    lCoord := X;
 
2214
    if lLeftBtnPos < 0 then lLeftBtnPos := Width + lLeftBtnPos;
 
2215
    if lRightBtnPos < 0 then lRightBtnPos := Width + lRightBtnPos;
 
2216
  end
 
2217
  else
 
2218
  begin
 
2219
    lCoord := Y;
 
2220
    if lLeftBtnPos < 0 then lLeftBtnPos := Height + lLeftBtnPos;
 
2221
    if lRightBtnPos < 0 then lRightBtnPos := Height + lRightBtnPos;
 
2222
  end;
 
2223
 
 
2224
  if (lCoord > lLeftBtnPos) and (lCoord < lLeftBtnPos +
 
2225
    FDrawer.GetMeasures(TCDSCROLLBAR_BUTTON_WIDTH)) then Result := [csfLeftArrow]
 
2226
  else if (lCoord > lRightBtnPos) and (lCoord < lRightBtnPos +
 
2227
    FDrawer.GetMeasures(TCDSCROLLBAR_BUTTON_WIDTH)) then Result := [csfRightArrow];
 
2228
end;
 
2229
 
 
2230
function TCDScrollBar.GetPositionDisplacement(AOldMousePos, ANewMousePos: TPoint
 
2231
  ): Integer;
 
2232
var
 
2233
  lLeftBorder, lRightBorder: Integer;
 
2234
begin
 
2235
  lLeftBorder := FDrawer.GetMeasures(TCDSCROLLBAR_LEFT_SPACING);
 
2236
  lRightBorder := FDrawer.GetMeasures(TCDSCROLLBAR_RIGHT_SPACING);
 
2237
 
 
2238
  Result := GetPositionDisplacementWithMargins(AOldMousePos, ANewMousePos,
 
2239
    lLeftBorder, lRightBorder, FKind = sbHorizontal);
 
2240
end;
 
2241
 
 
2242
function TCDScrollBar.GetControlId: TCDControlID;
 
2243
begin
 
2244
  Result:= cidScrollBar;
 
2245
end;
 
2246
 
 
2247
procedure TCDScrollBar.PrepareControlState;
 
2248
begin
 
2249
  inherited PrepareControlState;
 
2250
 
 
2251
  if FKind = sbHorizontal then
 
2252
    FState := FState + [csfHorizontal] - [csfVertical, csfRightToLeft, csfTopDown]
 
2253
  else FState := FState + [csfVertical] - [csfHorizontal, csfRightToLeft, csfTopDown];
 
2254
end;
 
2255
 
 
2256
constructor TCDScrollBar.Create(AOwner: TComponent);
 
2257
begin
 
2258
  inherited Create(AOwner);
 
2259
  Width := 121;
 
2260
  Height := 17;
 
2261
  FMax := 100;
 
2262
  FMoveByDragging := True;
 
2263
end;
 
2264
 
 
2265
destructor TCDScrollBar.Destroy;
 
2266
begin
 
2267
  inherited Destroy;
 
2268
end;
 
2269
 
 
2270
{ TCDGroupBox }
 
2271
 
 
2272
function TCDGroupBox.GetControlId: TCDControlID;
 
2273
begin
 
2274
  Result := cidGroupBox;
 
2275
end;
 
2276
 
 
2277
procedure TCDGroupBox.RealSetText(const Value: TCaption);
 
2278
begin
 
2279
  inherited RealSetText(Value);
 
2280
  if not (csLoading in ComponentState) then Invalidate;
 
2281
end;
 
2282
 
 
2283
constructor TCDGroupBox.Create(AOwner: TComponent);
 
2284
begin
 
2285
  inherited Create(AOwner);
 
2286
  Width := 100;
 
2287
  Height := 100;
 
2288
  TabStop := False;
 
2289
  AutoSize := True;
 
2290
end;
 
2291
 
 
2292
destructor TCDGroupBox.Destroy;
 
2293
begin
 
2294
  inherited Destroy;
 
2295
end;
 
2296
 
 
2297
{ TCDStaticText }
 
2298
 
 
2299
function TCDStaticText.GetControlId: TCDControlID;
 
2300
begin
 
2301
  Result:=cidStaticText;
 
2302
end;
 
2303
 
 
2304
procedure TCDStaticText.RealSetText(const Value: TCaption);
 
2305
begin
 
2306
  inherited RealSetText(Value);
 
2307
  Invalidate;
 
2308
end;
 
2309
 
 
2310
constructor TCDStaticText.Create(AOwner: TComponent);
 
2311
begin
 
2312
  inherited Create(AOwner);
 
2313
  Width := 70;
 
2314
  Height := 20;
 
2315
  TabStop := False;
 
2316
  ControlStyle := ControlStyle - [csAcceptsControls];
 
2317
end;
 
2318
 
 
2319
destructor TCDStaticText.Destroy;
 
2320
begin
 
2321
  inherited Destroy;
 
2322
end;
 
2323
 
 
2324
{ TCDTrackBar }
 
2325
 
 
2326
procedure TCDTrackBar.SetOrientation(AValue: TTrackBarOrientation);
 
2327
var
 
2328
  lOldWidth: Integer;
 
2329
begin
 
2330
  if FOrientation=AValue then Exit;
 
2331
 
 
2332
  // Invert the width and the height, but not if the property comes from the LFM
 
2333
  // because the width was already inverted in the designer and stored in the new value
 
2334
  if not (csLoading in ComponentState) then
 
2335
  begin
 
2336
    lOldWidth := Width;
 
2337
    Width := Height;
 
2338
    Height := lOldWidth;
 
2339
  end;
 
2340
 
 
2341
  // Set the property and redraw
 
2342
  FOrientation:=AValue;
 
2343
  if not (csLoading in ComponentState) then
 
2344
    Invalidate;
 
2345
end;
 
2346
 
 
2347
function TCDTrackBar.GetPositionFromMousePos(X, Y: Integer): integer;
 
2348
var
 
2349
  lLeftBorder, lRightBorder: Integer;
 
2350
begin
 
2351
  lLeftBorder := FDrawer.GetMeasures(TCDTRACKBAR_LEFT_SPACING);
 
2352
  lRightBorder := FDrawer.GetMeasures(TCDTRACKBAR_RIGHT_SPACING);
 
2353
 
 
2354
  Result := GetPositionFromMousePosWithMargins(X, Y, lLeftBorder, lRightBorder, FOrientation = trHorizontal, True);
 
2355
end;
 
2356
 
 
2357
function TCDTrackBar.GetPositionDisplacement(AOldMousePos, ANewMousePos: TPoint
 
2358
  ): Integer;
 
2359
begin
 
2360
  Result := 0; // not used anyway
 
2361
end;
 
2362
 
 
2363
function TCDTrackBar.GetControlId: TCDControlID;
 
2364
begin
 
2365
  Result := cidTrackBar;
 
2366
end;
 
2367
 
 
2368
procedure TCDTrackBar.PrepareControlState;
 
2369
begin
 
2370
  inherited PrepareControlState;
 
2371
  case FOrientation of
 
2372
  trHorizontal: FState := FState + [csfHorizontal] - [csfVertical, csfRightToLeft, csfTopDown];
 
2373
  trVertical: FState := FState + [csfVertical] - [csfHorizontal, csfRightToLeft, csfTopDown];
 
2374
  end;
 
2375
end;
 
2376
 
 
2377
constructor TCDTrackBar.Create(AOwner: TComponent);
 
2378
begin
 
2379
  inherited Create(AOwner);
 
2380
  Height := 25;
 
2381
  Width := 100;
 
2382
 
 
2383
  TabStop := True;
 
2384
end;
 
2385
 
 
2386
destructor TCDTrackBar.Destroy;
 
2387
begin
 
2388
  inherited Destroy;
 
2389
end;
 
2390
 
 
2391
{ TCDProgressBar }
 
2392
 
 
2393
procedure TCDProgressBar.SetMax(AValue: integer);
 
2394
begin
 
2395
  if FMax=AValue then Exit;
 
2396
  FMax:=AValue;
 
2397
  if not (csLoading in ComponentState) then Invalidate;
 
2398
end;
 
2399
 
 
2400
procedure TCDProgressBar.SetBarShowText(AValue: Boolean);
 
2401
begin
 
2402
  if FBarShowText=AValue then Exit;
 
2403
  FBarShowText:=AValue;
 
2404
  if not (csLoading in ComponentState) then Invalidate;
 
2405
end;
 
2406
 
 
2407
procedure TCDProgressBar.SetMin(AValue: integer);
 
2408
begin
 
2409
  if FMin=AValue then Exit;
 
2410
  FMin:=AValue;
 
2411
  if not (csLoading in ComponentState) then Invalidate;
 
2412
end;
 
2413
 
 
2414
procedure TCDProgressBar.SetOrientation(AValue: TProgressBarOrientation);
 
2415
var
 
2416
  lOldWidth: Integer;
 
2417
begin
 
2418
  if FOrientation=AValue then Exit;
 
2419
  FOrientation:=AValue;
 
2420
  if not (csLoading in ComponentState) then Invalidate;
 
2421
end;
 
2422
 
 
2423
procedure TCDProgressBar.SetPosition(AValue: integer);
 
2424
begin
 
2425
  if FPosition=AValue then Exit;
 
2426
  FPosition:=AValue;
 
2427
  if not (csLoading in ComponentState) then Invalidate;
 
2428
end;
 
2429
 
 
2430
procedure TCDProgressBar.SetSmooth(AValue: Boolean);
 
2431
begin
 
2432
  if FSmooth=AValue then Exit;
 
2433
  FSmooth:=AValue;
 
2434
  if not (csLoading in ComponentState) then
 
2435
    Invalidate;
 
2436
end;
 
2437
 
 
2438
procedure TCDProgressBar.SetStyle(AValue: TProgressBarStyle);
 
2439
begin
 
2440
  if FStyle=AValue then Exit;
 
2441
  FStyle:=AValue;
 
2442
  if not (csLoading in ComponentState) then Invalidate;
 
2443
end;
 
2444
 
 
2445
function TCDProgressBar.GetControlId: TCDControlID;
 
2446
begin
 
2447
  Result := cidProgressBar;
 
2448
end;
 
2449
 
 
2450
procedure TCDProgressBar.CreateControlStateEx;
 
2451
begin
 
2452
  FPBState := TCDProgressBarStateEx.Create;
 
2453
  FStateEx := FPBState;
 
2454
end;
 
2455
 
 
2456
procedure TCDProgressBar.PrepareControlStateEx;
 
2457
begin
 
2458
  inherited PrepareControlStateEx;
 
2459
  if FMax <> FMin then FPBState.PercentPosition := (FPosition-FMin)/(FMax-FMin)
 
2460
  else FPBState.PercentPosition := 1.0;
 
2461
  FPBState.BarShowText := FBarShowText;
 
2462
  FPBState.Style := FStyle;
 
2463
  case FOrientation of
 
2464
  pbHorizontal:  FState := FState + [csfHorizontal] - [csfVertical, csfRightToLeft, csfTopDown];
 
2465
  pbVertical:    FState := FState + [csfVertical] - [csfHorizontal, csfRightToLeft, csfTopDown];
 
2466
  pbRightToLeft: FState := FState + [csfRightToLeft] - [csfVertical, csfHorizontal, csfTopDown];
 
2467
  pbTopDown:     FState := FState + [csfTopDown] - [csfVertical, csfRightToLeft, csfHorizontal];
 
2468
  end;
 
2469
  FPBState.Smooth := FSmooth;
 
2470
end;
 
2471
 
 
2472
constructor TCDProgressBar.Create(AOwner: TComponent);
 
2473
begin
 
2474
  inherited Create(AOwner);
 
2475
  Width := 100;
 
2476
  Height := 20;
 
2477
  FMax := 100;
 
2478
  TabStop := False;
 
2479
end;
 
2480
 
 
2481
destructor TCDProgressBar.Destroy;
 
2482
begin
 
2483
  inherited Destroy;
 
2484
end;
 
2485
 
 
2486
{ TCDListView }
 
2487
 
 
2488
function TCDListView.GetProperty(AIndex: Integer): Boolean;
 
2489
begin
 
2490
  Result := False;
 
2491
end;
 
2492
 
 
2493
procedure TCDListView.SetColumns(AValue: TListColumns);
 
2494
begin
 
2495
  if FColumns=AValue then Exit;
 
2496
  FColumns:=AValue;
 
2497
  if not (csLoading in ComponentState) then Invalidate;
 
2498
end;
 
2499
 
 
2500
procedure TCDListView.SetProperty(AIndex: Integer; AValue: Boolean);
 
2501
begin
 
2502
 
 
2503
end;
 
2504
 
 
2505
procedure TCDListView.SetShowColumnHeader(AValue: Boolean);
 
2506
begin
 
2507
  if FShowColumnHeader=AValue then Exit;
 
2508
  FShowColumnHeader:=AValue;
 
2509
  if not (csLoading in ComponentState) then Invalidate;
 
2510
end;
 
2511
 
 
2512
procedure TCDListView.SetViewStyle(AValue: TViewStyle);
 
2513
begin
 
2514
  if FViewStyle=AValue then Exit;
 
2515
  FViewStyle:=AValue;
 
2516
  if not (csLoading in ComponentState) then Invalidate;
 
2517
end;
 
2518
 
 
2519
function TCDListView.GetControlId: TCDControlID;
 
2520
begin
 
2521
  Result := cidListView;
 
2522
end;
 
2523
 
 
2524
procedure TCDListView.CreateControlStateEx;
 
2525
begin
 
2526
  FLVState := TCDListViewStateEx.Create;
 
2527
  FStateEx := FLVState;
 
2528
end;
 
2529
 
 
2530
procedure TCDListView.PrepareControlStateEx;
 
2531
begin
 
2532
  inherited PrepareControlStateEx;
 
2533
  FLVState.Items := FListItems;
 
2534
  FLVState.Columns := FColumns;
 
2535
  FLVState.ViewStyle := FViewStyle;
 
2536
  FLVState.ShowColumnHeader := FShowColumnHeader;
 
2537
end;
 
2538
 
 
2539
constructor TCDListView.Create(AOwner: TComponent);
 
2540
begin
 
2541
  inherited Create(AOwner);
 
2542
  Width := 250;
 
2543
  Height := 150;
 
2544
  FColumns := TListColumns.Create(nil);
 
2545
  FListItems := TCDListItems.Create();
 
2546
  TabStop := True;
 
2547
  FShowColumnHeader := True;
 
2548
//  FProperties: TListViewProperties;
 
2549
//  FViewStyle: TViewStyle;
 
2550
 
 
2551
  ScrollBars := ssBoth;
 
2552
end;
 
2553
 
 
2554
destructor TCDListView.Destroy;
 
2555
begin
 
2556
  FColumns.Free;
 
2557
  FListItems.Free;
 
2558
  inherited Destroy;
 
2559
end;
 
2560
 
 
2561
{ TCDTabSheet }
 
2562
 
 
2563
procedure TCDTabSheet.RealSetText(const Value: TCaption);
 
2564
var
 
2565
  lIndex: Integer;
 
2566
begin
 
2567
  inherited RealSetText(Value);
 
2568
  lIndex := CDTabControl.Tabs.IndexOfObject(Self);
 
2569
  if lIndex >= 0 then
 
2570
    CDTabControl.Tabs.Strings[lIndex] := Value;
 
2571
  CDTabControl.Invalidate;
 
2572
end;
 
2573
 
 
2574
procedure TCDTabSheet.SetParent(NewParent: TWinControl);
 
2575
begin
 
2576
  inherited SetParent(NewParent);
 
2577
  // Code adding tabs added via the object inspector
 
2578
  if (csLoading in ComponentState) and
 
2579
    (NewParent <> nil) and (NewParent is TCDPageControl) then
 
2580
  begin
 
2581
    CDTabControl := NewParent as TCDCustomTabControl;
 
2582
    TCDPageControl(CDTabControl).AddPage(Self);
 
2583
  end;
 
2584
end;
 
2585
 
 
2586
constructor TCDTabSheet.Create(AOwner: TComponent);
 
2587
begin
 
2588
  inherited Create(AOwner);
 
2589
 
 
2590
  TabStop := False;
 
2591
  ParentColor := True;
 
2592
  parentFont := True;
 
2593
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
 
2594
    csDesignFixedBounds, csDoubleClicks, csDesignInteractive];
 
2595
  //ControlStyle := ControlStyle + [csAcceptsControls, csDesignFixedBounds,
 
2596
  //  csNoDesignVisible, csNoFocus];
 
2597
end;
 
2598
 
 
2599
destructor TCDTabSheet.Destroy;
 
2600
var
 
2601
  lIndex: Integer;
 
2602
begin
 
2603
  // We should support deleting the tabsheet directly too,
 
2604
  // and then it should update the tabcontrol
 
2605
  // This is important mostly for the designer
 
2606
  if CDTabControl <> nil then
 
2607
  begin
 
2608
    lIndex := CDTabControl.FTabs.IndexOfObject(Self);
 
2609
    if lIndex >= 0 then
 
2610
    begin
 
2611
      CDTabControl.FTabs.Delete(lIndex);
 
2612
      CDTabControl.CorrectTabIndex();
 
2613
    end;
 
2614
  end;
 
2615
 
 
2616
  inherited Destroy;
 
2617
end;
 
2618
 
 
2619
procedure TCDTabSheet.EraseBackground(DC: HDC);
 
2620
begin
 
2621
 
 
2622
end;
 
2623
 
 
2624
procedure TCDTabSheet.Paint;
 
2625
var
 
2626
  lSize: TSize;
 
2627
begin
 
2628
  if CDTabControl <> nil then
 
2629
  begin
 
2630
    lSize := Size(Width, Height);
 
2631
    CDTabControl.FDrawer.DrawTabSheet(Canvas, Point(0, 0), lSize, CDTabControl.FState,
 
2632
      CDTabControl.FTabCState);
 
2633
  end;
 
2634
end;
 
2635
 
 
2636
{ TCDCustomTabControl }
 
2637
 
 
2638
procedure TCDCustomTabControl.MouseDown(Button: TMouseButton;
 
2639
  Shift: TShiftState; X, Y: integer);
 
2640
var
 
2641
  lTabIndex: Integer;
 
2642
begin
 
2643
  inherited MouseDown(Button, Shift, X, Y);
 
2644
 
 
2645
  lTabIndex := MousePosToTabIndex(X, Y);
 
2646
 
 
2647
  if lTabIndex >=0 then
 
2648
  begin
 
2649
    if Self is TCDPageControl then
 
2650
      (Self as TCDPageControl).PageIndex := lTabIndex
 
2651
    else
 
2652
      TabIndex := lTabIndex;
 
2653
  end;
 
2654
end;
 
2655
 
 
2656
procedure TCDCustomTabControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
 
2657
  X, Y: integer);
 
2658
var
 
2659
  lTabIndex, lCloseButtonSize: Integer;
 
2660
  lNewPage: TCDTabSheet;
 
2661
  lCloseButtonPos: TPoint;
 
2662
begin
 
2663
  inherited MouseUp(Button, Shift, X, Y);
 
2664
 
 
2665
  lTabIndex := MousePosToTabIndex(X, Y);
 
2666
 
 
2667
  // Check if the add button was clicked
 
2668
  if (nboShowAddTabButton in Options) and (lTabIndex = Tabs.Count) then
 
2669
  begin
 
2670
    if Self is TCDPageControl then
 
2671
    begin
 
2672
      lNewPage := (Self as TCDPageControl).AddPage('New Page');
 
2673
      if Assigned(OnUserAddedPage) then OnUserAddedPage(Self, lNewPage);
 
2674
    end
 
2675
    else
 
2676
    begin
 
2677
      Tabs.Add('New Tab');
 
2678
      if Assigned(OnUserAddedPage) then OnUserAddedPage(Self, nil);
 
2679
    end;
 
2680
  end
 
2681
  // Check if a close button was clicked
 
2682
  else if (nboShowCloseButtons in Options) and (lTabIndex >= 0) then
 
2683
  begin
 
2684
    FTabCState.CurTabIndex := lTabIndex;
 
2685
    lCloseButtonPos.X := FDrawer.GetMeasuresEx(Canvas, TCDCTABCONTROL_CLOSE_BUTTON_POS_X, FState, FStateEx);
 
2686
    lCloseButtonPos.Y := FDrawer.GetMeasuresEx(Canvas, TCDCTABCONTROL_CLOSE_BUTTON_POS_Y, FState, FStateEx);
 
2687
    lCloseButtonSize := FDrawer.GetMeasures(TCDCTABCONTROL_CLOSE_TAB_BUTTON_WIDTH);
 
2688
    if (X >= lCloseButtonPos.X) and (X <= lCloseButtonPos.X + lCloseButtonSize) and
 
2689
       (Y >= lCloseButtonPos.Y) and (Y <= lCloseButtonPos.Y + lCloseButtonSize) then
 
2690
    begin
 
2691
      if Self is TCDPageControl then (Self as TCDPageControl).RemovePage(lTabIndex)
 
2692
      else Tabs.Delete(lTabIndex);
 
2693
    end;
 
2694
  end;
 
2695
end;
 
2696
 
 
2697
procedure TCDCustomTabControl.SetOptions(AValue: TCTabControlOptions);
 
2698
begin
 
2699
  if FOptions=AValue then Exit;
 
2700
  FOptions:=AValue;
 
2701
  Invalidate;
 
2702
end;
 
2703
 
 
2704
procedure TCDCustomTabControl.SetTabIndex(AValue: Integer);
 
2705
begin
 
2706
  if FTabIndex = AValue then Exit;
 
2707
  if Assigned(OnChanging) then OnChanging(Self);
 
2708
  FTabIndex := AValue;
 
2709
  if Assigned(OnChange) then OnChange(Self);
 
2710
  Invalidate;
 
2711
end;
 
2712
 
 
2713
procedure TCDCustomTabControl.SetTabs(AValue: TStringList);
 
2714
begin
 
2715
  if FTabs=AValue then Exit;
 
2716
  FTabs.Assign(AValue);
 
2717
  CorrectTabIndex();
 
2718
  Invalidate;
 
2719
end;
 
2720
 
 
2721
function TCDCustomTabControl.MousePosToTabIndex(X, Y: Integer): Integer;
 
2722
var
 
2723
  i: Integer;
 
2724
  CurPage: TCDTabSheet;
 
2725
  CurStartLeftPos: Integer = 0;
 
2726
  VisiblePagesStarted: Boolean = False;
 
2727
  lLastTab, lTabWidth, lTabHeight: Integer;
 
2728
begin
 
2729
  Result := -1;
 
2730
 
 
2731
  if nboShowAddTabButton in Options then lLastTab := Tabs.Count
 
2732
  else lLastTab := Tabs.Count - 1;
 
2733
 
 
2734
  for i := 0 to lLastTab do
 
2735
  begin
 
2736
    if i = FTabCState.LeftmostTabVisibleIndex then
 
2737
      VisiblePagesStarted := True;
 
2738
 
 
2739
    if VisiblePagesStarted then
 
2740
    begin
 
2741
      FTabCState.CurTabIndex := i;
 
2742
      lTabWidth := FDrawer.GetMeasuresEx(Canvas, TCDCTABCONTROL_TAB_WIDTH, FState, FTabCState);
 
2743
      lTabHeight := FDrawer.GetMeasuresEx(Canvas, TCDCTABCONTROL_TAB_HEIGHT, FState, FTabCState);
 
2744
      if (X > CurStartLeftPos) and
 
2745
        (X < CurStartLeftPos + lTabWidth) and
 
2746
        (Y < lTabHeight) then
 
2747
      begin
 
2748
        Exit(i);
 
2749
      end;
 
2750
      CurStartLeftPos := CurStartLeftPos + lTabWidth;
 
2751
    end;
 
2752
  end;
 
2753
end;
 
2754
 
 
2755
function TCDCustomTabControl.GetControlId: TCDControlID;
 
2756
begin
 
2757
  Result := cidCTabControl;
 
2758
end;
 
2759
 
 
2760
procedure TCDCustomTabControl.CreateControlStateEx;
 
2761
begin
 
2762
  FTabCState := TCDCTabControlStateEx.Create;
 
2763
  FStateEx := FTabCState;
 
2764
end;
 
2765
 
 
2766
procedure TCDCustomTabControl.PrepareControlStateEx;
 
2767
begin
 
2768
  inherited PrepareControlStateEx;
 
2769
 
 
2770
  FTabCState.Tabs := Tabs;
 
2771
  FTabCState.TabIndex := TabIndex;
 
2772
  FTabCState.TabCount := GetTabCount();
 
2773
  FTabCState.Options := FOptions;
 
2774
end;
 
2775
 
 
2776
constructor TCDCustomTabControl.Create(AOwner: TComponent);
 
2777
begin
 
2778
  inherited Create(AOwner);
 
2779
 
 
2780
  Width := 232;
 
2781
  Height := 184;
 
2782
  TabStop := True;
 
2783
 
 
2784
  ParentColor := True;
 
2785
  ParentFont := True;
 
2786
  ControlStyle := ControlStyle + [csAcceptsControls, csDesignInteractive];
 
2787
 
 
2788
  // FTabs should hold only visible tabs
 
2789
  FTabs := TStringList.Create;
 
2790
end;
 
2791
 
 
2792
destructor TCDCustomTabControl.Destroy;
 
2793
begin
 
2794
  FTabs.Free;
 
2795
 
 
2796
  inherited Destroy;
 
2797
end;
 
2798
 
 
2799
function TCDCustomTabControl.GetTabCount: Integer;
 
2800
begin
 
2801
  Result := 0;
 
2802
  if FTabs <> nil then Result := FTabs.Count;
 
2803
end;
 
2804
 
 
2805
procedure TCDCustomTabControl.CorrectTabIndex;
 
2806
begin
 
2807
  if FTabIndex >= FTabs.Count then SetTabIndex(FTabs.Count - 1);
 
2808
end;
 
2809
 
 
2810
{ TCDPageControl }
 
2811
 
 
2812
function TCDPageControl.AddPage(S: string): TCDTabSheet;
 
2813
//  InsertPage(FPages.Count, S);
 
2814
var
 
2815
  NewPage: TCDTabSheet;
 
2816
begin
 
2817
  NewPage := TCDTabSheet.Create(Owner);
 
2818
  NewPage.Parent := Self;
 
2819
  NewPage.CDTabControl := Self;
 
2820
  NewPage.Caption := S;
 
2821
 
 
2822
  PositionTabSheet(NewPage);
 
2823
 
 
2824
  FTabs.AddObject(S, NewPage);
 
2825
 
 
2826
  SetActivePage(NewPage);
 
2827
 
 
2828
  Result := NewPage;
 
2829
end;
 
2830
 
 
2831
procedure TCDPageControl.AddPage(APage: TCDTabSheet);
 
2832
begin
 
2833
  APage.CDTabControl := Self;
 
2834
  PositionTabSheet(APage);
 
2835
  FTabs.AddObject(APage.Caption, APage);
 
2836
  SetActivePage(APage);
 
2837
end;
 
2838
 
 
2839
function TCDPageControl.GetPage(AIndex: integer): TCDTabSheet;
 
2840
begin
 
2841
  if (AIndex >= 0) and (AIndex < FTabs.Count) then
 
2842
    Result := TCDTabSheet(FTabs.Objects[AIndex])
 
2843
  else
 
2844
    Result := nil;
 
2845
end;
 
2846
 
 
2847
function TCDPageControl.InsertPage(aIndex: integer; S: string): TCDTabSheet;
 
2848
var
 
2849
  NewPage: TCDTabSheet;
 
2850
begin
 
2851
  NewPage := TCDTabSheet.Create(Owner);
 
2852
  NewPage.Parent := Self;
 
2853
  NewPage.CDTabControl := Self;
 
2854
  NewPage.Caption := S;
 
2855
 
 
2856
  PositionTabSheet(NewPage);
 
2857
 
 
2858
  FTabs.InsertObject(AIndex, S, NewPage);
 
2859
 
 
2860
  SetActivePage(NewPage);
 
2861
  Result := NewPage;
 
2862
end;
 
2863
 
 
2864
procedure TCDPageControl.RemovePage(aIndex: integer);
 
2865
begin
 
2866
  if (AIndex < 0) or (AIndex >= FTabs.Count) then Exit;
 
2867
 
 
2868
  Application.ReleaseComponent(TComponent(FTabs.Objects[AIndex]));
 
2869
 
 
2870
  FTabs.Delete(aIndex);
 
2871
  if FTabIndex >= FTabs.Count then SetPageIndex(FTabIndex-1);
 
2872
 
 
2873
  Invalidate;
 
2874
end;
 
2875
 
 
2876
function TCDPageControl.FindNextPage(CurPage: TCDTabSheet;
 
2877
  GoForward, CheckTabVisible: boolean): TCDTabSheet;
 
2878
var
 
2879
  I, TempStartIndex: integer;
 
2880
begin
 
2881
  if FTabs.Count <> 0 then
 
2882
  begin
 
2883
    //StartIndex := FPages.IndexOfObject(CurPage);
 
2884
    TempStartIndex := FTabs.IndexOfObject(CurPage);
 
2885
    if TempStartIndex = -1 then
 
2886
      if GoForward then
 
2887
        TempStartIndex := FTabs.Count - 1
 
2888
      else
 
2889
        TempStartIndex := 0;
 
2890
    I := TempStartIndex;
 
2891
    repeat
 
2892
      if GoForward then
 
2893
      begin
 
2894
        Inc(I);
 
2895
        if I = FTabs.Count then
 
2896
          I := 0;
 
2897
      end
 
2898
      else
 
2899
      begin
 
2900
        if I = 0 then
 
2901
          I := FTabs.Count;
 
2902
        Dec(I);
 
2903
      end;
 
2904
      Result := TCDTabSheet(FTabs.Objects[I]);
 
2905
      if not CheckTabVisible or Result.Visible then
 
2906
        Exit;
 
2907
    until I = TempStartIndex;
 
2908
  end;
 
2909
  Result := nil;
 
2910
end;
 
2911
 
 
2912
procedure TCDPageControl.SelectNextPage(GoForward: boolean;
 
2913
  CheckTabVisible: boolean = True);
 
2914
var
 
2915
  Page: TCDTabSheet;
 
2916
begin
 
2917
  Page := FindNextPage(ActivePage, GoForward, CheckTabVisible);
 
2918
  if (Page <> nil) and (Page <> ActivePage) then
 
2919
    SetActivePage(Page);
 
2920
end;
 
2921
 
 
2922
constructor TCDPageControl.Create(AOwner: TComponent);
 
2923
begin
 
2924
  inherited Create(AOwner);
 
2925
 
 
2926
  ControlStyle := ControlStyle - [csAcceptsControls];
 
2927
end;
 
2928
 
 
2929
destructor TCDPageControl.Destroy;
 
2930
begin
 
2931
  inherited Destroy;
 
2932
end;
 
2933
 
 
2934
procedure TCDPageControl.SetActivePage(Value: TCDTabSheet);
 
2935
var
 
2936
  i: integer;
 
2937
  CurPage: TCDTabSheet;
 
2938
begin
 
2939
  for i := 0 to FTabs.Count - 1 do
 
2940
  begin
 
2941
    CurPage := TCDTabSheet(FTabs.Objects[i]);
 
2942
    if CurPage = Value then
 
2943
    begin
 
2944
      PositionTabSheet(CurPage);
 
2945
      CurPage.BringToFront;
 
2946
      CurPage.Visible := True;
 
2947
 
 
2948
      // Check first, Tab is Visible?
 
2949
      SetTabIndex(i);
 
2950
    end
 
2951
    else if CurPage <> nil then
 
2952
    begin
 
2953
      //CurPage.Align := alNone;
 
2954
      //CurPage.Height := 0;
 
2955
      CurPage.Visible := False;
 
2956
    end;
 
2957
  end;
 
2958
 
 
2959
  Invalidate;
 
2960
end;
 
2961
 
 
2962
procedure TCDPageControl.SetPageIndex(Value: integer);
 
2963
begin
 
2964
  if (Value > -1) and (Value < FTabs.Count) then
 
2965
  begin
 
2966
    SetTabIndex(Value);
 
2967
    ActivePage := GetPage(Value);
 
2968
  end;
 
2969
end;
 
2970
 
 
2971
procedure TCDPageControl.UpdateAllDesignerFlags;
 
2972
var
 
2973
  i: integer;
 
2974
begin
 
2975
  for i := 0 to FTabs.Count - 1 do
 
2976
    UpdateDesignerFlags(i);
 
2977
end;
 
2978
 
 
2979
procedure TCDPageControl.UpdateDesignerFlags(APageIndex: integer);
 
2980
var
 
2981
  CurPage: TCDTabSheet;
 
2982
begin
 
2983
  CurPage := GetPage(APageIndex);
 
2984
  if APageIndex <> fTabIndex then
 
2985
    CurPage.ControlStyle := CurPage.ControlStyle + [csNoDesignVisible]
 
2986
  else
 
2987
    CurPage.ControlStyle := CurPage.ControlStyle - [csNoDesignVisible];
 
2988
end;
 
2989
 
 
2990
procedure TCDPageControl.PositionTabSheet(ATabSheet: TCDTabSheet);
 
2991
var
 
2992
  lTabHeight, lIndex: Integer;
 
2993
  lClientArea: TRect;
 
2994
begin
 
2995
  lIndex := FTabs.IndexOfObject(ATabSheet);
 
2996
  FTabCState.TabIndex := lIndex;
 
2997
  PrepareControlState;
 
2998
  PrepareControlStateEx;
 
2999
  lClientArea := FDrawer.GetClientArea(Canvas, Size(Width, Height), GetControlId, FState, FStateEx);
 
3000
 
 
3001
  ATabSheet.BorderSpacing.Top := lClientArea.Top;
 
3002
  ATabSheet.BorderSpacing.Left := lClientArea.Left;
 
3003
  ATabSheet.BorderSpacing.Right := Width - lClientArea.Right;
 
3004
  ATabSheet.BorderSpacing.Bottom := Height - lClientArea.Bottom;
 
3005
  ATabSheet.Align := alClient;
 
3006
end;
 
3007
 
 
3008
function TCDPageControl.GetActivePage: TCDTabSheet;
 
3009
begin
 
3010
  Result := GetPage(FTabIndex);
 
3011
end;
 
3012
 
 
3013
function TCDPageControl.GetPageCount: integer;
 
3014
begin
 
3015
  Result := FTabs.Count;
 
3016
end;
 
3017
 
 
3018
function TCDPageControl.GetPageIndex: integer;
 
3019
begin
 
3020
  Result := FTabIndex;
 
3021
end;
 
3022
 
 
3023
{ TCDSpinEdit }
 
3024
 
 
3025
procedure TCDSpinEdit.UpDownChanging(Sender: TObject; var AllowChange: Boolean);
 
3026
begin
 
3027
  Value := FUpDown.Position / Power(10, FDecimalPlaces);
 
3028
end;
 
3029
 
 
3030
procedure TCDSpinEdit.SetIncrement(AValue: Double);
 
3031
begin
 
3032
  if FIncrement=AValue then Exit;
 
3033
  FIncrement:=AValue;
 
3034
  DoUpdateUpDown;
 
3035
end;
 
3036
 
 
3037
procedure TCDSpinEdit.SetDecimalPlaces(AValue: Byte);
 
3038
begin
 
3039
  if FDecimalPlaces=AValue then Exit;
 
3040
  FDecimalPlaces:=AValue;
 
3041
  DoUpdateUpDown;
 
3042
  DoUpdateText;
 
3043
end;
 
3044
 
 
3045
procedure TCDSpinEdit.SetMaxValue(AValue: Double);
 
3046
begin
 
3047
  if FMaxValue=AValue then Exit;
 
3048
  FMaxValue:=AValue;
 
3049
  if FValue > FMaxValue then Value := FMaxValue;
 
3050
  DoUpdateUpDown;
 
3051
end;
 
3052
 
 
3053
procedure TCDSpinEdit.SetMinValue(AValue: Double);
 
3054
begin
 
3055
  if FMinValue=AValue then Exit;
 
3056
  FMinValue:=AValue;
 
3057
  if FValue < FMinValue then Value := FMinValue;
 
3058
  DoUpdateUpDown;
 
3059
end;
 
3060
 
 
3061
procedure TCDSpinEdit.SetValue(AValue: Double);
 
3062
begin
 
3063
  if FValue=AValue then Exit;
 
3064
  if FValue < FMinValue then Exit;
 
3065
  if FValue > FMaxValue then Exit;
 
3066
  FValue:=AValue;
 
3067
  DoUpdateText;
 
3068
  DoUpdateUpDown;
 
3069
end;
 
3070
 
 
3071
procedure TCDSpinEdit.DoUpdateText;
 
3072
begin
 
3073
  if FDecimalPlaces > 0 then Text := FloatToStr(FValue)
 
3074
  else Text := IntToStr(Round(FValue));
 
3075
  Invalidate;
 
3076
end;
 
3077
 
 
3078
procedure TCDSpinEdit.DoUpdateUpDown;
 
3079
begin
 
3080
  FUpDown.Min := Round(FMinValue * Power(10, FDecimalPlaces));
 
3081
  FUpDown.Max := Round(FMaxValue * Power(10, FDecimalPlaces));
 
3082
  FUpDown.Position := Round(FValue * Power(10, FDecimalPlaces));
 
3083
end;
 
3084
 
 
3085
procedure TCDSpinEdit.DoChange;
 
3086
var
 
3087
  lValue: Double;
 
3088
begin
 
3089
  if SysUtils.TryStrToFloat(Caption, lValue) then FValue := lValue;
 
3090
  DoUpdateUpDown;
 
3091
  inherited DoChange;
 
3092
end;
 
3093
 
 
3094
constructor TCDSpinEdit.Create(AOwner: TComponent);
 
3095
begin
 
3096
  inherited Create(AOwner);
 
3097
 
 
3098
  FUpDown := TUpDown.Create(Self);
 
3099
  FUpDown.Align := alRight;
 
3100
  FUpDown.Parent := Self;
 
3101
  FUpDown.OnChanging :=@UpDownChanging;
 
3102
 
 
3103
  FMinValue := 0;
 
3104
  FMaxValue := 100;
 
3105
  FIncrement := 1;
 
3106
 
 
3107
  DoUpdateText();
 
3108
end;
 
3109
 
 
3110
destructor TCDSpinEdit.Destroy;
 
3111
begin
 
3112
  inherited Destroy;
 
3113
end;
 
3114
 
 
3115
end.
 
3116