Jesse Newman
Jesse Newman

Reputation: 11

Borderless form with Aero Snap creates white border on top

I'm creating a form with FormBorderStyle set to None.

I am using the following to enable Aero Snapping:

protected override CreateParams CreateParams
{
  get
  {
    CreateParams cp = base.CreateParams;
    {
      cp.Style |= 0x20000 | 0x80000 | 0x40000; //WS_MINIMIZEBOX | WS_SYSMENU | WS_SIZEBOX;
    }
     return cp;
  }
}

This works fine except it creates two issues.

  1. I now have a white border on the top of my form that I cannot remove. screenshot
  2. When I snap the form to the top of the screen, it fills the entire screen, covering the taskbar.

I am definitely a beginner at this so any help would be very much appreciated.

Upvotes: 1

Views: 670

Answers (2)

MohsenB
MohsenB

Reputation: 1921

This is better solution , fix resizable, borderless, top white bar, areo edge snap, full screen size, ... :

type
  TBorderlessForm = class(TForm)
    CustomTitleBar: TPanel;
    procedure CustomTitleBarMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure CustomTitleBarDblClick(Sender: TObject);

  private
    function IsBorderless: Boolean;
    function GetBorderSpace: Integer;

    procedure WM_NCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WM_NCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;

  protected
    procedure Paint; override;
    procedure Resize; override;

  public
  end;

...

function TBorderlessForm.IsBorderless: Boolean;
begin
  Result := BorderStyle in [bsNone, bsToolWindow, bsSizeToolWin];
end;

function TBorderlessForm.GetBorderSpace: Integer;
begin
  case BorderStyle of
    bsSingle:
      Result :=
        GetSystemMetrics(SM_CYFIXEDFRAME);
    bsDialog, bsToolWindow:
      Result :=
        GetSystemMetrics(SM_CYDLGFRAME);
    bsSizeable, bsSizeToolWin:
      Result :=
        GetSystemMetrics(SM_CYSIZEFRAME) +
        GetSystemMetrics(SM_CXPADDEDBORDER);
    else
      Result := 0;
  end;
end;

{ CUSTOM METHODS }

procedure TBorderlessForm.Paint;
begin
  inherited;
  if (WindowState = wsNormal) and (not IsBorderless) then
    begin
      Canvas.Pen.Color := clBlack;
      Canvas.MoveTo(0, 0);
      Canvas.LineTo(Width, 0);
    end;
end;

procedure TBorderlessForm.Resize;
begin
  inherited;
  if (WindowState = wsNormal) and (not IsBorderless) then
    Padding.Top := 1
  else
    Padding.Top := 0;
end;

{ MESSAGES }

procedure TBorderlessForm.WM_NCCalcSize(var Msg: TWMNCCalcSize);
var
  CaptionBarHeight: Integer;
begin
  inherited;
  if BorderStyle = bsNone then exit;

  CaptionBarHeight := GetSystemMetrics(SM_CYCAPTION);
  if WindowState = wsNormal then
    Inc(CaptionBarHeight, GetBorderSpace);

  Dec(Msg.CalcSize_Params.rgrc[0].Top, CaptionBarHeight);
end;

procedure TBorderlessForm.WM_NCHitTest(var Msg: TWMNCHitTest);
var
  ResizeSpace: Integer;
begin
  inherited;
  ResizeSpace := GetBorderSpace;

  if
    (WindowState = wsNormal) and
    (BorderStyle in [bsSizeable, bsSizeToolWin]) and
    (Msg.YPos - BoundsRect.Top <= ResizeSpace)
  then
    begin
      if Msg.XPos - BoundsRect.Left <= 2 * ResizeSpace then
        Msg.Result := HTTOPLEFT
      else if BoundsRect.Right - Msg.XPos <= 2 * ResizeSpace then
        Msg.Result := HTTOPRIGHT
      else
        Msg.Result := HTTOP;
    end;
end;

procedure TBorderlessForm.CustomTitleBarDblClick(Sender: TObject);
begin
  if WindowState = wsNormal then
    WindowState := wsMaximized
  else
    WindowState := wsNormal;
end;

procedure TBorderlessForm.CustomTitleBarMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  Perform(WM_SYSCOMMAND, $F012, 0);
end;

Upvotes: -3

IlcIliaDev
IlcIliaDev

Reputation: 11

For the second point there is a solution. But I have the same problem with the first one. Here is the solution: MaximizedBounds = Screen.FromHandle(Handle).WorkingArea;

Upvotes: 0

Related Questions