Я также пытался найти решение, чтобы иметь тень DWM и либо без границ, либо с минимальным размером (для 1 пикселя).После некоторых исследований я могу сделать вывод, что такая задача может быть успешно выполнена (я хотел иметь тень вокруг формы, которая имеет минимальные видимые границы).
В приведенном ниже коде показано, как достичь этой цели с минимальным размером кода.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, DwmAPI, Vcl.ExtCtrls, Vcl.Buttons;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
{ Private declarations }
procedure CreateAlphaChannel(ABmpIn: TBitmap; Alpha: Byte);
procedure WndProc(var Message: TMessage); override;
public
{ Public declarations }
Active: Boolean;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Active := false;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Flag: LongInt;
begin
if Active then
Exit;
if HandleAllocated then
begin
Active := true;
Flag := DWMNCRP_ENABLED;
DwmSetWindowAttribute(Handle, DWMWA_ALLOW_NCPAINT, @Flag, SizeOf(Flag));
SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOSENDCHANGING or SWP_FRAMECHANGED);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Flag: LongInt;
begin
if not Active then
Exit;
if HandleAllocated then
begin
Active := false;
Flag := DWMNCRP_DISABLED;
DwmSetWindowAttribute(Handle, DWMWA_ALLOW_NCPAINT, @Flag, SizeOf(Flag));
SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOSENDCHANGING or SWP_DRAWFRAME or SWP_FRAMECHANGED);
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_ERASE or RDW_FRAME);
SendMessage(Handle, WM_NCPAINT, 1, 0);
end;
end;
procedure TForm1.CreateAlphaChannel(ABmpIn: TBitmap; Alpha: Byte);
type
TRGBAQuad = Record
Blue: Byte;
Green: Byte;
Red: Byte;
Alpha: Byte;
end;
const
Max = MaxInt div SizeOf(TRGBAQuad) - 1;
type
PRGBAArray = ^TRGBAArray;
TRGBAArray = Array [0..Max-1] of TRGBAQuad;
var
RowIn: PRGBAArray;
X: Integer;
Y: Integer;
DeltaAlpha: Byte;
begin
if not Assigned(ABmpIn) or (ABmpIn.PixelFormat <> pf32bit) then
Exit;
DeltaAlpha := Trunc(Alpha * (1 / MaxByte));
for Y:=0 to ABmpIn.Height - 1 do
begin
RowIn := ABmpIn.ScanLine[Y];
for X:=0 to ABmpIn.Width - 1 do
begin
RowIn[X].Blue := RowIn[X].Blue * DeltaAlpha;
RowIn[X].Green := RowIn[X].Green * DeltaAlpha;
RowIn[X].Red := RowIn[X].Red * DeltaAlpha;
RowIn[X].Alpha := Alpha;
end;
end;
end;
procedure TForm1.WndProc(var Message: TMessage);
var
Bmp: TBitmap;
R: TRect;
DC: HDC;
AB: TBlendFunction;
SavedDC: Integer;
begin
case Message.Msg of
WM_NCPAINT:
begin
Inherited WndProc(Message);
if Active then
begin
if HandleAllocated then
begin
// Obtain context to draw within
DC := GetWindowDC(Handle);
try
// Prepare bitmap that contains graphical image of borders
Bmp := TBitmap.Create;
Bmp.SetSize(Width, Height);
Bmp.PixelFormat := pf32bit;
try
// Draw on this bitmap something useful (f.e. just fill it with solid color)
Bmp.Canvas.Brush.Color := $467321;
Bmp.Canvas.FillRect(Bmp.Canvas.ClipRect);
// Paint text
Bmp.Canvas.Font.Size := 14;
Bmp.Canvas.Font.Style := [fsBold];
Bmp.Canvas.Font.Color := clWhite;
Bmp.Canvas.TextOut(16, 32, 'Form Shadow');
Bmp.Canvas.Font.Size := 11;
Bmp.Canvas.Font.Style := [];
Bmp.Canvas.TextOut(16, 66, 'built with DWM API');
// IMPORTANT! This routine fills bitmap with alpha
// that needs for AlphaBlend function to properly
// draw our bitmap.
// Just comment CreateAlphaChannel(Bmp, 255) below
// and run the example - you will see what I meant.
CreateAlphaChannel(Bmp, 255);
// Set up special structure to output bitmap respecting its alpha
AB.BlendOp := AC_SRC_OVER;
AB.BlendFlags := 0;
AB.SourceConstantAlpha := 255;
AB.AlphaFormat := AC_SRC_ALPHA;
// Exclude ClientArea of form to avoid its overpainting
R := Rect(1, 1, Width - 1, Height - 1);
SavedDC := SaveDC(DC);
try
ExcludeClipRect(DC, {R.Left,}240, R.Top, R.Right, R.Bottom);
WinAPI.Windows.AlphaBlend(DC, 0, 0, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, AB);
finally
RestoreDC(DC, SavedDC);
end;
finally
Bmp.Free;
end;
finally
ReleaseDC(Handle, DC);
end;
end;
end;
end;
WM_EXITSIZEMOVE, WM_WINDOWPOSCHANGED:
begin
Inherited WndProc(Message);
// Repaint our borders
if Active then
begin
if HandleAllocated then
SendMessage(Handle, WM_NCPAINT, 1, 0);
end;
end;
WM_NCCALCSIZE:
begin
Inherited WndProc(Message);
if Active then
begin
if TWMNCCALCSIZE(Message).CalcValidRects then
begin
// This value at right side (7 and 29) just a size of borders of form under enabled Aero.
// Usually this values should be 8 but without non-client area Aero eefects will not work.
// So we must to leave at least 1 pixel of default NC-area around form.
// IMPORTANT! 29 is a cumulative value of 7 (top border of form) and caption
// height (by default - it is set to 22 px.).
Dec(TWMNCCALCSIZE(Message).CalcSize_Params.rgrc[0].Left, 7);
Inc(TWMNCCALCSIZE(Message).CalcSize_Params.rgrc[0].Right, 7);
Dec(TWMNCCALCSIZE(Message).CalcSize_Params.rgrc[0].Top, 29);
Inc(TWMNCCALCSIZE(Message).CalcSize_Params.rgrc[0].Bottom, 7);
end;
end;
end;
else
Inherited WndProc(Message);
end;
end;
end.
DFM:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 290
ClientWidth = 556
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
DesignSize = (
556
290)
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 330
Top = 250
Width = 97
Height = 32
Caption = 'Apply shadow!'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 433
Top = 250
Width = 113
Height = 32
Caption = 'Return state back!'
TabOrder = 1
OnClick = Button2Click
end
object Panel1: TPanel
Left = 239
Top = 0
Width = 322
Height = 26
Anchors = [akLeft, akTop, akRight]
BevelOuter = bvNone
Color = 4616993
ParentBackground = False
TabOrder = 2
object SpeedButton1: TSpeedButton
Left = 304
Top = 2
Width = 23
Height = 22
Caption = 'X'
OnClick = SpeedButton1Click
end
object SpeedButton2: TSpeedButton
Left = 282
Top = 2
Width = 23
Height = 22
Caption = '?'
end
object SpeedButton3: TSpeedButton
Left = 260
Top = 2
Width = 23
Height = 22
Caption = '_'
end
end
end
Я написал несколько комментариев в коде, чтобы проиллюстрировать моменты, которые я считаю важным знать.Очевидно, что многие из этих комментариев содержат информацию, которая бесполезна, но я попробовал:)
Теперь скомпилируйте пример и нажмите кнопку «Применить тень!»Вы столкнетесь с формой, которая выглядит на изображении ниже:
Выглядит прекрасно, не так ли?Но не будьте слишком быстры - теперь нажмите «Вернуть состояние назад!»и вы увидите очень плохой эффект, такой как на экране ниже:
Действительно, я понятия не имею, что мне следует делать, чтобы избежать этого графического артефакта,Единственный вариант - свернуть и восстановить окно.Это позволяет Windows
правильно рисовать нашу форму, но попробуйте изменить границы восстановленной формы, например с правой стороны.
Вы видите?Если нет, то посмотрите на картинку ниже:
Позвольте мне объяснить эту картинку.
Самая левая красная стрелка показывает, что форма "потеряла" свою подпись.Вторая правая верхняя стрелка подтверждает, что указатель мыши находится над кнопкой Maximize
.Последняя стрелка указывает white space
над NC-областью формы.
Мы можем наблюдать, что NC-область правой стороны окрашена в белый цвет, но мы уже отключили наш механизм рисования, и Windows
- этотеперь рисует область NC.
После некоторых исследований я обнаружил, что есть проблема с вызовом DwmSetWindowAttribute(Handle, DWMWA_ALLOW_NCPAINT, @Flag, SizeOf(Flag))
с Flag
, установленным на DWMNCRP_ENABLED
и в другом обработчике Flag
, установленным на DWMNCRP_DISABLED
.
Вы можете воспроизвести описанную проблему, если стереть весь код внутри WndProc
и оставить только унаследованный обработчик.Теперь запустите программу, активируйте тень, деактивируйте ее и попробуйте снова изменить правую сторону формы.Он снова производит белый цвет над NC-областью правой стороны формы, как было сказано выше.Это единственное (пока) ограничение использования подхода, представленного в этом примере.
PS
Возможно, я был слеп, когда читал вопрос, потому что я отвечаю только на его часть.Проблема с кнопками может быть решена, как описано ниже:
1. Поместите элемент управления TPanel
в форму.
2. Добавьте столько кнопок (или других элементов управления) на TPanel
, сколько вам нужно.
3. Назначьте обработчики этим элементам управления.
4. «Воспроизведение» с помощью TPanel
: из-за исключения границ ЧПУ панель во время разработки должна быть аккуратно размещена, чтобы быть полностью видимой во время выполнения.Предположим, вы не будете часто двигаться TPanel
;Вы должны поместить и заполнить его один раз и оставить его в покое.
Изображение ниже демонстрирует, что я имел в виду:
Вы можете видеть, как размещается TPanel
выглядит хорошо на форме результата с минимальной NC-областью.
После некоторых манипуляций наша форма имеет такой «стиль»:
Попробуйте нажать кнопку «заголовок» с надписью «X».
Если вы хотите «стилизовать» форму более элегантным способом, то вам определенно следует создать компонент (я думаю, невизуальный), который будет играть роль контроллера формы: применяет тень DWM, выделяетTPanel
с кнопками и т. Д. Затем вы должны использовать ловушку, чтобы узнать, была ли создана форма (это полезно, если проект содержит много форм).Для получения дополнительной информации о хуках, пожалуйста, используйте третью ссылку.
Когда вы используете хук, вы будете знать, что форма была создана, и вы сможете выделить экземпляр вашего контроллера в этой форме.Это позволяет вам «стилизовать» любую форму вашего приложения (даже если такая форма была создана программно) «на ходу».
Надеюсь, вы понимаете, что приведенный выше код не является законченным проектом.Существует огромное количество возможностей для добавления новых функций, устранения некоторых ошибок и т. Д. Например, перемещение формы по указателю мыши не реализовано.
И еще одна вещь, которая заслуживает вашего внимания: вы должны проверить, работает ли ваша программа под Windows 7
(по крайней мере), чтобы обеспечить тень.В противном случае при XP
, например, форма вообще не будет иметь тени.И я не знаю, что насчет Win 8
, Win 8.1
, Win 10
(возможно, я что-то пропустил?).На мой взгляд, вам нужно будет протестировать вашу программу под всеми Windows OS
, да, еще одним: я не тестирую этот пример под Windows Vista
.Полагаю, здесь могут быть обнаружены некоторые странные ошибки из-за ранних версий DWM.Но это всего лишь личное мнение.
Полезные ссылки:
Справочник Microsoft по DWM API
Функция AlphaBlend
Функция обратного вызова CBTProc
PSS
Я почти уверен, что в тексте много грамматических ошибок и ошибок, поэтому приношу свои извинения;)