Ceci est une ancienne révision du document !


TControl

Code

\lcl\controls.pp
  TControl = class(TLCLComponent)
  private
    FActionLink: TControlActionLink;
    FAlign: TAlign;
    FAnchors: TAnchors;
    FAnchorSides: array[TAnchorKind] of TAnchorSide;
    FAnchoredControls: TFPList; // list of TControl anchored to this control
    FAutoSizingLockCount: Integer; // in/decreased by DisableAutoSizing/EnableAutoSizing
    {$IFDEF DebugDisableAutoSizing}
    FAutoSizingLockReasons: TStrings;
    {$ENDIF}
    FBaseBounds: TRect;
    FBaseBoundsLock: Integer;
    FBaseParentClientSize: TSize;
    FBiDiMode: TBiDiMode;
    FBorderSpacing: TControlBorderSpacing;
    FBoundsRectForNewParent: TRect;
    FCaption: TCaption;
    FCaptureMouseButtons: TCaptureMouseButtons;
    FColor: TColor;
    FConstraints: TSizeConstraints;
    FControlFlags: TControlFlags;
    FControlHandlers: array[TControlHandlerType] of TMethodList;
    FControlStyle: TControlStyle;
    FDockOrientation: TDockOrientation;
    FDragCursor: TCursor;
    FDragKind: TDragKind;
    FDragMode: TDragMode;
    FFloatingDockSiteClass: TWinControlClass;
    FFont: TFont;
    FHeight: Integer;
    FHelpContext: THelpContext;
    FHelpKeyword: string;
    FHelpType: THelpType;
    FHint: TTranslateString;
    FHostDockSite: TWinControl;
    FLastDoChangeBounds: TRect;
    FLastDoChangeClientSize: TPoint;
    FLastResizeClientHeight: Integer;
    FLastResizeClientWidth: Integer;
    FLastResizeHeight: Integer;
    FLastResizeWidth: Integer;
    FLeft: Integer;
    FLoadedClientSize: TSize;
    FLRDockWidth: Integer;
    FOnChangeBounds: TNotifyEvent;
    FOnClick: TNotifyEvent;
    FOnConstrainedResize: TConstrainedResizeEvent;
    FOnContextPopup: TContextPopupEvent;
    FOnDblClick: TNotifyEvent;
    FOnDragDrop: TDragDropEvent;
    FOnDragOver: TDragOverEvent;
    FOnEditingDone: TNotifyEvent;
    FOnEndDock: TEndDragEvent;
    FOnEndDrag: TEndDragEvent;
    FOnMouseDown: TMouseEvent;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FOnMouseMove: TMouseMoveEvent;
    FOnMouseUp: TMouseEvent;
    FOnMouseWheel: TMouseWheelEvent;
    FOnMouseWheelDown: TMouseWheelUpDownEvent;
    FOnMouseWheelUp: TMouseWheelUpDownEvent;
    FOnMouseWheelHorz: TMouseWheelEvent;
    FOnMouseWheelLeft: TMouseWheelUpDownEvent;
    FOnMouseWheelRight: TMouseWheelUpDownEvent;
    FOnQuadClick: TNotifyEvent;
    FOnResize: TNotifyEvent;
    FOnShowHint: TControlShowHintEvent;
    FOnStartDock: TStartDockEvent;
    FOnStartDrag: TStartDragEvent;
    FOnTripleClick: TNotifyEvent;
    FParent: TWinControl;
    FPopupMenu: TPopupMenu;
    FPreferredMinWidth: Integer;// without theme space
    FPreferredMinHeight: Integer;// without theme space
    FPreferredWidth: Integer;// with theme space
    FPreferredHeight: Integer;// with theme space
    FReadBounds: TRect;
    FSessionProperties: string;
    FSizeLock: Integer;
    FTBDockHeight: Integer;
    FTop: Integer;
    FUndockHeight: Integer;
    FUndockWidth: Integer;
    FWidth: Integer;
    FWindowProc: TWndMethod;
    //boolean fields, keep together to save some bytes
    FDesktopFont: Boolean;
    FParentBiDiMode: Boolean;
    FIsControl: Boolean;
    FShowHint: Boolean;
    FParentColor: Boolean;
    FParentFont: Boolean;
    FParentShowHint: Boolean;
    FAutoSize: Boolean;
    FAutoSizingAll: Boolean;
    FAutoSizingSelf: Boolean;
    FEnabled: Boolean;
    FMouseInClient: Boolean;
    FVisible: Boolean;
    function CaptureMouseButtonsIsStored: Boolean;
    procedure DoActionChange(Sender: TObject);
    function GetAccessibleName: TCaption;
    function GetAccessibleDescription: TCaption;
    function GetAccessibleValue: TCaption;
    function GetAccessibleRole: TLazAccessibilityRole;
    function GetAutoSizingAll: Boolean;
    function GetAnchorSide(Kind: TAnchorKind): TAnchorSide;
    function GetAnchoredControls(Index: Integer): TControl;
    function GetBoundsRect: TRect;
    function GetClientHeight: Integer;
    function GetClientWidth: Integer;
    function GetLRDockWidth: Integer;
    function GetTBDockHeight: Integer;
    function GetText: TCaption;
    function GetUndockHeight: Integer;
    function GetUndockWidth: Integer;
    function IsAnchorsStored: Boolean;
    function IsBiDiModeStored: Boolean;
    function IsEnabledStored: Boolean;
    function IsFontStored: Boolean;
    function IsHintStored: Boolean;
    function IsHelpContextStored: Boolean;
    function IsHelpKeyWordStored: Boolean;
    function IsShowHintStored: Boolean;
    function IsVisibleStored: Boolean;
    procedure DoBeforeMouseMessage(TheMessage: TLMessage);
    procedure DoConstrainedResize(var NewLeft, NewTop, NewWidth, NewHeight: Integer);
    procedure SetAccessibleName(AValue: TCaption);
    procedure SetAccessibleDescription(AValue: TCaption);
    procedure SetAccessibleValue(AValue: TCaption);
    procedure SetAccessibleRole(AValue: TLazAccessibilityRole);
    procedure SetAnchorSide(Kind: TAnchorKind; AValue: TAnchorSide);
    procedure SetBorderSpacing(const AValue: TControlBorderSpacing);
    procedure SetBoundsRect(const ARect: TRect);
    procedure SetBoundsRectForNewParent(const AValue: TRect);
    procedure SetClientHeight(Value: Integer);
    procedure SetClientSize(const Value: TPoint);
    procedure SetClientWidth(Value: Integer);
    procedure SetConstraints(const Value: TSizeConstraints);
    procedure SetDesktopFont(const AValue: Boolean);
    procedure SetDragCursor(const AValue: TCursor);
    procedure SetFont(Value: TFont);
    procedure SetHeight(Value: Integer);
    procedure SetHelpContext(const AValue: THelpContext);
    procedure SetHelpKeyword(const AValue: string);
    procedure SetHostDockSite(const AValue: TWinControl);
    procedure SetLeft(Value: Integer);
    procedure SetMouseCapture(Value: Boolean);
    procedure SetParentShowHint(Value: Boolean);
    procedure SetParentColor(Value: Boolean);
    procedure SetParentFont(Value: Boolean);
    procedure SetPopupMenu(Value: TPopupMenu);
    procedure SetShowHint(Value: Boolean);
    procedure SetText(const Value: TCaption);
    procedure SetTop(Value: Integer);
    procedure SetWidth(Value: Integer);
  protected
    FAccessibleObject: TLazAccessibleObject;
    FControlState: TControlState;
    FCursor: TCursor;
    class procedure WSRegisterClass; override;
    function GetCursor: TCursor; virtual;
    procedure SetCursor(Value: TCursor); virtual;
    procedure SetVisible(Value: Boolean); virtual;
    procedure DoOnParentHandleDestruction; virtual;
  protected
    // sizing/aligning
    procedure DoAutoSize; virtual;
    procedure DoAllAutoSize; virtual; // while autosize needed call DoAutoSize, used by AdjustSize and EnableAutoSizing
    procedure BeginAutoSizing; // set AutoSizing=true, can be used to prevent circles
    procedure EndAutoSizing;   // set AutoSizing=false
    procedure AnchorSideChanged(TheAnchorSide: TAnchorSide); virtual;
    procedure ForeignAnchorSideChanged(TheAnchorSide: TAnchorSide;
                                       Operation: TAnchorSideChangeOperation); virtual;
    procedure SetAlign(Value: TAlign); virtual;
    procedure SetAnchors(const AValue: TAnchors); virtual;
    procedure SetAutoSize(Value: Boolean); virtual;
    procedure BoundsChanged; virtual;
    function CreateControlBorderSpacing: TControlBorderSpacing; virtual;
    procedure DoConstraintsChange(Sender: TObject); virtual;
    procedure DoBorderSpacingChange(Sender: TObject;
                                    InnerSpaceChanged: Boolean); virtual;
    function IsBorderSpacingInnerBorderStored: Boolean; virtual;
    function IsCaptionStored: Boolean;
    procedure SendMoveSizeMessages(SizeChanged, PosChanged: Boolean); virtual;
    procedure ConstrainedResize(var MinWidth, MinHeight,
                                MaxWidth, MaxHeight: TConstraintSize); virtual;
    procedure CalculatePreferredSize(
                         var PreferredWidth, PreferredHeight: Integer;
                         WithThemeSpace: Boolean); virtual;
    procedure DoOnResize; virtual;// call OnResize
    procedure DoOnChangeBounds; virtual;// call OnChangeBounds
    procedure CheckOnChangeBounds;// checks for changes and calls DoOnChangeBounds
    procedure Resize; virtual;// checks for changes and calls DoOnResize
    procedure RequestAlign; virtual;// smart calling Parent.AlignControls
    procedure UpdateAnchorRules;
    procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: Integer; KeepBase: Boolean); virtual;
    procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: Integer); virtual;
    procedure ScaleConstraints(Multiplier, Divider: Integer);
    procedure ChangeScale(Multiplier, Divider: Integer); virtual;
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; virtual;
    procedure SetBiDiMode(AValue: TBiDiMode); virtual;
    procedure SetParentBiDiMode(AValue: Boolean); virtual;
    function IsAParentAligning: Boolean;
    function GetClientOrigin: TPoint; virtual;
    function GetClientRect: TRect; virtual;// visual size of client area
    function GetLogicalClientRect: TRect; virtual;// logical size of client area (e.g. in a TScrollBox the logical client area can be bigger than the visual)
    function GetScrolledClientRect: TRect; virtual;// visual client area scrolled
    function GetClientScrollOffset: TPoint; virtual;
    function GetControlOrigin: TPoint; virtual;
    function IsClientHeightStored: Boolean; virtual;
    function IsClientWidthStored: Boolean; virtual;
    function WidthIsAnchored: Boolean;
    function HeightIsAnchored: Boolean;
 
    property AutoSizing: Boolean read FAutoSizingSelf;// see Begin/EndAutoSizing
    property AutoSizingAll: Boolean read GetAutoSizingAll;// set in DoAllAutoSize
    property AutoSizingLockCount: Integer read FAutoSizingLockCount; // in/decreased by Disable/EnableAutoSizing
  protected
    // protected messages
    procedure WMCancelMode(var Message: TLMessage); message LM_CANCELMODE;
    procedure WMContextMenu(var Message: TLMContextMenu); message LM_CONTEXTMENU;
 
    procedure WMLButtonDown(var Message: TLMLButtonDown); message LM_LBUTTONDOWN;
    procedure WMRButtonDown(var Message: TLMRButtonDown); message LM_RBUTTONDOWN;
    procedure WMMButtonDown(var Message: TLMMButtonDown); message LM_MBUTTONDOWN;
    procedure WMXButtonDown(var Message: TLMXButtonDown); message LM_XBUTTONDOWN;
    procedure WMLButtonDBLCLK(var Message: TLMLButtonDblClk); message LM_LBUTTONDBLCLK;
    procedure WMRButtonDBLCLK(var Message: TLMRButtonDblClk); message LM_RBUTTONDBLCLK;
    procedure WMMButtonDBLCLK(var Message: TLMMButtonDblClk); message LM_MBUTTONDBLCLK;
    procedure WMXButtonDBLCLK(var Message: TLMXButtonDblClk); message LM_XBUTTONDBLCLK;
    procedure WMLButtonTripleCLK(var Message: TLMLButtonTripleClk); message LM_LBUTTONTRIPLECLK;
    procedure WMRButtonTripleCLK(var Message: TLMRButtonTripleClk); message LM_RBUTTONTRIPLECLK;
    procedure WMMButtonTripleCLK(var Message: TLMMButtonTripleClk); message LM_MBUTTONTRIPLECLK;
    procedure WMXButtonTripleCLK(var Message: TLMXButtonTripleClk); message LM_XBUTTONTRIPLECLK;
    procedure WMLButtonQuadCLK(var Message: TLMLButtonQuadClk); message LM_LBUTTONQUADCLK;
    procedure WMRButtonQuadCLK(var Message: TLMRButtonQuadClk); message LM_RBUTTONQUADCLK;
    procedure WMMButtonQuadCLK(var Message: TLMMButtonQuadClk); message LM_MBUTTONQUADCLK;
    procedure WMXButtonQuadCLK(var Message: TLMXButtonQuadClk); message LM_XBUTTONQUADCLK;
    procedure WMMouseMove(var Message: TLMMouseMove); message LM_MOUSEMOVE;
    procedure WMLButtonUp(var Message: TLMLButtonUp); message LM_LBUTTONUP;
    procedure WMRButtonUp(var Message: TLMRButtonUp); message LM_RBUTTONUP;
    procedure WMMButtonUp(var Message: TLMMButtonUp); message LM_MBUTTONUP;
    procedure WMXButtonUp(var Message: TLMXButtonUp); message LM_XBUTTONUP;
    procedure WMMouseWheel(var Message: TLMMouseEvent); message LM_MOUSEWHEEL;
    procedure WMMouseHWheel(var Message: TLMMouseEvent); message LM_MOUSEHWHEEL;
    procedure WMMove(var Message: TLMMove); message LM_MOVE;
    procedure WMSize(var Message: TLMSize); message LM_SIZE;
    procedure WMWindowPosChanged(var Message: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED;
    procedure CMChanged(var Message: TLMessage); message CM_CHANGED;
    procedure LMCaptureChanged(var Message: TLMessage); message LM_CaptureChanged;
    procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
    procedure CMSysFontChanged(var Message: TLMessage); message CM_SYSFONTCHANGED;
    procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED;
    procedure CMHitTest(var Message: TCMHittest) ; message CM_HITTEST;
    procedure CMMouseEnter(var Message :TLMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message :TLMessage); message CM_MOUSELEAVE;
    procedure CMHintShow(var Message: TLMessage); message CM_HINTSHOW;
    procedure CMParentBiDiModeChanged(var Message: TLMessage); message CM_PARENTBIDIMODECHANGED;
    procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
    procedure CMParentFontChanged(var Message: TLMessage); message CM_PARENTFONTCHANGED;
    procedure CMParentShowHintChanged(var Message: TLMessage); message CM_PARENTSHOWHINTCHANGED;
    procedure CMVisibleChanged(var Message: TLMessage); message CM_VISIBLECHANGED;
    procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED;
    procedure CMCursorChanged(var Message: TLMessage); message CM_CURSORCHANGED;
  protected
    // drag and drop
    procedure CalculateDockSizes;
    function CreateFloatingDockSite(const Bounds: TRect): TWinControl;
    function GetDockEdge(const MousePos: TPoint): TAlign; virtual;
    function GetDragImages: TDragImageList; virtual;
    function GetFloating: Boolean; virtual;
    function GetFloatingDockSiteClass: TWinControlClass; virtual;
    procedure BeforeDragStart; virtual;
    procedure BeginAutoDrag; virtual;
    procedure DoFloatMsg(ADockSource: TDragDockObject);virtual;//CM_FLOAT
    procedure DockTrackNoTarget(Source: TDragDockObject; X, Y: Integer); virtual;
    procedure DoDock(NewDockSite: TWinControl; var ARect: TRect); virtual;
    function DoDragMsg(ADragMessage: TDragMessage; APosition: TPoint; ADragObject: TDragObject; ATarget: TControl; ADocking: Boolean):LRESULT; virtual;//Cm_Drag
    procedure DoEndDock(Target: TObject; X, Y: Integer); virtual;
    procedure DoEndDrag(Target: TObject; X,Y: Integer); virtual;
    procedure DoStartDock(var DragObject: TDragObject); virtual;
    procedure DoStartDrag(var DragObject: TDragObject); virtual;
    procedure DragCanceled; virtual;
    procedure DragOver(Source: TObject; X,Y: Integer; State: TDragState;
                       var Accept: Boolean); virtual;
    procedure PositionDockRect(DragDockObject: TDragDockObject); virtual;
    procedure SetDragMode(Value: TDragMode); virtual;
    function GetDefaultDockCaption: string; virtual;
    //procedure SendDockNotification; virtual; MG: probably not needed
  protected
    // key and mouse
    procedure Click; virtual;
    procedure DblClick; virtual;
    procedure TripleClick; virtual;
    procedure QuadClick; virtual;
    function GetMousePosFromMessage(const MessageMousePos: TSmallPoint): TPoint;
    procedure DoMouseDown(var Message: TLMMouse; Button: TMouseButton; Shift: TShiftState); virtual;
    procedure DoMouseUp(var Message: TLMMouse; Button: TMouseButton); virtual;
    procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); virtual;
    procedure MouseMove(Shift: TShiftState; X,Y: Integer); virtual;
    procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); virtual;
    procedure MouseEnter; virtual;
    procedure MouseLeave; virtual;
    function  DialogChar(var Message: TLMKey): Boolean; virtual;
    procedure UpdateMouseCursor(X, Y: Integer);
  protected
    procedure Changed;
    function  GetPalette: HPalette; virtual;
    function GetParentBackground: Boolean;
    function ChildClassAllowed(ChildClass: TClass): Boolean; virtual;
    procedure ReadState(Reader: TReader); override; // called
    procedure Loaded; override;
    procedure LoadedAll; virtual; // called when all controls were Loaded and lost their csLoading
    procedure DefineProperties(Filer: TFiler); override;
    procedure AssignTo(Dest: TPersistent); override;
    procedure FormEndUpdated; virtual;
    procedure InvalidateControl(CtrlIsVisible, CtrlIsOpaque: Boolean);
    procedure InvalidateControl(CtrlIsVisible, CtrlIsOpaque, IgnoreWinControls: Boolean);
    procedure FontChanged(Sender: TObject); virtual;
    procedure ParentFontChanged; virtual;
    function GetAction: TBasicAction; virtual;
    function RealGetText: TCaption; virtual;
    procedure RealSetText(const Value: TCaption); virtual;
    procedure TextChanged; virtual;
    function GetCachedText(var CachedText: TCaption): Boolean; virtual;
    procedure SetAction(Value: TBasicAction); virtual;
    procedure SetColor(Value: TColor); virtual;
    procedure SetEnabled(Value: Boolean); virtual;
    procedure SetHint(const Value: TTranslateString); virtual;
    procedure SetName(const Value: TComponentName); override;
    procedure SetParent(NewParent: TWinControl); virtual;
    procedure SetParentBackground(const AParentBackground: Boolean); virtual;
    procedure SetParentComponent(NewParentComponent: TComponent); override;
    procedure WndProc(var TheMessage: TLMessage); virtual;
    procedure ParentFormHandleInitialized; virtual; // called by ChildHandlesCreated of parent form
    function GetMouseCapture: Boolean; virtual;
    procedure CaptureChanged; virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function CanTab: Boolean; virtual;
    function GetDeviceContext(var WindowHandle: HWND): HDC; virtual;
    function GetEnabled: Boolean; virtual;
    function GetPopupMenu: TPopupMenu; virtual;
    procedure DoOnShowHint(HintInfo: PHintInfo); virtual;
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; virtual;
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; virtual;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; virtual;
    function DoMouseWheelHorz(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; virtual;
    function DoMouseWheelLeft(Shift: TShiftState; MousePos: TPoint): Boolean; virtual;
    function DoMouseWheelRight(Shift: TShiftState; MousePos: TPoint): Boolean; virtual;
    procedure VisibleChanging; virtual;
    procedure VisibleChanged; virtual;
    procedure EnabledChanging; virtual;
    procedure EnabledChanged; virtual;
    procedure AddHandler(HandlerType: TControlHandlerType;
                         const AMethod: TMethod; AsFirst: Boolean = false);
    procedure RemoveHandler(HandlerType: TControlHandlerType;
                            const AMethod: TMethod);
    procedure DoCallNotifyHandler(HandlerType: TControlHandlerType);
    procedure DoCallKeyEventHandler(HandlerType: TControlHandlerType;
                                    var Key: Word; Shift: TShiftState);
    procedure DoCallMouseWheelEventHandler(HandlerType: TControlHandlerType;
                                           Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
                                           var Handled: Boolean);
    procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); virtual;
    procedure SetZOrder(TopMost: Boolean); virtual;
    class function GetControlClassDefaultSize: TSize; virtual;
    function ColorIsStored: Boolean; virtual;
    procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
      const AXProportion, AYProportion: Double); virtual;
    procedure DoFixDesignFontPPI(const AFont: TFont; const ADesignTimePPI: Integer);
    procedure DoScaleFontPPI(const AFont: TFont; const AToPPI: Integer; const AProportion: Double);
  protected
    // actions
    function GetActionLinkClass: TControlActionLinkClass; virtual;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual;
  protected
    // optional properties (not every descendent supports them)
    property ActionLink: TControlActionLink read FActionLink write FActionLink;
    property DesktopFont: Boolean read FDesktopFont write SetDesktopFont;
    property DragCursor: TCursor read FDragCursor write SetDragCursor default crDrag;
    property DragKind: TDragKind read FDragKind write FDragKind default dkDrag;
    property DragMode: TDragMode read FDragMode write SetDragMode default dmManual;
    property MouseCapture: Boolean read GetMouseCapture write SetMouseCapture;
    property ParentBackground: Boolean read GetParentBackground write SetParentBackground;
    property ParentColor: Boolean read FParentColor write SetParentColor default True;
    property ParentFont: Boolean  read FParentFont write SetParentFont default True;
    property ParentShowHint: Boolean read FParentShowHint write SetParentShowHint default True;
    property SessionProperties: string read FSessionProperties write FSessionProperties;
    property Text: TCaption read GetText write SetText;
    property OnConstrainedResize: TConstrainedResizeEvent read FOnConstrainedResize write FOnConstrainedResize;
    property OnContextPopup: TContextPopupEvent read FOnContextPopup write FOnContextPopup;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnTripleClick: TNotifyEvent read FOnTripleClick write FOnTripleClick;
    property OnQuadClick: TNotifyEvent read FOnQuadClick write FOnQuadClick;
    property OnDragDrop: TDragDropEvent read FOnDragDrop write FOnDragDrop;
    property OnDragOver: TDragOverEvent read FOnDragOver write FOnDragOver;
    property OnEndDock: TEndDragEvent read FOnEndDock write FOnEndDock;
    property OnEndDrag: TEndDragEvent read FOnEndDrag write FOnEndDrag;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;
    property OnMouseWheelDown: TMouseWheelUpDownEvent read FOnMouseWheelDown write FOnMouseWheelDown;
    property OnMouseWheelUp: TMouseWheelUpDownEvent read FOnMouseWheelUp write FOnMouseWheelUp;
    property OnMouseWheelHorz: TMouseWheelEvent read FOnMouseWheelHorz write FOnMouseWheelHorz;
    property OnMouseWheelLeft: TMouseWheelUpDownEvent read FOnMouseWheelLeft write FOnMouseWheelLeft;
    property OnMouseWheelRight: TMouseWheelUpDownEvent read FOnMouseWheelRight write FOnMouseWheelRight;
    property OnStartDock: TStartDockEvent read FOnStartDock write FOnStartDock;
    property OnStartDrag: TStartDragEvent read FOnStartDrag write FOnStartDrag;
    property OnEditingDone: TNotifyEvent read FOnEditingDone write FOnEditingDone;
  public
    FCompStyle: Byte; // DEPRECATED. Enables (valid) use of 'IN' operator (this
      // is a hack for speed. It will be replaced by the use of the widgetset
      // classes.
      // So, don't use it anymore.
  public
    // drag and dock
    procedure DragDrop(Source: TObject; X,Y: Integer); virtual;
    procedure Dock(NewDockSite: TWinControl; ARect: TRect); virtual;
    function ManualDock(NewDockSite: TWinControl;
                        DropControl: TControl = nil;
                        ControlSide: TAlign = alNone;
                        KeepDockSiteSize: Boolean = true): Boolean; virtual;
    function ManualFloat(TheScreenRect: TRect;
                         KeepDockSiteSize: Boolean = true): Boolean; virtual;
    function ReplaceDockedControl(Control: TControl; NewDockSite: TWinControl;
                           DropControl: TControl; ControlSide: TAlign): Boolean;
    function Docked: Boolean;
    function Dragging: Boolean;
    // accessibility
    function GetAccessibleObject: TLazAccessibleObject;
    function CreateAccessibleObject: TLazAccessibleObject; virtual;
    function GetSelectedChildAccessibleObject: TLazAccessibleObject; virtual;
    function GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject; virtual;
    //scale support
    function ScaleDesignToForm(const ASize: Integer): Integer;
    function ScaleFormToDesign(const ASize: Integer): Integer;
    function Scale96ToForm(const ASize: Integer): Integer;
    function ScaleFormTo96(const ASize: Integer): Integer;
    function Scale96ToFont(const ASize: Integer): Integer;
    function ScaleFontTo96(const ASize: Integer): Integer;
    function ScaleScreenToFont(const ASize: Integer): Integer;
    function ScaleFontToScreen(const ASize: Integer): Integer;
    function Scale96ToScreen(const ASize: Integer): Integer;
    function ScaleScreenTo96(const ASize: Integer): Integer;
  public
    // size
    procedure AdjustSize; virtual;// smart calling DoAutoSize
    function AutoSizePhases: TControlAutoSizePhases; virtual;
    function AutoSizeDelayed: Boolean; virtual;
    function AutoSizeDelayedReport: string; virtual;
    function AutoSizeDelayedHandle: Boolean; virtual;
    procedure AnchorToNeighbour(Side: TAnchorKind; Space: TSpacingSize;
                                Sibling: TControl);
    procedure AnchorParallel(Side: TAnchorKind; Space: TSpacingSize;
                             Sibling: TControl);
    procedure AnchorHorizontalCenterTo(Sibling: TControl);
    procedure AnchorVerticalCenterTo(Sibling: TControl);
    procedure AnchorToCompanion(Side: TAnchorKind; Space: TSpacingSize;
                                Sibling: TControl;
                                FreeCompositeSide: Boolean = true);
    procedure AnchorSame(Side: TAnchorKind; Sibling: TControl);
    procedure AnchorAsAlign(TheAlign: TAlign; Space: TSpacingSize);
    procedure AnchorClient(Space: TSpacingSize);
    function AnchoredControlCount: Integer;
    property AnchoredControls[Index: Integer]: TControl read GetAnchoredControls;
    procedure SetBounds(aLeft, aTop, aWidth, aHeight: Integer); virtual;
    procedure SetInitialBounds(aLeft, aTop, aWidth, aHeight: Integer); virtual;
    procedure SetBoundsKeepBase(aLeft, aTop, aWidth, aHeight: Integer
            ); virtual; // if you use this, disable the LCL autosizing for this control
    procedure GetPreferredSize(var PreferredWidth, PreferredHeight: Integer;
                               Raw: Boolean = false;
                               WithThemeSpace: Boolean = true); virtual;
    function GetCanvasScaleFactor: Double;
    function GetDefaultWidth: Integer;
    function GetDefaultHeight: Integer;
    function GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor; virtual;
    // These two are helper routines to help obtain the background color of a control
    function GetColorResolvingParent: TColor;
    function GetRGBColorResolvingParent: TColor;
    //
    function GetSidePosition(Side: TAnchorKind): Integer;
    procedure CNPreferredSizeChanged;
    procedure InvalidatePreferredSize; virtual;
    function GetAnchorsDependingOnParent(WithNormalAnchors: Boolean): TAnchors;
    procedure DisableAutoSizing{$IFDEF DebugDisableAutoSizing}(const Reason: string){$ENDIF};
    procedure EnableAutoSizing{$IFDEF DebugDisableAutoSizing}(const Reason: string){$ENDIF};
    {$IFDEF DebugDisableAutoSizing}
    procedure WriteAutoSizeReasons(NotIfEmpty: Boolean);
    {$ENDIF}
    procedure UpdateBaseBounds(StoreBounds, StoreParentClientSize,
                               UseLoadedValues: Boolean); virtual;
    property BaseBounds: TRect read FBaseBounds;
    property ReadBounds: TRect read FReadBounds;
    property BaseParentClientSize: TSize read FBaseParentClientSize;
    procedure WriteLayoutDebugReport(const Prefix: string); virtual;
  public
    // LCL Scaling (High-DPI)
    procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
      const AFromPPI, AToPPI, AOldFormWidth, ANewFormWidth: Integer); virtual;
    procedure ShouldAutoAdjust(var AWidth, AHeight: Boolean); virtual;
    procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); virtual;
    procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); virtual;
  public
    constructor Create(TheOwner: TComponent);override;
    destructor Destroy; override;
    procedure BeforeDestruction; override;
    procedure EditingDone; virtual;
    procedure ExecuteDefaultAction; virtual;
    procedure ExecuteCancelAction; virtual;
    procedure BeginDrag(Immediate: Boolean; Threshold: Integer = -1);
    procedure EndDrag(Drop: Boolean);
    procedure BringToFront;
    function HasParent: Boolean; override;
    function GetParentComponent: TComponent; override;
    function IsParentOf(AControl: TControl): Boolean; virtual;
    function GetTopParent: TControl;
    function FindSubComponent(AName: string): TComponent;
    function IsVisible: Boolean; virtual;// checks parents too
    function IsControlVisible: Boolean; virtual;// does not check parents
    function IsEnabled: Boolean; // checks parent too
    function IsParentColor: Boolean; // checks protected ParentColor, needed by widgetsets
    function IsParentFont: Boolean; // checks protected ParentFont, needed by widgetsets
    function FormIsUpdating: Boolean; virtual;
    function IsProcessingPaintMsg: Boolean;
    procedure Hide;
    procedure Refresh;
    procedure Repaint; virtual;
    procedure Invalidate; virtual;
    function CheckChildClassAllowed(ChildClass: TClass;
                                    ExceptionOnInvalid: Boolean): Boolean;
    procedure CheckNewParent(AParent: TWinControl); virtual;
    procedure SendToBack;
    procedure SetTempCursor(Value: TCursor); virtual;
    procedure UpdateRolesForForm; virtual;
    procedure ActiveDefaultControlChanged(NewControl: TControl); virtual;
    function  GetTextBuf(Buffer: PChar; BufSize: Integer): Integer; virtual;
    function  GetTextLen: Integer; virtual;
    procedure SetTextBuf(Buffer: PChar); virtual;
    function  Perform(Msg: Cardinal; WParam: WParam; LParam: LParam): LRESULT;
    function  ScreenToClient(const APoint: TPoint): TPoint; virtual;
    function  ClientToScreen(const APoint: TPoint): TPoint; overload; virtual;
    function  ClientToScreen(const ARect: TRect): TRect; overload;
    function  ScreenToControl(const APoint: TPoint): TPoint;
    function  ControlToScreen(const APoint: TPoint): TPoint;
    function  ClientToParent(const Point: TPoint; AParent: TWinControl = nil): TPoint;
    function  ParentToClient(const Point: TPoint; AParent: TWinControl = nil): TPoint;
    function GetChildrenRect(Scrolled: Boolean): TRect; virtual;
    procedure Show;
    procedure Update; virtual;
    function HandleObjectShouldBeVisible: Boolean; virtual;
    function ParentDestroyingHandle: Boolean;
    function ParentHandlesAllocated: Boolean; virtual;
    procedure InitiateAction; virtual;
    procedure ShowHelp; virtual;
    function HasHelp: Boolean;
  public
    // Event lists
    procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
    procedure AddHandlerOnResize(const OnResizeEvent: TNotifyEvent;
                                 AsFirst: Boolean = false);
    procedure RemoveHandlerOnResize(const OnResizeEvent: TNotifyEvent);
    procedure AddHandlerOnChangeBounds(const OnChangeBoundsEvent: TNotifyEvent;
                                       AsFirst: Boolean = false);
    procedure RemoveHandlerOnChangeBounds(const OnChangeBoundsEvent: TNotifyEvent);
    procedure AddHandlerOnVisibleChanging(const OnVisibleChangingEvent: TNotifyEvent;
                                          AsFirst: Boolean = false);
    procedure RemoveHandlerOnVisibleChanging(const OnVisibleChangingEvent: TNotifyEvent);
    procedure AddHandlerOnVisibleChanged(const OnVisibleChangedEvent: TNotifyEvent;
                                         AsFirst: Boolean = false);
    procedure RemoveHandlerOnVisibleChanged(const OnVisibleChangedEvent: TNotifyEvent);
    procedure AddHandlerOnEnabledChanging(const OnEnabledChangingEvent: TNotifyEvent;
                                         AsFirst: Boolean = false);
    procedure RemoveHandlerOnEnabledChanging(const OnEnabledChangingEvent: TNotifyEvent);
    procedure AddHandlerOnEnabledChanged(const OnEnabledChangedEvent: TNotifyEvent;
                                         AsFirst: Boolean = false);
    procedure RemoveHandlerOnEnabledChanged(const OnEnabledChangedEvent: TNotifyEvent);
    procedure AddHandlerOnKeyDown(const OnKeyDownEvent: TKeyEvent;
                                  AsFirst: Boolean = false);
    procedure RemoveHandlerOnKeyDown(const OnKeyDownEvent: TKeyEvent);
    procedure AddHandlerOnBeforeDestruction(const OnBeforeDestructionEvent: TNotifyEvent;
                                  AsFirst: Boolean = false);
    procedure RemoveHandlerOnBeforeDestruction(const OnBeforeDestructionEvent: TNotifyEvent);
    procedure AddHandlerOnMouseWheel(const OnMouseWheelEvent: TMouseWheelEvent;
                                  AsFirst: Boolean = false);
    procedure RemoveHandlerOnMouseWheel(const OnMouseWheelEvent: TMouseWheelEvent);
  public
    // standard properties, which should be supported by all descendants
    property AccessibleName: TCaption read GetAccessibleName write SetAccessibleName;
    property AccessibleDescription: TCaption read GetAccessibleDescription write SetAccessibleDescription;
    property AccessibleValue: TCaption read GetAccessibleValue write SetAccessibleValue;
    property AccessibleRole: TLazAccessibilityRole read GetAccessibleRole write SetAccessibleRole;
    property Action: TBasicAction read GetAction write SetAction;
    property Align: TAlign read FAlign write SetAlign default alNone;
    property Anchors: TAnchors read FAnchors write SetAnchors stored IsAnchorsStored default [akLeft, akTop];
    property AnchorSide[Kind: TAnchorKind]: TAnchorSide read GetAnchorSide;
    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
    property BorderSpacing: TControlBorderSpacing read FBorderSpacing write SetBorderSpacing;
    property BoundsRect: TRect read GetBoundsRect write SetBoundsRect;
    property BoundsRectForNewParent: TRect read FBoundsRectForNewParent write SetBoundsRectForNewParent;
    property Caption: TCaption read GetText write SetText stored IsCaptionStored;
    property CaptureMouseButtons: TCaptureMouseButtons read FCaptureMouseButtons
      write FCaptureMouseButtons stored CaptureMouseButtonsIsStored default [mbLeft];
    property ClientHeight: Integer read GetClientHeight write SetClientHeight stored  IsClientHeightStored;
    property ClientOrigin: TPoint read GetClientOrigin;
    property ClientRect: TRect read GetClientRect;
    property ClientWidth: Integer read GetClientWidth write SetClientWidth stored IsClientWidthStored;
    property Color: TColor read FColor write SetColor stored ColorIsStored default {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif};
    property Constraints: TSizeConstraints read FConstraints write SetConstraints;
    property ControlOrigin: TPoint read GetControlOrigin;
    property ControlState: TControlState read FControlState write FControlState;
    property ControlStyle: TControlStyle read FControlStyle write FControlStyle;
    property Enabled: Boolean read GetEnabled write SetEnabled stored IsEnabledStored default True;
    property Font: TFont read FFont write SetFont stored IsFontStored;
    property IsControl: Boolean read FIsControl write FIsControl;
    property MouseEntered: Boolean read FMouseInClient; deprecated 'use MouseInClient instead';// changed in 1.9, will be removed in 1.11
    property MouseInClient: Boolean read FMouseInClient;
    property OnChangeBounds: TNotifyEvent read FOnChangeBounds write FOnChangeBounds;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnResize: TNotifyEvent read FOnResize write FOnResize;
    property OnShowHint: TControlShowHintEvent read FOnShowHint write FOnShowHint;
    property Parent: TWinControl read FParent write SetParent;
    property PopupMenu: TPopupmenu read GetPopupmenu write SetPopupMenu;
    property ShowHint: Boolean read FShowHint write SetShowHint stored IsShowHintStored default False;
    property Visible: Boolean read FVisible write SetVisible stored IsVisibleStored default True;
    property WindowProc: TWndMethod read FWindowProc write FWindowProc;
  public
    // docking properties
    property DockOrientation: TDockOrientation read FDockOrientation write FDockOrientation;
    property Floating: Boolean read GetFloating;
    property FloatingDockSiteClass: TWinControlClass read GetFloatingDockSiteClass write FFloatingDockSiteClass;
    property HostDockSite: TWinControl read FHostDockSite write SetHostDockSite;
    property LRDockWidth: Integer read GetLRDockWidth write FLRDockWidth;
    property TBDockHeight: Integer read GetTBDockHeight write FTBDockHeight;
    property UndockHeight: Integer read GetUndockHeight write FUndockHeight;// Height used when undocked
    property UndockWidth: Integer read GetUndockWidth write FUndockWidth;// Width used when undocked
  public
    function UseRightToLeftAlignment: Boolean; virtual;
    function UseRightToLeftReading: Boolean; virtual;
    function UseRightToLeftScrollBar: Boolean;
    function IsRightToLeft: Boolean;
    property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode stored IsBiDiModeStored default bdLeftToRight;
    property ParentBiDiMode: Boolean read FParentBiDiMode write SetParentBiDiMode default True;
  published
    property AnchorSideLeft: TAnchorSide index akLeft read GetAnchorSide write SetAnchorSide;
    property AnchorSideTop: TAnchorSide index akTop read GetAnchorSide write SetAnchorSide;
    property AnchorSideRight: TAnchorSide index akRight read GetAnchorSide write SetAnchorSide;
    property AnchorSideBottom: TAnchorSide index akBottom read GetAnchorSide write SetAnchorSide;
    property Cursor: TCursor read GetCursor write SetCursor default crDefault;
    property Left: Integer read FLeft write SetLeft; // no default value - controls usually placed to different positions
    property Height: Integer read FHeight write SetHeight; // no default value - controls usually have different sizes
    property Hint: TTranslateString read FHint write SetHint stored IsHintStored;
    property Top: Integer read FTop write SetTop; // no default value - controls usually placed to different positions
    property Width: Integer read FWidth write SetWidth; // no default value - controls usually have different sizes
    property HelpType: THelpType read FHelpType write FHelpType default htContext;
    property HelpKeyword: string read FHelpKeyword write SetHelpKeyword stored IsHelpKeyWordStored;
    property HelpContext: THelpContext read FHelpContext write SetHelpContext stored IsHelpContextStored default 0;
  end;
Vous pourriez laisser un commentaire si vous étiez connecté.