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