크기가 큰 테두리가있는 창의 크기를 맞춤 설정하는 방법은 무엇입니까?

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 코너, LEFTTOP 코너 & TopRight 코너 크기 조정 꺼집니다)의 집합입니다

PS 실제로 하나 bsNone에 BorderStyle 세트로 양식을 작성하고 내부 국경을 통해 크기 달성하기 위해 0보다 BorderWidth 높은 설정할 수 있습니다

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