如何为具有不可大小边框的窗口进行自定义大小调整？

Question

如何为窗口实现自定义大小调整例程，这些例程的边界本身并不大？

e.g。将BorderStyle设置为bsToolWindow

的表单

Answer 1

这是一个自定义的表单类，具有实现的非大小边框大小调整以及禁用指定边缘大小的可能性。此外，它还支持在边框上双击以在两个矩形边界之间切换：AutoSizeRect到在dblclick和SavedSizeRect上移动的形式边的值，在更改之前，这些值形成保存的边坐标。因此，AutoSizeRect可以在运行时设置到屏幕的某个区域，以便用户能够在指定区域和当前BoundsRect之间交换边界侧的坐标。非常方便各种调色板窗口（又名ToolWindows）。最好结合自定义粘贴/对齐。

{...}
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属性是一组将被关闭的边（例如DisabledSizingEdges:=[akLeft,akTop];将关闭左侧，上侧，左下角，左下角和顶级右侧的大小调整 - 角）

P.S。实际上可以创建一个表单，BorderStyle设置为bsNone并设置BorderWidth高于零，以通过内部边框实现大小调整：

{...}
type
  TForm1 = class(TCustomSizingForm)
    procedure FormCreate(Sender: TObject);
  private
  public
  end;
{...}
procedure TForm1.FormCreate(Sender: TObject);
begin
  BorderStyle:=bsNone;
  BorderWidth:=4;
end;
{...}