[Solved] How to make custom sizing for window with non-sizeable borders?

by


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;
{...}

2

solved How to make custom sizing for window with non-sizeable borders?