procedure TdcbsSizeControlTemplate.PopupMenuItemFreeClick(Sender: TObject);
begin
SizeControlTemplateExit(Self);
end;
procedure TdcbsSizeControlTemplate.SizeControlTemplateExit(
Sender: TObject);
begin
Free;
end;
procedure TdcbsSizeControlTemplate.WMLButtonDown(var Msg: TWMLButtonDown);
begin
Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;
procedure TdcbsSizeControlTemplate.WMMove(var Msg: TWMMove);
var
R: TRect;
begin
R := BoundsRect;
InflateRect(R, -2, -2);
FControl.Invalidate;
FControl.BoundsRect := R;
end;
procedure TdcbsSizeControlTemplate.WMNcHitTest(var Msg: TWMNcHitTest);
var
Pt: TPoint;
I: Byte;
begin
Pt := Point(Msg.XPos, Msg.YPos);
Pt := ScreenToClient(Pt);
Msg.Result := 0;
for I := 1 to 8 do
if PtInRect(FRectList[I], Pt) then
Msg.Result := FResizePosList[I];
if Msg.Result = 0 then
inherited;
end;
procedure TdcbsSizeControlTemplate.WMPaint(var Msg: TWMPaint);
var
I: Byte;
begin
with Canvas do
begin
Brush.Color := clBlue;
for I := 1 to 8 do
Rectangle(FRectList[I]);
end;
end;
procedure TdcbsSizeControlTemplate.WMRButtonUp(var Msg: TWMRButtonUp);
begin
inherited;
FControl.Invalidate;
end;
procedure TdcbsSizeControlTemplate.WMSize(var Msg: TWMSize);
var
R: TRect;
begin
R := BoundsRect;
InflateRect(R, -2, -2);
FControl.BoundsRect := R;
procedure CreateSizeControl(AOwner: TComponent; AControl: TControl);
begin
if not Assigned(AOwner) then
raise Exception.Create('Invalid parameter "AOwner"!');
if not Assigned(AControl) then
raise Exception.Create('Invalid parameter "AControl"');
TdcbsSizeControlTemplate.Create(AOwner, AControl);
end;