Delphi Borderless and Captionless Application

I am ready to develop one application in Delphi XE2 without fields and without restrictions, using the following code:

  BorderIcons = []
  BorderStyle = bsNone

But the problem is that there is no menu on the right. Click the application on the taskbar in the same way as in the above image. Then I tried the following codes in the FormShow event, but there is another problem. One border is created on the left side and left side. Codes:

procedure TForm1.FormShow(Sender: TObject);
var
  r: TRect;
begin
  r := ClientRect;
  OffsetRect(r, 0, GetSystemMetrics(SM_CYCAPTION));
  OffsetRect(r, GetSystemMetrics(SM_CXFRAME), GetSystemMetrics(SM_CYFRAME));
  SetWindowRgn(Handle,
  CreateRectRgn(
  r.Left, r.Top,
  ClientWidth + r.Left, ClientHeight + r.Top), True);

end;

Please help me.

+5
source share
4 answers

You can do what David says and / or also watch: SetWindowRgn API .

If you use only SetWindowRgn, you do not need to remove the TForm border, just create a rectangle that starts below.

+2

. , , .

.dfm :

BorderIcons = [biSystemMenu]
BorderStyle = bsNone

FormShow - .

, , - . .

, .dfm:

BorderIcons = []
BorderStyle = bsNone

, CreateParams:

TForm1 = class(TForm)
protected
  procedure CreateParams(var Params: TCreateParams); override;
end;
...
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style := Params.Style or WS_SYSMENU;
end;
+7
procedure TForm1.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  SetWindowLong(Handle, GWL_STYLE, 
      WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or WS_SYSMENU);
  SetWindowLong(Handle, GWL_EXSTYLE, WS_EX_CONTROLPARENT or WS_EX_APPWINDOW);
end;

OnShow .

( OnCreate), (, WS_VISIBLE , ),

, , CreateParams ( VCL). . - OI , :

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

..

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style := WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or WS_SYSMENU;
  Params.ExStyle := WS_EX_CONTROLPARENT or WS_EX_APPWINDOW;
end;
+5

, , :

. :

unit ncUnit1;

interface

// XE2 uses clause
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,      
  Vcl.Graphics,   Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
// If you're not using XE2 take out the prefixes (WinApi, Vcl, System, etc)

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  protected
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    procedure SolidColorNcPaint(solidColor,frameColor:TColor);
    procedure Resizing(State: TWindowState); override;


  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.WMNCPaint(var Message: TWMNCPaint);
begin
  SolidColorNcPaint(clBtnFace,clBtnFace);
end;

procedure TForm1.Resizing(State: TWindowState);
begin
  inherited;
  PostMessage(Self.Handle,WM_NCPAINT,0,0); {force initial paint}
end;

procedure TForm1.SolidColorNcPaint(solidColor,frameColor:TColor);
var
 aBorder:Integer;
 ahdc : HDC;
begin
 aBorder := GetSystemMetrics(SM_CYSIZEFRAME);
 canvas.Lock;
 ahdc := GetWindowDC(Handle);
 canvas.Handle := ahdc;
 ExcludeClipRect(canvas.Handle, aBorder, 0, Width-aBorder, Height - aBorder) ;
 Canvas.Brush.Style := bsSolid;
 Canvas.Brush.Color := frameColor;
 Canvas.Pen.Color := solidColor;
 Canvas.Rectangle( 0,0, Width,Height);
 ReleaseDC(Self.Handle, ahdc);
 canvas.Handle := 0;
 canvas.Unlock;
end;


end.

, , , , . , , , , . "", , , . FormStyle=fsDialog , ( , ). , , , .

+3

All Articles