How to implement custom sizing routines for window which borders are not natively sizeable?
e.g. a form with BorderStyle set to bsToolWindow
Here a customized form-class with implemented non-sizeable borders sizing and possibility to disable sizing for specified edges. Also it supports double clicks on borders to toggle between two rectangle-boundaries: AutoSizeRect to values of which form sides getting moved on dblclick and SavedSizeRect into which values form side coordinates saved before changing. So AutoSizeRect could be setted to some area of the screen at a run-time to give user ability to swap border-side's coords between specified area and current BoundsRect. Very convenient for all kinds of palette-windows (aka ToolWindows). Best combined with custom sticking/aligning.
{...}
const
crMin=-32768; {lowest value for tCursor}
{predefined variable for tRect with undefined values:}
nullRect:tRect=(Left:MaxInt;Top:MaxInt;Right:MaxInt;Bottom:MaxInt);
type
{all sides and corners of Rect including inner part (rcClient):}
TRectCorner=(rcClient,rcTopLeft,rcTop,rcTopRight,rcLeft,rcRight,rcBottomLeft,rcBottom,rcBottomRight);
{here goes the mentioned class:}
TCustomSizingForm = class(TForm)
protected
private
disSizing:tAnchors; {edges with disabled sizing}
cCorner:tRectCorner; {current corner}
cCurSaved:tCursor; {saved cursor value for sizing}
coordsSv:tRect; {saved side's coordinates}
coordsASize:tRect; {auto-sizing area for dblclicks}
aSizeAcc:byte; {auto-sizing accuracy}
{checking if current edge-side is not disabled:}
function cCornerAvailable:boolean;
{setting sizing-cursor based on the edge-side:}
procedure setCursorViaCorner(Corner:tRectCorner);
{checking if mouse on borders and setting sizing cursor:}
function checkMouseOnBorders(msg:tWmNcHitMessage):boolean;
{NcHitTes and other NC-messages handlers:}
procedure WMNCHitTest(var msg:tWmNcHitTest); message WM_NCHITTEST;
procedure BordersLButtonDown(var msg:tWmNcHitMessage); message WM_NCLBUTTONDOWN;
procedure BordersLButtonUp(var msg:tWmNcHitMessage); message WM_NCLBUTTONUP;
procedure BordersMouseMove(var msg:tWmNcHitMessage); message WM_NCMOUSEMOVE;
procedure BordersLDblClick(var msg:tWmNcHitMessage); message WM_NCLBUTTONDBLCLK;
public
{Create-override for initializing rect-values:}
constructor Create(AOwner: TComponent); override;
{calculation of edge-side from tPoint:}
function getCornerFromPoint(BoundsRect:tRect; x,y:smallInt):tRectCorner;
{properties:}
property CursorSaved:tCursor read cCurSaved write cCurSaved default crMin;
property AutoSizeRect:tRect read coordsASize write coordsASize;
property SavedSizeRect:tRect read coordsSv write coordsSv;
published
{overwriting default BorderStyle:}
property BorderStyle default bsToolWindow;
{publishing disSizing property for Object Inspector:}
property DisabledSizingEdges:tAnchors read disSizing write disSizing default [];
end;
{...}
implementation
{--- TCustomSizingForm - public section: ---}
constructor TCustomSizingForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SavedSizeRect:=nullRect;
AutoSizeRect:=nullRect;
end;
function TCustomSizingForm.getCornerFromPoint(BoundsRect:tRect; x,y:smallInt):tRectCorner;
var CornerSize,BorderSize:tBorderWidth;
begin
BorderSize:=4+self.BorderWidth;
CornerSize:=8+BorderSize;
with BoundsRect do
if y<Top+BorderSize then
if x<Left+CornerSize then Result:=rcTopLeft
else if x>Right-CornerSize then Result:=rcTopRight
else Result:=rcTop
else if y>Bottom-BorderSize then
if x<Left+CornerSize then Result:=rcBottomLeft
else if x>Right-CornerSize then Result:=rcBottomRight
else Result:=rcBottom
else if x<Left+BorderSize then
if y<Top+CornerSize then Result:=rcTopLeft
else if y>Bottom-CornerSize then Result:=rcBottomLeft
else Result:=rcLeft
else if x>Right-BorderSize then
if y<Top+CornerSize then Result:=rcTopRight
else if y>Bottom-CornerSize then Result:=rcBottomRight
else Result:=rcRight
else Result:=rcClient;
end;
{--- TCustomSizingForm - private section: ---}
function TCustomSizingForm.cCornerAvailable:boolean;
var ca:tAnchorKind;
begin
result:=true;
if(disSizing=[])then exit;
if(cCorner in[rcTopLeft,rcLeft,rcBottomLeft])then begin
ca:=akLeft;
end else if(cCorner in[rcTopRight,rcRight,rcBottomRight])then begin
ca:=akRight;
end else if(cCorner in[rcTopLeft,rcTop,rcTopRight])then begin
ca:=akTop;
end else ca:=akBottom;
if(ca in disSizing)then result:=false;
end;
procedure TCustomSizingForm.setCursorViaCorner(Corner:tRectCorner);
var c:tCursor;
begin
case Corner of
rcLeft,rcRight: c:=crSizeWE;
rcTop,rcBottom: c:=crSizeNS;
rcTopLeft,rcBottomRight: c:=crSizeNWSE;
rcTopRight,rcBottomLeft: c:=crSizeNESW;
else exit;
end;
if(cursorSaved=crMin)then cursorSaved:=screen.Cursor;
setCursor(screen.Cursors[c]);
end;
function TCustomSizingForm.checkMouseOnBorders(msg:tWmNcHitMessage):boolean;
begin
result:=true;
cCorner:=rcClient;
if(msg.HitTest<>HTBORDER)then exit;
cCorner:=getCornerFromPoint(self.BoundsRect,msg.XCursor,msg.YCursor);
if(cCorner=rcClient)then exit;
if(cCornerAvailable)then begin
setCursorViaCorner(cCorner);
result:=false;
end;
end;
{--- TCustomSizingForm - WinApi_message_handlers: ---}
procedure TCustomSizingForm.WMNCHitTest(var msg:tWmNcHitTest);
var hitMsg:tWmNcHitMessage;
begin
inherited;
if(msg.Result=HTNOWHERE)and(PtInRect(self.BoundsRect,point(msg.XPos,msg.YPos)))then msg.Result:=HTBORDER
else if(msg.Result<>HTBORDER)then exit;
hitMsg.HitTest:=msg.Result;
hitMsg.XCursor:=msg.XPos;
hitMsg.YCursor:=msg.YPos;
checkMouseOnBorders(hitMsg);
end;
procedure TCustomSizingForm.BordersLButtonDown(var msg:tWmNcHitMessage);
const SC_SIZELEFT=1; SC_SIZERIGHT=2; SC_SIZETOP=3; SC_SIZEBOTTOM=6;
var m:integer;
begin
inherited;
if(checkMouseOnBorders(msg))then exit;
m:=SC_SIZE;
if(cCorner in[rcTopLeft,rcLeft,rcBottomLeft])then begin
inc(m,SC_SIZELEFT);
end else if(cCorner in[rcTopRight,rcRight,rcBottomRight])then begin
inc(m,SC_SIZERIGHT);
end;
if(cCorner in[rcTopLeft,rcTop,rcTopRight])then begin
inc(m,SC_SIZETOP);
end else if(cCorner in[rcBottomLeft,rcBottom,rcBottomRight])then begin
inc(m,SC_SIZEBOTTOM);
end;
ReleaseCapture;
SendMessage(self.Handle,WM_SYSCOMMAND,m,0);
end;
procedure TCustomSizingForm.BordersLButtonUp(var msg:tWmNcHitMessage);
begin
inherited;
if(cursorSaved=crMin)then exit;
setCursor(screen.Cursors[cursorSaved]);
cursorSaved:=crMin;
end;
procedure TCustomSizingForm.BordersMouseMove(var msg:tWmNcHitMessage);
begin
inherited;
checkMouseOnBorders(msg);
end;
procedure TCustomSizingForm.BordersLDblClick(var msg:tWmNcHitMessage);
var es:tAnchors; old,new:tRect;
begin
inherited;
if(checkMouseOnBorders(msg))or(EqualRect(coordsASize,nullRect))then exit;
es:=[];
ReleaseCapture;
if(cCorner in[rcTopLeft,rcLeft,rcBottomLeft])then es:=es+[akLeft];
if(cCorner in[rcTopRight,rcRight,rcBottomRight])then es:=es+[akRight];
if(cCorner in[rcTopLeft,rcTop,rcTopRight])then es:=es+[akTop];
if(cCorner in[rcBottomLeft,rcBottom,rcBottomRight])then es:=es+[akBottom];
if(es=[])then exit;
old:=self.BoundsRect;
new:=old;
if(akLeft in es)and(coordsASize.Left<MaxInt)then begin
if(abs(old.Left-coordsASize.Left)<=aSizeAcc)then begin
new.Left:=coordsSv.Left;
end else begin
coordsSv.Left:=old.Left;
new.Left:=coordsASize.Left;
end;
end;
if(akRight in es)and(coordsASize.Right<MaxInt)then begin
if(abs(old.Right-coordsASize.Right)<=aSizeAcc)then begin
new.Right:=coordsSv.Right;
end else begin
coordsSv.Right:=old.Right;
new.Right:=coordsASize.Right;
end;
end;
if(akTop in es)and(coordsASize.Top<MaxInt)then begin
if(abs(old.Top-coordsASize.Top)<=aSizeAcc)then begin
new.Top:=coordsSv.Top;
end else begin
coordsSv.Top:=old.Top;
new.Top:=coordsASize.Top;
end;
end;
if(akBottom in es)and(coordsASize.Bottom<MaxInt)then begin
if(abs(old.Bottom-coordsASize.Bottom)<=aSizeAcc)then begin
new.Bottom:=coordsSv.Bottom;
end else begin
coordsSv.Bottom:=old.Bottom;
new.Bottom:=coordsASize.Bottom;
end;
end;
self.BoundsRect:=new;
end;
{...}
DisabledSizingEdges property is a set of edges which will be turned off (e.g. DisabledSizingEdges:=[akLeft,akTop]; will turn off sizing for Left-side, Top-side, LeftBottom-corner, LeftTop-corner & TopRight-corner)
P.S. actually one can create form with BorderStyle set to bsNone and set BorderWidth higher than zero to achieve sizing via inner borders:
{...}
type
TForm1 = class(TCustomSizingForm)
procedure FormCreate(Sender: TObject);
private
public
end;
{...}
procedure TForm1.FormCreate(Sender: TObject);
begin
BorderStyle:=bsNone;
BorderWidth:=4;
end;
{...}