2016-10-14 9 views
1

테스트를 위해 새로운 버튼을 추가하여 내 응용 프로그램의 비 클라이언트 영역을 데스크탑 창 관리자의 도움으로 페인팅합니다.Delphi에서 DWM으로 비 클라이언트 페인팅을 한 후에 캡션 버튼이 마우스 클릭에 응답하지 않습니다.

컴파일 한 후 내 사용자 정의 버튼을 클릭 할 수 있지만 기본 캡션 버튼 (최소화, 최대화 및 닫기)은 위에 마우스를 올리거나 클릭 할 때 아무 작업도 수행하지 않습니다.

다시 그리기 된 제목 표시 줄은 끌기 및 두 번 클릭에 응답합니다. 제목 표시 줄을 기본값으로 두 번 클릭하면 양식 이 최대화됩니다. 닫기 버튼은 양식의 오른쪽 테두리 근처의 가장 가까운 모서리에 응답합니다.

내가 추가 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. 

image

날이 될 캡션 버튼의 원인을 찾아 도와주세요 마우스 클릭에 응답하지 않습니다.

+1

참고이 코드는 완전히 NC 영역의 상단면을 제거합니다. 나쁜 일이든 아니든 ...'ClientOrigin.Y'가 폼의'Top'과 동일하다는 것을 알 수 있습니다. –

+0

'message' 지시어가 없으면'CM_TEXTCHANGED' 핸들러가 호출되지 않습니다. –

+0

'message' 지시어를 추가 한 후에, 나는 이전보다 몇 가지 윈도우 동작을 알아 챘습니다. :-) – Blueeyes789

답변

2

WM_NCHITTEST 처리기가 HTCAPTION을 반환하기 때문에 표준 버튼이 작동하지 않습니다. 당신은 마우스가 버튼 위에있을지라도 실제로는 윈도우에 누워 있습니다. 상속 된 핸들러가 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; 
+0

고맙습니다. 매우 많이! 그게 문제를 해결했습니다! – Blueeyes789