Wie wird die benutzerdefinierte Größe für Fenster mit nicht großen Rahmen festgelegt?

Question

Wie implementiert benutzerdefinierte Dimensionierungsroutinen für Fenster, deren Grenzen nicht nativ sind?

z.B. ein Formular mit BorderStylebsToolWindow

Answer 1

Hier eine benutzerdefinierte Formularklasse mit implementierten nicht-großen Rahmengrößen und der Möglichkeit, die Bemaßung für bestimmte Kanten zu deaktivieren. Es unterstützt auch Doppelklicks auf Rahmen, um zwischen zwei Rechteck-Grenzen umzuschalten: AutoSizeRect zu Werten, von denen Seiten auf dblclick verschoben werden und SavedSizeRect, in denen Werte Seitenkoordinaten bilden, die vor dem Ändern gespeichert wurden. So könnte AutoSizeRect zu einem bestimmten Bereich des Bildschirms zu einer Laufzeit festgelegt werden, um dem Benutzer die Möglichkeit zu geben, die Randseitenkoordinaten zwischen dem angegebenen Bereich und dem aktuellen BoundsRect zu tauschen. Sehr praktisch für alle Arten von Palettenfenstern (auch ToolWindows genannt). Am besten kombiniert mit kundenspezifischen Kleben/Ausrichten.

{...} 
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 Eigenschaft ist ein Satz von Kanten, die ausgeschaltet werden soll (zB DisabledSizingEdges:=[akLeft,akTop]; für linksseitige deaktivieren Schlichte, Top-Seite, LeftBottom-Ecke, LeftTop-Ecke & TopRight-Ecke)

PS tatsächlich kann eine Form mit BorderStyle Satz bsNone erstellen und BorderWidth größer als Null über innere Grenzen zu erreichen Schlichte:

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