DelphiでDWMを使用した非クライアントペインティングの後で、キャプションボタンがマウスのクリックに反応しない

Question

私はデスクトップウィンドウマネージャを使用してアプリケーションの非クライアント領域をペイントしています。

コンパイル後、私のカスタムボタンをクリックできますが、上にカーソルを置いたりクリックしたりすると、デフォルトのキャプションボタン（最小化、最大化、および閉じる）は何もしません。

再描画されたタイトルバーは、ドラッグやダブルクリックに応答します。デフォルトでタイトルバーをダブルクリックすると、フォーム が最大になります。そして、閉じるボタンは、フォームの右の枠の近くのその隅に応答します。

私は追加 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. 

は私になる​​キャプションボタンを引き起こしているものを見つける助けてくださいマウスクリックに反応しません。

Answer 1

WM_NCHITTESTハンドラがHTCAPTIONを返すため、標準ボタンが機能しません。あなたはWindowsに嘘をついて、実際にはマウスがボタンの上にないことを伝えます。継承されたハンドラがMessage.Resultを変更することなく、単に終了し、HTMINBUTTON、HTMAXBUTTON、またはHTCLOSEを返す場合：

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;