procedure TResizer.MoverUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Moving := False;
ResizeControl.BoundsRect := NewSize;
CurMover.Invalidate;
ResizeControl.Refresh;
DrawSizeRect(NewSize);
ShowSizers;
if Assigned(OnMoved) then OnMoved(Self);
end;
//---------------------------------------
procedure TResizer.Calc_Move_Rect(dx, dy: integer);
begin
NewSize := OrigSize;
dx := (dx div GridX) * GridX;
dy := (dy div GridY) * GridY;
OffsetRect(NewSize, dx, dy);
if KeepInParent then Constrain_Move;
end;
//---------------------------------------
procedure TResizer.DoMovingEvent;
var
tmpWid, tmpHgt : integer;
begin
tmpWid := NewSize.Right - NewSize.Left;
tmpHgt := NewSize.Bottom - NewSize.Top;
if Assigned(OnMoving) then
OnMoving(Self, NewSize.Left, NewSize.Top);
NewSize.Right := NewSize.Left + tmpWid;
NewSize.Bottom := NewSize.Top + tmpHgt;
end;
//---------------------------------------
procedure TResizer.MoverMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
dx, dy: integer;
begin
if Moving then
begin
DrawSizeRect(NewSize);
if AllowMove then
begin
dx := X - DownX;
dy := Y - DownY;
Calc_Move_Rect(dx, dy);
DoMovingEvent;
end;
DrawSizeRect(NewSize);
if HotTrack then ResizeControl.BoundsRect := NewSize;
end;
end;
//---------------------------------------
procedure TResizer.Constrain_Size;
var
p : TWinControl;
begin
p := ResizeControl.Parent;
with NewSize do begin
if Left < 0 then Left := 0;
if Top < 0 then Top := 0;
if Right > p.ClientWidth then Right := p.ClientWidth;
if Bottom > p.ClientHeight then Bottom := p.ClientHeight;
if Right < Left + GridX then Right := Left + GridX;
if Bottom < Top + GridY then Bottom := Top + GridY;
end;
end;
//---------------------------------------
procedure TResizer.Constrain_Move;
begin
if NewSize.Left < 0 then
OffsetRect(NewSize, -NewSize.Left, 0);
if NewSize.Top < 0 then
OffsetRect(NewSize, 0, -NewSize.Top);
if NewSize.Right > ResizeControl.Parent.ClientWidth then
OffsetRect(NewSize, ResizeControl.Parent.ClientWidth - NewSize.Right, 0);
if NewSize.Bottom > ResizeControl.Parent.ClientHeight then
OffsetRect(NewSize, 0, ResizeControl.Parent.ClientHeight - NewSize.Bottom);
end;
//---------------------------------------
procedure TResizer.MoverKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Active then
begin
case Key of
VK_LEFT : DoSizeMove(Key, Shift, -GridX, 0);
VK_RIGHT : DoSizeMove(Key, Shift, GridX, 0);
VK_UP : DoSizeMove(Key, Shift, 0, -GridY);
VK_DOWN : DoSizeMove(Key, Shift, 0, GridY);
end;
end;
end;
//---------------------------------------
procedure TResizer.DoSizeMove(var Key: Word; Shift: TShiftState; dx, dy: integer);
begin
if (ssCtrl in Shift) or (ssShift in Shift) then
begin
Key := 0;
NewSize := ResizeControl.BoundsRect;
if (ssCtrl in Shift) and AllowMove then
begin
OffsetRect(NewSize, dx, dy);
if KeepInParent then Constrain_Move;
DoMovingEvent;
end;
if (ssShift in Shift) and AllowSize then
begin
NewSize.Right := NewSize.Right + dx;
NewSize.Bottom := NewSize.Bottom + dy;
if KeepInParent then Constrain_Size;
DoSizingEvent;
end;
function TResizer.FindMoverByBuddy(c: TControl): TMover;
var
i : integer;
begin
Result := nil;
for i := 0 to GroupMovers.Count-1 do
if TMover(GroupMovers[i]).Buddy = c then
Result := GroupMovers[i];
procedure TResizer.ShowSizers;
var
i : integer;
p : TPanel;
c : TControl;
begin
c := ResizeControl;
Assert(c <> nil);
for i := 0 to 7 do
begin
p := TPanel(Sizers[i]);
case i of
0, 1, 2 : p.Top := c.Top - HALFSIZE;
3, 4 : p.Top := c.Top + c.Height div 2 - HALFSIZE;
5, 6, 7 : p.Top := c.Top + c.Height - HALFSIZE;
end;
case i of
0, 3, 5 : p.Left := c.Left - HALFSIZE;
1, 6 : p.Left := c.Left + c.Width div 2 - HALFSIZE;
2, 4, 7 : p.Left := c.Left + c.Width - HALFSIZE;
end;
end;
Assert(CurMover<>nil);
CurMover.Show;
for i := 0 to Sizers.Count-1 do
begin
p := TPanel(Sizers[i]);
p.Parent := c.Parent;
p.Visible := True;
p.BringToFront;
end;
if CurMover.HandleAllocated and CurMover.CanFocus then
CurMover.SetFocus;
end;
//---------------------------------------
procedure TResizer.HideSizers;
var
i : integer;
p : TPanel;
begin
for i := 0 to Sizers.Count-1 do
begin
p := TPanel(Sizers[i]);
p.Visible := False;
p.Update;
end;
procedure DoSwap(DoSwap: boolean; var a, b: integer);
var
t : integer;
begin
if DoSwap then
begin
t := a;
a := b;
b := t;
end;
end;
//---------------------------------------
procedure TResizer.SizerUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if NewSize.Right < NewSize.Left then
DoSwap(True, NewSize.Right, NewSize.Left);
if NewSize.Bottom < NewSize.Top then
DoSwap(True, NewSize.Bottom, NewSize.Top);
Sizing := False;
DrawSizeRect(NewSize);
ResizeControl.Invalidate;
ResizeControl.BoundsRect := NewSize;
ShowSizers;
if Assigned(OnSized) then OnSized(Self);
end;
//---------------------------------------
procedure TResizer.SizerMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if Sizing then
begin
DrawSizeRect(NewSize);
if AllowSize then
begin
Calc_Size_Rect((Sender as TSizer).Tag, X - DownX, Y - DownY);
DoSizingEvent;
end;
DrawSizeRect(NewSize);
if HotTrack then ResizeControl.BoundsRect := NewSize;
end;
end;
//---------------------------------------
procedure TResizer.DoSizingEvent;
var
tmpWid, tmpHgt : integer;
begin
tmpWid := NewSize.Right - NewSize.Left;
tmpHgt := NewSize.Bottom - NewSize.Top;
if Assigned(OnSizing) then
OnSizing(Self, NewSize.Left, NewSize.Top, tmpWid, tmpHgt);
procedure GetNonClientOffset(h: THandle; var nx, ny: integer);
var
p : TPoint;
R : TRect;
begin
p := Point(0, 0);
Windows.ClientToScreen(h, p);
Windows.GetWindowRect(h, R);
nx := p.x - R.Left;
ny := p.y - R.Top;
end;
//---------------------------------------
procedure TResizer.DrawSizeRect(Rect: TRect);
var
h : THandle;
dc : THandle;
c : TCanvas;
nx, ny : integer;
OldPen : TPen;
OldBrush : TBrush;
begin
if HotTrack then exit;
h := (ResizeControl.Parent as TWinControl).Handle;
GetNonClientOffset(h, nx, ny);
dc := GetWindowDC(h);
procedure TResizer.SetActive(b: boolean);
begin
if b<>FActive then
begin
FActive := b;
CheckSizers;
end;
end;
//---------------------------------------
procedure TResizer.SetControl(c: TControl);
begin
if c <> FControl then
begin
if c<>nil then
begin
if ResizeGroup<>nil then
begin
Assert(c.Parent = ResizeGroup, 'ResizeControl is not in ResizeGroup!');
CurMover := FindMoverByBuddy(c);
end else
begin
CurMover := OneMover;
CurMover.Buddy := c;
end;
CurMover.Show;
end;
FControl := c;
CheckSizers;
end;
end;
//---------------------------------------
procedure TResizer.SetGroup(p: TWinControl);
begin
if p <> FGroup then
begin
FGroup := p;
CreateGroupMovers;
end;
end;
//---------------------------------------
procedure TResizer.CreateGroupMovers;
var
i : integer;
m : TMover;
c : TControl;
begin
if csDesigning in ComponentState then exit;
// Clear out the old Movers
for i := 0 to GroupMovers.Count-1 do
TObject(GroupMovers[i]).Free;
GroupMovers.Clear;
if ResizeGroup <> nil then
begin
for i := 0 to ResizeGroup.ControlCount-1 do
begin
c := ResizeGroup.Controls[i];
if (c is TMover) or (c is TSizer) then continue;
m := TMover.Create(Self);
CreateOneMover(m, c);
GroupMovers.Add(m);
m.Show;
end;
end;
end;
//---------------------------------------
procedure TResizer.CreateSizers;
var
i : integer;
p : TSizer;
begin
if csDesigning in ComponentState then exit;
for i := 0 to 7 do
begin
p := TSizer.Create(Self);
Sizers.Add(p);
p.BevelOuter := bvNone;
p.Width := SIZE;
p.Height := SIZE;
p.Color := clBlack;
p.Caption := '';
p.Tag := i;
p.OnMouseDown := SizerDown;
p.OnMouseUp := SizerUp;
p.OnMouseMove := SizerMove;
p.TabStop := False;
case i of
0, 7 : p.Cursor := crSizeNWSE;
2, 5 : p.Cursor := crSizeNESW;
1, 6 : p.Cursor := crSizeNS;
3, 4 : p.Cursor := crSizeWE;
end;
end;
end;
//---------------------------------------
procedure TResizer.CheckSizers;
begin
if (ResizeControl<>nil) and Active and (not (csDesigning in ComponentState)) then
ShowSizers
else
HideSizers;
end;
//---------------------------------------
procedure TResizer.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;
if csDestroying in ComponentState then exit;
if (AComponent = ResizeControl) and (Operation = opRemove) then
ResizeControl := nil;
end;
//---------------------------------------