Resize Formular aus, auch wenn es randlos ist - Entfernen Abflachungskantenabschluss

Question

Verwendung des folgenden Codes eine randlose Form veränderbare Werke groß zu machen:

type 
TForm1 = class(TForm) 
protected 
    procedure CreateParams(var Params: TCreateParams); override; 
end; 

procedure TForm1.CreateParams(var Params: TCreateParams); 
begin 
BorderStyle := bsNone; 
inherited; 
Params.ExStyle := Params.ExStyle or WS_EX_STATICEDGE; 
Params.Style := Params.Style or WS_SIZEBOX; 
end; 

Aber siehe Bild:

Warum an der Spitze Gibt es eine Abschrägung an der Kante? Irgendwelche Vorschläge, um es zu entfernen?

Answer 1

hinzufügen 5 Platten

pnlTop

pnlRight

pnlLeft

pnlBottom

pnlRSZ

 procedure Tfrmmain.FormCreate(Sender: TObject); 
      begin 
      BorderStyle := bsNone; 
      pnlTop.height:=1; 
      pnlTop.Align:=alTop; 
      pnlBottom.height:=1; 
      pnlBottom.Align:=alBottom; 
      pnlRight.width:=1; 
      pnlRight.Align:=alRight; 
      pnlLeft.width:=1; 
      pnlLeft.Align:=alLeft; 
      pnlRSZ.width:=3; 
      pnlRSZ.height:=3; 
      pnlRSZ.left:=frmmain.width-3; 
      pnlRSZ.top:=frmmain.height-3; 
      pnlRSZ.anchors:=[akRight,akBottom]; 


      pnlTop.Cursor:=crSizeNS; 
      pnlBottom.Cursor:=crSizeNS; 
      pnlRight.Cursor:=crSizeWE; 
      pnlLeft.Cursor:=crSizeWE; 
      pnlRSZ.Cursor:=crSizeNWSE; 

      pnlTop.color:=frmmain.color; 
      pnlBottom.color:=frmmain.color; 
      pnlRight.color:=frmmain.color; 
      pnlLeft.color:=frmmain.color; 
      pnlRSZ.color:=frmmain.color; 
      End; 


    procedure Tfrmmain.pnlTopMouseDown(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); 
    begin 
     if Button = mbLeft then 
     begin 
     ReleaseCapture; 
     TForm(FrmMain).Perform(WM_SYSCOMMAND, SC_SIZE + WMSZ_Top, 0); 
     end; 
    end; 

    procedure Tfrmmain.pnlRightMouseDown(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); 
    begin 
     if Button = mbLeft then 
     begin 
     ReleaseCapture; 
     TForm(FrmMain).Perform(WM_SYSCOMMAND, SC_SIZE + WMSZ_RIGHT, 0); 
     end; 
    end; 

    procedure Tfrmmain.pnlLeftMouseDown(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); 
    begin 
     if Button = mbLeft then 
     begin 
     ReleaseCapture; 
     TForm(FrmMain).Perform(WM_SYSCOMMAND, SC_SIZE + WMSZ_Left, 0); 
     end; 
    end; 

    procedure Tfrmmain.pnlBottomMouseDown(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); 
    begin 
     if Button = mbLeft then 
     begin 
     ReleaseCapture; 
     TForm(FrmMain).Perform(WM_SYSCOMMAND, SC_SIZE + WMSZ_Bottom, 0); 
     end; 
    end; 

    procedure Tfrmmain.pnlRSZMouseDown(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); 
    begin 
     if Button = mbLeft then 
     begin 
     ReleaseCapture; 
     TForm(FrmMain).Perform(WM_SYSCOMMAND, SC_SIZE + WMSZ_BOTTOMRIGHT, 0); 
     end; 
    end; 

Answer 2

Hier abs olute Antwort. Arbeiten an gewinnen 7,8 win10. auch seltsame dünne obere Leiste, die erscheint, sind weg.

(Anmerkung: Vergessen Sie nicht formmain.borderstyle zu bsNone zu setzen;)

protected 
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; 

..

procedure Tfmmain.WMNCHitTest(var Message: TWMNCHitTest); 
const 
    EDGEDETECT = 7; // adjust 
var 
    deltaRect: TRect; 
begin 
    inherited; 
    if BorderStyle = bsNone then 
    with Message, deltaRect do 
    begin 
     Left := XPos - BoundsRect.Left; 
     Right := BoundsRect.Right - XPos; 
     Top := YPos - BoundsRect.Top; 
     Bottom := BoundsRect.Bottom - YPos; 
     if (Top < EDGEDETECT) and (Left < EDGEDETECT) then 
     Result := HTTOPLEFT 
     else if (Top < EDGEDETECT) and (Right < EDGEDETECT) then 
     Result := HTTOPRIGHT 
     else if (Bottom < EDGEDETECT) and (Left < EDGEDETECT) then 
     Result := HTBOTTOMLEFT 
     else if (Bottom < EDGEDETECT) and (Right < EDGEDETECT) then 
     Result := HTBOTTOMRIGHT 
     else if (Top < EDGEDETECT) then 
     Result := HTTOP 
     else if (Left < EDGEDETECT) then 
     Result := HTLEFT 
     else if (Bottom < EDGEDETECT) then 
     Result := HTBOTTOM 
     else if (Right < EDGEDETECT) then 
     Result := HTRIGHT 
    end; 
end;