RDP1974 40 Posted March 21, 2020 hello,  perhaps somebody knows how to drop the windows 10 aero shadow under a borderless vcl form?  I'm using from MSDN const MARGINS shadow_on = { 0, 0, 0, 0 }; DwmExtendFrameIntoClientArea(hwnd, &shadow_on);  But the DWM compositor wants atleast 1px border in the frame, else don't cast the shadow. So a line with the color of the global theme will be always visible and not accessible bcz border.  Btw. I don't want to use WS_LAYER_EX composited, but normal Delphi vcl form.  Thanks R. Share this post Link to post
Turan Can 3 Posted April 20, 2020 (edited)    if IsActive then SystemParametersInfo(SPI_SETDROPSHADOW, 0, nil, 0);    else    begin   SystemParametersInfo(SPI_SETDROPSHADOW, 0, PChar(''), 0);    end; Edited April 20, 2020 by Turan Can Share this post Link to post
Turan Can 3 Posted April 20, 2020 (edited) unit Unit1; interface uses  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; type  TForm1 = class(TForm)   Edit1: TEdit;   procedure FormCreate(Sender: TObject);   procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);  private   procedure CreateFlatRoundRgn; procedure CreateParams(var Params: TCreateParams); override;   { Private declarations }  public   { Public declarations }  end; var  Form1: TForm1; implementation {$R *.dfm} procedure ExcludeRectRgn(var Rgn: HRGN; LeftRect, TopRect, RightRect, BottomRect: Integer); var  RgnEx: HRGN; begin  RgnEx := CreateRectRgn(LeftRect, TopRect, RightRect, BottomRect);  CombineRgn(Rgn, Rgn, RgnEx, RGN_OR);  DeleteObject(RgnEx); end; procedure TForm1.CreateFlatRoundRgn; const  CORNER_SIZE = 6; var  Rgn: HRGN; begin  with BoundsRect do  begin   Rgn := CreateRoundRectRgn(0, 0, Right - Left + 1, Bottom - Top + 1, CORNER_SIZE, CORNER_SIZE);   // exclude left-bottom corner   ExcludeRectRgn(Rgn, 0, Bottom - Top - CORNER_SIZE div 4, CORNER_SIZE div 4, Bottom - Top + 1);   // exclude right-bottom corner   ExcludeRectRgn(Rgn, Right - Left - CORNER_SIZE div 4, Bottom - Top - CORNER_SIZE div 4, Right - Left , Bottom - Top);  end;  // the operating system owns the region, delete the Rgn only SetWindowRgn fails  if SetWindowRgn(Handle, Rgn, True) = 0 then   DeleteObject(Rgn); end; procedure TForm1.CreateParams(var Params: TCreateParams); const  CS_DROPSHADOW = $00020000; begin  inherited CreateParams(Params);  with Params do  begin   Style := WS_POPUP;   WindowClass.Style := WindowClass.Style or CS_DROPSHADOW;  end; end; procedure TForm1.FormCreate(Sender: TObject); begin  //BorderStyle := bsNone;  CreateFlatRoundRgn; end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin  if Button = mbLeft then  begin   ReleaseCapture;   SendMessage(Self.Handle, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0);  end; end; end.  Edited April 20, 2020 by Turan Can Share this post Link to post
vfbb 299 Posted April 20, 2020 @RDP1974, @Turan Can To get a beatiful shadow, use the DWM API. Â Shadow in borderless form in VCL: unit Unit3; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs; type TForm3 = class(TForm) private { Private declarations } function SetBordelessShadow: Boolean; protected procedure CreateParams(var AParams: TCreateParams); override; procedure CreateWindowHandle(const AParams: TCreateParams); override; procedure WndProc(var AMessage: TMessage); override; public { Public declarations } end; var Form3: TForm3; implementation uses Winapi.DwmApi, Winapi.UxTheme; {$R *.dfm} { TForm3 } procedure TForm3.CreateParams(var AParams: TCreateParams); begin inherited CreateParams(AParams); if TOSVersion.Major < 6 then begin AParams.Style := WS_POPUP; AParams.WindowClass.Style := AParams.WindowClass.Style or CS_DROPSHADOW; end; end; procedure TForm3.CreateWindowHandle(const AParams: TCreateParams); begin inherited; if TOSVersion.Major >= 6 then SetBordelessShadow; end; function TForm3.SetBordelessShadow: Boolean; var LMargins: TMargins; LPolicy: Integer; begin if TOSVersion.Major < 6 then Exit(False); LPolicy := DWMNCRP_ENABLED; Result := Succeeded(DwmSetWindowAttribute(Handle, DWMWA_NCRENDERING_POLICY, @LPolicy, SizeOf(Integer))) and DwmCompositionEnabled; if Result then begin LMargins.cxLeftWidth := 1; LMargins.cxRightWidth := 1; LMargins.cyTopHeight := 1; LMargins.cyBottomHeight := 1; Result := Succeeded(DwmExtendFrameIntoClientArea(Handle, LMargins)); end; end; procedure TForm3.WndProc(var AMessage: TMessage); begin case AMessage.Msg of WM_DWMCOMPOSITIONCHANGED, WM_DWMNCRENDERINGCHANGED: if SetBordelessShadow then begin AMessage.Result := 0; Exit; end; else end; inherited; end; end. Note: You can do the same in FMX! See the difference in the images attached: 1 Share this post Link to post
RDP1974 40 Posted April 20, 2020 thank you, but the problem is the 1px frame of the color of theme title I have read a C++ example that I will try in Delphi, needs a return parameter from paint API where VCL use a procedure without return 😕 Share this post Link to post
Turan Can 3 Posted April 21, 2020 procedure TfmBar1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin  OnBaseMove(Button, Self.Handle); end; procedure TfmBar1.FormPaint(Sender: TObject); begin  OnBasePaint(ClientWidth, ClientHeight, Canvas); end; procedure TfmBar1.FormShow(Sender: TObject); begin  FClSys.OnMenuEvent := MenuEvent;  BorderStyle := bsNone; end; procedure TfmBar1.OnBaseMove(Button: TMouseButton; Handle: HWND); begin  if Button = mbLeft then  begin   ReleaseCapture;   SendMessage(Handle, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0);  end; end; procedure TfmBar1.OnBasePaint(ClientWidth, ClientHeight: Integer; Canvas: TCanvas); var  Rect: TRect; begin  Rect.Left := 0;  Rect.Top := 0;  Rect.Bottom := ClientHeight;  Rect.Right := ClientWidth;  with Canvas do  begin   Pen.Width := 1;    Brush.Color := $00000000;   Pen.Color := $006B6B6B;   Rectangle(0, 0, ClientWidth, ClientHeight);  end; end; Share this post Link to post
RDP1974 40 Posted April 21, 2020 (edited) No, the canvas is inside the external frame.  The solution in plain API is here: https://stackoverflow.com/questions/22165258/how-to-create-window-without-border-and-with-shadow-like-github-app/44489430#44489430  Create window with WS_CAPTION style Call DwmExtendFrameIntoClientArea WDM API passing 1 pixel top margin Handle WM_NCCALCSIZE message, do not forward call to DefWindowProc while processing this message, but just return 0  (https://stackoverflow.com/questions/43818022/borderless-window-with-drop-shadow) Edited April 21, 2020 by RDP1974 Share this post Link to post
vfbb 299 Posted April 21, 2020 36 minutes ago, RDP1974 said: No, the canvas is inside the external frame.  The solution in plain API is here: https://stackoverflow.com/questions/22165258/how-to-create-window-without-border-and-with-shadow-like-github-app/44489430#44489430  Create window with WS_CAPTION style Call DwmExtendFrameIntoClientArea WDM API passing 1 pixel top margin Handle WM_NCCALCSIZE message, do not forward call to DefWindowProc while processing this message, but just return 0  (https://stackoverflow.com/questions/43818022/borderless-window-with-drop-shadow) Roberto, now I undestand your question, but this solution not work for me. I don't know why this line is there, but if it helps you, the same is not happening in FMX applications. The possible solution may be in the units FMX.Platform.Win or FMX.Forms.Border.Win.  Share this post Link to post
vhanla 5 Posted September 6, 2020 type TForm1 = class(TForm) Panel1: TPanel; procedure FormCreate(Sender: TObject); private { Private declarations } procedure WMNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin // to hide white 1px line in top DoubleBuffered := True; Panel1.Align := alClient; Panel1.BevelOuter := TBevelCut.bvNone; Panel1.Caption := ''; // enable DWMApi Shadow GlassFrame.Top := 1; GlassFrame.Enabled := True; end; procedure TForm1.WMNCCalcSize(var Msg: TWMNCCalcSize); begin // to hide caption bar Msg.Msg := WM_NULL; inherited; end; I was playing with this in Windows 10/Rio. I don't know if on other versions requires more adjustments (I guess so), but this was short code to achieve that. Â And it keeps system context menu, aero snap response too. I tried painting canvas to remove the 1 pixel white line at the top, no success, but `doublebuffered` set to true along a component occupying that part was enough. 1 Share this post Link to post