窗體皮膚實現 - 重繪窗體非客戶區（一）

現在皮膚控件也很多，但每次裝一堆控件，使用又繁瑣。稍微研究一下內部機制，還是比較簡單的。

主要會使用到下面幾個消息

 1 const
    WM_NCUAHDRAWCAPTION = $00AE;
    WM_NCUAHDRAWFRAME = $00AF;

// 繪制非客戶區消息
procedure WMNCPaint(var message: TWMNCPaint); message WM_NCPAINT;
// 在激活程序時需要相應的消息
procedure WMNCActivate(var Message: TMessage); message WM_NCACTIVATE;
// 鼠標按下時需要控制系統響應繪制
procedure WMNCLButtonDown(var Message: TWMNCHitMessage); message WM_NCLBUTTONDOWN;
// 下面這2個消息是Windows內部Bug處理，直接屏蔽處理（winxp下有）
procedure WMNCUAHDrawCaption(var Message: TMessage); message WM_NCUAHDRAWCAPTION;
procedure WMNCUAHDrawFrame(var Message: TMessage); message WM_NCUAHDRAWFRAME;

 

第一步直接覆蓋WM_NCPAINT 消息進行外邊框繪制。

會發現有2個問題：

  1、點擊右上角的系統按鈕區域會出現系統按鈕

  2、當切換程序的時候窗體會恢復默認樣式。

需要處理WM_NCACTIVATE 和 WM_NCLBUTTONDOWN 這兩個消息，解決上面2個問題。

 

如果你是Win7或以上，那么恭喜！埋了個Bug。在WinXP下使用Spy++會出現下面消息

1 <00003> 00140124 S WM_NCHITTEST xPos:557 yPos:182
<00004> 00140124 R WM_NCHITTEST nHittest:HTTOPRIGHT
<00005> 00140124 S WM_SETCURSOR hwnd:00140124 nHittest:HTTOPRIGHT wMouseMsg:WM_MOUSEMOVE
<00006> 00140124 S message:0x00AE [未知] wParam:00001000 lParam:00000000
<00007> 00140124 R message:0x00AE [未知] lResult:00000000
<00008> 00140124 R WM_SETCURSOR fHaltProcessing:True
<00009> 00140124 P WM_NCMOUSEMOVE nHittest:HTTOPRIGHT xPos:557 yPos:182

Message:0x00AE 這個隱秘的消息，會讓系統按鈕重現江湖。網上查了下是Windows的Bug處理。由於是自己控制繪制，所以直接可以丟棄此消息。另外還有個0x00AF的消息也一樣處理。

 

通過上面5個消息，基本實現非客戶區的繪制。現在怎么動都不會出現恢復系統樣式問題。

有全白的是正好切換到記事本，里面沒內容。

 

unit ufrmCaptionToolbar;

interface

uses
  Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Types, Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TTest = class
  strict private const
    WM_NCUAHDRAWCAPTION = $00AE;
    WM_NCUAHDRAWFRAME = $00AF;
  private
    FControl: TWinControl;
    //FFormActive: Boolean;
    FHandled: Boolean;

    function  GetHandle: HWND;
    function GetForm: TCustomForm; inline;

    procedure WMNCPaint(var message: TWMNCPaint); message WM_NCPAINT;
    procedure WMNCActivate(var Message: TMessage); message WM_NCACTIVATE;
    procedure WMNCUAHDrawCaption(var Message: TMessage); message WM_NCUAHDRAWCAPTION;
    procedure WMNCUAHDrawFrame(var Message: TMessage); message WM_NCUAHDRAWFRAME;
    procedure WMNCLButtonDown(var Message: TWMNCHitMessage); message WM_NCLBUTTONDOWN;

    procedure WndProc(var message: TMessage);
  protected
    property Handle: HWND read GetHandle;
    procedure InvalidateNC;
    procedure PaintNC(ARGN: HRGN = 0);
  public
    constructor Create(AOwner: TWinControl);
    property Handled: Boolean read FHandled write FHandled;
    property Control: TWinControl read FControl;
    property Form: TCustomForm read GetForm;
  end;

  TForm11 = class(TForm)
  private
    FTest: TTest;
  protected
    function DoHandleMessage(var message: TMessage): Boolean;
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

var
  Form11: TForm11;

implementation

{$R *.dfm}

{ TForm11 }

constructor TForm11.Create(AOwner: TComponent);
begin
  FTest := TTest.Create(Self);
  inherited;
end;

destructor TForm11.Destroy;
begin
  inherited;
  FreeAndNil(FTest);
end;

function TForm11.DoHandleMessage(var message: TMessage): Boolean;
begin
  FTest.WndProc(message);
  Result := FTest.Handled;
end;

procedure TForm11.WndProc(var Message: TMessage);
begin
  if not DoHandleMessage(Message) then
    inherited;
end;

constructor TTest.Create(AOwner: TWinControl);
begin
  FControl := AOwner;
end;

function TTest.GetForm: TCustomForm;
begin
  Result := TCustomForm(Control);
end;

function TTest.GetHandle: HWND;
begin
  if FControl.HandleAllocated then
    Result := FControl.Handle
  else
    Result := 0;
end;

procedure TTest.InvalidateNC;
begin
  if FControl.HandleAllocated then
    SendMessage(Handle, WM_NCPAINT, 0, 0);
end;

procedure TTest.PaintNC(ARGN: HRGN = 0);
var
  DC: HDC;
  Flags: cardinal;
  hb: HBRUSH;
  P: TPoint;
  r: TRect;
begin
  Flags := DCX_CACHE or DCX_CLIPSIBLINGS or DCX_WINDOW or DCX_VALIDATE;
  if (ARgn = 1) then
    DC := GetDCEx(Handle, 0, Flags)
  else
    DC := GetDCEx(Handle, ARgn, Flags or DCX_INTERSECTRGN);

  if DC <> 0 then
  begin
    P := Point(0, 0);
    Windows.ClientToScreen(Handle, P);
    Windows.GetWindowRect(Handle, R);
    P.X := P.X - R.Left;
    P.Y := P.Y - R.Top;
    Windows.GetClientRect(Handle, R);

    ExcludeClipRect(DC, P.X, P.Y, R.Right - R.Left + P.X, R.Bottom - R.Top + P.Y);

    GetWindowRect(handle, r);
    OffsetRect(R, -R.Left, -R.Top);

    hb := CreateSolidBrush($00bf7b18);
    FillRect(dc, r, hb);
    DeleteObject(hb);

    SelectClipRgn(DC, 0);

    ReleaseDC(Handle, dc);
  end;
end;

procedure TTest.WMNCActivate(var Message: TMessage);
begin
  //FFormActive := Message.WParam > 0;
  Message.Result := 1;
  InvalidateNC;
  Handled := True;
end;

procedure TTest.WMNCLButtonDown(var Message: TWMNCHitMessage);
begin
  inherited;

  if (Message.HitTest = HTCLOSE) or (Message.HitTest = HTMAXBUTTON) or
     (Message.HitTest = HTMINBUTTON) or (Message.HitTest = HTHELP) then
  begin
    //FPressedButton := Message.HitTest;
    InvalidateNC;
    Message.Result := 0;
    Message.Msg := WM_NULL;
    Handled := True;
  end;
end;

procedure TTest.WMNCPaint(var message: TWMNCPaint);
begin
  PaintNC(message.RGN);
  Handled := True;
end;

procedure TTest.WMNCUAHDrawCaption(var Message: TMessage);
begin
  ///  這個消息會在winxp下產生，是內部Bug處理，直接丟棄此消息
  Handled := True;
end;

procedure TTest.WMNCUAHDrawFrame(var Message: TMessage);
begin
  ///  這個消息會在winxp下產生，是內部Bug處理，直接丟棄此消息
  Handled := True;
end;

procedure TTest.WndProc(var message: TMessage);
begin
  FHandled := False;
  Dispatch(message);
end;

end.

 

開發環境：

    XE3

    win7

 

蘑菇房 (moguf.com)