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

Question

如何实现自定义大小例程的边框本身不是可调整大小的窗口？

例如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]; 将关闭左侧、顶部、LeftBottom-corner、LeftTop-corner 和 TopRight-corner 的大小）

附：实际上，可以将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;
{...}