现在皮肤控件也很多，但每次装一堆控件，使用又繁琐。稍微研究一下内部机制，还是比较简单的。
主要会使用到下面几个消息
1 const 2 WM_NCUAHDRAWCAPTION = $00AE; 3 WM_NCUAHDRAWFRAME = $00AF; 4 5 // 绘制非客户区消息 6 procedure WMNCPaint(var message: TWMNCPaint); message WM_NCPAINT; 7 // 在激活程序时需要相应的消息 8 procedure WMNCActivate(var Message: TMessage); message WM_NCACTIVATE; 9 // 鼠标按下时需要控制系统响应绘制 10 procedure WMNCLButtonDown(var Message: TWMNCHitMessage); message WM_NCLBUTTONDOWN; 11 // 下面这2个消息是Windows内部Bug处理，直接屏蔽处理（winxp下有） 12 procedure WMNCUAHDrawCaption(var Message: TMessage); message WM_NCUAHDRAWCAPTION; 13 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 2 <00004> 00140124 R WM_NCHITTEST nHittest:HTTOPRIGHT 3 <00005> 00140124 S WM_SETCURSOR hwnd:00140124 nHittest:HTTOPRIGHT wMouseMsg:WM_MOUSEMOVE 4 <00006> 00140124 S message:0x00AE [未知] wParam:00001000 lParam:00000000 5 <00007> 00140124 R message:0x00AE [未知] lResult:00000000 6 <00008> 00140124 R WM_SETCURSOR fHaltProcessing:True 7 <00009> 00140124 P WM_NCMOUSEMOVE nHittest:HTTOPRIGHT xPos:557 yPos:182
Message:0x00AE 这个隐秘的消息，会让系统按钮重现江湖。网上查了下，是Windows的Bug。由于是自己控制绘制，所以直接可以丢弃此消息。另外还有个0x00AF的消息也一样处理。
通过上面5个消息，基本实现非客户区的绘制。现在怎么动都不会出现恢复系统样式我问题。
有全白的是正好切换到记事本，里面没内容。
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.
全部代码
时间： 2024-11-25 18:50:46