Кнопки с надписью не реагируют на щелчки мышью после того, как не-клиентская картина с DWM в Delphi

Question

Я рисую неклиентскую область приложения с помощью Desktop Window Manager, добавляя новую кнопку для тестирования.

После компиляции моя пользовательская кнопка доступна по клику, но кнопки заголовка по умолчанию (сворачивание, максимизация и закрытие) ничего не делают, когда я навис над ними или нажимаю на них.

Перекрашенная строка заголовка отвечает на перетаскивание и двойное нажатие. Форма максимизирует, когда я по умолчанию дважды щелкаю по заголовку. Кнопка «Закрыть» отвечает на самый угол ее возле правой границы формы.

Я написал мою процедуру рисования, как описано в this post.

новые коды, которые я добавил:

unit Unit1; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, ImgList, Buttons; 

type 
    TForm1 = class(TForm) 
    ImageList1: TImageList; 
    SpeedButton1: TSpeedButton; 
    function GetSysIconRect: TRect; 
    procedure PaintWindow(DC: HDC); 
    procedure InvalidateTitleBar; 
    procedure FormCreate(Sender: TObject); 
    procedure WndProc(var Message: TMessage); 
    procedure FormPaint(Sender: TObject); 
    procedure SpeedButton1Click(Sender: TObject); 
    protected 
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; 
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; 
    procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE; 
    procedure CMTextChanged(var Message: TMessage); 
    procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING; 
    procedure WMNCRButtonUp(var Message: TWMNCRButtonUp); message WM_NCRBUTTONUP; 
    private 
    { Private declarations } 
    FWndFrameSize: Integer; 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

uses 
    DWMAPI, CommCtrl, Themes, UXTheme, StdCtrls; 

{$R *.dfm} 

{$IF not Declared(UnicodeString)} 
type 
    UnicodeString = WideString; 
{$IFEND} 

procedure DrawGlassCaption(Form: TForm; const Text: UnicodeString; 
    Color: TColor; var R: TRect; HorzAlignment: TAlignment = taLeftJustify; 
    VertAlignment: TTextLayout = tlCenter; ShowAccel: Boolean = False); overload; 
const 
    BasicFormat = DT_SINGLELINE or DT_END_ELLIPSIS; 
    HorzFormat: array[TAlignment] of UINT = (DT_LEFT, DT_RIGHT, DT_CENTER); 
    VertFormat: array[TTextLayout] of UINT = (DT_TOP, DT_VCENTER, DT_BOTTOM); 
    AccelFormat: array[Boolean] of UINT = (DT_NOPREFIX, 0); 
var 
    DTTOpts: TDTTOpts; 
    Element: TThemedWindow; 
    IsVistaAndMaximized: Boolean; 
    NCM: TNonClientMetrics; 
    ThemeData: HTHEME; 

    procedure DoTextOut; 
    begin 
    with ThemeServices.GetElementDetails(Element) do 
     DrawThemeTextEx(ThemeData, Form.Canvas.Handle, Part, State, PWideChar(Text), 
     Length(Text), BasicFormat or AccelFormat[ShowAccel] or 
     HorzFormat[HorzAlignment] or VertFormat[VertAlignment], @R, DTTOpts); 
    end; 

begin 
    if Color = clNone then Exit; 
    IsVistaAndMaximized := (Form.WindowState = wsMaximized) and 
    (Win32MajorVersion = 6) and (Win32MinorVersion = 0); 
    ThemeData := OpenThemeData(0, 'CompositedWindow::Window'); 
    Assert(ThemeData <> 0, SysErrorMessage(GetLastError)); 
    Try 
    NCM.cbSize := SizeOf(NCM); 
    if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCM, 0) then 
     if Form.BorderStyle in [bsToolWindow, bsSizeToolWin] then 
     Form.Canvas.Font.Handle := CreateFontIndirect(NCM.lfSmCaptionFont) 
     else 
     Form.Canvas.Font.Handle := CreateFontIndirect(NCM.lfCaptionFont); 
    ZeroMemory(@DTTOpts, SizeOf(DTTOpts)); 
    DTTOpts.dwSize := SizeOf(DTTOpts); 
    DTTOpts.dwFlags := DTT_COMPOSITED or DTT_TEXTCOLOR; 
    if Color <> clDefault then 
     DTTOpts.crText := ColorToRGB(Color) 
    else if IsVistaAndMaximized then 
     DTTOpts.dwFlags := DTTOpts.dwFlags and not DTT_TEXTCOLOR 
    else if Form.Active then 
     DTTOpts.crText := GetSysColor(COLOR_CAPTIONTEXT) 
    else 
     DTTOpts.crText := GetSysColor(COLOR_INACTIVECAPTIONTEXT); 
    if not IsVistaAndMaximized then 
    begin 
     DTTOpts.dwFlags := DTTOpts.dwFlags or DTT_GLOWSIZE; 
     DTTOpts.iGlowSize := 15; 
    end; 
    if Form.WindowState = wsMaximized then 
     if Form.Active then 
     Element := twMaxCaptionActive 
     else 
     Element := twMaxCaptionInactive 
    else if Form.BorderStyle in [bsToolWindow, bsSizeToolWin] then 
     if Form.Active then 
     Element := twSmallCaptionActive 
     else 
     Element := twSmallCaptionInactive 
    else 
     if Form.Active then 
     Element := twCaptionActive 
     else 
     Element := twCaptionInactive; 
    DoTextOut; 
    if IsVistaAndMaximized then DoTextOut; 
    Finally 
    CloseThemeData(ThemeData); 
    end; 
end; 

function GetDwmBorderIconsRect(Form: TForm): TRect; 
begin 
    if DwmGetWindowAttribute(Form.Handle, DWMWA_CAPTION_BUTTON_BOUNDS, @Result, SizeOf(Result)) <> S_OK then SetRectEmpty(Result); 
end; 

procedure DrawGlassCaption(Form: TForm; var R: TRect; 
    HorzAlignment: TAlignment = taLeftJustify; VertAlignment: TTextLayout = tlCenter; 
    ShowAccel: Boolean = False); overload; 
begin 
    DrawGlassCaption(Form, Form.Caption, clDefault, R, 
    HorzAlignment, VertAlignment, ShowAccel); 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
var 
    R: TRect; 
begin 
    if DwmCompositionEnabled then 
    begin 
    SetRectEmpty(R); 
    AdjustWindowRectEx(R, GetWindowLong(Handle, GWL_STYLE), False, 
     GetWindowLong(Handle, GWL_EXSTYLE)); 
    FWndFrameSize := R.Right; 
    GlassFrame.Top := -R.Top; 
    GlassFrame.Enabled := True; 
    SetWindowPos(Handle, 0, Left, Top, Width, Height, SWP_FRAMECHANGED); 
    DoubleBuffered := True; 
    end; 
end; 

procedure TForm1.InvalidateTitleBar; 
var 
    R: TRect; 
begin 
    if not HandleAllocated then Exit; 
    R.Left := 0; 
    R.Top := 0; 
    R.Right := Width; 
    R.Bottom := GlassFrame.Top; 
    InvalidateRect(Handle, @R, False); 
end; 

procedure TForm1.CMTextChanged(var Message: TMessage); 
begin 
    inherited; 
    InvalidateTitleBar; 
end; 

procedure TForm1.WMActivate(var Message: TWMActivate); 
begin 
    inherited; 
    InvalidateTitleBar; 
end; 

procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest); 
var 
    ClientPos: TPoint; 
    IconRect: TRect; 
begin 
    inherited; 
    if not GlassFrame.Enabled then Exit; 
    case Message.Result of 
    HTCLIENT: 
    HTMINBUTTON, HTMAXBUTTON, HTCLOSE: 
    begin 
     Message.Result := HTCAPTION; 
     Exit; 
    end; 
    else 
    Exit; 
    end; 
    ClientPos := ScreenToClient(Point(Message.XPos, Message.YPos)); 
    if ClientPos.Y > GlassFrame.Top then Exit; 
    if ControlAtPos(ClientPos, True) <> nil then Exit; 
    IconRect := GetSysIconRect; 
    if (ClientPos.X < IconRect.Right) and ((WindowState = wsMaximized) or 
    ((ClientPos.Y >= IconRect.Top) and (ClientPos.Y < IconRect.Bottom))) then 
    Message.Result := HTSYSMENU 
    else if ClientPos.Y < FWndFrameSize then 
    Message.Result := HTTOP 
    else 
    Message.Result := HTCAPTION; 
end; 

procedure ShowSystemMenu(Form: TForm; const Message: TWMNCRButtonUp); 
var 
    Cmd: WPARAM; 
    Menu: HMENU; 

    procedure UpdateItem(ID: UINT; Enable: Boolean; MakeDefaultIfEnabled: Boolean = False); 
    const 
    Flags: array[Boolean] of UINT = (MF_GRAYED, MF_ENABLED); 
    begin 
    EnableMenuItem(Menu, ID, MF_BYCOMMAND or Flags[Enable]); 
    if MakeDefaultIfEnabled and Enable then 
     SetMenuDefaultItem(Menu, ID, MF_BYCOMMAND); 
    end; 

begin 
    Menu := GetSystemMenu(Form.Handle, False); 
    if Form.BorderStyle in [bsSingle, bsSizeable, bsToolWindow, bsSizeToolWin] then 
    begin 
    SetMenuDefaultItem(Menu, UINT(-1), 0); 
    UpdateItem(SC_RESTORE, Form.WindowState <> wsNormal, True); 
    UpdateItem(SC_MOVE, Form.WindowState <> wsMaximized); 
    UpdateItem(SC_SIZE, (Form.WindowState <> wsMaximized) and 
     (Form.BorderStyle in [bsSizeable, bsSizeToolWin])); 
    UpdateItem(SC_MINIMIZE, (biMinimize in Form.BorderIcons) and 
     (Form.BorderStyle in [bsSingle, bsSizeable])); 
    UpdateItem(SC_MAXIMIZE, (biMaximize in Form.BorderIcons) and 
     (Form.BorderStyle in [bsSingle, bsSizeable]) and 
     (Form.WindowState <> wsMaximized), True); 
    end; 
    if Message.HitTest = HTSYSMENU then 
    SetMenuDefaultItem(Menu, SC_CLOSE, MF_BYCOMMAND); 
    Cmd := WPARAM(TrackPopupMenu(Menu, TPM_RETURNCMD or 
    GetSystemMetrics(SM_MENUDROPALIGNMENT), Message.XCursor, 
    Message.YCursor, 0, Form.Handle, nil)); 
    PostMessage(Form.Handle, WM_SYSCOMMAND, Cmd, 0) 
end; 

procedure TForm1.WMWindowPosChanging(var Message: TWMWindowPosChanging); 
const 
    SWP_STATECHANGED = $8000; 
begin 
    if GlassFrame.Enabled then 
    if (Message.WindowPos.flags and SWP_STATECHANGED) = SWP_STATECHANGED then 
     Invalidate 
    else 
     InvalidateTitleBar; 
    inherited; 
end; 

procedure TForm1.WMNCRButtonUp(var Message: TWMNCRButtonUp); 
begin 
    if not GlassFrame.Enabled or not (biSystemMenu in BorderIcons) then 
    inherited 
    else 
    case Message.HitTest of 
     HTCAPTION, HTSYSMENU: ShowSystemMenu(Self, Message); 
    else 
     inherited; 
    end; 
end; 

procedure TForm1.WndProc(var Message: TMessage); 
begin 
    if GlassFrame.Enabled and HandleAllocated and DwmDefWindowProc(Handle, 
    Message.Msg, Message.WParam, Message.LParam, Message.Result) then 
    Exit; 
    inherited; 
end; 

procedure TForm1.PaintWindow(DC: HDC); 
begin 
    with GetClientRect do 
    ExcludeClipRect(DC, 0, GlassFrame.Top, Right, Bottom); 
    inherited; 
end; 

procedure TForm1.SpeedButton1Click(Sender: TObject); 
begin 
    Close; 
end; 

procedure TForm1.FormPaint(Sender: TObject); 
var 
    IconHandle: HICON; 
    R: TRect; 
begin 
    if ImageList1.Count = 0 then 
    begin 
    ImageList1.Width := GetSystemMetrics(SM_CXSMICON); 
    ImageList1.Height := GetSystemMetrics(SM_CYSMICON); 
    {$IF NOT DECLARED(TColorDepth)} 
    ImageList1.Handle := ImageList_Create(ImageList1.Width, 
     ImageList1.Height, ILC_COLOR32 or ILC_MASK, 1, 1); 
    {$IFEND} 
    IconHandle := Icon.Handle; 
    if IconHandle = 0 then IconHandle := Application.Icon.Handle; 
    ImageList_AddIcon(ImageList1.Handle, IconHandle); 
    end; 
    R := GetSysIconRect; 
    ImageList1.Draw(Canvas, R.Left, R.Top, 0); 
    R.Left := R.Right + FWndFrameSize - 3; 
    if WindowState = wsMaximized then 
    R.Top := FWndFrameSize 
    else 
    R.Top := 0; 
    R.Right := GetDwmBorderIconsRect(Self).Left - FWndFrameSize - 1; 
    R.Bottom := GlassFrame.Top; 
    DrawGlassCaption(Self, R); 
end; 

function TForm1.GetSysIconRect: TRect; 
begin 
    if not (biSystemMenu in BorderIcons) or not (BorderStyle in [bsSingle, bsSizeable]) then 
    SetRectEmpty(Result) 
    else 
    begin 
    Result.Left := 0; 
    Result.Right := GetSystemMetrics(SM_CXSMICON); 
    Result.Bottom := GetSystemMetrics(SM_CYSMICON); 
    if WindowState = wsMaximized then 
     Result.Top := GlassFrame.Top - Result.Bottom - 2 
    else 
     Result.Top := 6; 
    Inc(Result.Bottom, Result.Top); 
    end; 
end; 

procedure TForm1.WMNCCalcSize(var Message: TWMNCCalcSize); 
begin 
    if not GlassFrame.Enabled then 
    inherited 
    else 
    with Message.CalcSize_Params.rgrc[0] do 
    begin 
     Inc(Left, FWndFrameSize); 
     Dec(Right, FWndFrameSize); 
     Dec(Bottom, FWndFrameSize); 
    end; 
end; 

end. 

Пожалуйста, помогите мне найти то, что вызывает Caption кнопки, чтобы стать не реагирует на щелчки мыши.

Answer 1

Стандартные кнопки не работают, потому что ваш WM_NCHITTEST обработчик возвращает HTCAPTION для них. Вы лжете Windows, говоря, что мышь не над кнопками, даже если это действительно так. Если унаследованный обработчик возвращает HTMINBUTTON, HTMAXBUTTON или HTCLOSE, просто выйти без изменения Message.Result:

procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest); 
var 
    ClientPos: TPoint; 
    IconRect: TRect; 
begin 
    inherited; 
    if not GlassFrame.Enabled then Exit; 
    case Message.Result of 
    HTCLIENT: 
    HTMINBUTTON, HTMAXBUTTON, HTCLOSE: 
    begin 
     //Message.Result := HTCAPTION; // <-- here 
     Exit; 
    end; 
    else 
    Exit; 
    end; 
    ... 
end;