2
Copyright (C) 2011 Felipe Monteiro de Carvalho
4
License: The same modifying LGPL with static linking exception as the LCL
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.
10
unit customdrawncontrols;
14
{$if defined(Windows)} // LCL defines like LCLWin32 don't reach the LCL
15
{$define CDControlsDoDoubleBuffer}
22
Classes, SysUtils, contnrs, Math, types,
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,
36
TCDControl = class(TCustomControl)
38
FDrawStyle: TCDDrawStyle;
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;
53
procedure DoEnter; override;
54
procedure DoExit; override;
56
procedure MouseEnter; override;
57
procedure MouseLeave; override;
58
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
59
X, Y: integer); override;
61
property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle;
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);
72
TCDControlClass = class of TCDControl;
76
{ TCDScrollableControl }
78
TCDScrollableControl = class(TCDControl)
80
FRightScrollBar, FBottomScrollBar: TCDScrollBar;
82
FScrollBars: TScrollStyle;
83
procedure SetScrollBars(AValue: TScrollStyle);
85
constructor Create(AOwner: TComponent); override;
86
destructor Destroy; override;
87
property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars;
90
// ===================================
92
// ===================================
96
TCDButtonControl = class(TCDControl)
98
// This fields are set by descendents
99
FHasOnOffStates: Boolean;
101
FGroupIndex: Integer;
102
FAllowGrayed: Boolean;
104
procedure KeyDown(var Key: word; Shift: TShiftState); override;
105
procedure KeyUp(var Key: word; Shift: TShiftState); override;
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);
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;
132
TCDButton = class(TCDButtonControl)
135
procedure SetGlyph(AValue: TBitmap);
137
FBState: TCDButtonStateEx;
138
function GetControlId: TCDControlID; override;
139
procedure CreateControlStateEx; override;
140
procedure PrepareControlStateEx; override;
142
constructor Create(AOwner: TComponent); override;
143
destructor Destroy; override;
151
property Constraints;
155
property Glyph: TBitmap read FGlyph write SetGlyph;
156
// property IsToggleBox: Boolean read FGlyph write SetGlyph;
157
property OnChangeBounds;
159
property OnContextPopup;
168
property OnMouseDown;
169
property OnMouseEnter;
170
property OnMouseLeave;
171
property OnMouseMove;
174
property OnStartDrag;
175
property OnUTF8KeyPress;
177
property ParentShowHint;
187
TCDEdit = class(TCDControl)
189
DragDropStarted: boolean;
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;
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;
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;
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;
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;
235
property TabStop default True;
236
property Text: string read GetText write SetText;
237
property OnChange: TNotifyEvent read FOnChange write FOnChange;
242
TCDCheckBox = class(TCDButtonControl)
244
function GetControlId: TCDControlID; override;
246
constructor Create(AOwner: TComponent); override;
247
destructor Destroy; override;
249
property AllowGrayed default False;
254
property TabStop default True;
260
TCDRadioButton = class(TCDButtonControl)
262
function GetControlId: TCDControlID; override;
264
constructor Create(AOwner: TComponent); override;
265
destructor Destroy; override;
271
property TabStop default True;
274
TKeyboardInputBehavior = (kibAutomatic, kibRequires, kibDoesntRequire);
278
TCDComboBox = class(TCDEdit)
280
FIsClickingButton: Boolean;
283
FKeyboardInputBehavior: TKeyboardInputBehavior;
284
function GetItems: TStrings;
285
procedure OnShowSelectItemDialogResult(ASelectedItem: Integer);
286
procedure SetItemIndex(AValue: Integer);
287
procedure SetKeyboardInputBehavior(AValue: TKeyboardInputBehavior);
289
function GetControlId: TCDControlID; override;
291
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
292
X, Y: integer); override;
293
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
295
constructor Create(AOwner: TComponent); override;
296
destructor Destroy; override;
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;
304
{ TCDPositionedControl }
306
TCDPositionedControl = class(TCDControl)
308
DragDropStarted: boolean;
309
FLastMouseDownPos: TPoint;
310
FPositionAtMouseDown: Integer;
311
FButton: TCDControlState; // the button currently being clicked
312
FBtnClickTimer: TTimer;
316
FOnChange, FOnChangeByUser: TNotifyEvent;
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);
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;
341
procedure KeyDown(var Key: word; Shift: TShiftState); override;
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;
348
property PageSize: Integer read FPageSize write SetPageSize;
350
constructor Create(AOwner: TComponent); override;
351
destructor Destroy; override;
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;
362
TCDScrollBar = class(TCDPositionedControl)
364
FKind: TScrollBarKind;
365
procedure SetKind(AValue: TScrollBarKind);
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;
373
constructor Create(AOwner: TComponent); override;
374
destructor Destroy; override;
378
property Kind: TScrollBarKind read FKind write SetKind;
380
property TabStop default True;
384
TCDGroupBox is a custom-drawn group box control
389
TCDGroupBox = class(TCDControl)
391
function GetControlId: TCDControlID; override;
393
procedure RealSetText(const Value: TCaption); override; // to update on caption changes
395
constructor Create(AOwner: TComponent); override;
396
destructor Destroy; override;
402
property TabStop default False;
407
TCDPanel = class(TCDControl)
409
FBevelInner: TPanelBevel;
410
FBevelOuter: TPanelBevel;
411
FBevelWidth: TBevelWidth;
412
procedure SetBevelInner(AValue: TPanelBevel);
413
procedure SetBevelOuter(AValue: TPanelBevel);
414
procedure SetBevelWidth(AValue: TBevelWidth);
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
422
constructor Create(AOwner: TComponent); override;
423
destructor Destroy; override;
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;
432
property TabStop default False;
435
// ===================================
437
// ===================================
441
TCDStaticText = class(TCDControl)
443
function GetControlId: TCDControlID; override;
445
procedure RealSetText(const Value: TCaption); override; // to update on caption changes
447
constructor Create(AOwner: TComponent); override;
448
destructor Destroy; override;
453
property TabStop default False;
456
// ===================================
457
// Common Controls Tab
458
// ===================================
461
TCDTrackBar is a custom-drawn trackbar control
466
TCDTrackBar = class(TCDPositionedControl)
468
FOrientation: TTrackBarOrientation;
469
procedure SetOrientation(AValue: TTrackBarOrientation);
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;
476
constructor Create(AOwner: TComponent); override;
477
destructor Destroy; override;
478
//procedure Paint; override;
484
property Orientation: TTrackBarOrientation read FOrientation write SetOrientation default trHorizontal;
485
property TabStop default True;
490
TCDProgressBar = class(TCDControl)
492
DragDropStarted: boolean;
493
FBarShowText: Boolean;
497
FOrientation: TProgressBarOrientation;
499
FOnChange: TNotifyEvent;
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);
510
FPBState: TCDProgressBarStateEx;
511
function GetControlId: TCDControlID; override;
512
procedure CreateControlStateEx; override;
513
procedure PrepareControlStateEx; override;
515
constructor Create(AOwner: TComponent); override;
516
destructor Destroy; override;
518
property BarShowText: Boolean read FBarShowText write SetBarShowText;
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;
533
TCDListView = class(TCDScrollableControl)
535
DragDropStarted: boolean;
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);
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;
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;}
562
FLVState: TCDListViewStateEx;
563
function GetControlId: TCDControlID; override;
564
procedure CreateControlStateEx; override;
565
procedure PrepareControlStateEx; override;
567
constructor Create(AOwner: TComponent); override;
568
destructor Destroy; override;
571
property TabStop default True;
572
property Columns: TListColumns read FColumns write SetColumns;
574
//property GridLines: Boolean index Ord(lvpGridLines) read GetProperty write SetProperty default False;
575
property Items: TCDListItems read FListItems;
577
property ShowColumnHeader: Boolean read FShowColumnHeader write SetShowColumnHeader default True;
578
property ViewStyle: TViewStyle read FViewStyle write SetViewStyle default vsList;
583
{ TCDCustomTabControl }
585
TCDCustomTabControl = class;
589
TCDTabSheet = class(TCustomControl)
591
CDTabControl: TCDCustomTabControl;
592
FTabVisible: Boolean;
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
597
constructor Create(AOwner: TComponent); override;
598
destructor Destroy; override;
599
procedure EraseBackground(DC: HDC); override;
600
procedure Paint; override;
605
property TabVisible: Boolean read FTabVisible write FTabVisible;
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;
612
TCDCustomTabControl = class(TCDControl)
614
FOnUserAddedPage: TOnUserAddedPage;
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;
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;
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;
647
// TTabSelectedEvent = procedure(Sender: TObject; ATab: TTabItem;
648
// ASelected: boolean) of object;
650
TCDTabControl = class(TCDCustomTabControl)
659
property OnUserAddedPage;
664
TCDPageControl = class(TCDCustomTabControl)
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);
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);
689
property ActivePage: TCDTabSheet read GetActivePage write SetActivePage;
695
property PageIndex: integer read GetPageIndex write SetPageIndex;
697
property ParentColor;
699
property TabStop default True;
703
property OnUserAddedPage;
706
// ===================================
708
// ===================================
712
TCDSpinEdit = class(TCDEdit)
714
FDecimalPlaces: Byte;
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;
729
procedure DoChange; override;
731
constructor Create(AOwner: TComponent); override;
732
destructor Destroy; override;
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;
744
sTABSHEET_DEFAULT_NAME = 'CTabSheet';
748
procedure TCDControl.CalculatePreferredSize(var PreferredWidth,
749
PreferredHeight: integer; WithThemeSpace: Boolean);
752
PrepareControlStateEx;
753
FDrawer.CalculatePreferredSize(Canvas, GetControlId(), FState, FStateEx,
754
PreferredWidth, PreferredHeight, WithThemeSpace);
757
procedure TCDControl.SetState(const AValue: TCDControlState);
759
if AValue <> FState then
766
procedure TCDControl.PrepareCurrentDrawer;
768
OldDrawer: TCDDrawer;
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();
777
procedure TCDControl.SetDrawStyle(const AValue: TCDDrawStyle);
779
if FDrawStyle = AValue then exit;
780
FDrawStyle := AValue;
782
PrepareCurrentDrawer();
784
//FCurrentDrawer.SetClientRectPos(Self);
787
function TCDControl.GetClientRect: TRect;
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()
793
//Result := FCurrentDrawer.GetClientRect(Self);
796
function TCDControl.GetControlId: TCDControlID;
798
Result := cidControl;
801
procedure TCDControl.CreateControlStateEx;
803
FStateEx := TCDControlStateEx.Create;
806
procedure TCDControl.PrepareControlState;
808
if Focused then FState := FState + [csfHasFocus]
809
else FState := FState - [csfHasFocus];
811
if Enabled then FState := FState + [csfEnabled]
812
else FState := FState - [csfEnabled];
815
procedure TCDControl.PrepareControlStateEx;
817
if Parent <> nil then FStateEx.ParentRGBColor := Parent.GetRGBColorResolvingParent
818
else FStateEx.ParentRGBColor := clSilver;
819
FStateEx.FPParentRGBColor := TColorToFPColor(FStateEx.ParentRGBColor);
821
if Color = clDefault then FStateEx.RGBColor := FDrawer.GetControlDefaultColor(GetControlId())
822
else FStateEx.RGBColor := GetRGBColorResolvingParent;
823
FStateEx.FPRGBColor := TColorToFPColor(FStateEx.RGBColor);
825
FStateEx.Caption := Caption;
826
FStateEx.Font := Font;
827
FStateEx.AutoSize := AutoSize;
830
procedure TCDControl.DoEnter;
836
procedure TCDControl.DoExit;
842
procedure TCDControl.EraseBackground(DC: HDC);
847
procedure TCDControl.Paint;
853
DrawToCanvas(Canvas);
856
procedure TCDControl.DrawToCanvas(ACanvas: TCanvas);
859
lControlId: TCDControlID;
861
PrepareCurrentDrawer();
863
lSize := Size(Width, Height);
864
lControlId := GetControlId();
866
PrepareControlStateEx;
867
FDrawer.DrawControl(ACanvas, lSize, lControlId, FState, FStateEx);
870
procedure TCDControl.MouseEnter;
872
FState := FState + [csfMouseOver];
873
inherited MouseEnter;
876
procedure TCDControl.MouseLeave;
878
FState := FState - [csfMouseOver];
879
inherited MouseLeave;
882
procedure TCDControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
885
inherited MouseDown(Button, Shift, X, Y);
889
constructor TCDControl.Create(AOwner: TComponent);
891
inherited Create(AOwner);
892
CreateControlStateEx;
893
PrepareCurrentDrawer();
894
{$ifdef CDControlsDoDoubleBuffer}
895
DoubleBuffered := True;
899
destructor TCDControl.Destroy;
905
// A CalculatePreferredSize which is utilized by LCL-CustomDrawn
906
procedure TCDControl.LCLWSCalculatePreferredSize(var PreferredWidth,
907
PreferredHeight: integer; WithThemeSpace, AAutoSize: Boolean);
910
PrepareControlStateEx;
911
FStateEx.AutoSize := AAutoSize;
912
FDrawer.CalculatePreferredSize(Canvas, GetControlId(), FState, FStateEx,
913
PreferredWidth, PreferredHeight, WithThemeSpace);
918
function TCDComboBox.GetItems: TStrings;
923
procedure TCDComboBox.OnShowSelectItemDialogResult(ASelectedItem: Integer);
925
SetItemIndex(ASelectedItem);
928
procedure TCDComboBox.SetItemIndex(AValue: Integer);
935
if lValue > FItems.Count then lValue := FItems.Count;
936
if lValue < -1 then lValue := -1;
938
if FItemIndex=lValue then Exit;
940
if lValue >= 0 then Text := FItems.Strings[lValue];
943
procedure TCDComboBox.SetKeyboardInputBehavior(AValue: TKeyboardInputBehavior);
945
if FKeyboardInputBehavior=AValue then Exit;
946
FKeyboardInputBehavior:=AValue;
947
if AValue = kibRequires then ControlStyle := ControlStyle + [csRequiresKeyboardInput]
948
else ControlStyle := ControlStyle + [csRequiresKeyboardInput];
951
function TCDComboBox.GetControlId: TCDControlID;
953
Result := cidComboBox;
956
procedure TCDComboBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
959
if (X > Width - Height) then
961
FIsClickingButton := True;
962
FEditState.ExtraButtonState := FEditState.ExtraButtonState + [csfSunken];
967
inherited MouseDown(Button, Shift, X, Y);
970
procedure TCDComboBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
973
if FIsClickingButton then
975
FIsClickingButton := False;
976
FEditState.ExtraButtonState := FEditState.ExtraButtonState - [csfSunken];
978
if (X > Width - Height) then
980
// Call the combobox dialog
981
LCLIntf.OnShowSelectItemDialogResult := @OnShowSelectItemDialogResult;
982
LCLIntf.ShowSelectItemDialog(FItems);
988
inherited MouseUp(Button, Shift, X, Y);
991
constructor TCDComboBox.Create(AOwner: TComponent);
993
inherited Create(AOwner);
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];
999
FItems := TStringList.Create;
1002
destructor TCDComboBox.Destroy;
1010
function TCDPanel.GetControlId: TCDControlID;
1015
procedure TCDPanel.CreateControlStateEx;
1017
FPState := TCDPanelStateEx.Create;
1018
FStateEx := FPState;
1021
procedure TCDPanel.PrepareControlStateEx;
1023
inherited PrepareControlStateEx;
1024
FPState.BevelInner := FBevelInner;
1025
FPState.BevelOuter := FBevelOuter;
1026
FPState.BevelWidth := FBevelWidth;
1029
procedure TCDPanel.SetBevelInner(AValue: TPanelBevel);
1031
if FBevelInner=AValue then Exit;
1032
FBevelInner:=AValue;
1033
if not (csLoading in ComponentState) then Invalidate;
1036
procedure TCDPanel.SetBevelOuter(AValue: TPanelBevel);
1038
if FBevelOuter=AValue then Exit;
1039
FBevelOuter:=AValue;
1040
if not (csLoading in ComponentState) then Invalidate;
1043
procedure TCDPanel.SetBevelWidth(AValue: TBevelWidth);
1045
if FBevelWidth=AValue then Exit;
1046
FBevelWidth:=AValue;
1047
if not (csLoading in ComponentState) then Invalidate;
1050
procedure TCDPanel.RealSetText(const Value: TCaption);
1052
inherited RealSetText(Value);
1053
if not (csLoading in ComponentState) then Invalidate;
1056
constructor TCDPanel.Create(AOwner: TComponent);
1058
inherited Create(AOwner);
1065
destructor TCDPanel.Destroy;
1070
{ TCDScrollableControl }
1072
procedure TCDScrollableControl.SetScrollBars(AValue: TScrollStyle);
1074
if FScrollBars=AValue then Exit;
1075
FScrollBars:=AValue;
1077
if AValue = ssNone then
1079
FSpacer.Visible := False;
1080
FRightScrollBar.Visible := False;
1081
FBottomScrollBar.Visible := False;
1083
else if AValue in [ssHorizontal, ssAutoHorizontal] then
1085
FSpacer.Visible := False;
1086
FRightScrollBar.Visible := False;
1087
FBottomScrollBar.BorderSpacing.Bottom := 0;
1088
FBottomScrollBar.Align := alRight;
1089
FBottomScrollBar.Visible := True;
1091
else if AValue in [ssVertical, ssAutoVertical] then
1093
FSpacer.Visible := False;
1094
FRightScrollBar.BorderSpacing.Bottom := 0;
1095
FRightScrollBar.Align := alRight;
1096
FRightScrollBar.Visible := True;
1097
FBottomScrollBar.Visible := False;
1099
else // ssBoth, ssAutoBoth
1101
FSpacer.Visible := True;
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;
1108
// Enough spacing to fit the FSpacer
1109
FBottomScrollBar.BorderSpacing.Right := FBottomScrollBar.Height;
1110
FBottomScrollBar.Align := alBottom;
1111
FBottomScrollBar.Visible := True;
1115
constructor TCDScrollableControl.Create(AOwner: TComponent);
1119
inherited Create(AOwner);
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;
1130
FBottomScrollBar := TCDScrollBar.Create(nil);
1131
FBottomScrollBar.Kind := sbHorizontal;
1132
FBottomScrollBar.Visible := False;
1133
FBottomScrollBar.Parent := Self;
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];
1148
destructor TCDScrollableControl.Destroy;
1150
FRightScrollBar.Free;
1151
FBottomScrollBar.Free;
1158
procedure TCDButtonControl.KeyDown(var Key: word; Shift: TShiftState);
1160
inherited KeyDown(Key, Shift);
1162
if (Key = VK_SPACE) or (Key = VK_RETURN) then
1166
procedure TCDButtonControl.KeyUp(var Key: word; Shift: TShiftState);
1168
if (Key = VK_SPACE) or (Key = VK_RETURN) then
1171
Self.Click; // TCustomControl does not respond to LM_CLICKED
1174
inherited KeyUp(Key, Shift);
1177
procedure TCDButtonControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
1181
inherited MouseDown(Button, Shift, X, Y);
1184
procedure TCDButtonControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
1188
inherited MouseUp(Button, Shift, X, Y);
1191
procedure TCDButtonControl.MouseEnter;
1194
inherited MouseEnter;
1197
procedure TCDButtonControl.MouseLeave;
1200
inherited MouseLeave;
1203
procedure TCDButtonControl.DoUncheckButton;
1205
NewState: TCDControlState;
1207
NewState := FState + [csfOff] - [csfOn, csfPartiallyOn];
1211
procedure TCDButtonControl.DoCheckIfFirstButtonInGroup;
1213
NewState: TCDControlState;
1217
// Start with the checked value
1218
NewState := FState + [csfOn] - [csfOff, csfPartiallyOn];
1220
// Search for other buttons in the group in the same parent
1221
if Parent <> nil then
1223
for i := 0 to Parent.ControlCount - 1 do
1225
lControl := Parent.Controls[i];
1226
if (lControl is TCDButtonControl) and
1227
(lControl <> Self) and
1228
(TCDButtonControl(lControl).FGroupIndex = FGroupIndex) then
1230
NewState := FState + [csfOff] - [csfOn, csfPartiallyOn];
1239
procedure TCDButtonControl.DoButtonDown();
1241
NewState: TCDControlState;
1244
if not (csfSunken in FState) then NewState := FState + [csfSunken];
1248
procedure TCDButtonControl.DoButtonUp();
1252
NewState: TCDControlState;
1255
if csfSunken in FState then NewState := NewState - [csfSunken];
1257
// For grouped buttons, call DoButtonUp for all other buttons on the same parent
1260
NewState := NewState + [csfOn] - [csfOff, csfPartiallyOn];
1261
if Parent <> nil then
1263
for i := 0 to Parent.ControlCount - 1 do
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();
1273
// Only for buttons with checked/down states
1274
// TCDCheckbox, TCDRadiobutton, TCDButton configured as TToggleButton
1275
else if FHasOnOffStates then
1277
if FAllowGrayed then
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]
1284
NewState := NewState + [csfPartiallyOn] - [csfOn, csfOff];
1288
if csfOn in FState then
1289
NewState := NewState + [csfOff] - [csfOn]
1291
NewState := NewState + [csfOn] - [csfOff];
1298
procedure TCDButtonControl.RealSetText(const Value: TCaption);
1300
inherited RealSetText(Value);
1304
function TCDButtonControl.GetChecked: Boolean;
1306
Result := csfOn in FState;
1309
procedure TCDButtonControl.SetChecked(AValue: Boolean);
1311
NewState: TCDControlState;
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()
1318
if AValue then NewState := FState + [csfOn] - [csfOff, csfPartiallyOn]
1319
else NewState := FState + [csfOff] - [csfOn, csfPartiallyOn];
1324
function TCDButtonControl.GetCheckedState: TCheckBoxState;
1326
if csfOn in FState then Result := cbChecked
1327
else if csfPartiallyOn in FState then
1329
if FAllowGrayed then
1332
Result := cbChecked;
1334
else Result := cbUnchecked;
1337
procedure TCDButtonControl.SetCheckedState(AValue: TCheckBoxState);
1339
NewState: TCDControlState;
1342
cbUnchecked: NewState := FState + [csfOff] - [csfOn, csfPartiallyOn];
1343
cbChecked: NewState := FState + [csfOn] - [csfOff, csfPartiallyOn];
1346
if FAllowGrayed then
1347
NewState := FState + [csfPartiallyOn] - [csfOn, csfOff]
1349
NewState := FState + [csfOn] - [csfOff, csfPartiallyOn];
1357
function TCDEdit.GetText: string;
1362
procedure TCDEdit.SetLeftTextMargin(AValue: Integer);
1364
if FEditState.LeftTextMargin = AValue then Exit;
1365
FEditState.LeftTextMargin := AValue;
1369
procedure TCDEdit.SetRightTextMargin(AValue: Integer);
1371
if FEditState.RightTextMargin = AValue then Exit;
1372
FEditState.RightTextMargin := AValue;
1376
function TCDEdit.GetControlId: TCDControlID;
1381
procedure TCDEdit.CreateControlStateEx;
1383
FEditState := TCDEditStateEx.Create;
1384
FStateEx := FEditState;
1387
procedure TCDEdit.DoChange;
1389
if Assigned(FOnChange) then FOnChange(Self);
1392
procedure TCDEdit.HandleCaretTimer(Sender: TObject);
1394
if FEditState.EventArrived then
1396
FEditState.CaretIsVisible := True;
1397
FEditState.EventArrived := False;
1399
else FEditState.CaretIsVisible := not FEditState.CaretIsVisible;
1404
function TCDEdit.GetLeftTextMargin: Integer;
1406
Result := FEditState.LeftTextMargin;
1409
function TCDEdit.GetRightTextMargin: Integer;
1411
Result := FEditState.RightTextMargin;
1414
procedure TCDEdit.DoDeleteSelection;
1416
lSelLeftPos, lSelRightPos, lSelLength: Integer;
1417
lControlText, lTextLeft, lTextRight: string;
1419
if IsSomethingSelected then
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;
1429
// Text left of the selection
1430
lTextLeft := UTF8Copy(lControlText, FEditState.VisibleTextStart.X, lSelLeftPos-FEditState.VisibleTextStart.X+1);
1432
// Text right of the selection
1433
lTextRight := UTF8Copy(lControlText, lSelLeftPos+lSelLength+1, Length(lControlText));
1435
// Execute the deletion
1436
Text := lTextLeft + lTextRight;
1438
// Correct the caret position
1439
FEditState.CaretPos.X := Length(lTextLeft);
1445
procedure TCDEdit.DoClearSelection;
1447
FEditState.SelStart.X := 1;
1448
FEditState.SelLength := 0;
1451
procedure TCDEdit.DoManageVisibleTextStart;
1454
lVisibleTextCharCount: Integer;
1455
lAvailableWidth: Integer;
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);
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);
1469
procedure TCDEdit.SetText(AValue: string);
1471
OldCaption: TCaption;
1473
OldCaption := Caption;
1475
if (AValue <> OldCaption) then DoChange;
1479
// Result.X -> returns a zero-based position of the caret
1480
function TCDEdit.MousePosToCaretPos(X, Y: Integer): TPoint;
1483
lVisibleStr, lCurChar: String;
1484
lPos, lCurCharLen: Integer;
1485
lBestDiff: Cardinal = $FFFFFFFF;
1486
lLastDiff: Cardinal = $FFFFFFFF;
1487
lCurDiff, lBestMatch: Integer;
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
1495
lCurDiff := X - lPos;
1496
if lCurDiff < 0 then lCurDiff := lCurDiff * -1;
1498
if lCurDiff < lBestDiff then
1500
lBestDiff := lCurDiff;
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;
1508
if i <> lStrLen then
1510
lCurChar := UTF8Copy(lVisibleStr, i+1, 1);
1511
lCurCharLen := Canvas.TextWidth(lCurChar);
1512
lPos := lPos + lCurCharLen;
1516
Result.X := lBestMatch+(FEditState.VisibleTextStart.X-1);
1519
function TCDEdit.IsSomethingSelected: Boolean;
1521
Result := FEditState.SelLength <> 0;
1524
procedure TCDEdit.DoEnter;
1526
FCaretTimer.Enabled := True;
1527
FEditState.CaretIsVisible := True;
1531
procedure TCDEdit.DoExit;
1533
FCaretTimer.Enabled := False;
1534
FEditState.CaretIsVisible := False;
1539
procedure TCDEdit.KeyDown(var Key: word; Shift: TShiftState);
1541
lLeftText, lRightText, lOldText: String;
1542
lOldTextLength: PtrInt;
1543
lKeyWasProcessed: Boolean = True;
1545
inherited KeyDown(Key, Shift);
1548
lOldTextLength := UTF8Length(Text);
1554
// Selection backspace
1555
if IsSomethingSelected() then
1558
else if FEditState.CaretPos.X > 0 then
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();
1572
if IsSomethingSelected() then
1575
else if FEditState.CaretPos.X < lOldTextLength then
1577
lLeftText := UTF8Copy(lOldText, 1, FEditState.CaretPos.X);
1578
lRightText := UTF8Copy(lOldText, FEditState.CaretPos.X+2, lOldTextLength);
1579
Text := lLeftText + lRightText;
1585
if (FEditState.CaretPos.X > 0) then
1587
// Selecting to the left
1588
if [ssShift] = Shift then
1590
if FEditState.SelLength = 0 then FEditState.SelStart.X := FEditState.CaretPos.X;
1591
Dec(FEditState.SelLength);
1593
// Normal move to the left
1594
else FEditState.SelLength := 0;
1596
Dec(FEditState.CaretPos.X);
1597
DoManageVisibleTextStart();
1598
FEditState.CaretIsVisible := True;
1601
// if we are not moving, at least deselect
1602
else if ([ssShift] <> Shift) then
1604
FEditState.SelLength := 0;
1610
if (FEditState.CaretPos.X > 0) then
1612
// Selecting to the left
1613
if [ssShift] = Shift then
1615
if FEditState.SelLength = 0 then
1617
FEditState.SelStart.X := FEditState.CaretPos.X;
1618
FEditState.SelLength := -1 * FEditState.CaretPos.X;
1621
FEditState.SelLength := -1 * FEditState.SelStart.X;
1623
// Normal move to the left
1624
else FEditState.SelLength := 0;
1626
FEditState.CaretPos.X := 0;
1627
DoManageVisibleTextStart();
1628
FEditState.CaretIsVisible := True;
1631
// if we are not moving, at least deselect
1632
else if (FEditState.SelLength <> 0) and ([ssShift] <> Shift) then
1634
FEditState.SelLength := 0;
1640
if FEditState.CaretPos.X < lOldTextLength then
1642
// Selecting to the right
1643
if [ssShift] = Shift then
1645
if FEditState.SelLength = 0 then FEditState.SelStart.X := FEditState.CaretPos.X;
1646
Inc(FEditState.SelLength);
1648
// Normal move to the right
1649
else FEditState.SelLength := 0;
1651
Inc(FEditState.CaretPos.X);
1652
DoManageVisibleTextStart();
1653
FEditState.CaretIsVisible := True;
1656
// if we are not moving, at least deselect
1657
else if ([ssShift] <> Shift) then
1659
FEditState.SelLength := 0;
1665
if FEditState.CaretPos.X < lOldTextLength then
1667
// Selecting to the right
1668
if [ssShift] = Shift then
1670
if FEditState.SelLength = 0 then
1671
FEditState.SelStart.X := FEditState.CaretPos.X;
1672
FEditState.SelLength := lOldTextLength - FEditState.SelStart.X;
1674
// Normal move to the right
1675
else FEditState.SelLength := 0;
1677
FEditState.CaretPos.X := lOldTextLength;
1678
DoManageVisibleTextStart();
1679
FEditState.CaretIsVisible := True;
1682
// if we are not moving, at least deselect
1683
else if (FEditState.SelLength <> 0) and ([ssShift] <> Shift) then
1685
FEditState.SelLength := 0;
1691
lKeyWasProcessed := False;
1694
if lKeyWasProcessed then FEditState.EventArrived := True;
1697
procedure TCDEdit.KeyUp(var Key: word; Shift: TShiftState);
1699
inherited KeyUp(Key, Shift);
1701
// copy, paste, cut, etc
1702
if Shift = [ssCtrl] then
1712
procedure TCDEdit.UTF8KeyPress(var UTF8Key: TUTF8Char);
1714
lLeftText, lRightText, lOldText: String;
1716
inherited UTF8KeyPress(UTF8Key);
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;
1726
// Normal characters
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;
1738
procedure TCDEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
1741
inherited MouseDown(Button, Shift, X, Y);
1742
DragDropStarted := True;
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;
1753
procedure TCDEdit.MouseMove(Shift: TShiftState; X, Y: integer);
1755
inherited MouseMove(Shift, X, Y);
1757
// Mouse dragging selection
1758
if DragDropStarted then
1760
FEditState.CaretPos := MousePosToCaretPos(X, Y);
1761
FEditState.SelLength := FEditState.CaretPos.X - FEditState.SelStart.X;
1762
FEditState.EventArrived := True;
1763
FEditState.CaretIsVisible := True;
1768
procedure TCDEdit.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
1771
inherited MouseUp(Button, Shift, X, Y);
1772
DragDropStarted := False;
1775
procedure TCDEdit.MouseEnter;
1777
inherited MouseEnter;
1780
procedure TCDEdit.MouseLeave;
1782
inherited MouseLeave;
1785
constructor TCDEdit.Create(AOwner: TComponent);
1787
inherited Create(AOwner);
1791
ControlStyle := ControlStyle - [csAcceptsControls] + [csRequiresKeyboardInput];
1793
// State information
1794
FEditState.VisibleTextStart := Point(1, 1);
1797
FCaretTimer := TTimer.Create(Self);
1798
FCaretTimer.OnTimer := @HandleCaretTimer;
1799
FCaretTimer.Interval := 500;
1800
FCaretTimer.Enabled := False;
1803
destructor TCDEdit.Destroy;
1810
function TCDCheckBox.GetControlId: TCDControlID;
1812
Result := cidCheckBox;
1815
constructor TCDCheckBox.Create(AOwner: TComponent);
1817
inherited Create(AOwner);
1821
ControlStyle := ControlStyle - [csAcceptsControls];
1823
FHasOnOffStates := True;
1824
FState := FState + [csfOff];
1827
destructor TCDCheckBox.Destroy;
1834
procedure TCDButton.SetGlyph(AValue: TBitmap);
1836
if FGlyph=AValue then Exit;
1837
FGlyph.Assign(AValue);
1841
function TCDButton.GetControlId: TCDControlID;
1843
Result := cidButton;
1846
procedure TCDButton.CreateControlStateEx;
1848
FBState := TCDButtonStateEx.Create;
1849
FStateEx := FBState;
1852
procedure TCDButton.PrepareControlStateEx;
1854
inherited PrepareControlStateEx;
1855
FBState.Glyph := FGlyph;
1858
constructor TCDButton.Create(AOwner: TComponent);
1860
inherited Create(AOwner);
1865
FGlyph := TBitmap.Create;
1868
destructor TCDButton.Destroy;
1876
function TCDRadioButton.GetControlId: TCDControlID;
1878
Result := cidRadioButton;
1881
constructor TCDRadioButton.Create(AOwner: TComponent);
1883
inherited Create(AOwner);
1888
ControlStyle := ControlStyle - [csAcceptsControls];
1890
FHasOnOffStates := True;
1892
FGroupIndex := -2; // special value for TCDRadioButton
1893
DoCheckIfFirstButtonInGroup();
1896
destructor TCDRadioButton.Destroy;
1901
{ TCDPositionedControl }
1903
procedure TCDPositionedControl.SetMax(AValue: Integer);
1905
if FMax=AValue then Exit;
1908
if AValue < FMin then FMax := FMin
1909
else FMax := AValue;
1911
if FPosition > FMax then FPosition := FMax;
1913
if not (csLoading in ComponentState) then Invalidate;
1916
procedure TCDPositionedControl.SetMin(AValue: Integer);
1918
if FMin=AValue then Exit;
1920
if AValue > FMax then FMin := FMax
1923
if FPosition < FMin then FPosition := FMin;
1925
if not (csLoading in ComponentState) then Invalidate;
1928
procedure TCDPositionedControl.SetPageSize(AValue: Integer);
1930
if FPageSize=AValue then Exit;
1932
if not (csLoading in ComponentState) then Invalidate;
1935
procedure TCDPositionedControl.SetPosition(AValue: Integer);
1937
if FPosition=AValue then Exit;
1940
if FPosition > FMax then FPosition := FMax;
1941
if FPosition < FMin then FPosition := FMin;
1943
// Don't do OnChange during loading
1944
if not (csLoading in ComponentState) then
1946
if Assigned(OnChange) then OnChange(Self);
1951
procedure TCDPositionedControl.DoClickButton(AButton: TCDControlState; ALargeChange: Boolean);
1954
NewPosition: Integer = -1;
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;
1961
if (NewPosition >= 0) and (NewPosition <> Position) then
1963
Position := NewPosition;
1964
if Assigned(FOnChangeByUser) then FOnChangeByUser(Self);
1968
procedure TCDPositionedControl.HandleBtnClickTimer(ASender: TObject);
1970
lButton: TCDControlState;
1973
lMousePos := ScreenToClient(Mouse.CursorPos);
1974
lButton := GetButtonFromMousePos(lMousePos.X, lMousePos.Y);
1975
if lButton = FButton then DoClickButton(FButton, True);
1978
function TCDPositionedControl.GetPositionFromMousePosWithMargins(X, Y,
1979
ALeftMargin, ARightMargin: Integer; AIsHorizontal, AAcceptMouseOutsideStrictArea: Boolean): integer;
1981
lCoord, lSize: Integer;
1985
if AIsHorizontal then
1996
if lCoord > lSize - ARightMargin then
1998
if AAcceptMouseOutsideStrictArea then Result := FMax;
2001
else if lCoord < ALeftMargin then
2003
if AAcceptMouseOutsideStrictArea then Result := FMin;
2006
else Result := FMin + (lCoord - ALeftMargin) * (FMax - FMin + 1) div (lSize - ARightMargin - ALeftMargin);
2009
if Result > FMax then Result := FMax;
2010
if Result < FMin then Result := FMin;
2013
function TCDPositionedControl.GetPositionDisplacementWithMargins(AOldMousePos,
2014
ANewMousePos: TPoint; ALeftMargin, ARightMargin: Integer; AIsHorizontal: Boolean): Integer;
2016
lCoord, lSize: Integer;
2018
if AIsHorizontal then
2020
lCoord := ANewMousePos.X-AOldMousePos.X;
2025
lCoord := ANewMousePos.Y-AOldMousePos.Y;
2029
Result := FMin + (lCoord - ALeftMargin) * (FMax - FMin + 1) div (lSize - ARightMargin - ALeftMargin);
2030
Result := FPositionAtMouseDown + Result;
2033
if Result > FMax then Result := FMax;
2034
if Result < FMin then Result := FMin;
2037
function TCDPositionedControl.GetButtonFromMousePos(X, Y: Integer): TCDControlState;
2042
procedure TCDPositionedControl.CreateControlStateEx;
2044
FPCState := TCDPositionedCStateEx.Create;
2045
FStateEx := FPCState;
2048
procedure TCDPositionedControl.PrepareControlStateEx;
2050
inherited PrepareControlStateEx;
2052
if FMin < FMax then FPCState.FloatPos := FPosition / (FMax - FMin)
2053
else FPCState.FloatPos := 0.0;
2055
FPCState.PosCount := FMax - FMin + 1;
2056
FPCState.Position := FPosition - FMin;
2058
if FMin < FMax then FPCState.FloatPageSize := FPageSize / (FMax - FMin)
2059
else FPCState.FloatPageSize := 1.0;
2062
procedure TCDPositionedControl.KeyDown(var Key: word; Shift: TShiftState);
2064
NewPosition: Integer;
2066
inherited KeyDown(Key, Shift);
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;
2078
if NewPosition >= 0 then
2080
if NewPosition > FMax then NewPosition := FMax;
2081
if NewPosition < FMin then NewPosition := FMin;
2083
if (NewPosition <> Position) then
2085
Position := NewPosition;
2086
if Assigned(FOnChangeByUser) then FOnChangeByUser(Self);
2091
procedure TCDPositionedControl.MouseDown(Button: TMouseButton;
2092
Shift: TShiftState; X, Y: integer);
2094
NewPosition: Integer;
2097
if FMoveByDragging then
2099
FLastMouseDownPos := Point(X, Y);
2100
FPositionAtMouseDown := Position;
2101
DragDropStarted := True;
2105
NewPosition := GetPositionFromMousePos(X, Y);
2106
DragDropStarted := True;
2107
if (NewPosition >= 0) and (NewPosition <> Position) then
2109
Position := NewPosition;
2110
if Assigned(FOnChangeByUser) then FOnChangeByUser(Self);
2114
// Check if any buttons were clicked
2115
FButton := GetButtonFromMousePos(X, Y);
2116
FState := FState + FButton;
2117
if FButton <> [] then
2119
DoClickButton(FButton, False);
2120
FBtnClickTimer.Enabled := True;
2123
inherited MouseDown(Button, Shift, X, Y);
2126
procedure TCDPositionedControl.MouseMove(Shift: TShiftState; X, Y: integer);
2128
NewPosition: Integer;
2130
if DragDropStarted then
2132
if FMoveByDragging then
2134
NewPosition := FPositionAtMouseDown + GetPositionDisplacement(FLastMouseDownPos, Point(X, Y));
2135
if NewPosition <> Position then
2137
Position := NewPosition;
2138
if Assigned(FOnChangeByUser) then FOnChangeByUser(Self);
2143
NewPosition := GetPositionFromMousePos(X, Y);
2144
if (NewPosition >= 0) and (NewPosition <> Position) then
2146
Position := NewPosition;
2147
if Assigned(FOnChangeByUser) then FOnChangeByUser(Self);
2151
inherited MouseMove(Shift, X, Y);
2154
procedure TCDPositionedControl.MouseUp(Button: TMouseButton;
2155
Shift: TShiftState; X, Y: integer);
2157
DragDropStarted := False;
2158
FBtnClickTimer.Enabled := False;
2159
FState := FState - [csfLeftArrow, csfRightArrow];
2161
inherited MouseUp(Button, Shift, X, Y);
2164
constructor TCDPositionedControl.Create(AOwner: TComponent);
2166
inherited Create(AOwner);
2172
FBtnClickTimer := TTimer.Create(nil);
2173
FBtnClickTimer.Enabled := False;
2174
FBtnClickTimer.Interval := 100;
2175
FBtnClickTimer.OnTimer := @HandleBtnClickTimer;
2178
destructor TCDPositionedControl.Destroy;
2180
FBtnClickTimer.Free;
2186
procedure TCDScrollBar.SetKind(AValue: TScrollBarKind);
2188
if FKind=AValue then Exit;
2191
if not (csLoading in ComponentState) then Invalidate;
2194
function TCDScrollBar.GetPositionFromMousePos(X, Y: Integer): integer;
2196
lLeftBorder, lRightBorder: Integer;
2198
lLeftBorder := FDrawer.GetMeasures(TCDSCROLLBAR_LEFT_SPACING);
2199
lRightBorder := FDrawer.GetMeasures(TCDSCROLLBAR_RIGHT_SPACING);
2201
Result := GetPositionFromMousePosWithMargins(X, Y, lLeftBorder, lRightBorder, FKind = sbHorizontal, False);
2204
function TCDScrollBar.GetButtonFromMousePos(X, Y: Integer): TCDControlState;
2206
lCoord, lLeftBtnPos, lRightBtnPos: Integer;
2209
lLeftBtnPos := FDrawer.GetMeasures(TCDSCROLLBAR_LEFT_BUTTON_POS);
2210
lRightBtnPos := FDrawer.GetMeasures(TCDSCROLLBAR_RIGHT_BUTTON_POS);
2211
if FKind = sbHorizontal then
2214
if lLeftBtnPos < 0 then lLeftBtnPos := Width + lLeftBtnPos;
2215
if lRightBtnPos < 0 then lRightBtnPos := Width + lRightBtnPos;
2220
if lLeftBtnPos < 0 then lLeftBtnPos := Height + lLeftBtnPos;
2221
if lRightBtnPos < 0 then lRightBtnPos := Height + lRightBtnPos;
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];
2230
function TCDScrollBar.GetPositionDisplacement(AOldMousePos, ANewMousePos: TPoint
2233
lLeftBorder, lRightBorder: Integer;
2235
lLeftBorder := FDrawer.GetMeasures(TCDSCROLLBAR_LEFT_SPACING);
2236
lRightBorder := FDrawer.GetMeasures(TCDSCROLLBAR_RIGHT_SPACING);
2238
Result := GetPositionDisplacementWithMargins(AOldMousePos, ANewMousePos,
2239
lLeftBorder, lRightBorder, FKind = sbHorizontal);
2242
function TCDScrollBar.GetControlId: TCDControlID;
2244
Result:= cidScrollBar;
2247
procedure TCDScrollBar.PrepareControlState;
2249
inherited PrepareControlState;
2251
if FKind = sbHorizontal then
2252
FState := FState + [csfHorizontal] - [csfVertical, csfRightToLeft, csfTopDown]
2253
else FState := FState + [csfVertical] - [csfHorizontal, csfRightToLeft, csfTopDown];
2256
constructor TCDScrollBar.Create(AOwner: TComponent);
2258
inherited Create(AOwner);
2262
FMoveByDragging := True;
2265
destructor TCDScrollBar.Destroy;
2272
function TCDGroupBox.GetControlId: TCDControlID;
2274
Result := cidGroupBox;
2277
procedure TCDGroupBox.RealSetText(const Value: TCaption);
2279
inherited RealSetText(Value);
2280
if not (csLoading in ComponentState) then Invalidate;
2283
constructor TCDGroupBox.Create(AOwner: TComponent);
2285
inherited Create(AOwner);
2292
destructor TCDGroupBox.Destroy;
2299
function TCDStaticText.GetControlId: TCDControlID;
2301
Result:=cidStaticText;
2304
procedure TCDStaticText.RealSetText(const Value: TCaption);
2306
inherited RealSetText(Value);
2310
constructor TCDStaticText.Create(AOwner: TComponent);
2312
inherited Create(AOwner);
2316
ControlStyle := ControlStyle - [csAcceptsControls];
2319
destructor TCDStaticText.Destroy;
2326
procedure TCDTrackBar.SetOrientation(AValue: TTrackBarOrientation);
2330
if FOrientation=AValue then Exit;
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
2338
Height := lOldWidth;
2341
// Set the property and redraw
2342
FOrientation:=AValue;
2343
if not (csLoading in ComponentState) then
2347
function TCDTrackBar.GetPositionFromMousePos(X, Y: Integer): integer;
2349
lLeftBorder, lRightBorder: Integer;
2351
lLeftBorder := FDrawer.GetMeasures(TCDTRACKBAR_LEFT_SPACING);
2352
lRightBorder := FDrawer.GetMeasures(TCDTRACKBAR_RIGHT_SPACING);
2354
Result := GetPositionFromMousePosWithMargins(X, Y, lLeftBorder, lRightBorder, FOrientation = trHorizontal, True);
2357
function TCDTrackBar.GetPositionDisplacement(AOldMousePos, ANewMousePos: TPoint
2360
Result := 0; // not used anyway
2363
function TCDTrackBar.GetControlId: TCDControlID;
2365
Result := cidTrackBar;
2368
procedure TCDTrackBar.PrepareControlState;
2370
inherited PrepareControlState;
2371
case FOrientation of
2372
trHorizontal: FState := FState + [csfHorizontal] - [csfVertical, csfRightToLeft, csfTopDown];
2373
trVertical: FState := FState + [csfVertical] - [csfHorizontal, csfRightToLeft, csfTopDown];
2377
constructor TCDTrackBar.Create(AOwner: TComponent);
2379
inherited Create(AOwner);
2386
destructor TCDTrackBar.Destroy;
2393
procedure TCDProgressBar.SetMax(AValue: integer);
2395
if FMax=AValue then Exit;
2397
if not (csLoading in ComponentState) then Invalidate;
2400
procedure TCDProgressBar.SetBarShowText(AValue: Boolean);
2402
if FBarShowText=AValue then Exit;
2403
FBarShowText:=AValue;
2404
if not (csLoading in ComponentState) then Invalidate;
2407
procedure TCDProgressBar.SetMin(AValue: integer);
2409
if FMin=AValue then Exit;
2411
if not (csLoading in ComponentState) then Invalidate;
2414
procedure TCDProgressBar.SetOrientation(AValue: TProgressBarOrientation);
2418
if FOrientation=AValue then Exit;
2419
FOrientation:=AValue;
2420
if not (csLoading in ComponentState) then Invalidate;
2423
procedure TCDProgressBar.SetPosition(AValue: integer);
2425
if FPosition=AValue then Exit;
2427
if not (csLoading in ComponentState) then Invalidate;
2430
procedure TCDProgressBar.SetSmooth(AValue: Boolean);
2432
if FSmooth=AValue then Exit;
2434
if not (csLoading in ComponentState) then
2438
procedure TCDProgressBar.SetStyle(AValue: TProgressBarStyle);
2440
if FStyle=AValue then Exit;
2442
if not (csLoading in ComponentState) then Invalidate;
2445
function TCDProgressBar.GetControlId: TCDControlID;
2447
Result := cidProgressBar;
2450
procedure TCDProgressBar.CreateControlStateEx;
2452
FPBState := TCDProgressBarStateEx.Create;
2453
FStateEx := FPBState;
2456
procedure TCDProgressBar.PrepareControlStateEx;
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];
2469
FPBState.Smooth := FSmooth;
2472
constructor TCDProgressBar.Create(AOwner: TComponent);
2474
inherited Create(AOwner);
2481
destructor TCDProgressBar.Destroy;
2488
function TCDListView.GetProperty(AIndex: Integer): Boolean;
2493
procedure TCDListView.SetColumns(AValue: TListColumns);
2495
if FColumns=AValue then Exit;
2497
if not (csLoading in ComponentState) then Invalidate;
2500
procedure TCDListView.SetProperty(AIndex: Integer; AValue: Boolean);
2505
procedure TCDListView.SetShowColumnHeader(AValue: Boolean);
2507
if FShowColumnHeader=AValue then Exit;
2508
FShowColumnHeader:=AValue;
2509
if not (csLoading in ComponentState) then Invalidate;
2512
procedure TCDListView.SetViewStyle(AValue: TViewStyle);
2514
if FViewStyle=AValue then Exit;
2516
if not (csLoading in ComponentState) then Invalidate;
2519
function TCDListView.GetControlId: TCDControlID;
2521
Result := cidListView;
2524
procedure TCDListView.CreateControlStateEx;
2526
FLVState := TCDListViewStateEx.Create;
2527
FStateEx := FLVState;
2530
procedure TCDListView.PrepareControlStateEx;
2532
inherited PrepareControlStateEx;
2533
FLVState.Items := FListItems;
2534
FLVState.Columns := FColumns;
2535
FLVState.ViewStyle := FViewStyle;
2536
FLVState.ShowColumnHeader := FShowColumnHeader;
2539
constructor TCDListView.Create(AOwner: TComponent);
2541
inherited Create(AOwner);
2544
FColumns := TListColumns.Create(nil);
2545
FListItems := TCDListItems.Create();
2547
FShowColumnHeader := True;
2548
// FProperties: TListViewProperties;
2549
// FViewStyle: TViewStyle;
2551
ScrollBars := ssBoth;
2554
destructor TCDListView.Destroy;
2563
procedure TCDTabSheet.RealSetText(const Value: TCaption);
2567
inherited RealSetText(Value);
2568
lIndex := CDTabControl.Tabs.IndexOfObject(Self);
2570
CDTabControl.Tabs.Strings[lIndex] := Value;
2571
CDTabControl.Invalidate;
2574
procedure TCDTabSheet.SetParent(NewParent: TWinControl);
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
2581
CDTabControl := NewParent as TCDCustomTabControl;
2582
TCDPageControl(CDTabControl).AddPage(Self);
2586
constructor TCDTabSheet.Create(AOwner: TComponent);
2588
inherited Create(AOwner);
2591
ParentColor := True;
2593
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
2594
csDesignFixedBounds, csDoubleClicks, csDesignInteractive];
2595
//ControlStyle := ControlStyle + [csAcceptsControls, csDesignFixedBounds,
2596
// csNoDesignVisible, csNoFocus];
2599
destructor TCDTabSheet.Destroy;
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
2608
lIndex := CDTabControl.FTabs.IndexOfObject(Self);
2611
CDTabControl.FTabs.Delete(lIndex);
2612
CDTabControl.CorrectTabIndex();
2619
procedure TCDTabSheet.EraseBackground(DC: HDC);
2624
procedure TCDTabSheet.Paint;
2628
if CDTabControl <> nil then
2630
lSize := Size(Width, Height);
2631
CDTabControl.FDrawer.DrawTabSheet(Canvas, Point(0, 0), lSize, CDTabControl.FState,
2632
CDTabControl.FTabCState);
2636
{ TCDCustomTabControl }
2638
procedure TCDCustomTabControl.MouseDown(Button: TMouseButton;
2639
Shift: TShiftState; X, Y: integer);
2643
inherited MouseDown(Button, Shift, X, Y);
2645
lTabIndex := MousePosToTabIndex(X, Y);
2647
if lTabIndex >=0 then
2649
if Self is TCDPageControl then
2650
(Self as TCDPageControl).PageIndex := lTabIndex
2652
TabIndex := lTabIndex;
2656
procedure TCDCustomTabControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
2659
lTabIndex, lCloseButtonSize: Integer;
2660
lNewPage: TCDTabSheet;
2661
lCloseButtonPos: TPoint;
2663
inherited MouseUp(Button, Shift, X, Y);
2665
lTabIndex := MousePosToTabIndex(X, Y);
2667
// Check if the add button was clicked
2668
if (nboShowAddTabButton in Options) and (lTabIndex = Tabs.Count) then
2670
if Self is TCDPageControl then
2672
lNewPage := (Self as TCDPageControl).AddPage('New Page');
2673
if Assigned(OnUserAddedPage) then OnUserAddedPage(Self, lNewPage);
2677
Tabs.Add('New Tab');
2678
if Assigned(OnUserAddedPage) then OnUserAddedPage(Self, nil);
2681
// Check if a close button was clicked
2682
else if (nboShowCloseButtons in Options) and (lTabIndex >= 0) then
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
2691
if Self is TCDPageControl then (Self as TCDPageControl).RemovePage(lTabIndex)
2692
else Tabs.Delete(lTabIndex);
2697
procedure TCDCustomTabControl.SetOptions(AValue: TCTabControlOptions);
2699
if FOptions=AValue then Exit;
2704
procedure TCDCustomTabControl.SetTabIndex(AValue: Integer);
2706
if FTabIndex = AValue then Exit;
2707
if Assigned(OnChanging) then OnChanging(Self);
2708
FTabIndex := AValue;
2709
if Assigned(OnChange) then OnChange(Self);
2713
procedure TCDCustomTabControl.SetTabs(AValue: TStringList);
2715
if FTabs=AValue then Exit;
2716
FTabs.Assign(AValue);
2721
function TCDCustomTabControl.MousePosToTabIndex(X, Y: Integer): Integer;
2724
CurPage: TCDTabSheet;
2725
CurStartLeftPos: Integer = 0;
2726
VisiblePagesStarted: Boolean = False;
2727
lLastTab, lTabWidth, lTabHeight: Integer;
2731
if nboShowAddTabButton in Options then lLastTab := Tabs.Count
2732
else lLastTab := Tabs.Count - 1;
2734
for i := 0 to lLastTab do
2736
if i = FTabCState.LeftmostTabVisibleIndex then
2737
VisiblePagesStarted := True;
2739
if VisiblePagesStarted then
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
2750
CurStartLeftPos := CurStartLeftPos + lTabWidth;
2755
function TCDCustomTabControl.GetControlId: TCDControlID;
2757
Result := cidCTabControl;
2760
procedure TCDCustomTabControl.CreateControlStateEx;
2762
FTabCState := TCDCTabControlStateEx.Create;
2763
FStateEx := FTabCState;
2766
procedure TCDCustomTabControl.PrepareControlStateEx;
2768
inherited PrepareControlStateEx;
2770
FTabCState.Tabs := Tabs;
2771
FTabCState.TabIndex := TabIndex;
2772
FTabCState.TabCount := GetTabCount();
2773
FTabCState.Options := FOptions;
2776
constructor TCDCustomTabControl.Create(AOwner: TComponent);
2778
inherited Create(AOwner);
2784
ParentColor := True;
2786
ControlStyle := ControlStyle + [csAcceptsControls, csDesignInteractive];
2788
// FTabs should hold only visible tabs
2789
FTabs := TStringList.Create;
2792
destructor TCDCustomTabControl.Destroy;
2799
function TCDCustomTabControl.GetTabCount: Integer;
2802
if FTabs <> nil then Result := FTabs.Count;
2805
procedure TCDCustomTabControl.CorrectTabIndex;
2807
if FTabIndex >= FTabs.Count then SetTabIndex(FTabs.Count - 1);
2812
function TCDPageControl.AddPage(S: string): TCDTabSheet;
2813
// InsertPage(FPages.Count, S);
2815
NewPage: TCDTabSheet;
2817
NewPage := TCDTabSheet.Create(Owner);
2818
NewPage.Parent := Self;
2819
NewPage.CDTabControl := Self;
2820
NewPage.Caption := S;
2822
PositionTabSheet(NewPage);
2824
FTabs.AddObject(S, NewPage);
2826
SetActivePage(NewPage);
2831
procedure TCDPageControl.AddPage(APage: TCDTabSheet);
2833
APage.CDTabControl := Self;
2834
PositionTabSheet(APage);
2835
FTabs.AddObject(APage.Caption, APage);
2836
SetActivePage(APage);
2839
function TCDPageControl.GetPage(AIndex: integer): TCDTabSheet;
2841
if (AIndex >= 0) and (AIndex < FTabs.Count) then
2842
Result := TCDTabSheet(FTabs.Objects[AIndex])
2847
function TCDPageControl.InsertPage(aIndex: integer; S: string): TCDTabSheet;
2849
NewPage: TCDTabSheet;
2851
NewPage := TCDTabSheet.Create(Owner);
2852
NewPage.Parent := Self;
2853
NewPage.CDTabControl := Self;
2854
NewPage.Caption := S;
2856
PositionTabSheet(NewPage);
2858
FTabs.InsertObject(AIndex, S, NewPage);
2860
SetActivePage(NewPage);
2864
procedure TCDPageControl.RemovePage(aIndex: integer);
2866
if (AIndex < 0) or (AIndex >= FTabs.Count) then Exit;
2868
Application.ReleaseComponent(TComponent(FTabs.Objects[AIndex]));
2870
FTabs.Delete(aIndex);
2871
if FTabIndex >= FTabs.Count then SetPageIndex(FTabIndex-1);
2876
function TCDPageControl.FindNextPage(CurPage: TCDTabSheet;
2877
GoForward, CheckTabVisible: boolean): TCDTabSheet;
2879
I, TempStartIndex: integer;
2881
if FTabs.Count <> 0 then
2883
//StartIndex := FPages.IndexOfObject(CurPage);
2884
TempStartIndex := FTabs.IndexOfObject(CurPage);
2885
if TempStartIndex = -1 then
2887
TempStartIndex := FTabs.Count - 1
2889
TempStartIndex := 0;
2890
I := TempStartIndex;
2895
if I = FTabs.Count then
2904
Result := TCDTabSheet(FTabs.Objects[I]);
2905
if not CheckTabVisible or Result.Visible then
2907
until I = TempStartIndex;
2912
procedure TCDPageControl.SelectNextPage(GoForward: boolean;
2913
CheckTabVisible: boolean = True);
2917
Page := FindNextPage(ActivePage, GoForward, CheckTabVisible);
2918
if (Page <> nil) and (Page <> ActivePage) then
2919
SetActivePage(Page);
2922
constructor TCDPageControl.Create(AOwner: TComponent);
2924
inherited Create(AOwner);
2926
ControlStyle := ControlStyle - [csAcceptsControls];
2929
destructor TCDPageControl.Destroy;
2934
procedure TCDPageControl.SetActivePage(Value: TCDTabSheet);
2937
CurPage: TCDTabSheet;
2939
for i := 0 to FTabs.Count - 1 do
2941
CurPage := TCDTabSheet(FTabs.Objects[i]);
2942
if CurPage = Value then
2944
PositionTabSheet(CurPage);
2945
CurPage.BringToFront;
2946
CurPage.Visible := True;
2948
// Check first, Tab is Visible?
2951
else if CurPage <> nil then
2953
//CurPage.Align := alNone;
2954
//CurPage.Height := 0;
2955
CurPage.Visible := False;
2962
procedure TCDPageControl.SetPageIndex(Value: integer);
2964
if (Value > -1) and (Value < FTabs.Count) then
2967
ActivePage := GetPage(Value);
2971
procedure TCDPageControl.UpdateAllDesignerFlags;
2975
for i := 0 to FTabs.Count - 1 do
2976
UpdateDesignerFlags(i);
2979
procedure TCDPageControl.UpdateDesignerFlags(APageIndex: integer);
2981
CurPage: TCDTabSheet;
2983
CurPage := GetPage(APageIndex);
2984
if APageIndex <> fTabIndex then
2985
CurPage.ControlStyle := CurPage.ControlStyle + [csNoDesignVisible]
2987
CurPage.ControlStyle := CurPage.ControlStyle - [csNoDesignVisible];
2990
procedure TCDPageControl.PositionTabSheet(ATabSheet: TCDTabSheet);
2992
lTabHeight, lIndex: Integer;
2995
lIndex := FTabs.IndexOfObject(ATabSheet);
2996
FTabCState.TabIndex := lIndex;
2997
PrepareControlState;
2998
PrepareControlStateEx;
2999
lClientArea := FDrawer.GetClientArea(Canvas, Size(Width, Height), GetControlId, FState, FStateEx);
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;
3008
function TCDPageControl.GetActivePage: TCDTabSheet;
3010
Result := GetPage(FTabIndex);
3013
function TCDPageControl.GetPageCount: integer;
3015
Result := FTabs.Count;
3018
function TCDPageControl.GetPageIndex: integer;
3020
Result := FTabIndex;
3025
procedure TCDSpinEdit.UpDownChanging(Sender: TObject; var AllowChange: Boolean);
3027
Value := FUpDown.Position / Power(10, FDecimalPlaces);
3030
procedure TCDSpinEdit.SetIncrement(AValue: Double);
3032
if FIncrement=AValue then Exit;
3037
procedure TCDSpinEdit.SetDecimalPlaces(AValue: Byte);
3039
if FDecimalPlaces=AValue then Exit;
3040
FDecimalPlaces:=AValue;
3045
procedure TCDSpinEdit.SetMaxValue(AValue: Double);
3047
if FMaxValue=AValue then Exit;
3049
if FValue > FMaxValue then Value := FMaxValue;
3053
procedure TCDSpinEdit.SetMinValue(AValue: Double);
3055
if FMinValue=AValue then Exit;
3057
if FValue < FMinValue then Value := FMinValue;
3061
procedure TCDSpinEdit.SetValue(AValue: Double);
3063
if FValue=AValue then Exit;
3064
if FValue < FMinValue then Exit;
3065
if FValue > FMaxValue then Exit;
3071
procedure TCDSpinEdit.DoUpdateText;
3073
if FDecimalPlaces > 0 then Text := FloatToStr(FValue)
3074
else Text := IntToStr(Round(FValue));
3078
procedure TCDSpinEdit.DoUpdateUpDown;
3080
FUpDown.Min := Round(FMinValue * Power(10, FDecimalPlaces));
3081
FUpDown.Max := Round(FMaxValue * Power(10, FDecimalPlaces));
3082
FUpDown.Position := Round(FValue * Power(10, FDecimalPlaces));
3085
procedure TCDSpinEdit.DoChange;
3089
if SysUtils.TryStrToFloat(Caption, lValue) then FValue := lValue;
3094
constructor TCDSpinEdit.Create(AOwner: TComponent);
3096
inherited Create(AOwner);
3098
FUpDown := TUpDown.Create(Self);
3099
FUpDown.Align := alRight;
3100
FUpDown.Parent := Self;
3101
FUpDown.OnChanging :=@UpDownChanging;
3110
destructor TCDSpinEdit.Destroy;