DLL und VCL Events

[Jens Kallup]

Hallo Gemeinde,

in einer Library/DLL Projekt habe ich folgenden code:

function getform(win: THandle): THandle;
var
msg: tagMSG;
begin
Form1 := TForm1.CreateParented(win);
Form1.ParentWindow := win;
Form1.WindowProc := Form1.SubClassWinProc;
Form1.Show;

Form1.ssControlSizer1.AllowMove := true;
Form1.ssControlSizer1.AllowResize := true;

Application.ProcessMessages;

while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
//if Msg.Message <> WM_QUIT then // bekommt ein Thread vermutlich
nie, aber gut
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
result := Form1.Handle;
end;



leider weiss ich nicht genau, warum einige Events nicht beachtet werden.
Was habe ich vor:
in einer separaten exe mï¿œchte ich eine dll mit einen formular einfï¿œgen.
Dieses Formular beinhaltet einen Panel.
Den mï¿œchte ich verschieben.
leider klappt das nicht.
wenn ihr ideen habt immer her damit
danke
jens

[Peter]

Jens Kallup wrote:

> Hallo Gemeinde,
>
> in einer Library/DLL Projekt habe ich folgenden code:
>
> function getform(win: THandle): THandle;
> var
> msg: tagMSG;
> begin
> Form1 := TForm1.CreateParented(win);
> Form1.ParentWindow := win;

Du erzeugst damit ein Control.

> Form1.WindowProc := Form1.SubClassWinProc;

Speichere den alten Inhalt von WindowProc. Deine SubClassWinProc muss
alle nicht behandelten Messages an die alte WindowProc ï¿œbergeben!

> Form1.Show;
>
> Form1.ssControlSizer1.AllowMove := true;
> Form1.ssControlSizer1.AllowResize := true;
>

> leider weiss ich nicht genau, warum einige Events nicht beachtet
> werden.

Das ist ein generelles Problem mit Forms in einem anderen Modul, die
von der message loop im main executable gefï¿œttert werden. Die VCL
message loop macht eine Menge mit den messages bevor sie an
DispatchMessage ï¿œbergeben werden, und ein Teil dieser Vorverarbeitung
wird nur gemacht, wenn die VCL das Zielfenster als ein VCL control
identifizieren kann. Das kann sie aber nicht, wenn das control einem
anderen Modul gehï¿œrt.

Fï¿œr solche Sachen muss man packages anstelle von DLLs verwenden, was
aber dann leider bedeutet, das man die verwendeten RTL und VCL packages
mit installieren muss.



--
Peter Below

[Jens Kallup]

Hallo Peter,

ich habe nun ein Package angelegt.
Es beinhaltet nur ein Control - ein TPanel.
Leider erhalte ich einen crash, wenn ich die Prozedur von einen C++
Programm heraus aufrufe.

was mache ich da nun falsch?


unit Panel1;

interface

uses
SysUtils, Classes, Controls, ExtCtrls, Dialogs;

type
TPanel1 = class(TPanel)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
end;

procedure Register;

procedure TestPanel(win: THandle); cdecl;

implementation

procedure TestPanel(win: THandle); cdecl; export;
begin
showmessage('SSSAAA');
ShowMessage(inttostr(win));
end;

procedure Register;
begin
RegisterComponents('MyTest', [TPanel1]);
end;

exports
TestPanel;

end.

[Peter]

Jens Kallup wrote:

> Hallo Peter,
>
> ich habe nun ein Package angelegt.
> Es beinhaltet nur ein Control - ein TPanel.
> Leider erhalte ich einen crash, wenn ich die Prozedur von einen C++
> Programm heraus aufrufe.
>
> was mache ich da nun falsch?

Kann ich nicht sagen, C++ Builder als host (ist doch Builder, oder VC?)
hab ich keine Erfahrung mit. Ein Delphi-Host Programm mￜￜte man selbst
mit Packages bauen damit deine Controlpackage voll integriert ist (dann
benutzen beide Module die gleiche RTL und VCL "Instanz" aus den
Standard-Packages.



--
Peter Below

[Jens Kallup]

Also,
jetzt habe ich ein ActiveXForm erstellt und erfolgreich in das C++
Programm implementiert.
Leider werden jedoch auch dort messages nicht an das haupt
programm weiter geleitet.
liegt das am Qt 5.3.1 Programm oder an dem Activex?
Jens

[Hans-Peter Diettrich]

Jens Kallup schrieb:

Wenn das Formular in einer DLL liegt, dann enthï¿œlt die eine komplette
Kopie der VCL/CLX und RTL, mit eigener Message-Schleife.

DoDi

[Jens Kallup]

Hallo HP,

ja das jabe ich gerade bemerkt.
Allerdings, reagiert die Komponente nicht auf Move.

Jens

Am 15/05/2014 22:50, schrieb Hans-Peter Diettrich:

> Wenn das Formular in einer DLL liegt, dann enthï¿œlt die eine komplette
> Kopie der VCL/CLX und RTL, mit eigener Message-Schleife.
>
> DoDi

unit SsCtrlSize;

interface

uses
{$IFDEF VER80}
WinTypes, WinProcs,
{$ELSE}
Windows,
{$ENDIF}
Forms, Messages, SysUtils, Classes, Graphics, Controls;

type
TssGrabHandlePosition = (ghTopLeft, ghTopMiddle, ghTopRight,
ghRightMiddle,
ghBottomRight, ghBottomMiddle, ghBottomLeft, ghLeftMiddle);
TssPositiveInteger = 0..MaxInt;
TssGrabEvent = procedure(Sender: TObject; sx, sy: integer) of object;
TssSizeAndMoveEvent = procedure(Sender: TObject; rct: TRect) of object;

TssGrabHandle = class(TCustomControl)
private
FCaptured: boolean;
FControl: TControl;
FHandlePosition: TssGrabHandlePosition;
FOnDrag: TssGrabEvent;
FOnEndDrag: TssGrabEvent;
FOnStartDrag: TssGrabEvent;
FVisible: boolean;
procedure SetControl(const c: TControl);
procedure SetHandlePosition(const p: TssGrabHandlePosition);
procedure SetPosition;
procedure SetVisible(const v: boolean);
protected
procedure Notification(AComponent: TComponent; AOperation:
TOperation); override;
procedure WmMouseDown(var msg: TWmLButtonDown); message WM_LBUTTONDOWN;
procedure WmMouseMove(var msg: TWmMouseMove); message WM_MOUSEMOVE;
procedure WmMouseUp(var msg: TWmLButtonUp); message WM_LBUTTONUP;
public
constructor Create(AOwner: TComponent); override;
procedure ResetPosition;
property Control: TControl read FControl write SetControl;
property HandlePosition: TssGrabHandlePosition read FHandlePosition
write SetHandlePosition;
property Visible: boolean read FVisible write SetVisible;
property OnDrag: TssGrabEvent read FOnDrag write FOnDrag;
property OnEndDrag: TssGrabEvent read FOnEndDrag write FOnEndDrag;
property OnStartDrag: TssGrabEvent read FOnStartDrag write
FOnStartDrag;
end;

TssControlSizer = class(TComponent)
private
FAllowMove: boolean;
FAllowResize: boolean;
FCanvas: TCanvas;
FControl: TControl;
FGrabHandles: array[TssGrabHandlePosition] of TssGrabHandle;
FLastSizeRect: TRect;
FLimitToParentRect: boolean;
FMinimumMove: TssPositiveInteger;
FMoved: boolean;
FMoving: boolean;
FNewWndProc: Pointer;
FOldWndProc: Pointer;
FOnEndMove: TNotifyEvent;
FOnEndSize: TNotifyEvent;
FOnStartMove: TNotifyEvent;
FOnStartSize: TNotifyEvent;
FParentControl: TWinControl;
FParentRect: TRect;
FStartMovePos: TPoint;
FOnSize: TssSizeAndMoveEvent;
FOnMove: TssSizeAndMoveEvent;
procedure DoSubclass;
procedure DrawMoveRect(const sx, sy: integer);
procedure DrawSizeRect(Sender: TObject; sx, sy: integer);
procedure EndMoveControl(const x, y: Smallint);
procedure FreeCanvas;
procedure GetCanvas;
function GetControlBoundsRect(Sender: TObject; sx, sy: integer): TRect;
function LimitPointToParent(const pt: TPoint): TPoint;
function LimitRectToParent(const rct: TRect): TRect;
procedure MoveControl(const x, y: Smallint);
procedure OnDragHandle(Sender: TObject; sx, sy: integer);
procedure OnEndDragHandle(Sender: TObject; sx, sy: integer);
procedure OnStartDragHandle(Sender: TObject; sx, sy: integer);
procedure SetAllowMove(const v: boolean);
procedure SetAllowResize(const v: boolean);
procedure SetControl(const c: TControl);
procedure SetVisible(const v: boolean);
procedure StartMoveControl(const x, y: Smallint);
procedure UnDoSubclass;
protected
procedure Notification(AComponent: TComponent; AOperation:
TOperation); override;
procedure ReSetHandles;
procedure SubclassProc(var msg: TMessage); virtual;
public
constructor Create(AOwner: TComponent); override;
published
property AllowMove: boolean read FAllowMove write SetAllowMove
default true;
property AllowResize: boolean read FAllowResize write
SetAllowResize default true;
property Control: TControl read FControl write SetControl;
property LimitToParentRect: boolean read FLimitToParentRect write
FLimitToParentRect default false;
property MinimumMove: TssPositiveInteger read FMinimumMove write
FMinimumMove default 3;
property OnStartSize: TNotifyEvent read FOnStartSize write
FOnStartSize;
property OnSize: TssSizeAndMoveEvent read FOnSize write FOnSize;
property OnEndSize: TNotifyEvent read FOnEndSize write FOnEndSize;
property OnStartMove: TNotifyEvent read FOnStartMove write
FOnStartMove;
property OnMove: TssSizeAndMoveEvent read FOnMove write FOnMove;
property OnEndMove: TNotifyEvent read FOnEndMove write FOnEndMove;
end;

procedure Register;

implementation

{$IFDEF WIN32}
{$R *.R32}
{$ELSE}
{$R *.R16}
{$ENDIF}

procedure Register;
begin
RegisterComponents('SadMan', [TssControlSizer]);
end;

function NormaliseRect(const rct: TRect): TRect;
begin
result := rct;
if rct.Left > rct.Right then begin
result.Left := rct.Right;
result.Right := rct.Left;
end;
if rct.Top > rct.Bottom then begin
result.Top := rct.Bottom;
result.Bottom := rct.Top;
end;
end;

function FindParent(const comp: TComponent): TWinControl;
function UpOne(const comp: TComponent): TComponent;
begin
if comp is TControl then
result := TControl(comp).Parent
else
result := comp.Owner;
end;
var
o: TComponent;
begin
result := nil;
if Assigned(comp) then begin
o := UpOne(comp);
while Assigned(o) and not (o is TWinControl) do
o := UpOne(o);
if o is TWinControl then
result := TWinControl(o);
end;
end;

{ TssGrabHandle }

const
HandleCursors: array[TssGrabHandlePosition] of TCursor = (
crSizeNWSE, crSizeNS,
crSizeNESW, crSizeWE,
crSizeNWSE, crSizeNS,
crSizeNESW, crSizeWE);

constructor TssGrabHandle.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Color := clBlack;
Cursor := HandleCursors[FHandlePosition];
Width := 5;
Height := 5;
inherited Visible := false;
FVisible := false;
FCaptured := false;
Parent := nil;
end;

procedure TssGrabHandle.Notification(AComponent: TComponent; AOperation:
TOperation);
begin
inherited Notification(AComponent, AOperation);
if (AComponent = FControl) and (AOperation = opRemove) then
Control := nil;
end;

procedure TssGrabHandle.ResetPosition;
begin
SetPosition;
end;

procedure TssGrabHandle.SetControl(const c: TControl);
begin
if csDestroying in ComponentState then exit;
if FControl <> c then begin
FControl := c;
if Assigned(FControl) then begin
Parent := FindParent(FControl);
HandleNeeded;
SetPosition;
end else begin
DestroyWindowHandle;
Parent := nil;
end;
end;
end;

procedure TssGrabHandle.SetHandlePosition(const p: TssGrabHandlePosition);
begin
if FHandlePosition <> p then begin
FHandlePosition := p;
Cursor := HandleCursors[FHandlePosition];
SetPosition;
end;
end;

procedure TssGrabHandle.SetPosition;
var
x, y: integer;
begin
if Assigned(FControl) then begin
with FControl do
case FHandlePosition of
ghTopMiddle: begin
x := Left + Width div 2;
y := Top;
end;
ghTopRight: begin
x := Left + Width;
y := Top;
end;
ghRightMiddle: begin
x := Left + Width;
y := Top + Height div 2;
end;
ghBottomRight: begin
x := Left + Width;
y := Top + Height;
end;
ghBottomMiddle: begin
x := Left + Width div 2;
y := Top + Height;
end;
ghBottomLeft: begin
x := Left;
y := Top + Height;
end;
ghLeftMiddle: begin
x := Left;
y := Top + Height div 2;
end;
else begin
x := Left;
y := Top;
end;
end;
Left := x - Width div 2;
Top := y - Height div 2;
inherited Visible := FVisible;
end else
inherited Visible := false;
end;

procedure TssGrabHandle.SetVisible(const v: boolean);
begin
if FVisible <> v then begin
FVisible := v;
inherited Visible := FVisible and Assigned(FControl);
end;
end;

procedure TssGrabHandle.WmMouseDown(var msg: TWmLButtonDown);
var
pt: TPoint;
begin
if not FCaptured and ((MK_LBUTTON and msg.keys) <> 0) then begin
SetCaptureControl(Self);
FCaptured := true;
if Assigned(FOnStartDrag) then begin
pt := ClientToScreen(Point(msg.xpos, msg.ypos));
FOnStartDrag(Self, pt.x, pt.y);
end;
end;
end;

procedure TssGrabHandle.WmMouseMove(var msg: TWmMouseMove);
var
pt: TPoint;
begin
inherited;
if FCaptured and Assigned(FOnDrag) then begin
pt := ClientToScreen(Point(msg.xpos, msg.ypos));
FOnDrag(Self, pt.x, pt.y);
end;
end;

procedure TssGrabHandle.WmMouseUp(var msg: TWmLButtonUp);
var
pt: TPoint;
begin
inherited;
if FCaptured then begin
pt := ClientToScreen(Point(msg.xpos, msg.ypos));
if (MK_LBUTTON and msg.keys) = 0 then begin
SetCaptureControl(nil);
FCaptured := false;
if Assigned(FOnEndDrag) then
FOnEndDrag(Self, pt.x, pt.y);
end;
end;
end;

{ TssControlSizer }

constructor TssControlSizer.Create(AOwner: TComponent);
var
h: TssGrabHandlePosition;
begin
inherited Create(AOwner);
FControl := nil;
FParentControl := nil;
FNewWndProc := nil;
FOldWndProc := nil;
FAllowResize := true;
FAllowMove := true;
FStartMovePos := Point(-1, -1);
FLimitToParentRect := false;
FMinimumMove := 3;
if not (csDesigning in ComponentState) then
for h := low(TssGrabHandlePosition) to High(TssGrabHandlePosition)
do begin
FGrabHandles[h] := TssGrabHandle.Create(Self);
with FGrabHandles[h] do begin
HandlePosition := h;
OnStartDrag := Self.OnStartDragHandle;
OnDrag := Self.OnDragHandle;
OnEndDrag := Self.OnEndDragHandle;
Control := Self.FControl;
Visible := Self.FAllowResize;
end;
end
else
for h := low(TssGrabHandlePosition) to High(TssGrabHandlePosition) do
FGrabHandles[h] := nil;
end;

procedure TssControlSizer.DoSubclass;
begin
if not (csDesigning in ComponentState) and (FControl is TWinControl)
then begin
UndoSubclass;
FNewWndProc := MakeObjectInstance(SubclassProc);
FOldWndProc := Pointer(GetWindowLong(TWinControl(FControl).Handle,
GWL_WNDPROC));
SetWindowLong(TWinControl(FControl).Handle, GWL_WNDPROC,
Longint(FNewWndProc));
end;
end;

procedure TssControlSizer.DrawMoveRect(const sx, sy: integer);
var
l, t: integer;
rct: TRect;
begin
if not Assigned(FControl) or
not Assigned(FCanvas) then exit;

l := FControl.Left + sx - FStartMovePos.x;
t := FControl.Top + sy - FStartMovePos.y;
rct := Rect(l, t, l + FControl.Width - 1, t + FControl.Height - 1);
if FLimitToParentRect then
rct := LimitRectToParent(rct);
with FParentControl, rct do begin
TopLeft := ClientToScreen(TopLeft);
BottomRight := ClientToScreen(BottomRight);
end;
with FCanvas do begin
with FLastSizeRect do
Rectangle(Left, Top, Right, Bottom);
with rct do
Rectangle(Left, Top, Right, Bottom);
end;
FLastSizeRect := rct;
if Assigned(FOnMove) then
FOnMove(self, rct);
end;

procedure TssControlSizer.DrawSizeRect(Sender: TObject; sx, sy: integer);
var
rct: TRect;
begin
if not Assigned(FControl) or
not Assigned(FCanvas) then exit;
rct := NormaliseRect(GetControlBoundsRect(sender, sx, sy));
if FLimitToParentRect then
with rct do begin
TopLeft := LimitPointToParent(TopLeft);
BottomRight := LimitPointToParent(BottomRight);
end;
with FParentControl, rct do begin
TopLeft := ClientToScreen(TopLeft);
BottomRight := ClientToScreen(BottomRight);
end;
with FCanvas do begin
with FLastSizeRect do
Rectangle(Left, Top, Right, Bottom);
with rct do
Rectangle(Left, Top, Right, Bottom);
end;
FLastSizeRect := rct;
if Assigned(FOnSize) then
FOnSize(self, rct);
end;

procedure TssControlSizer.EndMoveControl(const x, y: Smallint);
var
l, t: integer;
rct: TRect;
begin
if FMoving and FMoved then begin
DrawMoveRect(x, y);
FLastSizeRect := rect(-1, -1, -1, -1);
DrawMoveRect(x, y);
FreeCanvas;
l := FControl.Left + x - FStartMovePos.x;
t := FControl.Top + y - FStartMovePos.y;
rct := Rect(l, t, l + FControl.Width - 1, t + FControl.Height - 1);
if FLimitToParentRect then
rct := LimitRectToParent(rct);
with rct do begin
FControl.Left := Left;
FControl.Top := Top;
end;
ReSetHandles;
if Assigned(FOnEndMove) then
FOnEndMove(self);
end;
SetVisible(FAllowResize);
FMoving := false;
ReleaseCapture;
FStartMovePos := Point(-1, -1);
end;

procedure TssControlSizer.FreeCanvas;
var
h: THandle;
begin
if Assigned(FCanvas) then begin
h := FCanvas.Handle;
FCanvas.Handle := 0;
ReleaseDC(0, h);
FCanvas.Free;
FCanvas := nil;
end;
end;

procedure TssControlSizer.GetCanvas;
var
h: THandle;
begin
h := 0;
FCanvas := TCanvas.Create;
with FCanvas do try
h := GetDC(0);
Handle := h;
with Brush do begin
Color := clBlack;
Style := bsClear;
end;
with Pen do begin
Color := clBlack;
Style := psSolid;
Mode := pmNot;
Width := 2;
end;
except
Handle := 0;
if h <> 0 then
ReleaseDC(0, h);
Free;
FCanvas := nil;
end;
end;

function TssControlSizer.GetControlBoundsRect(Sender: TObject; sx, sy:
integer): TRect;
var
pt: TPoint;
begin
pt := FParentControl.ScreenToClient(Point(sx, sy));
result := FControl.BoundsRect;
with result do
case TssGrabHandle(Sender).FHandlePosition of
ghTopLeft: begin
Left := pt.x;
Top := pt.y;
end;
ghTopMiddle: begin
Top := pt.y;
end;
ghTopRight: begin
Right := pt.x;
Top := pt.y;
end;
ghRightMiddle: begin
Right := pt.x;
end;
ghBottomRight: begin
Right := pt.x;
Bottom := pt.y;
end;
ghBottomMiddle: begin
Bottom := pt.y;
end;
ghBottomLeft: begin
Left := pt.x;
Bottom := pt.y;
end;
ghLeftMiddle: begin
Left := pt.x;
end;
end;
end;

function TssControlSizer.LimitPointToParent(const pt: TPoint): TPoint;
begin
result := pt;
with result do begin
if X < FParentRect.Left then
X := FParentRect.Left;
if X > FParentRect.Right - 1 then
X := FParentRect.Right - 1;
if Y < FParentRect.Top then
Y := FParentRect.Top;
if Y > FParentRect.Bottom - 1 then
Y := FParentRect.Bottom - 1;
end;
end;

function TssControlSizer.LimitRectToParent(const rct: TRect): TRect;
begin
result := rct;
if result.Left < FParentRect.Left then begin
result.Left := FParentRect.Left;
result.Right := FParentRect.Left + FControl.Width;
end;
if result.Right > FParentRect.Right - 1 then begin
result.Left := FParentRect.Right - FControl.Width - 1;
result.Right := FParentRect.Right - 1;
end;
if result.Top < FParentRect.Top then begin
result.Top := FParentRect.Top;
result.Bottom := FParentRect.Top + FControl.Height;
end;
if result.Bottom > FParentRect.Bottom - 1 then begin
result.Top := FParentRect.Bottom - FControl.Height - 1;
result.Bottom := FParentRect.Bottom - 1;
end;
end;

procedure TssControlSizer.MoveControl(const x, y: Smallint);
begin
if not FMoving then exit;
if not FMoved then begin
FMoved := (abs(x - FStartMovePos.x) >= FMinimumMove) or
(abs(y - FStartMovePos.y) >= FMinimumMove);
if FMoved then begin
GetCanvas;
if Assigned(FOnStartMove) then
FOnStartMove(self);
end;
end;
if FMoved then
DrawMoveRect(x, y);
end;

procedure TssControlSizer.Notification(AComponent: TComponent;
AOperation: TOperation);
begin
inherited Notification(AComponent, AOperation);
if (AComponent = FControl) and (AOperation = opRemove) then
Control := nil;
end;

procedure TssControlSizer.OnDragHandle(Sender: TObject; sx, sy: integer);
begin
DrawSizeRect(Sender, sx, sy);
end;

procedure TssControlSizer.OnEndDragHandle(Sender: TObject; sx, sy: integer);
var
rct: TRect;
begin
if not Assigned(FControl) then exit;

DrawSizeRect(Sender, sx, sy);
FLastSizeRect := rect(-1, -1, -1, -1);
DrawSizeRect(Sender, sx, sy);
FreeCanvas;

rct := NormaliseRect(GetControlBoundsRect(sender, sx, sy));
if FLimitToParentRect then
with rct do begin
TopLeft := LimitPointToParent(TopLeft);
BottomRight := LimitPointToParent(BottomRight);
end;
with rct do
FControl.SetBounds(Left, Top, Right - Left, Bottom - Top);

ReSetHandles;
SetVisible(true); { must have been visible to start dragging }
if Assigned(FOnEndSize) then
FOnEndSize(Self);
end;

procedure TssControlSizer.OnStartDragHandle(Sender: TObject; sx, sy:
integer);
begin
if Assigned(FOnStartSize) then
FOnStartSize(Self);

SetVisible(false);
{ if Assigned(FControl.Parent) then}
FControl.Parent.Update; { to repaint under invisible GrabHandles }
FControl.Update; { to repaint under invisible GrabHandles }

FParentControl := FindParent(FControl);
if Assigned(FParentControl) then
FParentRect := FParentControl.ClientRect
else
FParentRect := rect(0, 0, 0, 0);
GetCanvas;
FLastSizeRect := rect(-1, -1, -1, -1);
DrawSizeRect(Sender, sx, sy);
end;

procedure TssControlSizer.ReSetHandles;
var
h: TssGrabHandlePosition;
begin
for h := low(TssGrabHandlePosition) to High(TssGrabHandlePosition) do
begin
if Assigned(FGrabHandles[h]) then
FGrabHandles[h].ResetPosition;
end;
end;

procedure TssControlSizer.SetAllowMove(const v: boolean);
begin
if FAllowMove <> v then begin
FAllowMove := v;
if not (csDesigning in ComponentState) then begin
if FAllowMove then
DoSubclass
else
UnDoSubclass;
end;
end;
end;

procedure TssControlSizer.SetAllowResize(const v: boolean);
begin
if FAllowResize <> v then begin
FAllowResize := v;
SetVisible(FAllowResize);
end;
end;

procedure TssControlSizer.SetControl(const c: TControl);
var
h: TssGrabHandlePosition;
begin
if csDestroying in ComponentState then exit;
if FControl <> c then begin
UnDoSubclass;
SetVisible(false);
FControl := c;
for h := low(TssGrabHandlePosition) to high(TssGrabHandlePosition) do
if Assigned(FGrabHandles[h]) then
FGrabHandles[h].Control := FControl;
DoSubclass;
SetVisible(FAllowResize);
end;
end;

procedure TssControlSizer.SetVisible(const v: boolean);
var
h: TssGrabHandlePosition;
begin
for h := low(TssGrabHandlePosition) to high(TssGrabHandlePosition) do
if Assigned(FGrabHandles[h]) then
FGrabHandles[h].Visible := v;
end;

procedure TssControlSizer.StartMoveControl(const x, y: Smallint);
begin
if FStartMovePos.X <> -1 then exit;
FStartMovePos := Point(x, y);
FParentControl := FindParent(FControl);
FParentControl := FindParent(FControl);
if Assigned(FParentControl) then
FParentRect := FParentControl.ClientRect
else
FParentRect := rect(0, 0, 0, 0);
FLastSizeRect := rect(-1, -1, -1, -1);
FMoved := false;
FMoving := true;
SetCapture(TWinControl(FControl).Handle);
SetVisible(false);
if FControl.Parent <> nil then
FControl.Parent.Update; { to repaint under invisible GrabHandles }
FControl.Update; { to repaint under invisible GrabHandles }
end;

procedure TssControlSizer.SubclassProc(var msg: TMessage);
begin
if FAllowMove and (msg.msg = WM_LBUTTONDOWN) then begin
{$R-}
StartMoveControl(LOWORD(msg.lParam), HIWORD(msg.lParam));
{$R+}
msg.Result := 1;
end else if FAllowMove and (msg.msg = WM_LBUTTONUP) then begin
{$R-}
EndMoveControl(LOWORD(msg.lParam), HIWORD(msg.lParam));
{$R+}
msg.Result := 1;
end else if FAllowMove and (msg.msg = WM_MOUSEMOVE) then begin
{$R-}
MoveControl(LOWORD(msg.lParam), HIWORD(msg.lParam));
{$R+}
msg.Result := 1;
end else
msg.Result := CallWindowProc(FOldWndProc,
TWinControl(FControl).Handle, Msg.Msg, Msg.wParam, Msg.lParam);
if msg.Msg = WM_DESTROY then
UndoSubclass
else if msg.Msg = WM_WINDOWPOSCHANGED then
ReSetHandles;
end;

procedure TssControlSizer.UndoSubclass;
begin
if (FControl is TWinControl) and Assigned(FNewWndProc) and
Assigned(FOldWndProc) then begin
SetWindowLong(TWinControl(FControl).Handle, GWL_WNDPROC,
Longint(FOldWndProc));
FreeObjectInstance(FNewWndProc);
FNewWndProc := nil;
FOldWndProc := nil;
end;
end;

end.