Изменение размера формы, даже если она без полей - Удалить край скоса

Question

Использование следующего кода для изменения размера формы без полей прекрасно работает:

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;

Но посмотрите на изображение:

Почему сверху есть скос по краю? Любые предложения, чтобы удалить это?

Answer 1

Здесь абсолютный ответ. работает на win 7,8 win10. также странные тонкие верхние панели, которые появляются, исчезли.

(примечание: не забудьте установить для formmain.borderstyle значение bsNone;)

 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;

Answer 2

Добавить 5 панелей

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 3

Этот код создает форму без полей с изменяемым размером и исправляет максимизацию панели задач:

      protected
     procedure CreateParams(var Params: TCreateParams); override;

...

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

procedure TForm1.FormResize(Sender: TObject);
begin
  if WindowState = TWindowState.wsMaximized then begin
    SetWindowLong(Handle,GWL_STYLE,GetWindowLong(Handle,GWL_STYLE) and (not WS_SIZEBOX));
    SetWindowLong(Handle,GWL_EXSTYLE,GetWindowLong(Handle,GWL_EXSTYLE) and (not WS_EX_STATICEDGE));
  end
  else begin
    SetWindowLong(Handle,GWL_STYLE,GetWindowLong(Handle,GWL_STYLE) or WS_SIZEBOX);
    SetWindowLong(Handle,GWL_EXSTYLE,GetWindowLong(Handle,GWL_EXSTYLE) or WS_EX_STATICEDGE);
  end;
end;
    
procedure TForm1.BtnMaximaizeClick(Sender: TObject);
begin
  if WindowState = TWindowState.wsNormal then begin
    WindowState:= TWindowState.wsMaximized;
    SetBounds(Screen.WorkAreaRect.Left, Screen.WorkAreaRect.Top, Screen.WorkAreaRect.Width, Screen.WorkAreaRect.Height);
  end else
    WindowState:= TWindowState.wsNormal;
end;