现在皮肤控件也很多,但每次装一堆控件,使用又繁琐。稍微研究一下内部机制,还是比较简单的。
主要会使用到下面几个消息
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:1822 <00004> 00140124 R WM_NCHITTEST nHittest:HTTOPRIGHT3 <00005> 00140124 S WM_SETCURSOR hwnd:00140124 nHittest:HTTOPRIGHT wMouseMsg:WM_MOUSEMOVE4 <00006> 00140124 S message:0x00AE [未知] wParam:00001000 lParam:000000005 <00007> 00140124 R message:0x00AE [未知] lResult:000000006 <00008> 00140124 R WM_SETCURSOR fHaltProcessing:True7 <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 begin104 if FControl.HandleAllocated then105 SendMessage(Handle, WM_NCPAINT, 0, 0);106 end;107 108 procedure TTest.PaintNC(ARGN: HRGN = 0);109 var110 DC: HDC;111 Flags: cardinal;112 hb: HBRUSH;113 P: TPoint;114 r: TRect;115 begin116 Flags := DCX_CACHE or DCX_CLIPSIBLINGS or DCX_WINDOW or DCX_VALIDATE;117 if (ARgn = 1) then118 DC := GetDCEx(Handle, 0, Flags)119 else120 DC := GetDCEx(Handle, ARgn, Flags or DCX_INTERSECTRGN);121 122 if DC <> 0 then123 begin124 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 begin148 //FFormActive := Message.WParam > 0;149 Message.Result := 1;150 InvalidateNC;151 Handled := True;152 end;153 154 procedure TTest.WMNCLButtonDown(var Message: TWMNCHitMessage);155 begin156 inherited;157 158 if (Message.HitTest = HTCLOSE) or (Message.HitTest = HTMAXBUTTON) or159 (Message.HitTest = HTMINBUTTON) or (Message.HitTest = HTHELP) then160 begin161 //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 begin171 PaintNC(message.RGN);172 Handled := True;173 end;174 175 procedure TTest.WMNCUAHDrawCaption(var Message: TMessage);176 begin177 /// 这个消息会在winxp下产生,是内部Bug处理,直接丢弃此消息178 Handled := True;179 end;180 181 procedure TTest.WMNCUAHDrawFrame(var Message: TMessage);182 begin183 /// 这个消息会在winxp下产生,是内部Bug处理,直接丢弃此消息184 Handled := True;185 end;186 187 procedure TTest.WndProc(var message: TMessage);188 begin189 FHandled := False;190 Dispatch(message);191 end;192 193 end.
开发环境:
XE3
win7