サイズの大きいボーダーでウィンドウのカスタムサイズを設定するにはどうすればよいですか？

Question

ボーダーがネイティブにサイズ変更できないウィンドウのカスタムサイジングルーチンを実装するにはどうすればよいですか？

BorderStyleのフォームはbsToolWindow

Answer 1

に設定されています。ここでは、カスタマイズされたフォームクラスが実装されており、サイズが制限されていない境界線のサイジングと、指定されたエッジのサイジングを無効にできます。また、境界線をダブルクリックすると、2つの矩形境界を切り替えることができます。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コーナー、LeftTopコーナー& TopRightコーナーのためのサイジングオフになります）のセットです

PS実際には1つはbsNoneにBorderStyleセットでフォームを作成し、内部の境界線を経由して、サイジングを達成するために、ゼロよりも高いBorderWidthを設定することができます。

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