Problem/Question/Abstract:
How to resize a TPanel at runtime
Answer:
Solve 1:
You should add a SIZEBOX constant to the your panel window style:
TMyNewPanel = class(TPanel)
{ ... }
procedure CreateParams(var Params: TCreateParams); override;
{ ... }
procedure TMyNewPanel.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or WS_SIZEBOX;
end;
Solve 2:
The best way to deal with this is to make a descendent of TPanel that incorporates the required behaviour. Copy the following to a file SizeablePanel.pas, and install that via Component -> Install component.
unit SizeablePanel;
interface
uses
Messages, Windows, SysUtils, Classes, Controls, ExtCtrls;
type
TSizeablePanel = class(TPanel)
private
FMoveable: Boolean;
procedure wmNCHittest(var msg: TWMNCHittest); message WM_NCHITTEST;
published
property Moveable: Boolean read FMoveable write FMoveable default false;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('PBGoodies', [TSizeablePanel]);
end;
procedure TSizeablePanel.wmNCHittest(var msg: TWMNCHittest);
var
bottom, right: Integer;
pt: TPoint;
begin
if moveable then
msg.result := HTCAPTION
else
inherited;
pt := parent.ScreenToClient(SmallpointToPoint(msg.Pos));
bottom := Top + Height;
right := Left + Width;
if (pt.x - Left) < 10 then
if (pt.y - Top) < 10 then
msg.Result := HTTOPLEFT
else if (Bottom - pt.y) < 10 then
msg.result := HTBOTTOMLEFT
else
msg.result := HTLEFT
else if (right - pt.x) < 10 then
if (pt.y - Top) < 10 then
msg.Result := HTTOPRIGHT
else if (Bottom - pt.y) < 10 then
msg.result := HTBOTTOMRIGHT
else
msg.result := HTRIGHT
else if (pt.y - Top) < 10 then
msg.Result := HTTOP
else if (Bottom - pt.y) < 10 then
msg.result := HTBOTTOM;
end;
end.
Nincsenek megjegyzések:
Megjegyzés küldése