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