Class TStretchHandle (unit Handles)

Inherits from

TCustomControl

TStretchHandle component declaration

Constructors


constructor Create(AOwner: TComponent);

add the component to the 'Samples' tab


Functions

procedure Attach(ChildControl: TControl);

completely fake erase, don't call inherited, don't collect $200

procedure BringToFront;

simply pass on the result.

destructor Destroy;

doesn't do anything until it is Attached to something else

procedure Detach;

get keyboard events

function IndexOf(ChildControl: TControl): integer;

set size to bound remaining children, plus room for handles

procedure ReleaseChild(ChildControl: TControl);

disable & hide StretchHandle

procedure SendToBack;

make sure keyboard focus is restored

procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);

draw new rectangle unless this is a final erase

procedure SetColors(Color1, Color2: TColor);

set multiple select color, repaint immediately

procedure CreateParams(var Params: TCreateParams);

tidy up carefully

procedure KeyDown(var key: Word; Shift: TShiftState);

forward the message to the control if found, else to the Parent

procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

Handles stay in front of everything, always

procedure MouseMove(Shift: TShiftState; X, Y: Integer);

perform default processing

procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

only process MouseDown if it is over a Child, else forward

procedure Paint;

restore visibility

procedure ForwardMessage(FwdMsg: TForwardMessage; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

perform default processing

function GetChildControl(idx: integer): TControl;


function GetChildCount: integer;


function GetGridState: boolean;

a value of 1 effectively disables a grid axis

function GetModifiedRect(XPos, YPos: integer): TRect;

process arrow keys to move/resize Handles & Child, also move siblings

function IsAttached: boolean;


function PointOverChild(P: TPoint): boolean;


procedure Rubberband(XPos, YPos: integer; ShowBox: boolean);

impose a minimum size for sanity

procedure SetGridState(Value: boolean);

set single/multiple select colors, repaint

procedure SetPrimaryColor(Color: TColor);

only for single Children, draw center boxes

procedure SetSecondaryColor(Color: TColor);

set single select color, repaint immediately

procedure WMEraseBkgnd(var Message: TWMEraseBkgnd);

Added by JAB

get arrow key press events


procedure WMGetDLGCode(var Message: TMessage);

then add transparency; ensures correct repaint order

function XGridAdjust(X: integer): integer;

P is relative to the Parent

function YGridAdjust(Y: integer): integer;


Properties

property Color : TColor

new properties

property DragCursor :

inherited properties

property Enabled :


property GridX : GridValues


property GridY : GridValues


property Hint :


property Locked : boolean


property ParentShowHint :


property PopupMenu :


property SecondaryColor : TColor


property ShowHint :


property SnapToGrid : boolean


property Visible :


property Attached : boolean

new run-time only properties

property ChildCount : integer


property Children : TControl


property Canvas :


Events

event OnClick :

defined events

event OnDblClick :


event OnKeyDown :


event OnKeyPress :


event OnKeyUp :


event OnMouseDown :


event OnMouseMove :


event OnMouseUp :


event OnMoved : TNotifyEvent


Variables

FChildList : TList;


FDragging : boolean;


FDragOffset : TPoint;


FDragRect : TRect;


FDragStyle : TDragStyle;


FGridX : GridValues;


FGridY : GridValues;


FLocked : boolean;


FOnMoved : TNotifyEvent;


FPrimaryColor : TColor;


FSecondaryColor : TColor;



Constructors


constructor Create(AOwner: TComponent);

add the component to the 'Samples' tab


Functions


procedure Attach(ChildControl: TControl);

completely fake erase, don't call inherited, don't collect $200


procedure BringToFront;

simply pass on the result...


destructor Destroy;

doesn't do anything until it is Attached to something else


procedure Detach;

get keyboard events


function IndexOf(ChildControl: TControl): integer;

set size to bound remaining children, plus room for handles


procedure ReleaseChild(ChildControl: TControl);

disable & hide StretchHandle


procedure SendToBack;

make sure keyboard focus is restored


procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);

draw new rectangle unless this is a final erase


procedure SetColors(Color1, Color2: TColor);

set multiple select color, repaint immediately


procedure CreateParams(var Params: TCreateParams);

tidy up carefully


procedure KeyDown(var key: Word; Shift: TShiftState);

forward the message to the control if found, else to the Parent


procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

Handles stay in front of everything, always


procedure MouseMove(Shift: TShiftState; X, Y: Integer);

perform default processing


procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

only process MouseDown if it is over a Child, else forward


procedure Paint;

restore visibility


procedure ForwardMessage(FwdMsg: TForwardMessage; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

perform default processing


function GetChildControl(idx: integer): TControl;


function GetChildCount: integer;


function GetGridState: boolean;

a value of 1 effectively disables a grid axis


function GetModifiedRect(XPos, YPos: integer): TRect;

process arrow keys to move/resize Handles & Child, also move siblings


function IsAttached: boolean;


function PointOverChild(P: TPoint): boolean;


procedure Rubberband(XPos, YPos: integer; ShowBox: boolean);

impose a minimum size for sanity


procedure SetGridState(Value: boolean);

set single/multiple select colors, repaint


procedure SetPrimaryColor(Color: TColor);

only for single Children, draw center boxes


procedure SetSecondaryColor(Color: TColor);

set single select color, repaint immediately


procedure WMEraseBkgnd(var Message: TWMEraseBkgnd);

Added by JAB

get arrow key press events


procedure WMGetDLGCode(var Message: TMessage);

then add transparency; ensures correct repaint order


function XGridAdjust(X: integer): integer;

P is relative to the Parent


function YGridAdjust(Y: integer): integer;


Properties


property Color : TColor

new properties


property DragCursor :

inherited properties


property Enabled :


property GridX : GridValues


property GridY : GridValues


property Hint :


property Locked : boolean


property ParentShowHint :


property PopupMenu :


property SecondaryColor : TColor


property ShowHint :


property SnapToGrid : boolean


property Visible :


property Attached : boolean

new run-time only properties


property ChildCount : integer


property Children : TControl


property Canvas :


Events


event OnClick :

defined events


event OnDblClick :


event OnKeyDown :


event OnKeyPress :


event OnKeyUp :


event OnMouseDown :


event OnMouseMove :


event OnMouseUp :


event OnMoved : TNotifyEvent


Variables


FChildList : TList;


FDragging : boolean;


FDragOffset : TPoint;


FDragRect : TRect;


FDragStyle : TDragStyle;


FGridX : GridValues;


FGridY : GridValues;


FLocked : boolean;


FOnMoved : TNotifyEvent;


FPrimaryColor : TColor;


FSecondaryColor : TColor;