窗体皮肤实现 - 重绘窗体非客户区（一）

  1 unit ufrmCaptionToolbar;
  2 
  3 interface
  4 
  5 uses
  6   Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7   Types, Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
  8 
  9 type
 10   TTest = class
 11   strict private const
 12     WM_NCUAHDRAWCAPTION = $00AE;
 13     WM_NCUAHDRAWFRAME = $00AF;
 14   private
 15     FControl: TWinControl;
 16     //FFormActive: Boolean;
 17     FHandled: Boolean;
 18 
 19     function  GetHandle: HWND;
 20     function GetForm: TCustomForm; inline;
 21 
 22     procedure WMNCPaint(var message: TWMNCPaint); message WM_NCPAINT;
 23     procedure WMNCActivate(var Message: TMessage); message WM_NCACTIVATE;
 24     procedure WMNCUAHDrawCaption(var Message: TMessage); message WM_NCUAHDRAWCAPTION;
 25     procedure WMNCUAHDrawFrame(var Message: TMessage); message WM_NCUAHDRAWFRAME;
 26     procedure WMNCLButtonDown(var Message: TWMNCHitMessage); message WM_NCLBUTTONDOWN;
 27 
 28     procedure WndProc(var message: TMessage);
 29   protected
 30     property Handle: HWND read GetHandle;
 31     procedure InvalidateNC;
 32     procedure PaintNC(ARGN: HRGN = 0);
 33   public
 34     constructor Create(AOwner: TWinControl);
 35     property Handled: Boolean read FHandled write FHandled;
 36     property Control: TWinControl read FControl;
 37     property Form: TCustomForm read GetForm;
 38   end;
 39 
 40   TForm11 = class(TForm)
 41   private
 42     FTest: TTest;
 43   protected
 44     function DoHandleMessage(var message: TMessage): Boolean;
 45     procedure WndProc(var Message: TMessage); override;
 46   public
 47     constructor Create(AOwner: TComponent); override;
 48     destructor Destroy; override;
 49   end;
 50 
 51 var
 52   Form11: TForm11;
 53 
 54 implementation
 55 
 56 {$R *.dfm}
 57 
 58 { TForm11 }
 59 
 60 constructor TForm11.Create(AOwner: TComponent);
 61 begin
 62   FTest := TTest.Create(Self);
 63   inherited;
 64 end;
 65 
 66 destructor TForm11.Destroy;
 67 begin
 68   inherited;
 69   FreeAndNil(FTest);
 70 end;
 71 
 72 function TForm11.DoHandleMessage(var message: TMessage): Boolean;
 73 begin
 74   FTest.WndProc(message);
 75   Result := FTest.Handled;
 76 end;
 77 
 78 procedure TForm11.WndProc(var Message: TMessage);
 79 begin
 80   if not DoHandleMessage(Message) then
 81     inherited;
 82 end;
 83 
 84 constructor TTest.Create(AOwner: TWinControl);
 85 begin
 86   FControl := AOwner;
 87 end;
 88 
 89 function TTest.GetForm: TCustomForm;
 90 begin
 91   Result := TCustomForm(Control);
 92 end;
 93 
 94 function TTest.GetHandle: HWND;
 95 begin
 96   if FControl.HandleAllocated then
 97     Result := FControl.Handle
 98   else
 99     Result := 0;
100 end;
101 
102 procedure TTest.InvalidateNC;
103 begin
104   if FControl.HandleAllocated then
105     SendMessage(Handle, WM_NCPAINT, 1, 0);
106 end;
107 
108 procedure TTest.PaintNC(ARGN: HRGN = 0);
109 var
110   DC: HDC;
111   Flags: cardinal;
112   hb: HBRUSH;
113   P: TPoint;
114   r: TRect;
115 begin
116   Flags := DCX_CACHE or DCX_CLIPSIBLINGS or DCX_WINDOW or DCX_VALIDATE;
117   if (ARgn = 1) then
118     DC := GetDCEx(Handle, 0, Flags)
119   else
120     DC := GetDCEx(Handle, ARgn, Flags or DCX_INTERSECTRGN);
121 
122   if DC <> 0 then
123   begin
124     P := Point(0, 0);
125     Windows.ClientToScreen(Handle, P);
126     Windows.GetWindowRect(Handle, R);
127     P.X := P.X - R.Left;
128     P.Y := P.Y - R.Top;
129     Windows.GetClientRect(Handle, R);
130 
131     ExcludeClipRect(DC, P.X, P.Y, R.Right - R.Left + P.X, R.Bottom - R.Top + P.Y);
132 
133     GetWindowRect(handle, r);
134     OffsetRect(R, -R.Left, -R.Top);
135 
136     hb := CreateSolidBrush($00bf7b18);
137     FillRect(dc, r, hb);
138     DeleteObject(hb);
139 
140     SelectClipRgn(DC, 0);
141 
142     ReleaseDC(Handle, dc);
143   end;
144 end;
145 
146 procedure TTest.WMNCActivate(var Message: TMessage);
147 begin
148   //FFormActive := Message.WParam > 0;
149   Message.Result := 1;
150   InvalidateNC;
151   Handled := True;
152 end;
153 
154 procedure TTest.WMNCLButtonDown(var Message: TWMNCHitMessage);
155 begin
156   inherited;
157 
158   if (Message.HitTest = HTCLOSE) or (Message.HitTest = HTMAXBUTTON) or
159      (Message.HitTest = HTMINBUTTON) or (Message.HitTest = HTHELP) then
160   begin
161     //FPressedButton := Message.HitTest;
162     InvalidateNC;
163     Message.Result := 0;
164     Message.Msg := WM_NULL;
165     Handled := True;
166   end;
167 end;
168 
169 procedure TTest.WMNCPaint(var message: TWMNCPaint);
170 begin
171   PaintNC(message.RGN);
172   Handled := True;
173 end;
174 
175 procedure TTest.WMNCUAHDrawCaption(var Message: TMessage);
176 begin
177   ///  这个消息会在winxp下产生，是内部Bug处理，直接丢弃此消息
178   Handled := True;
179 end;
180 
181 procedure TTest.WMNCUAHDrawFrame(var Message: TMessage);
182 begin
183   ///  这个消息会在winxp下产生，是内部Bug处理，直接丢弃此消息
184   Handled := True;
185 end;
186 
187 procedure TTest.WndProc(var message: TMessage);
188 begin
189   FHandled := False;
190   Dispatch(message);
191 end;
192 
193 end.