1{
2 /***************************************************************************
3                               extctrls.pp
4                               -----------
5                             Component Library Extended Controls
6                   Initial Revision  : Sat Jul 26 12:04:35 PDT 1999
7
8 ***************************************************************************/
9
10 *****************************************************************************
11  This file is part of the Lazarus Component Library (LCL)
12
13  See the file COPYING.modifiedLGPL.txt, included in this distribution,
14  for details about the license.
15 *****************************************************************************
16}
17unit ExtCtrls;
18
19{$mode objfpc}{$H+}
20{$I lcl_defines.inc}
21
22interface
23
24{$ifdef Trace}
25{$ASSERTIONS ON}
26{$endif}
27
28uses
29  SysUtils, Types, Classes, contnrs, FGL,
30  // LCL
31  LCLStrConsts, LCLType, LCLProc, LResources, LMessages, Controls, Forms,
32  StdCtrls, GraphType, Graphics, LCLIntf, CustomTimer, Themes, LCLClasses, Menus,
33  PopupNotifier, ImgList,
34  // LazUtils
35  LazLoggerBase, LazUtilities;
36
37type
38
39  { TPage }
40
41  TPage = class;
42
43  TBeforeShowPageEvent = procedure (ASender: TObject; ANewPage: TPage; ANewIndex: Integer) of object;
44  TImagePaintBackgroundEvent = procedure (ASender: TObject; ACanvas: TCanvas; ARect: TRect) of object;
45
46  TPage = class(TCustomControl)
47  private
48    FOnBeforeShow: TBeforeShowPageEvent;
49    function GetPageIndex: Integer;
50  protected
51    procedure SetParent(AParent: TWinControl); override;
52  public
53    constructor Create(TheOwner: TComponent); override;
54    destructor Destroy; override;
55  public
56    property PageIndex: Integer read GetPageIndex;
57  published
58    // Lazarus-specific TPage events
59    // OnBeforeShow occurs before a page is displayed, so that
60    // preparations can be executed in it's user interface, for example
61    property OnBeforeShow: TBeforeShowPageEvent read FOnBeforeShow write FOnBeforeShow;
62    // Other events and properties
63    property BiDiMode;
64    property ChildSizing;
65    property Color;
66    property Left stored False;
67    property Top stored False;
68    property Width stored False;
69    property Height stored False;
70    property OnContextPopup;
71    property OnEnter;
72    property OnExit;
73    property OnMouseDown;
74    property OnMouseEnter;
75    property OnMouseLeave;
76    property OnMouseMove;
77    property OnMouseUp;
78    property OnMouseWheel;
79    property OnMouseWheelDown;
80    property OnMouseWheelUp;
81    property OnResize;
82    property ParentBiDiMode;
83    property ParentShowHint;
84    property PopupMenu;
85    property TabOrder stored False;
86    property TabStop;
87    property Visible stored False;
88  end;
89
90  { TUNBPages }
91
92  TNotebook = class;
93
94  TUNBPages = class(TStrings)
95  private
96    FPageList: TObjectList;
97    FNotebook: TNotebook;
98    function GetNotebookOwner: TComponent;
99  protected
100    function Get(Index: Integer): String; override;
101    function GetCount: Integer; override;
102    function GetObject(Index: Integer): TObject; override;
103    procedure Put(Index: Integer; const S: String); override;
104  public
105    constructor Create(theNotebook: TNotebook);
106    destructor Destroy; override;
107    function Add(const S: string): Integer; override;
108    function AddObject(const S: string; AObject: TObject): Integer; override;
109    procedure Clear; override;
110    procedure Delete(Index: Integer); override;
111    function IndexOfObject(AObject: TObject): Integer; override;
112    procedure Insert(Index: Integer; const S: string); override;
113//    procedure Move(CurIndex, NewIndex: Integer); override;
114  end;
115
116  { TNotebook }
117
118  TNotebook = class(TCustomControl)
119  private
120    FPages: TStrings; // TUNBPages
121    FPageIndex: Integer;
122    function GetActivePage: String;
123    function GetActivePageComponent: TPage;
124    function GetPage(AIndex: Integer): TPage;
125    function GetPageCount : integer;
126    function GetPageIndex: Integer;
127{    function FindVisiblePage(Index: Integer): Integer;}
128{    procedure MovePage(APage: TCustomPage; NewIndex: Integer);
129    procedure RemovePage(Index: Integer);
130    procedure SetActivePage(const Value: String);}
131    procedure SetPageIndex(AValue: Integer);
132    procedure SetPages(Items: TStrings);
133  public
134    constructor Create(TheOwner: TComponent); override;
135    destructor Destroy; override;
136    procedure ShowControl(AControl: TControl); override;
137{    function TabIndexAtClientPos(ClientPos: TPoint): integer;
138    function TabRect(AIndex: Integer): TRect;
139    function GetImageIndex(ThePageIndex: Integer): Integer; virtual;
140    function CustomPage(Index: integer): TCustomPage;}
141    function IndexOf(APage: TPage): integer;
142  public
143    property ActivePage: String read GetActivePage;// write SetActivePage; // should not be published because the read can raise an exception
144    property ActivePageComponent: TPage read GetActivePageComponent;// write SetActivePage; // should not be published because the read can raise an exception
145    property Page[Index: Integer]: TPage read GetPage;
146    property PageCount: integer read GetPageCount;
147//    property PageList: TList read FPageList;
148  published
149    // LCL TNotebook specific properties
150    property PageIndex: Integer read GetPageIndex write SetPageIndex default -1;
151    property Pages: TStrings read FPages write SetPages stored False;
152    // Generic properties
153    property Align;
154    property AutoSize;
155    property Anchors;
156    property BiDiMode;
157    property BorderSpacing;
158    property Color;
159    property Constraints;
160    property DragCursor;
161    property DragMode;
162    property Enabled;
163//    property OnChange;
164    property OnChangeBounds;
165//    property OnChanging;
166    property OnContextPopup;
167    property OnDragDrop;
168    property OnDragOver;
169    property OnEndDrag;
170    property OnEnter;
171    property OnExit;
172    property OnMouseDown;
173    property OnMouseEnter;
174    property OnMouseLeave;
175    property OnMouseMove;
176    property OnMouseUp;
177    property OnMouseWheel;
178    property OnMouseWheelDown;
179    property OnMouseWheelUp;
180    property OnResize;
181    property OnStartDrag;
182//    property Options;
183//    property PageIndex;
184    property ParentBiDiMode;
185    property PopupMenu;
186    property TabOrder;
187    property TabStop;
188  end;
189
190  { Timer }
191
192  TTimer = class (TCustomTimer)
193  published
194    property Enabled;
195    property Interval;
196    property OnTimer;
197    property OnStartTimer;
198    property OnStopTimer;
199  end;
200
201
202  { TIdleTimer
203    For example:
204      Do something after 2 seconds after user input and idle.
205      AutoEnabled:=true;
206      AutoStartEvent:=itaOnIdle;    // start the timer on first idle
207      AutoEndEvent:=itaOnUserInput; // end on any user input
208
209    If the OnTimer event works in several chunks, set FireOnIdle:=true.
210    The OnTimer event will then be called on idle until FireOnIdle is false.
211    FireOnIdle is set to false on any user input. }
212
213  TIdleTimerAutoEvent = (
214    itaOnIdle,
215    itaOnIdleEnd,
216    itaOnUserInput
217    );
218  TIdleTimerAutoEvents = set of TIdleTimerAutoEvent;
219
220  { TCustomIdleTimer }
221
222  TCustomIdleTimer = class(TCustomTimer)
223  private
224    FAutoEnabled: boolean;
225    FAutoEndEvent: TIdleTimerAutoEvent;
226    FAutoStartEvent: TIdleTimerAutoEvent;
227    FFireOnIdle: boolean;
228    FHandlersConnected: boolean;
229    procedure UpdateHandlers;
230  protected
231    procedure SetAutoEnabled(const AValue: boolean); virtual;
232    procedure DoOnIdle(Sender: TObject; var Done: Boolean); virtual;
233    procedure DoOnIdleEnd(Sender: TObject); virtual;
234    procedure DoOnUserInput(Sender: TObject; Msg: Cardinal); virtual;
235    procedure Loaded; override;
236  public
237    constructor Create(TheOwner: TComponent); override;
238    destructor Destroy; override;
239
240    property AutoEnabled: boolean read FAutoEnabled
241                                  write SetAutoEnabled default False;
242    property AutoStartEvent: TIdleTimerAutoEvent read FAutoStartEvent
243                                    write FAutoStartEvent default itaOnIdle;
244    property AutoEndEvent: TIdleTimerAutoEvent read FAutoEndEvent
245                                 write FAutoEndEvent default itaOnUserInput;
246    property FireOnIdle: boolean read FFireOnIdle write FFireOnIdle default false;
247  end;
248
249  TIdleTimer = class(TCustomIdleTimer)
250  published
251    property AutoEnabled;
252    property AutoStartEvent;
253    property AutoEndEvent;
254    property Enabled;
255    property Interval;
256    property OnTimer;
257    property OnStartTimer;
258    property OnStopTimer;
259  end;
260
261  { TShape }
262
263  TShapeType = (stRectangle, stSquare, stRoundRect, stRoundSquare,
264    stEllipse, stCircle, stSquaredDiamond, stDiamond,
265    stTriangle, stTriangleLeft, stTriangleRight, stTriangleDown,
266    stStar, stStarDown);
267
268  TShape = class(TGraphicControl)
269  private
270    FPen: TPen;
271    FBrush: TBrush;
272    FShape: TShapeType;
273    function GetStarAngle(N: Integer; ADown: boolean): Double;
274    procedure SetBrush(Value: TBrush);
275    procedure SetPen(Value: TPen);
276    procedure SetShape(Value: TShapeType);
277  protected
278    class procedure WSRegisterClass; override;
279    class function GetControlClassDefaultSize: TSize; override;
280  public
281    constructor Create(TheOwner: TComponent); override;
282    destructor Destroy; override;
283    procedure Paint; override;
284    procedure StyleChanged(Sender: TObject);
285  published
286    property Align;
287    property Anchors;
288    property BorderSpacing;
289    property Brush: TBrush read FBrush write SetBrush;
290    property Constraints;
291    property DragCursor;
292    property DragKind;
293    property DragMode;
294    property Enabled;
295    property ParentShowHint;
296    property Pen: TPen read FPen write SetPen;
297    property OnChangeBounds;
298    property OnDragDrop;
299    property OnDragOver;
300    property OnEndDock;
301    property OnEndDrag;
302    property OnMouseDown;
303    property OnMouseEnter;
304    property OnMouseLeave;
305    property OnMouseMove;
306    property OnMouseUp;
307    property OnMouseWheel;
308    property OnMouseWheelDown;
309    property OnMouseWheelUp;
310    property OnMouseWheelHorz;
311    property OnMouseWheelLeft;
312    property OnMouseWheelRight;
313    property OnPaint;
314    property OnResize;
315    property OnStartDock;
316    property OnStartDrag;
317    property Shape: TShapeType read FShape write SetShape default stRectangle;
318    property ShowHint;
319    property Visible;
320  end;
321
322
323  { TCustomSplitter }
324
325  TResizeStyle = (
326    rsLine,     // draw a line, don't update splitter position during moving
327    rsNone,     // draw nothing and don't update splitter position during moving
328    rsPattern,  // draw a dot pattern, don't update splitter position during moving
329    rsUpdate    // draw nothing, update splitter position during moving
330  );
331
332  TCanOffsetEvent = procedure(Sender: TObject; var NewOffset: Integer;
333    var Accept: Boolean) of object;
334  TCanResizeEvent = procedure(Sender: TObject; var NewSize: Integer;
335    var Accept: Boolean) of object;
336  { TCustomSplitter is a control to interactively resize another control.
337    It is a vertical or horizontal bar anchored to a side of a control.
338    You can either set the Align property to alLeft (alRight,alTop,alBottom),
339    then it will become a vertical bar, aligned to the left and when the user
340    moves it with the mouse, the control to the left with the same Align=alLeft
341    will be resized.
342    The second more flexible possibility is to set the properties Align=alNone,
343    AnchorSides and ResizeAnchor.
344    }
345  TCustomSplitter = class(TCustomControl)
346  private
347    FAutoSnap: boolean;
348    FBeveled: boolean;
349    FMinSize: integer;
350    FMouseInControl: Boolean;
351    FOnCanOffset: TCanOffsetEvent;
352    FOnCanResize: TCanResizeEvent;
353    FOnMoved: TNotifyEvent;
354    FResizeAnchor: TAnchorKind;
355    FResizeStyle: TResizeStyle;
356    FSplitDragging: Boolean;
357    FSplitterStartMouseXY: TPoint; // in screen coordinates
358    FSplitterStartLeftTop: TPoint; // in screen coordinates
359    FSplitterWindow: HWND;
360    function GetResizeControl: TControl;
361    procedure SetBeveled(const AValue: boolean);
362    procedure SetMinSize(const AValue: integer);
363  protected
364    procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED;
365
366    class procedure WSRegisterClass; override;
367    function AdaptAnchors(const a: TAnchors): TAnchors;
368    function CheckNewSize(var NewSize: Integer): Boolean; virtual;
369    function CheckOffset(var NewOffset: Integer): Boolean; virtual;
370
371    function FindAlignControl: TControl;
372    function FindAlignOtherControl: TControl;
373
374    procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
375    procedure MouseEnter; override;
376    procedure MouseLeave; override;
377    procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
378    procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
379
380    procedure Paint; override;
381    procedure SetAlign(Value: TAlign); override;
382    procedure SetAnchors(const AValue: TAnchors); override;
383    procedure SetResizeAnchor(const AValue: TAnchorKind); virtual;
384    procedure SetResizeControl(const AValue: TControl); virtual;
385    procedure StartSplitterMove(const MouseXY: TPoint);
386    procedure StopSplitterMove(const MouseXY: TPoint);
387    procedure UpdateCursor; virtual;
388  public
389    constructor Create(TheOwner: TComponent); override;
390    procedure AnchorSplitter(Kind: TAnchorKind; AControl: TControl);
391    property ResizeControl: TControl read GetResizeControl write SetResizeControl;
392    function GetOtherResizeControl: TControl;
393    procedure MoveSplitter(Offset: integer); virtual;
394    procedure SetSplitterPosition(NewPosition: integer);
395    function GetSplitterPosition: integer;
396  public
397    property Align default alLeft;
398    property AutoSnap: boolean read FAutoSnap write FAutoSnap default true;
399    property Beveled: boolean read FBeveled write SetBeveled default false;
400    property Cursor default crHSplit;
401    property MinSize: integer read FMinSize write SetMinSize default 30;
402    property OnCanOffset: TCanOffsetEvent read FOnCanOffset write FOnCanOffset;
403    property OnCanResize: TCanResizeEvent read FOnCanResize write FOnCanResize;
404    property OnMoved: TNotifyEvent read FOnMoved write FOnMoved;
405    property ResizeAnchor: TAnchorKind read FResizeAnchor write SetResizeAnchor default akLeft;
406    property ResizeStyle: TResizeStyle read FResizeStyle write FResizeStyle default rsUpdate;
407  end;
408
409
410  { TSplitter }
411
412  TSplitter = class(TCustomSplitter)
413  published
414    property Align;
415    property Anchors;
416    property AutoSnap;
417    property Beveled;
418    property Color;
419    property Constraints;
420    property Cursor;
421    property DoubleBuffered;
422    property Height;
423    property MinSize;
424    property OnCanOffset;
425    property OnCanResize;
426    property OnChangeBounds;
427    property OnMoved;
428    property OnMouseWheel;
429    property OnMouseWheelDown;
430    property OnMouseWheelUp;
431    property OnPaint;
432    property ParentColor;
433    property ParentDoubleBuffered;
434    property ParentShowHint;
435    property PopupMenu;
436    property ResizeAnchor;
437    property ResizeStyle;
438    property ShowHint;
439    property Visible;
440    property Width;
441  end;
442
443
444  { TPaintBox }
445
446  TPaintBox = class(TGraphicControl)
447  protected
448    class procedure WSRegisterClass; override;
449    procedure Paint; override;
450    class function GetControlClassDefaultSize: TSize; override;
451  public
452    constructor Create(AOwner: TComponent); override;
453    property Canvas;
454  published
455    property Align;
456    property Anchors;
457    property BorderSpacing;
458    property Color;
459    property Constraints;
460    property DragCursor;
461//    property DragKind;
462    property DragMode;
463    property Enabled;
464    property Font;
465    property Hint;
466    property ParentColor;
467    property ParentFont;
468    property ParentShowHint;
469    property PopupMenu;
470    property ShowHint;
471    property Visible;
472    property OnChangeBounds;
473    property OnClick;
474    property OnContextPopup;
475    property OnDblClick;
476    property OnDragDrop;
477    property OnDragOver;
478//    property OnEndDock;
479    property OnEndDrag;
480    property OnMouseDown;
481    property OnMouseEnter;
482    property OnMouseLeave;
483    property OnMouseMove;
484    property OnMouseUp;
485    property OnMouseWheel;
486    property OnMouseWheelDown;
487    property OnMouseWheelUp;
488    property OnPaint;
489    property OnResize;
490//    property OnStartDock;
491    property OnStartDrag;
492  end;
493
494
495  { TCustomImage }
496
497  TCustomImage = class(TGraphicControl)
498  private
499    FAntialiasingMode: TAntialiasingMode;
500    FOnPictureChanged: TNotifyEvent;
501    FOnPaintBackground: TImagePaintBackgroundEvent;
502    FPicture: TPicture;
503    FCenter: Boolean;
504    FKeepOriginXWhenClipped: Boolean;
505    FKeepOriginYWhenClipped: Boolean;
506    FProportional: Boolean;
507    FTransparent: Boolean;
508    FStretch: Boolean;
509    FStretchOutEnabled: Boolean;
510    FStretchInEnabled: Boolean;
511    FUseAncestorCanvas: boolean;
512    FPainting: boolean;
513    function  GetCanvas: TCanvas;
514    procedure SetAntialiasingMode(AValue: TAntialiasingMode);
515    procedure SetPicture(const AValue: TPicture);
516    procedure SetCenter(const AValue : Boolean);
517    procedure SetKeepOriginX(AValue: Boolean);
518    procedure SetKeepOriginY(AValue: Boolean);
519    procedure SetProportional(const AValue: Boolean);
520    procedure SetStretch(const AValue : Boolean);
521    procedure SetStretchInEnabled(AValue: Boolean);
522    procedure SetStretchOutEnabled(AValue: Boolean);
523    procedure SetTransparent(const AValue : Boolean);
524  protected
525    class procedure WSRegisterClass; override;
526    procedure PictureChanged(Sender : TObject); virtual;
527    procedure CalculatePreferredSize(var PreferredWidth,
528                                     PreferredHeight: integer;
529                                     WithThemeSpace: Boolean); override;
530    class function GetControlClassDefaultSize: TSize; override;
531    procedure Paint; override;
532  public
533    constructor Create(AOwner: TComponent); override;
534    destructor Destroy; override;
535    property Canvas: TCanvas read GetCanvas;
536    function DestRect: TRect; virtual;
537    procedure Invalidate; override;
538  public
539    property AntialiasingMode: TAntialiasingMode read FAntialiasingMode write SetAntialiasingMode default amDontCare;
540    property Align;
541    property AutoSize;
542    property Center: Boolean read FCenter write SetCenter default False;
543    property KeepOriginXWhenClipped: Boolean read FKeepOriginXWhenClipped write SetKeepOriginX default False;
544    property KeepOriginYWhenClipped: Boolean read FKeepOriginYWhenClipped write SetKeepOriginY default False;
545    property Constraints;
546    property Picture: TPicture read FPicture write SetPicture;
547    property Visible;
548    property OnClick;
549    property OnMouseDown;
550    property OnMouseEnter;
551    property OnMouseLeave;
552    property OnMouseMove;
553    property OnMouseUp;
554    property OnMouseWheel;
555    property OnMouseWheelDown;
556    property OnMouseWheelUp;
557    property Stretch: Boolean read FStretch write SetStretch default False;
558    property StretchOutEnabled: Boolean read FStretchOutEnabled write SetStretchOutEnabled default True;
559    property StretchInEnabled: Boolean read FStretchInEnabled write SetStretchInEnabled default True;
560    property Transparent: Boolean read FTransparent write SetTransparent default False;
561    property Proportional: Boolean read FProportional write SetProportional default False;
562    property OnPictureChanged: TNotifyEvent read FOnPictureChanged write FOnPictureChanged;
563    property OnPaintBackground: TImagePaintBackgroundEvent read FOnPaintBackground write FOnPaintBackground;
564  end;
565
566
567  { TImage }
568
569  TImage = class(TCustomImage)
570  published
571    property AntialiasingMode;
572    property Align;
573    property Anchors;
574    property AutoSize;
575    property BorderSpacing;
576    property Center;
577    property KeepOriginXWhenClipped;
578    property KeepOriginYWhenClipped;
579    property Constraints;
580    property DragCursor;
581    property DragMode;
582    property Enabled;
583    property OnChangeBounds;
584    property OnClick;
585    property OnContextPopup;
586    property OnDblClick;
587    property OnDragDrop;
588    property OnDragOver;
589    property OnEndDrag;
590    property OnMouseDown;
591    property OnMouseEnter;
592    property OnMouseLeave;
593    property OnMouseMove;
594    property OnMouseUp;
595    property OnMouseWheel;
596    property OnMouseWheelDown;
597    property OnMouseWheelUp;
598    property OnPaint;
599    property OnPictureChanged;
600    property OnPaintBackground;
601    property OnResize;
602    property OnStartDrag;
603    property ParentShowHint;
604    property Picture;
605    property PopupMenu;
606    property Proportional;
607    property ShowHint;
608    property Stretch;
609    property StretchOutEnabled;
610    property StretchInEnabled;
611    property Transparent;
612    property Visible;
613  end;
614
615
616  { TBevel }
617
618  TBevelStyle = (bsLowered, bsRaised);
619  TBevelShape=(bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine, bsRightLine, bsSpacer);
620
621  TBevel = class(TGraphicControl)
622  private
623    FStyle:TBevelStyle;
624    FShape:TBevelShape;
625    procedure SetStyle(AStyle: TBevelStyle);
626    procedure SetShape(AShape: TBevelShape);
627  protected
628    class procedure WSRegisterClass; override;
629    class function GetControlClassDefaultSize: TSize; override;
630    procedure Paint; override;
631  public
632    constructor Create(AOwner:TComponent); override;
633    destructor Destroy; override;
634    procedure Assign(Source: TPersistent); override;
635  published
636    property Align;
637    property Anchors;
638    property BorderSpacing;
639    property Constraints;
640    property ParentShowHint;
641    property Shape: TBevelShape read FShape write SetShape default bsBox;
642    property ShowHint;
643    property Style: TBevelStyle read FStyle write SetStyle default bsLowered;
644    property Visible;
645    property OnChangeBounds;
646    property OnResize;
647    property OnMouseDown;
648    property OnMouseEnter;
649    property OnMouseLeave;
650    property OnMouseMove;
651    property OnMouseUp;
652    property OnMouseWheel;
653    property OnMouseWheelDown;
654    property OnMouseWheelUp;
655    property OnPaint;
656  end;
657
658
659  { TCustomRadioGroup }
660
661  TColumnLayout = (
662    clHorizontalThenVertical,
663    clVerticalThenHorizontal
664    );
665
666  TCustomRadioGroup = class(TCustomGroupBox)
667  private
668    FAutoFill: Boolean;
669    FButtonList: TFPList; // list of TRadioButton
670    FColumnLayout: TColumnLayout;
671    FColumns: integer;
672    FCreatingWnd: boolean;
673    FHiddenButton: TRadioButton;
674    FIgnoreClicks: boolean;
675    FItemIndex: integer;
676    FItems: TStrings;
677    FLastClickedItemIndex: integer;
678    FOnClick: TNotifyEvent;
679    FOnSelectionChanged: TNotifyEvent;
680    FReading: boolean;
681    FUpdatingItems: Boolean;
682    procedure Changed(Sender: TObject);
683    procedure Clicked(Sender: TObject);
684    procedure ItemEnter(Sender: TObject);
685    procedure ItemExit(Sender: TObject);
686    procedure ItemKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
687    procedure ItemKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
688    procedure ItemKeyPress(Sender: TObject; var Key: Char);
689    procedure ItemUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
690    procedure ItemResize(Sender: TObject);
691    procedure SetAutoFill(const AValue: Boolean);
692    procedure SetColumnLayout(const AValue: TColumnLayout);
693    procedure UpdateControlsPerLine;
694    procedure UpdateItems;
695    procedure UpdateTabStops;
696  protected
697    class procedure WSRegisterClass; override;
698    procedure UpdateInternalObjectList;
699    procedure UpdateAll;
700    procedure InitializeWnd; override;
701    procedure UpdateRadioButtonStates; virtual;
702    procedure ReadState(Reader: TReader); override;
703    procedure SetItems(Value: TStrings);
704    procedure SetColumns(Value: integer);
705    procedure SetItemIndex(Value: integer);
706    function GetItemIndex: integer;
707    procedure CheckItemIndexChanged; virtual;
708  public
709    constructor Create(TheOwner: TComponent); override;
710    destructor Destroy; override;
711    function CanModify: boolean; virtual;
712    procedure FlipChildren(AllLevels: Boolean); override;
713    function Rows: integer;
714  public
715    property AutoFill: Boolean read FAutoFill write SetAutoFill;
716    property ItemIndex: integer read GetItemIndex write SetItemIndex default -1;
717    property Items: TStrings read FItems write SetItems;
718    property Columns: integer read FColumns write SetColumns default 1;
719    property ColumnLayout: TColumnLayout read FColumnLayout write SetColumnLayout default clHorizontalThenVertical;
720    property OnClick: TNotifyEvent read FOnClick write FOnClick;
721    property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged;
722  end;
723
724
725  { TRadioGroup }
726
727  TRadioGroup = class(TCustomRadioGroup)
728  published
729    property Align;
730    property Anchors;
731    property AutoFill;
732    property AutoSize;
733    property BidiMode;
734    property BorderSpacing;
735    property Caption;
736    property ChildSizing;
737    property ClientHeight;
738    property ClientWidth;
739    property Color;
740    property ColumnLayout;
741    property Columns;
742    property Constraints;
743    property DoubleBuffered;
744    property DragCursor;
745    property DragMode;
746    property Enabled;
747    property Font;
748    property ItemIndex;
749    property Items;
750    property OnChangeBounds;
751    property OnClick;
752    property OnDblClick;
753    property OnDragDrop;
754    property OnDragOver;
755    property OnEndDrag;
756    property OnEnter;
757    property OnExit;
758    property OnKeyDown;
759    property OnKeyPress;
760    property OnKeyUp;
761    property OnMouseDown;
762    property OnMouseEnter;
763    property OnMouseLeave;
764    property OnMouseMove;
765    property OnMouseUp;
766    property OnMouseWheel;
767    property OnMouseWheelDown;
768    property OnMouseWheelUp;
769    property OnResize;
770    property OnSelectionChanged;
771    property OnStartDrag;
772    property OnUTF8KeyPress;
773    property ParentBidiMode;
774    property ParentFont;
775    property ParentColor;
776    property ParentDoubleBuffered;
777    property ParentShowHint;
778    property PopupMenu;
779    property ShowHint;
780    property TabOrder;
781    property TabStop;
782    property Visible;
783  end;
784
785
786  { TCustomCheckGroup }
787
788  TCheckGroupClicked = procedure(Sender: TObject; Index: integer) of object;
789
790  TCustomCheckGroup = class(TCustomGroupBox)
791  private
792    FAutoFill: boolean;
793    FButtonList: TList; // list of TCheckBox
794    FColumnLayout: TColumnLayout;
795    FCreatingWnd: boolean;
796    FItems: TStrings;
797    FColumns: integer;
798    FOnItemClick: TCheckGroupClicked;
799    FUpdatingItems: Boolean;
800    function GetChecked(Index: integer): boolean;
801    function GetCheckEnabled(Index: integer): boolean;
802    procedure Clicked(Sender: TObject);
803    procedure DoClick(Index: integer);
804    procedure ItemKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
805    procedure ItemKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
806    procedure ItemKeyPress(Sender: TObject; var Key: Char);
807    procedure ItemUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
808    procedure RaiseIndexOutOfBounds(Index: integer );
809    procedure SetAutoFill(const AValue: boolean);
810    procedure SetChecked(Index: integer; const AValue: boolean);
811    procedure SetCheckEnabled(Index: integer; const AValue: boolean);
812    procedure SetColumnLayout(const AValue: TColumnLayout);
813    procedure UpdateItems;
814    procedure UpdateControlsPerLine;
815  protected
816    class procedure WSRegisterClass; override;
817    procedure UpdateInternalObjectList;
818    procedure UpdateAll;
819    procedure SetItems(Value: TStrings);
820    procedure SetColumns(Value: integer);
821    procedure DefineProperties(Filer: TFiler); override;
822    procedure ReadData(Stream: TStream);
823    procedure WriteData(Stream: TStream);
824    procedure Loaded; override;
825    procedure DoOnResize; override;
826  public
827    constructor Create(TheOwner: TComponent); override;
828    destructor Destroy; override;
829    procedure FlipChildren(AllLevels: Boolean); override;
830    function Rows: integer;
831  public
832    property AutoFill: boolean read FAutoFill write SetAutoFill;
833    property Items: TStrings read FItems write SetItems;
834    property Checked[Index: integer]: boolean read GetChecked write SetChecked;
835    property CheckEnabled[Index: integer]: boolean read GetCheckEnabled write SetCheckEnabled;
836    property Columns: integer read FColumns write SetColumns default 1;
837    property ColumnLayout: TColumnLayout read FColumnLayout write SetColumnLayout default clHorizontalThenVertical;
838    property OnItemClick: TCheckGroupClicked read FOnItemClick write FOnItemClick;
839  end;
840
841
842  { TCheckGroup }
843
844  TCheckGroup = class(TCustomCheckGroup)
845  published
846    property Align;
847    property Anchors;
848    property AutoFill;
849    property AutoSize;
850    property BiDiMode;
851    property BorderSpacing;
852    property Caption;
853    property ChildSizing;
854    property ClientHeight;
855    property ClientWidth;
856    property Color;
857    property ColumnLayout;
858    property Columns;
859    property Constraints;
860    property DoubleBuffered;
861    property DragCursor;
862    property DragMode;
863    property Enabled;
864    property Font;
865    property Items;
866    property OnChangeBounds;
867    property OnClick;
868    property OnDblClick;
869    property OnDragDrop;
870    property OnDragOver;
871    property OnEndDrag;
872    property OnEnter;
873    property OnExit;
874    property OnItemClick;
875    property OnKeyDown;
876    property OnKeyPress;
877    property OnKeyUp;
878    property OnMouseDown;
879    property OnMouseEnter;
880    property OnMouseLeave;
881    property OnMouseMove;
882    property OnMouseUp;
883    property OnMouseWheel;
884    property OnMouseWheelDown;
885    property OnMouseWheelUp;
886    property OnResize;
887    property OnStartDrag;
888    property OnUTF8KeyPress;
889    property ParentBiDiMode;
890    property ParentFont;
891    property ParentColor;
892    property ParentDoubleBuffered;
893    property ParentShowHint;
894    property PopupMenu;
895    property ShowHint;
896    property TabOrder;
897    property TabStop;
898    property Visible;
899  end;
900
901
902  { TBoundLabel }
903
904  TBoundLabel = class(TCustomLabel)
905  public
906    constructor Create(TheOwner: TComponent); override;
907    property FocusControl;
908  published
909    property AnchorSideLeft stored False;
910    property AnchorSideTop stored False;
911    property AnchorSideRight stored False;
912    property AnchorSideBottom stored False;
913    property Left stored False;
914    property Top stored False;
915    property Caption;
916    property Color;
917    property DragCursor;
918    property DragMode;
919    property Height;
920    property ParentColor;
921    property ParentFont;
922    property ParentShowHint;
923    property Font;
924    property PopupMenu;
925    property ShowAccelChar;
926    property ShowHint;
927    property Layout;
928    property WordWrap;
929    property OnClick;
930    property OnDblClick;
931    property OnDragDrop;
932    property OnDragOver;
933    property OnEndDrag;
934    property OnMouseDown;
935    property OnMouseEnter;
936    property OnMouseLeave;
937    property OnMouseMove;
938    property OnMouseUp;
939    property OnMouseWheel;
940    property OnMouseWheelDown;
941    property OnMouseWheelUp;
942    //property OnEnter;
943    //property OnExit;
944    property OnStartDrag;
945  end;
946
947
948  { TCustomLabeledEdit }
949
950  TLabelPosition = (lpAbove, lpBelow, lpLeft, lpRight);
951
952  TCustomLabeledEdit = class(TCustomEdit)
953  private
954    FEditLabel: TBoundLabel;
955    FLabelPosition: TLabelPosition;
956    FLabelSpacing: Integer;
957    procedure SetLabelPosition(const Value: TLabelPosition);
958    procedure SetLabelSpacing(const Value: Integer);
959  protected
960    class procedure WSRegisterClass; override;
961    procedure SetParent(AParent: TWinControl); override;
962    procedure SetName(const Value: TComponentName); override;
963    procedure Loaded; override;
964    procedure DoPositionLabel; virtual;
965    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
966    procedure CMBiDiModeChanged(var Msg: TLMessage); message CM_BIDIMODECHANGED;
967    procedure CMVisibleChanged(var Msg: TLMessage); message CM_VISIBLECHANGED;
968    procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED;
969    procedure CreateInternalLabel; virtual;
970  public
971    constructor Create(TheOwner: TComponent); override;
972    property EditLabel: TBoundLabel read FEditLabel;
973    property LabelPosition: TLabelPosition read FLabelPosition
974                                         write SetLabelPosition default lpAbove;
975    property LabelSpacing: Integer read FLabelSpacing write SetLabelSpacing
976                                                                      default 3;
977  end;
978
979
980  { TLabeledEdit }
981
982  TLabeledEdit = class(TCustomLabeledEdit)
983  published
984    property Alignment;
985    property Anchors;
986    property AutoSelect;
987    property AutoSize;
988    property BidiMode;
989    property BorderSpacing;
990    property BorderStyle;
991    property CharCase;
992    property Color;
993    property Constraints;
994    property DoubleBuffered;
995    property DragCursor;
996    property DragMode;
997    property EchoMode;
998    property EditLabel;
999    property Enabled;
1000    property Font;
1001    property LabelPosition;
1002    property LabelSpacing;
1003    property MaxLength;
1004    property ParentBidiMode;
1005    property ParentColor;
1006    property ParentDoubleBuffered;
1007    property ParentFont;
1008    property ParentShowHint;
1009    property PasswordChar;
1010    property PopupMenu;
1011    property ReadOnly;
1012    property ShowHint;
1013    property TabOrder;
1014    property TabStop;
1015    property Text;
1016    property TextHint;
1017    property Visible;
1018    property OnChange;
1019    property OnClick;
1020    property OnDblClick;
1021    property OnDragDrop;
1022    property OnDragOver;
1023    property OnEditingDone;
1024    property OnEndDrag;
1025    property OnEnter;
1026    property OnExit;
1027    property OnKeyDown;
1028    property OnKeyPress;
1029    property OnKeyUp;
1030    property OnMouseDown;
1031    property OnMouseEnter;
1032    property OnMouseLeave;
1033    property OnMouseMove;
1034    property OnMouseUp;
1035    property OnMouseWheel;
1036    property OnMouseWheelDown;
1037    property OnMouseWheelUp;
1038    property OnStartDrag;
1039    property OnUTF8KeyPress;
1040  end;
1041
1042
1043  { TCustomPanel }
1044
1045  TPanelBevel = TBevelCut;
1046  TBevelWidth = 1..Maxint;
1047
1048  TCustomPanel = class(TCustomControl)
1049  private
1050    FBevelColor : TColor;
1051    FBevelInner, FBevelOuter : TPanelBevel;
1052    FBevelWidth : TBevelWidth;
1053    FAlignment : TAlignment;
1054    FFullRepaint: Boolean;
1055    FWordWrap: Boolean;
1056    procedure PaintBevel(var ARect: TRect; ABevel: TPanelBevel);
1057    procedure SetAlignment(const Value : TAlignment);
1058    procedure SetBevelColor(AValue: TColor);
1059    procedure SetBevelInner(const Value: TPanelBevel);
1060    procedure SetBevelOuter(const Value: TPanelBevel);
1061    procedure SetBevelWidth(const Value: TBevelWidth);
1062    procedure SetWordwrap(const Value: Boolean);
1063  protected
1064    class procedure WSRegisterClass; override;
1065    procedure AdjustClientRect(var aRect: TRect); override;
1066    class function GetControlClassDefaultSize: TSize; override;
1067    procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
1068    function GetDefaultDockCaption: String; override;
1069    procedure Loaded; override;
1070    procedure RealSetText(const Value: TCaption); override;
1071    procedure Paint; override;
1072    procedure SetParentBackground(const AParentBackground: Boolean); override;
1073    procedure UpdateParentColorChange;
1074    property WordWrap: Boolean read FWordwrap write SetWordwrap default false;
1075  public
1076    constructor Create(TheOwner: TComponent); override;
1077    property Align default alNone;
1078    property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
1079    property BevelColor: TColor read FBevelColor write SetBevelColor default clDefault;
1080    property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone;
1081    property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvRaised;
1082    property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1;
1083    property Color default {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif};
1084    property FullRepaint: Boolean read FFullRepaint write FFullRepaint default True; // exists only for Delphi compatibility, has no effect in LCL
1085    property ParentBackground default true;
1086    property ParentColor default true;
1087    property TabStop default False;
1088  end;
1089
1090
1091  { TPanel }
1092
1093  TPanel = class(TCustomPanel)
1094  published
1095    property Align;
1096    property Alignment;
1097    property Anchors;
1098    property AutoSize;
1099    property BorderSpacing;
1100    property BevelColor;
1101    property BevelInner;
1102    property BevelOuter;
1103    property BevelWidth;
1104    property BidiMode;
1105    property BorderWidth;
1106    property BorderStyle;
1107    property Caption;
1108    property ChildSizing;
1109    property ClientHeight;
1110    property ClientWidth;
1111    property Color;
1112    property Constraints;
1113    property DockSite;
1114    property DoubleBuffered;
1115    property DragCursor;
1116    property DragKind;
1117    property DragMode;
1118    property Enabled;
1119    property Font;
1120    property FullRepaint;
1121    property ParentBackground;
1122    property ParentBidiMode;
1123    property ParentColor;
1124    property ParentDoubleBuffered;
1125    property ParentFont;
1126    property ParentShowHint;
1127    property PopupMenu;
1128    property ShowHint;
1129    property TabOrder;
1130    property TabStop;
1131    property UseDockManager default True;
1132    property Visible;
1133    property Wordwrap;
1134    property OnClick;
1135    property OnContextPopup;
1136    property OnDockDrop;
1137    property OnDockOver;
1138    property OnDblClick;
1139    property OnDragDrop;
1140    property OnDragOver;
1141    property OnEndDock;
1142    property OnEndDrag;
1143    property OnEnter;
1144    property OnExit;
1145    property OnGetSiteInfo;
1146    property OnGetDockCaption;
1147    property OnMouseDown;
1148    property OnMouseEnter;
1149    property OnMouseLeave;
1150    property OnMouseMove;
1151    property OnMouseUp;
1152    property OnMouseWheel;
1153    property OnMouseWheelDown;
1154    property OnMouseWheelUp;
1155    property OnPaint;
1156    property OnResize;
1157    property OnStartDock;
1158    property OnStartDrag;
1159    property OnUnDock;
1160  end;
1161
1162  { TCustomFlowPanel }
1163
1164  TFlowPanel = class;
1165  TCustomFlowPanel = class;
1166  TFlowPanelControl = class;
1167  TFlowPanelControlList = class;
1168
1169  TFlowStyle = (fsLeftRightTopBottom, fsRightLeftTopBottom, fsLeftRightBottomTop, fsRightLeftBottomTop,
1170                fsTopBottomLeftRight, fsBottomTopLeftRight, fsTopBottomRightLeft, fsBottomTopRightLeft);
1171
1172  TWrapAfter = (
1173    waAuto,    // auto
1174    waForce,   // always wrap after this control
1175    waAvoid,   // try not to wrap after this control, if the control is already at the beginning of the row, wrap though
1176    waForbid); // never wrap after this control
1177
1178  TFlowPanelControl = class(TCollectionItem)
1179  private
1180    FControl: TControl;
1181    FWrapAfter: TWrapAfter;
1182    procedure SetControl(const aControl: TControl);
1183    procedure SetWrapAfter(const AWrapAfter: TWrapAfter);
1184  protected
1185    procedure SetIndex(Value: Integer); override;
1186    procedure AssignTo(Dest: TPersistent); override;
1187    function FPCollection: TFlowPanelControlList;
1188    function FPOwner: TCustomFlowPanel;
1189  published
1190    property Control: TControl read FControl write SetControl;
1191    property WrapAfter: TWrapAfter read FWrapAfter write SetWrapAfter;
1192    property Index;
1193  end;
1194
1195  TFlowPanelControlList = class(TOwnedCollection)
1196  private
1197    function GetItem(Index: Integer): TFlowPanelControl;
1198    procedure SetItem(Index: Integer; const AItem: TFlowPanelControl);
1199  protected
1200    function FPOwner: TCustomFlowPanel;
1201
1202    function Add: TFlowPanelControl;
1203    procedure AddControl(AControl: TControl; AIndex: Integer = -1);
1204    procedure RemoveControl(AControl: TControl);
1205  public
1206    constructor Create(AOwner: TPersistent);
1207  public
1208    function IndexOf(AControl: TControl): Integer;
1209
1210    property Items[Index: Integer]: TFlowPanelControl read GetItem write SetItem; default;
1211  end;
1212
1213  TCustomFlowPanel = class(TCustomPanel)
1214  private
1215    FControlList: TFlowPanelControlList;
1216    FAutoWrap: Boolean;
1217    FFlowStyle: TFlowStyle;
1218    FFlowLayout: TTextLayout;
1219    procedure SetAutoWrap(const AAutoWrap: Boolean);
1220    procedure SetControlList(const AControlList: TFlowPanelControlList);
1221    procedure SetFlowLayout(const aFlowLayout: TTextLayout);
1222    procedure SetFlowStyle(const AFlowStyle: TFlowStyle);
1223  protected
1224    procedure CMControlChange(var Message: TCMControlChange); message CM_CONTROLCHANGE;
1225
1226    procedure AlignControls(AControl: TControl; var RemainingClientRect: TRect); override;
1227    procedure CalculatePreferredSize(
1228                         var PreferredWidth, PreferredHeight: integer;
1229                         WithThemeSpace: Boolean); override;
1230  public
1231    constructor Create(AOwner: TComponent); override;
1232    destructor Destroy; override;
1233  public
1234    function GetControlIndex(AControl: TControl): Integer;
1235    procedure SetControlIndex(AControl: TControl; Index: Integer);
1236
1237    property AutoWrap: Boolean read FAutoWrap write SetAutoWrap;
1238    property ControlList: TFlowPanelControlList read FControlList write SetControlList;
1239    property FlowStyle: TFlowStyle read FFlowStyle write SetFlowStyle;
1240    property FlowLayout: TTextLayout read FFlowLayout write SetFlowLayout;
1241  end;
1242
1243  TFlowPanel = class(TCustomFlowPanel)
1244  published
1245    property Align;
1246    property Alignment;
1247    property Anchors;
1248    property AutoSize;
1249    property AutoWrap default True;
1250    property BevelInner;
1251    property BevelOuter;
1252    property BevelWidth;
1253    property BiDiMode;
1254    property BorderWidth;
1255    property BorderSpacing;
1256    property BorderStyle;
1257    property Caption;
1258    property Color;
1259    property Constraints;
1260    property ControlList;
1261    property UseDockManager default True;
1262    property DockSite;
1263    property DoubleBuffered;
1264    property DragCursor;
1265    property DragKind;
1266    property DragMode;
1267    property Enabled;
1268    property FlowLayout;
1269    property FlowStyle;
1270    property FullRepaint;
1271    property Font;
1272    property ParentBiDiMode;
1273    property ParentColor;
1274    property ParentDoubleBuffered;
1275    property ParentFont;
1276    property ParentShowHint;
1277    property PopupMenu;
1278    property ShowHint;
1279    property TabOrder;
1280    property TabStop;
1281    property Visible;
1282    property OnAlignInsertBefore;
1283    property OnAlignPosition;
1284    property OnClick;
1285    property OnConstrainedResize;
1286    property OnContextPopup;
1287    property OnDockDrop;
1288    property OnDockOver;
1289    property OnDblClick;
1290    property OnDragDrop;
1291    property OnDragOver;
1292    property OnEndDock;
1293    property OnEndDrag;
1294    property OnEnter;
1295    property OnExit;
1296    property OnGetSiteInfo;
1297    property OnMouseDown;
1298    property OnMouseEnter;
1299    property OnMouseLeave;
1300    property OnMouseMove;
1301    property OnMouseUp;
1302    property OnResize;
1303    property OnStartDock;
1304    property OnStartDrag;
1305    property OnUnDock;
1306  end;
1307
1308  { TCustomTrayIcon }
1309
1310  TBalloonFlags = (bfNone, bfInfo, bfWarning, bfError);
1311
1312  TCustomTrayIcon = class(TLCLComponent)
1313  private
1314    FDelayedShowing: Boolean;
1315    FAnimate: Boolean;
1316    FAnimateTimer: TTimer;
1317    FCurAnimationStep: Integer;
1318    FBalloonFlags: TBalloonFlags;
1319    FBalloonHint: string;
1320    FBalloonTimeout: Integer;
1321    FBalloonTitle: string;
1322    FPopUpMenu: TPopupMenu;
1323    FIcon: TIcon;
1324    FIcons: TCustomImageList;
1325    FHint: string;
1326    FVisible, FShowIcon: Boolean;
1327    FNotifier: TPopupNotifier;
1328    FTimer: TTimer;
1329    FOnPaint, FOnClick, FOnDblClick: TNotifyEvent;
1330    FOnMouseDown, FOnMouseUp: TMouseEvent;
1331    FOnMouseMove: TMouseMoveEvent;
1332    function GetAnimateInterval: Cardinal;
1333    function  GetCanvas: TCanvas;
1334    function InternalShow: Boolean;
1335    procedure SetAnimate(const AValue: Boolean);
1336    procedure SetAnimateInterval(const AValue: Cardinal);
1337    procedure SetHint(const AValue: string);
1338    procedure SetIcon(const AValue: TIcon);
1339    procedure SetIcons(const AValue: TCustomImageList);
1340    procedure SetPopUpMenu(const AValue: TPopupMenu);
1341    procedure SetVisible(Value: Boolean);
1342    procedure HandleNotifierClose(Sender: TObject; var CloseAction: TCloseAction);
1343    procedure HandleNotifierTimeout(Sender: TObject);
1344    procedure HandleOnAnimateTimer(Sender: TObject);
1345    procedure IconChanged(Sender: TObject);
1346  protected
1347    class procedure WSRegisterClass; override;
1348    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
1349    procedure Loaded; override;
1350  public
1351    Handle: HWND;
1352    constructor Create(TheOwner: TComponent); override;
1353    destructor Destroy; override;
1354    function Hide: Boolean;
1355    function Show: Boolean;
1356    procedure InternalUpdate;
1357    procedure ShowBalloonHint;
1358    function GetPosition: TPoint;
1359    { Properties }
1360    property Animate: Boolean read FAnimate write SetAnimate default False;
1361    property AnimateInterval: Cardinal read GetAnimateInterval write SetAnimateInterval default 1000;
1362    property BalloonFlags: TBalloonFlags read FBalloonFlags write FBalloonFlags default bfNone;
1363    property BalloonHint: string read FBalloonHint write FBalloonHint;
1364    property BalloonTimeout: Integer read FBalloonTimeout write FBalloonTimeout default 3000;
1365    property BalloonTitle: string read FBalloonTitle write FBalloonTitle;
1366    property Canvas: TCanvas read GetCanvas;
1367    property PopUpMenu: TPopupMenu read FPopUpMenu write SetPopUpMenu;
1368    property Icon: TIcon read FIcon write SetIcon;
1369    property Icons: TCustomImageList read FIcons write SetIcons;
1370    property Hint: string read FHint write SetHint;
1371    property ShowIcon: Boolean read FShowIcon write FShowIcon default True;
1372    property Visible: Boolean read FVisible write SetVisible default False;
1373    { Events }
1374    property OnClick: TNotifyEvent read FOnClick write FOnClick;
1375    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
1376    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
1377    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
1378    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
1379    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
1380  end;
1381
1382  { TTrayIcon }
1383
1384  TTrayIcon = class(TCustomTrayIcon)
1385  published
1386    property BalloonFlags;
1387    property BalloonHint;
1388    property BalloonTimeout;
1389    property BalloonTitle;
1390    property PopUpMenu;
1391    property Icon;
1392    property Hint;
1393    property Visible;
1394    property OnClick;
1395    property OnDblClick;
1396    property OnMouseDown;
1397    property OnMouseMove;
1398    property OnMouseUp;
1399    property OnPaint;
1400  end;
1401
1402  { TControlBar }
1403
1404  TBandDrawingStyle = (dsNormal, dsGradient);
1405  TBandPaintOption = (bpoGrabber, bpoFrame, bpoGradient, bpoRoundRect);
1406  TBandPaintOptions = set of TBandPaintOption;
1407
1408  TBandDragEvent = procedure (Sender: TObject; Control: TControl; var Drag: Boolean) of object;
1409  TBandInfoEvent = procedure (Sender: TObject; Control: TControl;
1410    var Insets: TRect; var PreferredSize, RowCount: Integer) of object;
1411  TBandMoveEvent = procedure (Sender: TObject; Control: TControl; var ARect: TRect) of object;
1412  TBandPaintEvent = procedure (Sender: TObject; Control: TControl; ACanvas: TCanvas;
1413    var ARect: TRect; var Options: TBandPaintOptions) of object;
1414
1415  TRowSize = 1..MaxInt;
1416
1417  TBandMove = (bmNone, bmReady, bmMoving);
1418  TCursorDesign = (cdDefault, cdGrabber, cdRestricted);
1419
1420{ BiDi is Left to Right:
1421  +----------------------------------------------------------------------------+
1422  | cBandBorder + |cGrabWidth| + cBandBorder + [ Control.Width ] + cBandBorder |
1423  +----------------------------------------------------------------------------+
1424  |                cFullGrabber                |                                 }
1425
1426  { TCtrlBand }
1427  TCtrlBand = class
1428  private
1429    FControl: TControl;
1430    FControlHeight: Integer;
1431    FControlLeft: Integer;
1432    FControlTop: Integer;
1433    FControlVisible: Boolean;
1434    FControlWidth: Integer;
1435    FHeight: Integer;
1436    FInitLeft: Integer;
1437    FInitTop: Integer;
1438    FLeft: Integer;
1439    FTop: Integer;
1440    FVisible: Boolean;
1441    FWidth: Integer;
1442    function GetBandRect: TRect;
1443    function GetBottom: Integer;
1444    function GetRight: Integer;
1445    procedure SetBandRect(AValue: TRect);
1446    procedure SetRight(AValue: Integer);
1447  public
1448    property BandRect: TRect read GetBandRect write SetBandRect;
1449    property Bottom: Integer read GetBottom;
1450    property Control: TControl read FControl write FControl;
1451    property ControlHeight: Integer read FControlHeight write FControlHeight;
1452    property ControlLeft: Integer read FControlLeft write FControlLeft;
1453    property ControlTop: Integer read FControlTop write FControlTop;
1454    property ControlWidth: Integer read FControlWidth write FControlWidth;
1455    property ControlVisible: Boolean read FControlVisible write FControlVisible;
1456    property Height: Integer read FHeight write FHeight;
1457    property InitLeft: Integer read FInitLeft write FInitLeft;
1458    property InitTop: Integer read FInitTop write FInitTop;
1459    property Left: Integer read FLeft write FLeft;
1460    property Right: Integer read GetRight write SetRight;
1461    property Top: Integer read FTop write FTop;
1462    property Visible: Boolean read FVisible write FVisible;
1463    property Width: Integer read FWidth write FWidth;
1464  end;
1465
1466  { TCtrlBands }
1467
1468  TCtrlBands = class ({$IFDEF FPDoc}TFPGObjectList{$ELSE}specialize TFPGObjectList<TCtrlBand>{$ENDIF})
1469  public
1470    function GetIndex(AControl: TControl): Integer;
1471  end;
1472
1473  { TCustomControlBar }
1474
1475  TCustomControlBar = class(TCustomPanel)
1476  private
1477    FAutoDrag: Boolean;
1478    FAutoDock: Boolean;
1479    FDrawingStyle: TBandDrawingStyle;
1480    FGradientDirection: TGradientDirection;
1481    FGradientEndColor: TColor;
1482    FGradientStartColor: TColor;
1483    FPicture: TPicture;
1484    FRowSize: TRowSize;
1485    FRowSnap: Boolean;
1486    FOnBandDrag: TBandDragEvent;
1487    FOnBandInfo: TBandInfoEvent;
1488    FOnBandMove: TBandMoveEvent;
1489    FOnBandPaint: TBandPaintEvent;
1490    FOnCanResize: TCanResizeEvent;
1491    FOnPaint: TNotifyEvent;
1492    procedure SetDrawingStyle(AValue: TBandDrawingStyle);
1493    procedure SetGradientDirection(AValue: TGradientDirection);
1494    procedure SetGradientEndColor(AValue: TColor);
1495    procedure SetGradientStartColor(AValue: TColor);
1496    procedure SetPicture(aValue: TPicture);
1497    procedure SetRowSize(AValue: TRowSize);
1498  protected const
1499    cBandBorderH: SmallInt = 4;
1500    cBandBorderV: SmallInt = 2;
1501    cGrabWidth: SmallInt = 3;
1502  protected
1503    class var cFullGrabber: SmallInt;
1504  protected
1505    FBands: TCtrlBands;
1506    FBandMove: TBandMove;
1507    FCursorLock: Boolean;
1508    FDefCursor: TCursor;
1509    FHoveredBand: TCtrlBand;
1510    FInitDrag: TPoint;
1511    FInnerBevelWidth: SmallInt;
1512    FLockResize: Boolean;
1513    FPrevWidth: Integer;
1514    FVisiBands: array of TCtrlBand;
1515    FVisiBandsEx: array of TCtrlBand;
1516    procedure AlignControlToBand(ABand: TCtrlBand; ARightToLeft: Boolean);
1517    procedure AlignControlsToBands;
1518    function CalcBandHeight(AControl: TControl): Integer;
1519    function CalcBandHeightSnapped(AControl: TControl): Integer;
1520    function CalcInnerBevelWidth: Integer;
1521    function CalcLowestBandBottomPx: Integer;
1522    procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer;
1523      {%H-}WithThemeSpace: Boolean); override;
1524    procedure ChangeCursor(ACursor: TCursorDesign);
1525    procedure CheckBandsSizeAndVisibility;
1526    procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
1527    procedure CMBorderChanged(var Message: TLMessage); message CM_BORDERCHANGED;
1528    procedure CreateWnd; override;
1529    procedure DoBandMove(AControl: TControl; var ARect: TRect); virtual;
1530    procedure DoBandPaint(AControl: TControl; ACanvas: TCanvas; var ARect: TRect;
1531      var AOptions: TBandPaintOptions); virtual;
1532    function DragControl(AControl: TControl; X, Y: Integer;
1533      KeepCapture: Boolean = False): Boolean; virtual;
1534    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
1535      var Accept: Boolean); override;
1536    procedure GetControlInfo(AControl: TControl; var Insets: TRect;
1537      var PreferredSize, RowCount: Integer); virtual;
1538    class constructor InitializeClass;
1539    procedure InitializeBand(ABand: TCtrlBand; AKeepPos: Boolean);
1540    procedure InitializeMove(AMovingBand: TCtrlBand);
1541    procedure Loaded; override;
1542    function IsBandOverlap(ARect, BRect: TRect): Boolean;
1543    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
1544    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
1545    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
1546    procedure MoveBand(AMoveBand: TCtrlBand; X, Y: Integer; ByMouse: Boolean);
1547    procedure NormalizeRows;
1548    procedure Paint; override;
1549    procedure PictureChanged(Sender: TObject);
1550    procedure Resize; override;
1551    procedure SetCursor(Value: TCursor); override;
1552    procedure ShiftBands(AFrom, ATo, AShift, ALimit: Integer);
1553    procedure SortVisibleBands;
1554    procedure WMSize(var Message: TLMSize); message LM_SIZE;
1555  public
1556    FUpdateCount: SmallInt;
1557    constructor Create(AOwner: TComponent); override;
1558    destructor Destroy; override;
1559    procedure BeginUpdate;
1560    procedure EndUpdate;
1561    procedure FlipChildren(AllLevels: Boolean); override;
1562    function HitTest(X, Y: Integer): TControl;
1563    procedure InsertControl(AControl: TControl; Index: Integer); override;
1564    function MouseToBandPos(X, Y: Integer; out AGrabber: Boolean): TCtrlBand;
1565    procedure RemoveControl(AControl: TControl); override;
1566    procedure StickControls;  virtual;
1567    property AutoDock: Boolean read FAutoDock write FAutoDock default True;
1568    property AutoDrag: Boolean read FAutoDrag write FAutoDrag default True;
1569    property AutoSize;
1570    property DockSite default True;
1571    property DrawingStyle: TBandDrawingStyle read FDrawingStyle write SetDrawingStyle default dsNormal;
1572    property GradientDirection: TGradientDirection read FGradientDirection write SetGradientDirection default gdVertical;
1573    property GradientStartColor: TColor read FGradientStartColor write SetGradientStartColor default clDefault;
1574    property GradientEndColor: TColor read FGradientEndColor write SetGradientEndColor default clDefault;
1575    property Picture: TPicture read FPicture write SetPicture;
1576    property RowSize: TRowSize read FRowSize write SetRowSize default 26;
1577    property RowSnap: Boolean read FRowSnap write FRowSnap default True;
1578    property OnBandDrag: TBandDragEvent read FOnBandDrag write FOnBandDrag;
1579    property OnBandInfo: TBandInfoEvent read FOnBandInfo write FOnBandInfo;
1580    property OnBandMove: TBandMoveEvent read FOnBandMove write FOnBandMove;
1581    property OnBandPaint: TBandPaintEvent read FOnBandPaint write FOnBandPaint;
1582    property OnCanResize: TCanResizeEvent read FOnCanResize write FOnCanResize;
1583    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
1584  end;
1585
1586  TControlBar = class(TCustomControlBar)
1587  public
1588    property Canvas;
1589  published
1590    property Align;
1591    property Anchors;
1592    property AutoDock;
1593    property AutoDrag;
1594    property AutoSize;
1595    property BevelInner default bvRaised;
1596    property BevelOuter default bvLowered;
1597    property BevelWidth;
1598    property BiDiMode;
1599    property BorderWidth;
1600    property Color;
1601    property Constraints;
1602    property DockSite;
1603    property DoubleBuffered;
1604    property DragCursor;
1605    property DragKind;
1606    property DragMode;
1607    property DrawingStyle;
1608    property Enabled;
1609    property GradientDirection;
1610    property GradientEndColor;
1611    property GradientStartColor;
1612    property ParentColor;
1613    property ParentDoubleBuffered;
1614    property ParentFont;
1615    property ParentShowHint;
1616    property Picture;
1617    property PopupMenu;
1618    property RowSize;
1619    property RowSnap;
1620    property ShowHint;
1621    property TabOrder;
1622    property TabStop;
1623    property Visible;
1624    property OnBandDrag;
1625    property OnBandInfo;
1626    property OnBandMove;
1627    property OnBandPaint;
1628    property OnCanResize;
1629    property OnClick;
1630    property OnConstrainedResize;
1631    property OnContextPopup;
1632    property OnDockDrop;
1633    property OnDockOver;
1634    property OnDblClick;
1635    property OnDragDrop;
1636    property OnDragOver;
1637    property OnEndDock;
1638    property OnEndDrag;
1639    property OnEnter;
1640    property OnExit;
1641    property OnGetSiteInfo;
1642    property OnMouseDown;
1643    property OnMouseEnter;
1644    property OnMouseLeave;
1645    property OnMouseMove;
1646    property OnMouseUp;
1647    property OnMouseWheel;
1648    property OnMouseWheelDown;
1649    property OnMouseWheelUp;
1650    property OnPaint;
1651    property OnResize;
1652    property OnStartDock;
1653    property OnStartDrag;
1654    property OnUnDock;
1655  end;
1656
1657
1658procedure Frame3D(ACanvas: TCanvas; var ARect: TRect;
1659  TopColor, BottomColor: TColor; const FrameWidth: integer);
1660
1661procedure Register;
1662
1663implementation
1664
1665// !!! Avoid unit circles. Only add units if really needed.
1666uses
1667  Math, WSExtCtrls;
1668
1669{.$define INSTALL_TUNTABBEDNOTEBOOK}
1670
1671// Wrapper function for TCanvas.Frame3D.
1672procedure Frame3D(ACanvas: TCanvas; var ARect: TRect;
1673  TopColor, BottomColor: TColor; const FrameWidth: integer);
1674begin
1675  ACanvas.Frame3D(ARect, TopColor, BottomColor, FrameWidth);
1676end;
1677
1678procedure Register;
1679begin
1680  RegisterComponents('Standard',[TRadioGroup,TCheckGroup,TPanel]);
1681  RegisterComponents('Additional',[TImage,TShape,TBevel,TPaintBox,
1682    TNotebook, TLabeledEdit, TSplitter, TTrayIcon, TControlBar, TFlowPanel]);
1683  RegisterComponents('System',[TTimer,TIdleTimer]);
1684  RegisterNoIcon([TPage]);
1685end;
1686
1687{$I page.inc}
1688{$I notebook.inc}
1689{$I idletimer.inc}
1690{$I shape.inc}
1691{$I customsplitter.inc}
1692{$I paintbox.inc}
1693{$I customcheckgroup.inc}
1694{$I boundlabel.inc}
1695{$I customlabelededit.inc}
1696{$I custompanel.inc}
1697{$I customflowpanel.inc}
1698{$I radiogroup.inc}
1699{$I bevel.inc}
1700{$I customimage.inc}
1701{$I customtrayicon.inc}
1702{$I controlbar.inc}
1703
1704initialization
1705  DockSplitterClass := TSplitter;
1706  RegisterPropertyToSkip(TPage, 'ClientHeight', 'This property was published for a long time in Lazarus 0.9.31', '');
1707  RegisterPropertyToSkip(TPage, 'ClientWidth', 'This property was published for a long time in Lazarus 0.9.31', '');
1708
1709end.
1710