lazarus/lcl/extctrls.pp

1791 lines
59 KiB
ObjectPascal

{
/***************************************************************************
extctrls.pp
-----------
Component Library Extended Controls
Initial Revision : Sat Jul 26 12:04:35 PDT 1999
***************************************************************************/
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
unit ExtCtrls;
{$mode objfpc}{$H+}
{$I lcl_defines.inc}
interface
{$ifdef Trace}
{$ASSERTIONS ON}
{$endif}
uses
SysUtils, Types, Classes, contnrs, FGL,
// LCL
LCLStrConsts, LCLType, LCLProc, LResources, LMessages, Controls, Forms,
StdCtrls, Graphics, LCLIntf, CustomTimer, Themes, LCLClasses, Menus,
PopupNotifier, ImgList,
// LazUtils
GraphType, LazLoggerBase, LazTracer, LazUtilities;
type
{ TPage }
TPage = class;
TBeforeShowPageEvent = procedure (ASender: TObject; ANewPage: TPage; ANewIndex: Integer) of object;
TImagePaintBackgroundEvent = procedure (ASender: TObject; ACanvas: TCanvas; ARect: TRect) of object;
TPage = class(TCustomControl)
private
FOnBeforeShow: TBeforeShowPageEvent;
function GetPageIndex: Integer;
protected
class procedure WSRegisterClass; override;
procedure SetParent(AParent: TWinControl); override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
public
property PageIndex: Integer read GetPageIndex;
published
// OnBeforeShow occurs before a page is displayed, so that
// preparations can be executed in it's user interface, for example
property OnBeforeShow: TBeforeShowPageEvent read FOnBeforeShow write FOnBeforeShow;
property BiDiMode;
property ChildSizing;
property Color;
property Left stored False;
property Top stored False;
property Width stored False;
property Height stored False;
property ParentBiDiMode;
property ParentShowHint;
property PopupMenu;
property TabOrder stored False;
property TabStop;
property Visible stored False;
property OnContextPopup;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnResize;
end;
{ TUNBPages }
TNotebook = class;
TUNBPages = class(TStrings)
private
FPageList: TObjectList;
FNotebook: TNotebook;
function GetNotebookOwner: TComponent;
protected
function Get(Index: Integer): String; override;
function GetCount: Integer; override;
function GetObject(Index: Integer): TObject; override;
procedure Put(Index: Integer; const S: String); override;
public
constructor Create(theNotebook: TNotebook);
destructor Destroy; override;
function Add(const S: string): Integer; override;
function AddObject(const S: string; AObject: TObject): Integer; override;
procedure Clear; override;
procedure Delete(Index: Integer); override;
function IndexOfObject(AObject: TObject): Integer; override;
procedure Insert(Index: Integer; const S: string); override;
procedure Move(CurIndex, NewIndex: Integer); override;
end;
{ TNotebook }
TNotebook = class(TCustomControl)
private
FPages: TStrings; // TUNBPages
FPageIndex: Integer;
function GetActivePage: String;
function GetActivePageComponent: TPage;
function GetPage(AIndex: Integer): TPage;
function GetPageCount : integer;
function GetPageIndex: Integer;
{ function FindVisiblePage(Index: Integer): Integer;}
{ procedure MovePage(APage: TCustomPage; NewIndex: Integer);
procedure RemovePage(Index: Integer);
procedure SetActivePage(const Value: String);}
procedure SetPageIndex(AValue: Integer);
procedure SetPages(Items: TStrings);
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure ShowControl(AControl: TControl); override;
{ function TabIndexAtClientPos(ClientPos: TPoint): integer;
function TabRect(AIndex: Integer): TRect;
function GetImageIndex(ThePageIndex: Integer): Integer; virtual;
function CustomPage(Index: integer): TCustomPage;}
function IndexOf(APage: TPage): integer;
public
property ActivePage: String read GetActivePage;// write SetActivePage; // should not be published because the read can raise an exception
property ActivePageComponent: TPage read GetActivePageComponent;// write SetActivePage; // should not be published because the read can raise an exception
property Page[Index: Integer]: TPage read GetPage;
property PageCount: integer read GetPageCount;
published
property PageIndex: Integer read GetPageIndex write SetPageIndex default -1;
property Pages: TStrings read FPages write SetPages stored False;
property Align;
property AutoSize;
property Anchors;
property BiDiMode;
property BorderSpacing;
property Color;
property Constraints;
property DragCursor;
property DragMode;
property Enabled;
property ParentBiDiMode;
property PopupMenu;
property TabOrder;
property TabStop;
property OnChangeBounds;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnResize;
property OnStartDrag;
end;
{ Timer }
TTimer = class (TCustomTimer)
published
property Enabled;
property Interval;
property OnTimer;
property OnStartTimer;
property OnStopTimer;
end;
{ TIdleTimer
For example:
Do something after 2 seconds after user input and idle.
AutoEnabled:=true;
AutoStartEvent:=itaOnIdle; // start the timer on first idle
AutoEndEvent:=itaOnUserInput; // end on any user input
If the OnTimer event works in several chunks, set FireOnIdle:=true.
The OnTimer event will then be called on idle until FireOnIdle is false.
FireOnIdle is set to false on any user input. }
TIdleTimerAutoEvent = (
itaOnIdle,
itaOnIdleEnd,
itaOnUserInput
);
TIdleTimerAutoEvents = set of TIdleTimerAutoEvent;
{ TCustomIdleTimer }
TCustomIdleTimer = class(TCustomTimer)
private
FAutoEnabled: boolean;
FAutoEndEvent: TIdleTimerAutoEvent;
FAutoStartEvent: TIdleTimerAutoEvent;
FFireOnIdle: boolean;
FHandlersConnected: boolean;
procedure UpdateHandlers;
protected
procedure SetAutoEnabled(const AValue: boolean); virtual;
procedure DoOnIdle(Sender: TObject; var Done: Boolean); virtual;
procedure DoOnIdleEnd(Sender: TObject); virtual;
procedure DoOnUserInput(Sender: TObject; Msg: Cardinal); virtual;
procedure Loaded; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
property AutoEnabled: boolean read FAutoEnabled
write SetAutoEnabled default False;
property AutoStartEvent: TIdleTimerAutoEvent read FAutoStartEvent
write FAutoStartEvent default itaOnIdle;
property AutoEndEvent: TIdleTimerAutoEvent read FAutoEndEvent
write FAutoEndEvent default itaOnUserInput;
property FireOnIdle: boolean read FFireOnIdle write FFireOnIdle default false;
end;
TIdleTimer = class(TCustomIdleTimer)
published
property AutoEnabled;
property AutoStartEvent;
property AutoEndEvent;
property Enabled;
property Interval;
property OnTimer;
property OnStartTimer;
property OnStopTimer;
end;
{ TShape }
TShapeType = (stRectangle, stSquare, stRoundRect, stRoundSquare,
stEllipse, stCircle, stSquaredDiamond, stDiamond,
stTriangle, stTriangleLeft, stTriangleRight, stTriangleDown,
stStar, stStarDown, stPolygon);
TShapePointsEvent = procedure (Sender: TObject; var Points: TPointArray;
var Winding: Boolean) of object;
TCustomShape = class(TGraphicControl)
private
FPen: TPen;
FBrush: TBrush;
FShape: TShapeType;
FBitmapCopy: TBitmap; // For testing if a mouse click is on the actual shape.
FOnShapeClick: TNotifyEvent;
FOnShapePoints: TShapePointsEvent;
procedure SetBrush(Value: TBrush);
procedure SetPen(Value: TPen);
procedure SetShape(Value: TShapeType);
procedure SetOnShapePoints(Value: TShapePointsEvent);
protected
class procedure WSRegisterClass; override;
class function GetControlClassDefaultSize: TSize; override;
procedure Click; override;
procedure CMShapeHitTest(var Message: TCMHittest); message CM_MASKHITTEST;
procedure DrawToCanvas(ACanvas: TCanvas); virtual;
procedure UpdateMask;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
function PtInShape(const P: TPoint): Boolean;
procedure Paint; override;
procedure StyleChanged(Sender: TObject);
property Brush: TBrush read FBrush write SetBrush;
property Pen: TPen read FPen write SetPen;
property Shape: TShapeType read FShape write SetShape default stRectangle;
property OnShapeClick: TNotifyEvent read FOnShapeClick write FOnShapeClick;
property OnShapePoints: TShapePointsEvent read FOnShapePoints write SetOnShapePoints;
end;
TShape = class(TCustomShape)
published
property Align;
property Anchors;
property BorderSpacing;
property Brush;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ParentShowHint;
property Pen;
property Shape;
property ShowHint;
property Visible;
property OnChangeBounds;
property OnClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnMouseWheelHorz;
property OnMouseWheelLeft;
property OnMouseWheelRight;
property OnPaint;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnShapeClick;
property OnShapePoints;
end;
{ TCustomSplitter }
TResizeStyle = (
rsLine, // Draw a line, don't update splitter position during moving.
rsNone, // Draw nothing and don't update splitter position during moving.
rsPattern, // Draw a dot pattern, don't update splitter position during moving.
rsUpdate // Draw nothing, update splitter position during moving.
);
TCanOffsetEvent = procedure(Sender: TObject; var NewOffset: Integer;
var Accept: Boolean) of object;
TCanResizeEvent = procedure(Sender: TObject; var NewSize: Integer;
var Accept: Boolean) of object;
{ TCustomSplitter is a control to interactively resize another control.
It is a vertical or horizontal bar anchored to a side of a control.
You can either set the Align property to alLeft (alRight,alTop,alBottom),
then it will become a vertical bar, aligned to the left and when the user
moves it with the mouse, the control to the left with the same Align=alLeft
will be resized.
The second more flexible possibility is to set the properties Align=alNone,
AnchorSides and ResizeAnchor.
}
TCustomSplitter = class(TCustomControl)
private
FAutoSnap: boolean;
FBeveled: boolean;
FMinSize: integer;
FMouseInControl: Boolean;
FOnCanOffset: TCanOffsetEvent;
FOnCanResize: TCanResizeEvent;
FOnMoved: TNotifyEvent;
FResizeAnchor: TAnchorKind;
FResizeStyle: TResizeStyle;
FSplitDragging: Boolean;
FSplitterStartMouseXY: TPoint; // in screen coordinates
FSplitterStartLeftTop: TPoint; // in screen coordinates
FSplitterWindow: HWND;
function GetResizeControl: TControl;
procedure SetBeveled(const AValue: boolean);
procedure SetMinSize(const AValue: integer);
protected
procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED;
class procedure WSRegisterClass; override;
function AdaptAnchors(const a: TAnchors): TAnchors;
function CheckNewSize(var NewSize: Integer): Boolean; virtual;
function CheckOffset(var NewOffset: Integer): Boolean; virtual;
function FindAlignControl: TControl;
function FindAlignOtherControl: TControl;
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure MouseEnter; override;
procedure MouseLeave; override;
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure Paint; override;
procedure SetAlign(Value: TAlign); override;
procedure SetAnchors(const AValue: TAnchors); override;
procedure SetResizeAnchor(const AValue: TAnchorKind); virtual;
procedure SetResizeControl(const AValue: TControl); virtual;
procedure StartSplitterMove(const MouseXY: TPoint);
procedure StopSplitterMove(const MouseXY: TPoint);
procedure UpdateCursor; virtual;
public
constructor Create(TheOwner: TComponent); override;
procedure AnchorSplitter(Kind: TAnchorKind; AControl: TControl);
property ResizeControl: TControl read GetResizeControl write SetResizeControl;
function GetOtherResizeControl: TControl;
procedure MoveSplitter(Offset: integer); virtual;
procedure SetSplitterPosition(NewPosition: integer);
function GetSplitterPosition: integer;
public
property Align default alLeft;
property AutoSnap: boolean read FAutoSnap write FAutoSnap default true;
property Beveled: boolean read FBeveled write SetBeveled default false;
property Cursor default crHSplit;
property MinSize: integer read FMinSize write SetMinSize default 30;
property OnCanOffset: TCanOffsetEvent read FOnCanOffset write FOnCanOffset;
property OnCanResize: TCanResizeEvent read FOnCanResize write FOnCanResize;
property OnMoved: TNotifyEvent read FOnMoved write FOnMoved;
property ResizeAnchor: TAnchorKind read FResizeAnchor write SetResizeAnchor default akLeft;
property ResizeStyle: TResizeStyle read FResizeStyle write FResizeStyle default rsUpdate;
end;
{ TSplitter }
TSplitter = class(TCustomSplitter)
published
property Align;
property Anchors;
property AutoSnap;
property Beveled;
property Color;
property Constraints;
property Cursor;
property DoubleBuffered;
property Height;
property MinSize;
property ParentColor;
property ParentDoubleBuffered;
property ParentShowHint;
property PopupMenu;
property ResizeAnchor;
property ResizeStyle;
property ShowHint;
property Visible;
property Width;
property OnCanOffset;
property OnCanResize;
property OnChangeBounds;
property OnMoved;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnMouseWheelHorz;
property OnMouseWheelLeft;
property OnMouseWheelRight;
property OnPaint;
end;
{ TPaintBox }
TPaintBox = class(TGraphicControl)
protected
class procedure WSRegisterClass; override;
procedure Paint; override;
class function GetControlClassDefaultSize: TSize; override;
public
constructor Create(AOwner: TComponent); override;
property Canvas;
published
property Align;
property Anchors;
property BorderSpacing;
property Color;
property Constraints;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property Hint;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property OnChangeBounds;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnMouseWheelHorz;
property OnMouseWheelLeft;
property OnMouseWheelRight;
property OnPaint;
property OnResize;
property OnStartDrag;
end;
{ TCustomImage }
TCustomImage = class(TGraphicControl)
private
FAntialiasingMode: TAntialiasingMode;
FImageIndex: Integer;
FImages: TCustomImageList;
FImageWidth: Integer;
FOnPictureChanged: TNotifyEvent;
FOnPaintBackground: TImagePaintBackgroundEvent;
FPicture: TPicture;
FCenter: Boolean;
FKeepOriginXWhenClipped: Boolean;
FKeepOriginYWhenClipped: Boolean;
FProportional: Boolean;
FTransparent: Boolean;
FStretch: Boolean;
FStretchOutEnabled: Boolean;
FStretchInEnabled: Boolean;
FUseAncestorCanvas: boolean;
FPainting: boolean;
function GetCanvas: TCanvas;
function GetHasGraphic: Boolean;
procedure SetAntialiasingMode(AValue: TAntialiasingMode);
procedure SetImageIndex(const AImageIndex: Integer);
procedure SetImages(const AImages: TCustomImageList);
procedure SetImageWidth(const AImageWidth: Integer);
procedure SetPicture(const AValue: TPicture);
procedure SetCenter(const AValue : Boolean);
procedure SetKeepOriginX(AValue: Boolean);
procedure SetKeepOriginY(AValue: Boolean);
procedure SetProportional(const AValue: Boolean);
procedure SetStretch(const AValue : Boolean);
procedure SetStretchInEnabled(AValue: Boolean);
procedure SetStretchOutEnabled(AValue: Boolean);
procedure SetTransparent(const AValue : Boolean);
protected
class procedure WSRegisterClass; override;
procedure PictureChanged(Sender : TObject); virtual;
procedure CalculatePreferredSize(var PreferredWidth,
PreferredHeight: integer;
WithThemeSpace: Boolean); override;
class function GetControlClassDefaultSize: TSize; override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas: TCanvas read GetCanvas;
function DestRect: TRect; virtual;
procedure Invalidate; override;
property HasGraphic: Boolean read GetHasGraphic; // has either a picture or valid image from imagelist
public
property AntialiasingMode: TAntialiasingMode read FAntialiasingMode write SetAntialiasingMode default amDontCare;
property Align;
property AutoSize;
property Center: Boolean read FCenter write SetCenter default False;
property KeepOriginXWhenClipped: Boolean read FKeepOriginXWhenClipped write SetKeepOriginX default False;
property KeepOriginYWhenClipped: Boolean read FKeepOriginYWhenClipped write SetKeepOriginY default False;
property Constraints;
property ImageIndex: Integer read FImageIndex write SetImageIndex default 0;
property ImageWidth: Integer read FImageWidth write SetImageWidth default 0; // a specific width for the image from Images
property Images: TCustomImageList read FImages write SetImages;
property Picture: TPicture read FPicture write SetPicture;
property Visible;
property OnClick;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property Stretch: Boolean read FStretch write SetStretch default False;
property StretchOutEnabled: Boolean read FStretchOutEnabled write SetStretchOutEnabled default True;
property StretchInEnabled: Boolean read FStretchInEnabled write SetStretchInEnabled default True;
property Transparent: Boolean read FTransparent write SetTransparent default False;
property Proportional: Boolean read FProportional write SetProportional default False;
property OnPictureChanged: TNotifyEvent read FOnPictureChanged write FOnPictureChanged;
property OnPaintBackground: TImagePaintBackgroundEvent read FOnPaintBackground write FOnPaintBackground;
end;
{ TImage }
TImage = class(TCustomImage)
published
property AntialiasingMode;
property Align;
property Anchors;
property AutoSize;
property BorderSpacing;
property Center;
property KeepOriginXWhenClipped;
property KeepOriginYWhenClipped;
property Constraints;
property DragCursor;
property DragMode;
property Enabled;
property ImageIndex;
property ImageWidth;
property Images;
property ParentShowHint;
property Picture;
property PopupMenu;
property Proportional;
property ShowHint;
property Stretch;
property StretchOutEnabled;
property StretchInEnabled;
property Transparent;
property Visible;
property OnChangeBounds;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnMouseWheelHorz;
property OnMouseWheelLeft;
property OnMouseWheelRight;
property OnPaint;
property OnPictureChanged;
property OnPaintBackground;
property OnResize;
property OnStartDrag;
end;
{ TBevel }
TBevelStyle = (bsLowered, bsRaised);
TBevelShape=(bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine, bsRightLine, bsSpacer);
TBevel = class(TGraphicControl)
private
FStyle:TBevelStyle;
FShape:TBevelShape;
procedure SetStyle(AStyle: TBevelStyle);
procedure SetShape(AShape: TBevelShape);
protected
class procedure WSRegisterClass; override;
class function GetControlClassDefaultSize: TSize; override;
procedure Paint; override;
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property Align;
property Anchors;
property BorderSpacing;
property Constraints;
property ParentShowHint;
property Shape: TBevelShape read FShape write SetShape default bsBox;
property ShowHint;
property Style: TBevelStyle read FStyle write SetStyle default bsLowered;
property Visible;
property OnChangeBounds;
property OnResize;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnPaint;
end;
{ TCustomRadioGroup }
TColumnLayout = (
clHorizontalThenVertical,
clVerticalThenHorizontal
);
TCustomRadioGroup = class(TCustomGroupBox)
private
FAutoFill: Boolean;
FButtonList: TFPList; // list of TRadioButton
FColumnLayout: TColumnLayout;
FColumns: integer;
FCreatingWnd: boolean;
FHiddenButton: TRadioButton;
FIgnoreClicks: boolean;
FItemIndex: integer;
FItems: TStrings;
FLastClickedItemIndex: integer;
FOnClick: TNotifyEvent;
FOnItemEnter: TNotifyEvent;
FOnItemExit: TNotifyEvent;
FOnSelectionChanged: TNotifyEvent;
FReading: boolean;
FUpdatingItems: Boolean;
procedure Changed(Sender: TObject);
procedure Clicked(Sender: TObject);
function GetButton(Index: integer): TRadioButton;
procedure ItemEnter(Sender: TObject);
procedure ItemExit(Sender: TObject);
procedure ItemKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ItemKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ItemKeyPress(Sender: TObject; var Key: Char);
procedure ItemUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
procedure ItemResize(Sender: TObject);
procedure SetAutoFill(const AValue: Boolean);
procedure SetColumnLayout(const AValue: TColumnLayout);
procedure UpdateControlsPerLine;
procedure UpdateItems;
procedure UpdateTabStops;
protected
class procedure WSRegisterClass; override;
procedure UpdateInternalObjectList;
procedure UpdateAll;
procedure InitializeWnd; override;
procedure UpdateRadioButtonStates; virtual;
procedure ReadState(Reader: TReader); override;
procedure SetItems(Value: TStrings);
procedure SetColumns(Value: integer);
procedure SetItemIndex(Value: integer);
function GetItemIndex: integer;
procedure CheckItemIndexChanged; virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
function CanModify: boolean; virtual;
procedure FlipChildren(AllLevels: Boolean); override;
function Rows: integer;
public
property AutoFill: Boolean read FAutoFill write SetAutoFill;
property Buttons[Index: integer]: TRadioButton read GetButton;
property ItemIndex: integer read GetItemIndex write SetItemIndex default -1;
property Items: TStrings read FItems write SetItems;
property Columns: integer read FColumns write SetColumns default 1;
property ColumnLayout: TColumnLayout read FColumnLayout write SetColumnLayout default clHorizontalThenVertical;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnItemEnter: TNotifyEvent read FOnItemEnter write FOnItemEnter;
property OnItemExit: TNotifyEvent read FOnItemExit write FOnItemExit;
property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged;
end;
{ TRadioGroup }
TRadioGroup = class(TCustomRadioGroup)
published
property Align;
property Anchors;
property AutoFill;
property AutoSize;
property BidiMode;
property BorderSpacing;
property Caption;
property ChildSizing;
property ClientHeight;
property ClientWidth;
property Color;
property ColumnLayout;
property Columns;
property Constraints;
property DoubleBuffered;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property ItemIndex;
property Items;
property ParentBackground;
property ParentBidiMode;
property ParentFont;
property ParentColor;
property ParentDoubleBuffered;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnChangeBounds;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnItemEnter;
property OnItemExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnResize;
property OnSelectionChanged;
property OnStartDrag;
property OnUTF8KeyPress;
end;
{ TCustomCheckGroup }
TCheckGroupClicked = procedure(Sender: TObject; Index: integer) of object;
TCustomCheckGroup = class(TCustomGroupBox)
private
FAutoFill: boolean;
FButtonList: TList; // list of TCheckBox
FColumnLayout: TColumnLayout;
FCreatingWnd: boolean;
FItems: TStrings;
FColumns: integer;
FOnItemClick: TCheckGroupClicked;
FUpdatingItems: Boolean;
function GetButton(Index: integer): TCheckBox;
function GetChecked(Index: integer): boolean;
function GetCheckEnabled(Index: integer): boolean;
procedure Clicked(Sender: TObject);
procedure DoClick(Index: integer);
procedure ItemKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ItemKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ItemKeyPress(Sender: TObject; var Key: Char);
procedure ItemUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
procedure RaiseIndexOutOfBounds(Index: integer );
procedure SetAutoFill(const AValue: boolean);
procedure SetChecked(Index: integer; const AValue: boolean);
procedure SetCheckEnabled(Index: integer; const AValue: boolean);
procedure SetColumnLayout(const AValue: TColumnLayout);
procedure UpdateItems;
procedure UpdateControlsPerLine;
protected
class procedure WSRegisterClass; override;
procedure UpdateInternalObjectList;
procedure UpdateAll;
procedure SetItems(Value: TStrings);
procedure SetColumns(Value: integer);
procedure DefineProperties(Filer: TFiler); override;
procedure ReadData(Stream: TStream);
procedure WriteData(Stream: TStream);
procedure Loaded; override;
procedure DoOnResize; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure FlipChildren(AllLevels: Boolean); override;
function Rows: integer;
public
property AutoFill: boolean read FAutoFill write SetAutoFill;
property Buttons[Index: integer]: TCheckBox read GetButton;
property Items: TStrings read FItems write SetItems;
property Checked[Index: integer]: boolean read GetChecked write SetChecked;
property CheckEnabled[Index: integer]: boolean read GetCheckEnabled write SetCheckEnabled;
property Columns: integer read FColumns write SetColumns default 1;
property ColumnLayout: TColumnLayout read FColumnLayout write SetColumnLayout default clHorizontalThenVertical;
property OnItemClick: TCheckGroupClicked read FOnItemClick write FOnItemClick;
end;
{ TCheckGroup }
TCheckGroup = class(TCustomCheckGroup)
published
property Align;
property Anchors;
property AutoFill;
property AutoSize;
property BiDiMode;
property BorderSpacing;
property Caption;
property ChildSizing;
property ClientHeight;
property ClientWidth;
property Color;
property ColumnLayout;
property Columns;
property Constraints;
property DoubleBuffered;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property Items;
property ParentBackground;
property ParentBiDiMode;
property ParentFont;
property ParentColor;
property ParentDoubleBuffered;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnChangeBounds;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnItemClick;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnResize;
property OnStartDrag;
property OnUTF8KeyPress;
end;
{ TBoundLabel }
TBoundLabel = class(TCustomLabel)
public
constructor Create(TheOwner: TComponent); override;
property FocusControl;
published
property Alignment;
property AnchorSideLeft stored False;
property AnchorSideTop stored False;
property AnchorSideRight stored False;
property AnchorSideBottom stored False;
property Left stored False;
property Top stored False;
property Caption;
property Color;
property DragCursor;
property DragMode;
property Height;
property ParentColor;
property ParentFont;
property ParentShowHint;
property Font;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property Layout default tlCenter;
property WordWrap;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnStartDrag;
end;
{ TCustomLabeledEdit }
TLabelPosition = (lpAbove, lpBelow, lpLeft, lpRight);
TCustomLabeledEdit = class(TCustomEdit)
private
FEditLabel: TBoundLabel;
FLabelPosition: TLabelPosition;
FLabelSpacing: Integer;
procedure SetLabelPosition(const Value: TLabelPosition);
procedure SetLabelSpacing(const Value: Integer);
protected
class procedure WSRegisterClass; override;
procedure SetParent(AParent: TWinControl); override;
procedure SetName(const Value: TComponentName); override;
procedure Loaded; override;
procedure DoPositionLabel; virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure CMBiDiModeChanged(var Msg: TLMessage); message CM_BIDIMODECHANGED;
procedure CMVisibleChanged(var Msg: TLMessage); message CM_VISIBLECHANGED;
procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED;
procedure CreateInternalLabel; virtual;
public
constructor Create(TheOwner: TComponent); override;
property EditLabel: TBoundLabel read FEditLabel;
property LabelPosition: TLabelPosition read FLabelPosition
write SetLabelPosition default lpAbove;
property LabelSpacing: Integer read FLabelSpacing write SetLabelSpacing
default 3;
end;
{ TLabeledEdit }
TLabeledEdit = class(TCustomLabeledEdit)
published
property Alignment;
property Anchors;
property AutoSelect;
property AutoSize;
property BidiMode;
property BorderSpacing;
property BorderStyle;
property CharCase;
property Color;
property Constraints;
property DoubleBuffered;
property DragCursor;
property DragMode;
property EchoMode;
property EditLabel;
property Enabled;
property Font;
property LabelPosition;
property LabelSpacing;
property MaxLength;
property NumbersOnly;
property ParentBidiMode;
property ParentColor;
property ParentDoubleBuffered;
property ParentFont;
property ParentShowHint;
property PasswordChar;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property Text;
property TextHint;
property Visible;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEditingDone;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnStartDrag;
property OnUTF8KeyPress;
end;
{ TCustomPanel }
TPanelBevel = TBevelCut;
TBevelWidth = 1..Maxint;
TCustomPanel = class(TCustomControl)
private
FBevelColor : TColor;
FBevelInner, FBevelOuter : TPanelBevel;
FBevelWidth : TBevelWidth;
FAlignment : TAlignment;
FVertAlignment: TVerticalAlignment;
FFullRepaint: Boolean;
FShowAccelChar: Boolean;
FWordWrap: Boolean;
procedure PaintBevel(var ARect: TRect; ABevel: TPanelBevel);
procedure SetAlignment(const Value : TAlignment);
procedure SetBevelColor(AValue: TColor);
procedure SetBevelInner(const Value: TPanelBevel);
procedure SetBevelOuter(const Value: TPanelBevel);
procedure SetBevelWidth(const Value: TBevelWidth);
procedure SetShowAccelChar(const Value: Boolean);
procedure SetVertAlignment(const Value: TVerticalAlignment);
procedure SetWordwrap(const Value: Boolean);
protected
class procedure WSRegisterClass; override;
procedure AdjustClientRect(var aRect: TRect); override;
class function GetControlClassDefaultSize: TSize; override;
procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
function GetDefaultDockCaption: String; override;
procedure Loaded; override;
procedure RealSetText(const Value: TCaption); override;
procedure Paint; override;
procedure SetParentBackground(const AParentBackground: Boolean); override;
procedure UpdateParentColorChange;
property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default false;
property VerticalAlignment: TVerticalAlignment read FVertAlignment write SetVertAlignment default taVerticalCenter;
property WordWrap: Boolean read FWordwrap write SetWordwrap default false;
public
constructor Create(TheOwner: TComponent); override;
property Align default alNone;
property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
property BevelColor: TColor read FBevelColor write SetBevelColor default clDefault;
property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone;
property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvRaised;
property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1;
property Color default {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif};
property FullRepaint: Boolean read FFullRepaint write FFullRepaint default True; // exists only for Delphi compatibility, has no effect in LCL
property ParentBackground default true;
property ParentColor default true;
property TabStop default False;
end;
{ TPanel }
TPanel = class(TCustomPanel)
published
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BorderSpacing;
property BevelColor;
property BevelInner;
property BevelOuter;
property BevelWidth;
property BidiMode;
property BorderWidth;
property BorderStyle;
property Caption;
property ChildSizing;
property ClientHeight;
property ClientWidth;
property Color;
property Constraints;
property DockSite;
property DoubleBuffered;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property FullRepaint;
property ParentBackground;
property ParentBidiMode;
property ParentColor;
property ParentDoubleBuffered;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property TabOrder;
property TabStop;
property UseDockManager default True;
property VerticalAlignment;
property Visible;
property Wordwrap;
property OnChangeBounds;
property OnClick;
property OnContextPopup;
property OnDockDrop;
property OnDockOver;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnGetDockCaption;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnMouseWheelHorz;
property OnMouseWheelLeft;
property OnMouseWheelRight;
property OnPaint;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;
{ TCustomFlowPanel }
TFlowPanel = class;
TCustomFlowPanel = class;
TFlowPanelControl = class;
TFlowPanelControlList = class;
TFlowStyle = (fsLeftRightTopBottom, fsRightLeftTopBottom, fsLeftRightBottomTop, fsRightLeftBottomTop,
fsTopBottomLeftRight, fsBottomTopLeftRight, fsTopBottomRightLeft, fsBottomTopRightLeft);
TWrapAfter = (
waAuto, // Wrap automatically.
waForce, // Always wrap after this control.
waAvoid, // Try not to wrap after this control, if the control is already at the beginning of the row, wrap though.
waForbid // Never wrap after this control.
);
TFlowPanelControl = class(TCollectionItem, IObjInspInterface)
private
FControl: TControl;
FWrapAfter: TWrapAfter;
procedure SetControl(const aControl: TControl);
procedure SetWrapAfter(const AWrapAfter: TWrapAfter);
protected
function GetDisplayName: String; override;
procedure SetIndex(Value: Integer); override;
procedure AssignTo(Dest: TPersistent); override;
function FPCollection: TFlowPanelControlList;
function FPOwner: TCustomFlowPanel;
public
// These methods are used by the Object Inspector only
function AllowAdd: Boolean;
function AllowDelete: Boolean;
published
property Control: TControl read FControl write SetControl;
property WrapAfter: TWrapAfter read FWrapAfter write SetWrapAfter;
property Index;
end;
TFlowPanelControlList = class(TOwnedCollection, IObjInspInterface)
private
function GetItem(Index: Integer): TFlowPanelControl;
procedure SetItem(Index: Integer; const AItem: TFlowPanelControl);
protected
function FPOwner: TCustomFlowPanel;
function Add: TFlowPanelControl;
procedure AddControl(AControl: TControl; AIndex: Integer = -1);
procedure RemoveControl(AControl: TControl);
public
constructor Create(AOwner: TPersistent);
public
function IndexOf(AControl: TControl): Integer;
property Items[Index: Integer]: TFlowPanelControl read GetItem write SetItem; default;
public
// These methods are used by the Object Inspector only
function AllowAdd: Boolean;
function AllowDelete: Boolean;
end;
TCustomFlowPanel = class(TCustomPanel)
private
FControlList: TFlowPanelControlList;
FAutoWrap: Boolean;
FFlowStyle: TFlowStyle;
FFlowLayout: TTextLayout;
procedure SetAutoWrap(const AAutoWrap: Boolean);
procedure SetControlList(const AControlList: TFlowPanelControlList);
procedure SetFlowLayout(const aFlowLayout: TTextLayout);
procedure SetFlowStyle(const AFlowStyle: TFlowStyle);
protected
procedure CMControlChange(var Message: TCMControlChange); message CM_CONTROLCHANGE;
procedure AlignControls(AControl: TControl; var RemainingClientRect: TRect); override;
procedure CalculatePreferredSize(
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
public
function GetControlIndex(AControl: TControl): Integer;
procedure SetControlIndex(AControl: TControl; Index: Integer);
property AutoWrap: Boolean read FAutoWrap write SetAutoWrap;
property ControlList: TFlowPanelControlList read FControlList write SetControlList;
property FlowStyle: TFlowStyle read FFlowStyle write SetFlowStyle;
property FlowLayout: TTextLayout read FFlowLayout write SetFlowLayout;
end;
TFlowPanel = class(TCustomFlowPanel)
published
property Align;
property Alignment;
property Anchors;
property AutoSize;
property AutoWrap default True;
property BevelInner;
property BevelOuter;
property BevelWidth;
property BiDiMode;
property BorderWidth;
property BorderSpacing;
property BorderStyle;
property Caption;
property Color;
property Constraints;
property ControlList;
property UseDockManager default True;
property DockSite;
property DoubleBuffered;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FlowLayout;
property FlowStyle;
property FullRepaint;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentDoubleBuffered;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnAlignInsertBefore;
property OnAlignPosition;
property OnClick;
property OnConstrainedResize;
property OnContextPopup;
property OnDockDrop;
property OnDockOver;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;
{ TCustomTrayIcon }
TBalloonFlags = (bfNone, bfInfo, bfWarning, bfError);
TCustomTrayIcon = class(TLCLComponent)
private
FDelayedShowing: Boolean;
FAnimate: Boolean;
FAnimateTimer: TTimer;
FCurAnimationStep: Integer;
FBalloonFlags: TBalloonFlags;
FBalloonHint: string;
FBalloonTimeout: Integer;
FBalloonTitle: string;
FPopUpMenu: TPopupMenu;
FIcon: TIcon;
FIcons: TCustomImageList;
FHint: string;
FVisible, FShowIcon: Boolean;
FNotifier: TPopupNotifier;
FTimer: TTimer;
FOnPaint, FOnClick, FOnDblClick: TNotifyEvent;
FOnMouseDown, FOnMouseUp: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
function GetAnimateInterval: Cardinal;
function GetCanvas: TCanvas;
function InternalShow: Boolean;
procedure SetAnimate(const AValue: Boolean);
procedure SetAnimateInterval(const AValue: Cardinal);
procedure SetHint(const AValue: string);
procedure SetIcon(const AValue: TIcon);
procedure SetIcons(const AValue: TCustomImageList);
procedure SetPopUpMenu(const AValue: TPopupMenu);
procedure SetVisible(Value: Boolean);
procedure HandleNotifierClose(Sender: TObject; var CloseAction: TCloseAction);
procedure HandleNotifierTimeout(Sender: TObject);
procedure HandleOnAnimateTimer(Sender: TObject);
procedure IconChanged(Sender: TObject);
protected
class procedure WSRegisterClass; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Loaded; override;
public
Handle: HWND;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
function Hide: Boolean;
function Show: Boolean;
procedure InternalUpdate;
procedure ShowBalloonHint;
function GetPosition: TPoint;
{ Properties }
property Animate: Boolean read FAnimate write SetAnimate default False;
property AnimateInterval: Cardinal read GetAnimateInterval write SetAnimateInterval default 1000;
property BalloonFlags: TBalloonFlags read FBalloonFlags write FBalloonFlags default bfNone;
property BalloonHint: string read FBalloonHint write FBalloonHint;
property BalloonTimeout: Integer read FBalloonTimeout write FBalloonTimeout default 3000;
property BalloonTitle: string read FBalloonTitle write FBalloonTitle;
property Canvas: TCanvas read GetCanvas;
property PopUpMenu: TPopupMenu read FPopUpMenu write SetPopUpMenu;
property Icon: TIcon read FIcon write SetIcon;
property Icons: TCustomImageList read FIcons write SetIcons;
property Hint: string read FHint write SetHint;
property ShowIcon: Boolean read FShowIcon write FShowIcon default True;
property Visible: Boolean read FVisible write SetVisible default False;
{ Events }
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
end;
{ TTrayIcon }
TTrayIcon = class(TCustomTrayIcon)
published
property BalloonFlags;
property BalloonHint;
property BalloonTimeout;
property BalloonTitle;
property PopUpMenu;
property Icon;
property Hint;
property Visible;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnPaint;
end;
{ TControlBar }
TBandDrawingStyle = (dsNormal, dsGradient);
TBandPaintOption = (bpoGrabber, bpoFrame, bpoGradient, bpoRoundRect);
TBandPaintOptions = set of TBandPaintOption;
TBandDragEvent = procedure (Sender: TObject; Control: TControl; var Drag: Boolean) of object;
TBandInfoEvent = procedure (Sender: TObject; Control: TControl;
var Insets: TRect; var PreferredSize, RowCount: Integer) of object;
TBandMoveEvent = procedure (Sender: TObject; Control: TControl; var ARect: TRect) of object;
TBandPaintEvent = procedure (Sender: TObject; Control: TControl; ACanvas: TCanvas;
var ARect: TRect; var Options: TBandPaintOptions) of object;
TRowSize = 1..MaxInt;
TBandMove = (bmNone, bmReady, bmMoving);
TCursorDesign = (cdDefault, cdGrabber, cdRestricted);
{ BiDi is Left to Right:
+----------------------------------------------------------------------------+
| cBandBorder + |cGrabWidth| + cBandBorder + [ Control.Width ] + cBandBorder |
+----------------------------------------------------------------------------+
| cFullGrabber | }
{ TCtrlBand }
TCtrlBand = class
private
FControl: TControl;
FControlHeight: Integer;
FControlLeft: Integer;
FControlTop: Integer;
FControlVisible: Boolean;
FControlWidth: Integer;
FHeight: Integer;
FInitLeft: Integer;
FInitTop: Integer;
FLeft: Integer;
FTop: Integer;
FVisible: Boolean;
FWidth: Integer;
function GetBandRect: TRect;
function GetBottom: Integer;
function GetRight: Integer;
procedure SetBandRect(AValue: TRect);
procedure SetRight(AValue: Integer);
public
property BandRect: TRect read GetBandRect write SetBandRect;
property Bottom: Integer read GetBottom;
property Control: TControl read FControl write FControl;
property ControlHeight: Integer read FControlHeight write FControlHeight;
property ControlLeft: Integer read FControlLeft write FControlLeft;
property ControlTop: Integer read FControlTop write FControlTop;
property ControlWidth: Integer read FControlWidth write FControlWidth;
property ControlVisible: Boolean read FControlVisible write FControlVisible;
property Height: Integer read FHeight write FHeight;
property InitLeft: Integer read FInitLeft write FInitLeft;
property InitTop: Integer read FInitTop write FInitTop;
property Left: Integer read FLeft write FLeft;
property Right: Integer read GetRight write SetRight;
property Top: Integer read FTop write FTop;
property Visible: Boolean read FVisible write FVisible;
property Width: Integer read FWidth write FWidth;
end;
{ TCtrlBands }
TCtrlBands = class ({$IFDEF FPDoc}TFPGObjectList{$ELSE}specialize TFPGObjectList<TCtrlBand>{$ENDIF})
public
function GetIndex(AControl: TControl): Integer;
end;
{ TCustomControlBar }
TCustomControlBar = class(TCustomPanel)
private
FAutoDrag: Boolean;
FAutoDock: Boolean;
FDrawingStyle: TBandDrawingStyle;
FGradientDirection: TGradientDirection;
FGradientEndColor: TColor;
FGradientStartColor: TColor;
FPicture: TPicture;
FRowSize: TRowSize;
FRowSnap: Boolean;
FOnBandDrag: TBandDragEvent;
FOnBandInfo: TBandInfoEvent;
FOnBandMove: TBandMoveEvent;
FOnBandPaint: TBandPaintEvent;
FOnCanResize: TCanResizeEvent;
FOnPaint: TNotifyEvent;
procedure SetDrawingStyle(AValue: TBandDrawingStyle);
procedure SetGradientDirection(AValue: TGradientDirection);
procedure SetGradientEndColor(AValue: TColor);
procedure SetGradientStartColor(AValue: TColor);
procedure SetPicture(aValue: TPicture);
procedure SetRowSize(AValue: TRowSize);
protected const
cBandBorderH: SmallInt = 4;
cBandBorderV: SmallInt = 2;
cGrabWidth: SmallInt = 3;
protected
class var cFullGrabber: SmallInt;
protected
FBands: TCtrlBands;
FBandMove: TBandMove;
FCursorLock: Boolean;
FDefCursor: TCursor;
FHoveredBand: TCtrlBand;
FInitDrag: TPoint;
FInnerBevelWidth: SmallInt;
FLockResize: Boolean;
FPrevWidth: Integer;
FVisiBands: array of TCtrlBand;
FVisiBandsEx: array of TCtrlBand;
procedure AlignControlToBand(ABand: TCtrlBand; ARightToLeft: Boolean);
procedure AlignControlsToBands;
function CalcBandHeight(AControl: TControl): Integer;
function CalcBandHeightSnapped(AControl: TControl): Integer;
function CalcInnerBevelWidth: Integer;
function CalcLowestBandBottomPx: Integer;
procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer;
{%H-}WithThemeSpace: Boolean); override;
procedure ChangeCursor(ACursor: TCursorDesign);
procedure CheckBandsSizeAndVisibility;
procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
procedure CMBorderChanged(var Message: TLMessage); message CM_BORDERCHANGED;
procedure CreateWnd; override;
procedure DoBandMove(AControl: TControl; var ARect: TRect); virtual;
procedure DoBandPaint(AControl: TControl; ACanvas: TCanvas; var ARect: TRect;
var AOptions: TBandPaintOptions); virtual;
function DragControl(AControl: TControl; X, Y: Integer;
KeepCapture: Boolean = False): Boolean; virtual;
procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
var Accept: Boolean); override;
procedure GetControlInfo(AControl: TControl; var Insets: TRect;
var PreferredSize, RowCount: Integer); virtual;
class constructor InitializeClass;
procedure InitializeBand(ABand: TCtrlBand; AKeepPos: Boolean);
procedure InitializeMove(AMovingBand: TCtrlBand);
procedure Loaded; override;
function IsBandOverlap(ARect, BRect: TRect): Boolean;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MoveBand(AMoveBand: TCtrlBand; X, Y: Integer; ByMouse: Boolean);
procedure NormalizeRows;
procedure Paint; override;
procedure PictureChanged(Sender: TObject);
procedure Resize; override;
procedure SetCursor(Value: TCursor); override;
procedure ShiftBands(AFrom, ATo, AShift, ALimit: Integer);
procedure SortVisibleBands;
procedure WMSize(var Message: TLMSize); message LM_SIZE;
public
FUpdateCount: SmallInt;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure BeginUpdate;
procedure EndUpdate;
procedure FlipChildren(AllLevels: Boolean); override;
function HitTest(X, Y: Integer): TControl;
procedure InsertControl(AControl: TControl; Index: Integer); override;
function MouseToBandPos(X, Y: Integer; out AGrabber: Boolean): TCtrlBand;
procedure RemoveControl(AControl: TControl); override;
procedure StickControls; virtual;
property AutoDock: Boolean read FAutoDock write FAutoDock default True;
property AutoDrag: Boolean read FAutoDrag write FAutoDrag default True;
property AutoSize;
property DockSite default True;
property DrawingStyle: TBandDrawingStyle read FDrawingStyle write SetDrawingStyle default dsNormal;
property GradientDirection: TGradientDirection read FGradientDirection write SetGradientDirection default gdVertical;
property GradientStartColor: TColor read FGradientStartColor write SetGradientStartColor default clDefault;
property GradientEndColor: TColor read FGradientEndColor write SetGradientEndColor default clDefault;
property Picture: TPicture read FPicture write SetPicture;
property RowSize: TRowSize read FRowSize write SetRowSize default 26;
property RowSnap: Boolean read FRowSnap write FRowSnap default True;
property OnBandDrag: TBandDragEvent read FOnBandDrag write FOnBandDrag;
property OnBandInfo: TBandInfoEvent read FOnBandInfo write FOnBandInfo;
property OnBandMove: TBandMoveEvent read FOnBandMove write FOnBandMove;
property OnBandPaint: TBandPaintEvent read FOnBandPaint write FOnBandPaint;
property OnCanResize: TCanResizeEvent read FOnCanResize write FOnCanResize;
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
end;
TControlBar = class(TCustomControlBar)
public
property Canvas;
published
property Align;
property Anchors;
property AutoDock;
property AutoDrag;
property AutoSize;
property BevelInner default bvRaised;
property BevelOuter default bvLowered;
property BevelWidth;
property BiDiMode;
property BorderWidth;
property Color;
property Constraints;
property DockSite;
property DoubleBuffered;
property DragCursor;
property DragKind;
property DragMode;
property DrawingStyle;
property Enabled;
property GradientDirection;
property GradientEndColor;
property GradientStartColor;
property ParentColor;
property ParentDoubleBuffered;
property ParentFont;
property ParentShowHint;
property Picture;
property PopupMenu;
property RowSize;
property RowSnap;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnBandDrag;
property OnBandInfo;
property OnBandMove;
property OnBandPaint;
property OnCanResize;
property OnClick;
property OnConstrainedResize;
property OnContextPopup;
property OnDockDrop;
property OnDockOver;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnPaint;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;
procedure Frame3D(ACanvas: TCanvas; var ARect: TRect;
TopColor, BottomColor: TColor; const FrameWidth: integer);
procedure Register;
implementation
// !!! Avoid unit circles. Only add units if really needed.
uses
Math, WSExtCtrls;
{.$define INSTALL_TUNTABBEDNOTEBOOK}
// Wrapper function for TCanvas.Frame3D.
procedure Frame3D(ACanvas: TCanvas; var ARect: TRect;
TopColor, BottomColor: TColor; const FrameWidth: integer);
begin
ACanvas.Frame3D(ARect, TopColor, BottomColor, FrameWidth);
end;
procedure Register;
begin
RegisterComponents('Standard',[TRadioGroup,TCheckGroup,TPanel]);
RegisterComponents('Additional',[TImage,TShape,TBevel,TPaintBox,
TNotebook, TLabeledEdit, TSplitter, TTrayIcon, TControlBar, TFlowPanel]);
RegisterComponents('System',[TTimer,TIdleTimer]);
RegisterNoIcon([TPage]);
end;
{$I page.inc}
{$I notebook.inc}
{$I idletimer.inc}
{$I shape.inc}
{$I customsplitter.inc}
{$I paintbox.inc}
{$I customcheckgroup.inc}
{$I boundlabel.inc}
{$I customlabelededit.inc}
{$I custompanel.inc}
{$I customflowpanel.inc}
{$I radiogroup.inc}
{$I bevel.inc}
{$I customimage.inc}
{$I customtrayicon.inc}
{$I controlbar.inc}
initialization
DockSplitterClass := TSplitter;
end.