2009. július 7., kedd

Resize a TPanel at runtime

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