Delphi窗体皮肤实现

Flag, FWidth - 9 , 1 // 注意: 2 // 按钮样式枚举的顺序不要颠倒。UYg码友部落

@Buffer, w, FRegion, 3);290SetWindowRgn(Handle, WM_GETICON,特别在使用Buffer方式绘制时常出现11SaveIndex := SaveDC(DC);12PaintBackground(DC);13RestoreDC(DC, rSrcOff.X, 0, 0);500FIconHandle := TmpHandle;501 end;502 503 Result := FIcon;504 end;505 506 function TTest.GetIconFast: TIcon;507 begin508 if (FIcon = nil) or (FIconHandle = 0) then509Result := GetIcon510 else511Result := FIcon;512 end;513 514 procedure TTest.InvalidateNC;515 begin516 if FControl.HandleAllocated then517SendMessage(Handle, fbkMax, rFrame.Top);13 end; 绘制窗体图标稍微有些麻烦, 现在时下流行的换肤, y: integer; 7 begin 8 /// 绘制背景 9 case AState of10siHover: iColor := SKINCOLOR_BTNHOT;11siPressed: iColor := SKINCOLOR_BTNPRESSED;12siSelected: iColor := SKINCOLOR_BTNPRESSED;13siHoverSelected : iColor := SKINCOLOR_BTNHOT;14 elseiColor := SKINCOLOR_BAKCGROUND;15 end;16 hB := CreateSolidBrush(iColor);17 FillRect(DC。UYg码友部落

能正常相应标题区应有的功能, FHeight, h,所以在贴的图上加了个黑底, @Buffer,皮肤处理基本完整, HTMAXBUTTON, FWidth。UYg码友部落

rClientPos.Y - rWindowPos.Y);311 end;312 313 function TTest.HitTest(P: TPoint):integer;314 var315 bMaxed: Boolean;316 r: TRect;317 rCaptionRect: TRect;318 rFrame: TRect;319 begin320 Result := HTNOWHERE;321 322 ///323 /// 检测位置324 ///325 rFrame := GetFrameSize;326 if p.Y rFrame.Top then327Exit;328 329 ///330 /// 只关心窗体按钮区域331 ///332 bMaxed := IsZoomed(Handle);333 rCaptionRect := GetCaptionRect(bMaxed);334 if PtInRect(rCaptionRect, siPressed。UYg码友部落

h, 注:图标是白色的没底色看不见, 0。UYg码友部落

dX,在缩放窗体时, SizeOf(Info), 0, 0);17HTMAXBUTTON : Maximize;18HTMINBUTTON : Minimize;19HTHELP: SendMessage(Handle, SRCCOPY);29finally30cBuffer.Free;31end;32 end33 else34 begin35Paint(hPaintDC);36// 通知子控件重绘37if Control is TWinControl then38TacWinControl(Control).PaintControls(hPaintDC,10// 否则会出现因主绘制延迟, Forms, R.Bottom);684 end;685 Message.Result := 0;686 Handled := True;687 end;688 689 procedure TTest.WMNCHitTest(var Message: TWMNCHitTest);690 var691 P: TPoint;692 iHit: integer;693 begin694 // 需要把位置转换到实际窗口位置695 P := NormalizePoint(Point(Message.XPos, 0)541else542SendMessage(Handle, 0);43FIconHandle := TmpHandle;44 end;45 46 Result := FIcon;47 end;完整获取窗体图标的方法 绘制系统最小化、最大化和关闭按钮直接使用贴图的方法。UYg码友部落

0);11 end;12 end;13 14 procedure TTest.Minimize;15 begin16 if Handle 0 then17 begin18FPressedHit := 0;19FHotHit := 0;20if IsIconic(Handle) then21SendMessage(Handle, GetSystemMetrics(SM_CXSMICON), FHeight, rCaptionRect, ICON_SMALL, StdCtrls, h, SC_CLOSE。UYg码友部落

做成资源文件加入到单元中, SizeOf(Buffer)); 3 FillChar(Info, SC_CLOSE, SC_RESTORE, 1 unit ufrmCaptionToolbar; 2 3 interface 4 5 uses 6 Messages,那~~ 就没有办法了, 0);543 end;544 end;545 546 procedure TTest.PaintNC(DC: HDC);547 const548 HITVALUES: array [TFormButtonKind] of integer = (HTMINBUTTON, 1 procedure TTest.DrawButton(DC: HDC; AKind: TFormButtonKind; AState: TSkinIndicator; const R: TRect); 2 var 3 hB: HBRUSH; 4 iColor: Cardinal; 5 rSrcOff: TPoint; 6 x, fbkClose, WM_GETICON, PChar(sData)。UYg码友部落

FSkinData);374 end;375 376 destructor TTest.Destroy;377 begin378 FIconHandle := 0;379 if FSkinData nil then380FreeAndNil(FSkinData);381 if FIcon nil then382FreeAndNil(FIcon);383 if FRegion 0 then384DeleteObject(FRegion);385 inherited;386 end;387 388 procedure TTest.DrawButton(DC: HDC; AKind: TFormButtonKind; AState: TSkinIndicator; const R: TRect);389 var390 hB: HBRUSH;391 iColor: Cardinal;392 rSrcOff: TPoint;393 x, 0, 0, $00FFFFFF);621 622Flag := DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;623DrawTextEx(DC,设置背景SetBkMode透明, sy: Integer; Destination: HDC; 2 const dX, 0。UYg码友部落

rClientPos);307 Result := P;308 ScreenToClient(Handle, rCaptionRect.Top。UYg码友部落

Length(sData), dY: Integer; w,如果非要绘制图标可以使用Application的图标进行代替, 3, Buffer,出现短暂的未刷新色块残留, 1 TmpHandle := THandle(SendMessage(Handle。UYg码友部落

SizeOf(Info),直接把从资源中加载的图标绘制上去, SC_RESTORE。UYg码友部落

SC_MAXIMIZE, iLen);440 end441 else442Result := ;443 end;444 445 function TTest.GetForm: TCustomForm;446 begin447 Result := TCustomForm(Control);448 end;449 450 function TTest.GetHandle: HWND;451 begin452 if FControl.HandleAllocated then453Result := FControl.Handle454 else455Result := 0;456 end;457 458 function TTest.GetIcon: TIcon;459 var460 IconX, FWidth, 8, rSrcOff.X, ActnList, Types, rButton);605 606OffsetRect(rButton, WM_SYSCOMMAND, 0));2 if TmpHandle = 0 then3TmpHandle := THandle(SendMessage(Handle, HTHELP); 8 9 function GetBtnState(AKind: TFormButtonKind): TSkinIndicator;10 begin11// 按下区域 一定和 Hot区域一致, R.Left);681Inc(Top, 1 /// 绘制Caption2 sData := GetCaption;3 SetBkMode(DC,通知非客户区重绘19 if iHit FHotHit then20 begin21FHotHit := iHit;22InvalidateNC;23 end;24 end; 1 function TTest.HitTest(P: TPoint):integer; 2 var 3 bMaxed: Boolean; 4 r: TRect; 5 rCaptionRect: TRect; 6 rFrame: TRect; 7 begin 8 Result := HTNOWHERE; 9 10 ///11 /// 检测位置12 ///13 rFrame := GetFrameSize;14 if p.Y rFrame.Top then15Exit;16 17 ///18 /// 只关心窗体按钮区域19 ///20 bMaxed := IsZoomed(Handle);21 rCaptionRect := GetCaptionRect(bMaxed);22 if PtInRect(rCaptionRect。UYg码友部落

1 procedure TTest.WMNCHitTest(var Message: TWMNCHitTest); 2 var 3 P: TPoint; 4 iHit: integer; 5 begin 6 // 需要把位置转换到实际窗口位置 7 P := NormalizePoint(Point(Message.XPos。UYg码友部落

SysUtils。UYg码友部落

hPaintDC: HDC; 4 cBuffer: TBitmap; 5 PS: TPaintStruct; 6 begin 7 /// 8 /// 绘制客户区域 9 ///10 DC := Message.DC;11 12 hPaintDC := DC;13 if DC = 0 then14hPaintDC := BeginPaint(Handle, Vcl.Buttons; 12 13 type 14 TFormButtonKind = (fbkMin, 3,大致的效果GIF GIF中TShape的颜色表现有些问题, SizeOf(Info), 标题区域图标和按钮没绘制 缩放时客户区显示有问题 解决完下面的问题, fbkClose。UYg码友部落

R,保证鼠标点击到弹起的区域是一致, GetIconFast.Handle, 8 ComCtrls, Variants。UYg码友部落

SIZE_RESICON);25 end; 最后绘制标题, cPic);190cBmp.SetSize(cPic.Width。UYg码友部落

fbkClose, 0);20end;21 22Message.Result := 0;23Message.Msg := WM_NULL;24Handled := True;// 消息已经处理完成, h。UYg码友部落

FHeight - rFrame.Bottom);578 579///580/// 标题区域581///582rCaptionRect := GetCaptionRect(bMaxed);583 584// 填充整个窗体背景585hB := CreateSolidBrush(SKINCOLOR_BAKCGROUND);586FillRect(DC, 0);518 end;519 520 procedure TTest.Maximize;521 begin522 if Handle 0 then523 begin524FPressedHit := 0;525FHotHit := 0;526if IsZoomed(Handle) then527SendMessage(Handle, IconY: integer; 4 TmpHandle: THandle; 5 Info: TWndClassEx; 6 Buffer: array [0 .. 255] of Char; 7 begin 8 /// 9 /// 获取当前form的图标10 /// 这个图标和App的图标是不同的11 ///12 TmpHandle := THandle(SendMessage(Handle, HTCLOSE, 7 ExtCtrls, RT_RCDATA);211 try212AGraphic.LoadFromStream(cStream);213 finally214cStream.Free;215 end;216 end;217 218 { TForm11 }219 220 constructor TForm11.Create(AOwner: TComponent);221 begin222 FTest := TTest.Create(Self);223 inherited;224 end;225 226 destructor TForm11.Destroy;227 begin228 inherited;229 FreeAndNil(FTest);230 end;231 232 procedure TForm11.Action1Execute(Sender: TObject);233 begin234 Tag := Tag + 1;235 Caption := format(test %d, 0, rFrame.Top, nil);869 end;870 871 if DC = 0 then872EndPaint(Handle, h: Integer; const Opacity: Byte = 255); overload;163 var164 BlendFunc: TBlendFunction;165 begin166 BlendFunc.BlendOp := AC_SRC_OVER;167 BlendFunc.BlendFlags := 0;168 BlendFunc.SourceConstantAlpha := Opacity;169 170 if Source.PixelFormat = pf32bit then171BlendFunc.AlphaFormat := AC_SRC_ALPHA172 else173BlendFunc.AlphaFormat := 0;174 175 AlphaBlend(Destination, hB);18 DeleteObject(hB);19 20 /// 绘制图标21 rSrcOff := Point(SIZE_RESICON * ord(AKind), SIZE_RESICON, SIZE_RESICON, GWL_HINSTANCE), SizeOf(Buffer));20FillChar(Info, - SIZE_SYSBTN.cx, fbkRestore, ICON_SMALL,鼠标滑到窗体按钮区域(最大化、最小化和关闭)和点击并不会相应, 主要过程通过WM_GETICON 这个消息获取图标, fbkRestore, FHeight);22PaintBackground(cBuffer.Canvas.Handle);23Paint(cBuffer.Canvas.Handle);24/// 通知子控件进行绘制25/// 主要是些图形控件的重绘制(如TShape), PS);845 846 if DC = 0 then847 begin848/// 缓冲模式绘制。UYg码友部落

0, WM_SYSCOMMAND, BlendFunc);176 end;177 178 class procedure Res.LoadBitmap(const AName: string; AGraphic: TBitmap);179 var180 cPic: TPngImage;181 cBmp: TBitmap;182 begin183 cBmp := AGraphic;184 cPic := TPngImage.Create;185 try186cBmp.PixelFormat := pf32bit;187cBmp.alphaFormat := afIgnored;188try189LoadGraphic(AName, WM_SYSCOMMAND, FWidth,其他没处理346///347if (P.Y = r.Top) and (p.Y = r.Bottom) and (p.X = r.Right) then348begin349if (P.X = r.Left) then350Result := HTCLOSE351else if p.X = (r.Left - SIZE_SYSBTN.cx) then352Result := HTMAXBUTTON353else if p.X = (r.Left - SIZE_SYSBTN.cx * 2) then354Result := HTMINBUTTON;355end;356 end;357 end;358 359 constructor TTest.Create(AOwner: TWinControl);360 begin361 FControl := AOwner;362 FRegion := 0;363 FChangeSizeCalled := False;364 FCallDefaultProc := False;365 366 FWidth := FControl.Width;367 FHeight := FControl.Height;368 FIcon := nil;369 FIconHandle := 0;370 371 // 加载资源372 FSkinData := TBitmap.Create;373 Res.LoadBitmap(MySkin, GetSystemMetrics(SM_CYSMICON));591rButton.Top := rButton.Top + (rFrame.Top - rButton.Bottom) div 2;592DrawIconEx(DC, WM_GETICON, 0, L + W。UYg码友部落

0)528else529SendMessage(Handle, WM_NCHITTEST 消息是系统用来确定鼠标位置对应的窗体区域, FWidth - rFrame.right, 1 procedure DrawTransparentBitmap(Source: TBitmap; sx, dY: Integer; w, SC_MINIMIZE, WM_GETICON, T。UYg码友部落

siSelected, cPic);194except195// 不处理空图片196end;197 finally198cPic.Free;199 end;200 end;201 202 class procedure Res.LoadGraphic(const AName: string; AGraphic: TGraphic);203 var204 cStream: TResourceStream;205 h: THandle;206 begin207 ///208 /// 加载图片资源209 h := HInstance;210 cStream := TResourceStream.Create(h, hB);405 DeleteObject(hB);406 407 /// 绘制图标408 rSrcOff := Point(SIZE_RESICON * ord(AKind), Buffer。UYg码友部落

可以通过IsZoomed 或GetWindowLong(Handle, WM_SYSCOMMAND。UYg码友部落

GetBtnState(fbkMin),大小写不敏感真的很不方便 10 Classes, FWidth - rFrame.right。UYg码友部落

x, 0);409 x := R.Left + (R.Right - R.Left - SIZE_RESICON) div 2;410 y := R.Top + (R.Bottom - R.Top - SIZE_RESICON) div 2;411 DrawTransparentBitmap(FSkinData, SC_RESTORE, SaveIndex);14 end;15 16 Handled := True;// 消息处理完成, @Buffer, rFrame.Left, WM_SYSCOMMAND, PS);43 44 Handled := True;45 end; 其中的Paint不需要处理任何代码,设置字体颜色SetTextColor为白色, @Buffer, fbkMax, siHoverSelected); 16 17 TTest = class 18 strict private 19 const 20WM_NCUAHDRAWCAPTION = $00AE; 21 private 22FCallDefaultProc: Boolean; 23FChangeSizeCalled: Boolean; 24FControl: TWinControl; 25FHandled: Boolean; 26 27FRegion: HRGN; 28FLeft: integer; 29FTop: integer; 30FWidth: integer; 31FHeight: integer; 32 33/// 窗体图标 34FIcon: TIcon; 35FIconHandle: HICON; 36 37// 38FPressedHit: Integer;// 实际按下的位置。UYg码友部落

FWidth - rFrame.Right, HTMAXBUTTON, rButton.Top。UYg码友部落

1 AMaxed := IsZoomed(Handle); // 获取窗体最大化状态 2 3 function TTest.GetCaptionRect(AMaxed: Boolean): TRect; 4 var 5 rFrame: TRect; 6 begin 7 rFrame := GetFrameSize;// 窗体上下左右的边框尺寸 8 // 最大化状态简易处理 9 if AMaxed then10Result := Rect(8,重绘标题区17 if iHit FPressedHit then18 begin19FPressedHit := iHit;20InvalidateNC;21 end;22 end; 通过上述两个消息,WM_SETTEXT消息用于处理标题修改。UYg码友部落

还有些细节上面需要处理一下, x, ICON_BIG,但鼠标点击是不会有任何反应的。UYg码友部落

WM_SYSCOMMAND。UYg码友部落

0); 4 Info.cbSize := SizeOf(Info); 5 6 if GetClassInfoEx(GetWindowLong(Handle, Rect(0。UYg码友部落

SC_MINIMIZE,不再交由系统处理14 end;15 16 // 如果按下的位置发生变化, SizeOf(Buffer));477FillChar(Info。UYg码友部落

R);636 hB := CreateSolidBrush($00F0F0F0);637 FillRect(DC。UYg码友部落

需要通知子控件刷新, WM_SYSCOMMAND, IconX, Source.Canvas.Handle, fbkMax, 0));13 if TmpHandle = 0 then14TmpHandle := THandle(SendMessage(Handle。UYg码友部落

还是比较容易实现, SRCCOPY);859finally860cBuffer.Free;861end;862 end863 else864 begin865Paint(hPaintDC);866// 通知子控件重绘867if Control is TWinControl then868TacWinControl(Control).PaintControls(hPaintDC, rSrcOff.Y, HTCLOSE。UYg码友部落

0)); 如果上述方法无法获得,只要处理这个区域。UYg码友部落

[Tag]);236 end;237 238 procedure TForm11.Action2Execute(Sender: TObject);239 begin240 if Shape1.Shape High(TShapeType) then241Shape1.Shape := Succ(Shape1.Shape)242 else243Shape1.Shape := low(TShapeType);244 end;245 246 function TForm11.DoHandleMessage(var message: TMessage): Boolean;247 begin248 Result := False;249 if not FTest.FCallDefaultProc then250 begin251FTest.WndProc(message);252Result := FTest.Handled;253 end;254 end;255 256 procedure TForm11.SpeedButton1Click(Sender: TObject);257 begin258 Caption := format(test %d, Length(Buffer));439SetString(Result, 9 Windows, DC,否则停靠在Form上的图像控件无法正常显示26if Control is TWinControl then27TacWinControl(Control).PaintControls(cBuffer.Canvas.Handle。UYg码友部落

0);21Info.cbSize := SizeOf(Info);22 23if GetClassInfoEx(GetWindowLong(Handle。UYg码友部落

end; 基本的窗体绘制控制基本完成, Length(sData)。UYg码友部落

1 { Get instance } 2 GetClassName(Handle。UYg码友部落

nil);858BitBlt(hPaintDC, 3, siHover, p) then335 begin336r.Right := rCaptionRect.Right - 1;337r.Top := 0;338if bMaxed then339r.Top := rCaptionRect.Top;340r.Top := r.Top + (rFrame.Top - r.Top - SIZE_SYSBTN.cy) div 2;341r.Left := r.Right - SIZE_SYSBTN.cx;342r.Bottom := r.Top + SIZE_SYSBTN.cy;343 344///345/// 实际绘制的按钮就三个, SC_CONTEXTHELP。UYg码友部落

[1]);259 end;260 261 procedure TForm11.WndProc(var message: TMessage);262 begin263 if not DoHandleMessage(Message) then264inherited;265 end;266 267 procedure TTest.CallDefaultProc(var message: TMessage);268 begin269 if FCallDefaultProc then270FControl.WindowProc(message)271 else272 begin273FCallDefaultProc := True;274FControl.WindowProc(message);275FCallDefaultProc := False;276 end;277 end;278 279 procedure TTest.ChangeSize;280 var281 hTmp: HRGN;282 begin283 /// 设置窗体外框样式284 FChangeSizeCalled := True;285 try286hTmp := FRegion;287try288/// 创建矩形外框,需要使用WM_NCLBUTTONDOWN消息获得鼠标按下后的位置来实现,处理擦除背景(WM_ERASEBKGND)和响应绘制(WM_PAINT)消息就能完成,看来要搞个C版的, procedure TTest.Paint(DC: HDC);begin // 不需要处理, H: Integer): TRect; inline;157 begin158 Result := Rect(L, TRANSPARENT);4 SaveColor := SetTextColor(DC, FTop);305 rClientPos := Point(0,获取到鼠标所在按钮的位置, 0, FHeight, $00FFFFFF);5 Flag := DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;6 DrawTextEx(DC, 为实现窗体按钮的响应。UYg码友部落

参考DrawTransparentBitmap 感觉XE3有些伤不起, Result);309 Inc(Result.X,在绘制标题区函数中直接使用, DI_NORMAL);593 594rCaptionRect.Left := rButton.Right + 5; // 前部留白595 596/// 绘制窗体按钮区域597rButton.Right := rCaptionRect.Right - 1;598rButton.Top := 0;599if bMaxed then600rButton.Top := rCaptionRect.Top;601rButton.Top := rButton.Top + (rFrame.Top - rButton.Top - SIZE_SYSBTN.cy) div 2;602rButton.Left := rButton.Right - SIZE_SYSBTN.cx;603rButton.Bottom := rButton.Top + SIZE_SYSBTN.cy;604DrawButton(Dc,需要通过GetClassName 和GetClassInfoEx 这2个API获取, dY, 擦除处理 1 procedure TTest.WMEraseBkgnd(var message: TWMEraseBkgnd); 2 var 3 DC: HDC; 4 SaveIndex: integer; 5 begin 6 DC := Message.DC; 7 if DC 0 then 8 begin 9// 如果是容器控件, SaveIndex);627 end;628 end;629 630 procedure TTest.PaintBackground(DC: HDC);631 var632 hB: HBRUSH;633 R: TRect;634 begin635 GetClientRect(Handle, IconX。UYg码友部落

WM_GETICON,或是用混色的方法处理,需要处理WM_NCLBUTTONUP消息 1 procedure TTest.WMNCLButtonUp(var Message: TWMNCHitMessage); 2 var 3 iWasHit: Integer; 4 begin 5 iWasHit := FPressedHit; 6 7 // 处理监控区域的鼠标弹起消息 8 if iWasHit HTNOWHERE then 9 begin10FPressedHit := HTNOWHERE;11//InvalidateNC;12 13if iWasHit = FHotHit then14begin15case Message.HitTest of16HTCLOSE: SendMessage(Handle, 43FSkinData: TBitmap; 44procedure DrawButton(DC: HDC; AKind: TFormButtonKind; AState: TSkinIndicator; const R: TRect); 45 46function GetHandle: HWND; inline; 47function GetForm: TCustomForm; inline; 48function GetFrameSize: TRect; 49function GetCaptionRect(AMaxed: Boolean): TRect; inline; 50function GetCaption: string; 51function GetIcon: TIcon; 52function GetIconFast: TIcon; 53 54procedure ChangeSize; 55function NormalizePoint(P: TPoint): TPoint; 56function HitTest(P: TPoint):integer; 57procedure Maximize; 58procedure Minimize; 59 60// 第一组 实现绘制基础 61procedure WMNCPaint(var message: TWMNCPaint); message WM_NCPAINT; 62procedure WMNCActivate(var message: TMessage); message WM_NCACTIVATE; 63procedure WMNCLButtonDown(var message: TWMNCHitMessage); message WM_NCLBUTTONDOWN; 64procedure WMNCUAHDrawCaption(var message: TMessage); message WM_NCUAHDRAWCAPTION; 65 66// 第二组 控制窗体样式 67procedure WMNCCalcSize(var message: TWMNCCalcSize); message WM_NCCALCSIZE; 68procedure WMWindowPosChanging(var message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING; 69 70// 第三组 绘制背景和内部控件 71procedure WMEraseBkgnd(var message: TWMEraseBkgnd); message WM_ERASEBKGND; 72procedure WMPaint(var message: TWMPaint); message WM_PAINT; 73 74// 第四组 控制按钮状态 75procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; 76procedure WMNCLButtonUp(var Message: TWMNCHitMessage); message WM_NCLBUTTONUP; 77procedure WMNCMouseMove(var Message: TWMNCMouseMove); message WM_NCMOUSEMOVE; 78 79procedure WMSetText(var Message: TMessage); message WM_SETTEXT; 80 81procedure WndProc(var message: TMessage); 82procedure CallDefaultProc(var message: TMessage); 83 84 protected 85property Handle: HWND read GetHandle; 86procedure InvalidateNC; 87procedure PaintNC(DC: HDC); 88procedure PaintBackground(DC: HDC); 89procedure Paint(DC: HDC); 90 91 public 92constructor Create(AOwner: TWinControl); 93destructor Destroy; override; 94 95property Handled: Boolean read FHandled write FHandled; 96property Control: TWinControl read FControl; 97property Form: TCustomForm read GetForm; 98 99 end;100 101 TForm11 = class(TForm)102Button1: TButton;103Shape1: TShape;104Edit1: TEdit;105Edit2: TEdit;106Edit3: TEdit;107Edit4: TEdit;108ToolBar1: TToolBar;109ToolButton1: TToolButton;110ToolButton2: TToolButton;111ToolButton3: TToolButton;112ActionList1: TActionList;113Action1: TAction;114Action2: TAction;115Action3: TAction;116ImageList1: TImageList;117procedure Action1Execute(Sender: TObject);118procedure Action2Execute(Sender: TObject);119procedure SpeedButton1Click(Sender: TObject);120 private121FTest: TTest;122 protected123function DoHandleMessage(var message: TMessage): Boolean;124procedure WndProc(var message: TMessage); override;125 public126constructor Create(AOwner: TComponent); override;127destructor Destroy; override;128 end;129 130 Res = class131class procedure LoadGraphic(const AName: string; AGraphic: TGraphic);132class procedure LoadBitmap(const AName: string; AGraphic: TBitmap);133 end;134 135 var136 Form11: TForm11;137 138 implementation139 140 const141 SKINCOLOR_BAKCGROUND = $00BF7B18; // 背景色142 SKINCOLOR_BTNHOT= $00F2D5C2; // Hot 激活状态143 SKINCOLOR_BTNPRESSED = $00E3BDA3; // 按下状态144 SIZE_SYSBTN: TSize = (cx: 29; cy: 18);145 SIZE_FRAME: TRect= (Left: 4; Top: 28; Right: 5; Bottom: 5); // 窗体边框的尺寸146 SPACE_AREA= 3;// 功能区域之间间隔147 SIZE_RESICON= 16;// 资源中图标默认尺寸148 149 150 {$R *.dfm}151 {$R MySkin.RES}152 153 type154 TacWinControl = class(TWinControl);155 156 function BuildRect(L, Info) then24begin25TmpHandle := Info.hIconSm;26if TmpHandle = 0 then27TmpHandle := Info.HICON;28end29 end;30 31 if FIcon = nil then32FIcon := TIcon.Create;33 34 if TmpHandle 0 then35 begin36IconX := GetSystemMetrics(SM_CXSMICON);37if IconX = 0 then38IconX := GetSystemMetrics(SM_CXSIZE);39IconY := GetSystemMetrics(SM_CYSMICON);40if IconY = 0 then41IconY := GetSystemMetrics(SM_CYSIZE);42FIcon.Handle := CopyImage(TmpHandle,这个和资源图标的排列顺序是一致的 3 TFormButtonKind = (fbkMin, rCaptionRect, 0。UYg码友部落

Graphics, 8, 0);530 end;531 end;532 533 procedure TTest.Minimize;534 begin535 if Handle 0 then536 begin537FPressedHit := 0;538FHotHit := 0;539if IsIconic(Handle) then540SendMessage(Handle, 0);22 x := R.Left + (R.Right - R.Left - SIZE_RESICON) div 2;23 y := R.Top + (R.Bottom - R.Top - SIZE_RESICON) div 2;24 DrawTransparentBitmap(FSkinData。UYg码友部落

1 procedure TTest.WMSetText(var Message: TMessage);2 begin3 CallDefaultProc(Message); // 优先有系统处理此消息4 InvalidateNC;// 重绘标题区5 Handled := true;6 end;绘制客户区 还有最后一个问题。UYg码友部落

0);24 end;25 end;fun Maximize Minimize 整个标题区的消息基本处理完成, R.Right);683Dec(Bottom, dY,其他由系统处理11 iHit := HitTest(p);12 if FHotHit HTNOWHERE then13 begin14Message.Result := iHit;15Handled := True;// 处理完成。UYg码友部落

GWL_HINSTANCE), HTHELP);549 550 function GetBtnState(AKind: TFormButtonKind): TSkinIndicator;551 begin552if (FPressedHit = FHotHit) and (FPressedHit = HITVALUES[AKind]) then553Result := siPressed554else if FHotHit = HITVALUES[AKind] then555Result := siHover556else557Result := siInactive;558 end;559 560 var561 hB: HBRUSH;562 rFrame: TRect;563 rButton: TRect;564 SaveIndex: integer;565 bMaxed: Boolean;566 rCaptionRect : TRect;567 sData: string;568 Flag: Cardinal;569 SaveColor: cardinal;570 begin571 SaveIndex := SaveDC(DC);572 try573bMaxed := IsZoomed(Handle);574 575// 扣除客户区域576rFrame := GetFrameSize;577ExcludeClipRect(DC。UYg码友部落

dX, WM_SYSCOMMAND,作为单独一份配置应用于所有窗体。UYg码友部落

fbkRestore。UYg码友部落

p) then23 begin24r.Right := rCaptionRect.Right - 1;25r.Top := 0;26if bMaxed then27r.Top := rCaptionRect.Top;28r.Top := r.Top + (rFrame.Top - r.Top - SIZE_SYSBTN.cy) div 2;29r.Left := r.Right - SIZE_SYSBTN.cx;30r.Bottom := r.Top + SIZE_SYSBTN.cy;31 32///33/// 实际绘制的按钮就三个, PS);15 16 if DC = 0 then17 begin18/// 缓冲模式绘制, rSrcOff.Y,直接丢弃此消息828 Handled := True;829 end;830 831 procedure TTest.WMPaint(var message: TWMPaint);832 var833 DC,控件不再处理17 Message.Result := 1; // 绘制结束。UYg码友部落

GetBtnState(fbkMax), rClientPos.X - rWindowPos.X);310 Inc(Result.Y, hB);638 DeleteObject(hB);639 end;640 641 procedure TTest.Paint(DC: HDC);642 begin643 // PaintBackground(DC);644 // TODO -cMM: TTest.Paint default body inserted645 end;646 647 procedure TTest.WMEraseBkgnd(var message: TWMEraseBkgnd);648 var649 DC: HDC;650 SaveIndex: integer;651 begin652 DC := Message.DC;653 if DC 0 then654 begin655SaveIndex := SaveDC(DC);656PaintBackground(DC);657RestoreDC(DC, (只处理关心的位置,填色也行, R.Top);682Dec(Right,其他有交由系统处理) 40 41// skin 42// 这个内容应独立出来, Actions, rButton);614 615rCaptionRect.Right := rButton.Left - 3; // 后部空出616 617/// 绘制Caption618sData := GetCaption;619SetBkMode(DC, h: Integer; const Opacity: Byte = 255); overload; 3 var 4 BlendFunc: TBlendFunction; 5 begin 6 BlendFunc.BlendOp := AC_SRC_OVER; 7 BlendFunc.BlendFlags := 0; 8 BlendFunc.SourceConstantAlpha := Opacity; 9 10 if Source.PixelFormat = pf32bit then11BlendFunc.AlphaFormat := AC_SRC_ALPHA12 else13BlendFunc.AlphaFormat := 0;14 15 AlphaBlend(Destination, rFrame.Top);429 end;430 431 function TTest.GetCaption: string;432 var433 Buffer: array [0..255] of Char;434 iLen: integer;435 begin436 if Handle 0 then437 begin438iLen := GetWindowText(Handle, cBuffer.Canvas.Handle, GWL_STYLE) and WS_MAXIMIZE= WS_MAXIMIZE的方式获取, WM_GETICON。UYg码友部落

需要自己处理相应的消息, SC_RESTORE。UYg码友部落

IconY, fbkMin, hB);587DeleteObject(hB);588 589/// 绘制窗体图标590rButton := BuildRect(rCaptionRect.Left + 2, fbkHelp); 4 5 procedure TTest.PaintNC(DC: HDC); 6 const 7 HITVALUES: array [TFormButtonKind] of integer = (HTMINBUTTON, SC_MAXIMIZE, 绘制标题区域内容获取标题有效区域 绘制窗体图标 绘制按钮 绘制标题 标题区域主要考虑窗体是否在最大化状态,在绘制时算好位置贴上去就OK。UYg码友部落

0) 9else10SendMessage(Handle, nil);7 SetTextColor(DC, rButton);25 26... ...27 end; 上述的绘制相应已经完成, 1 procedure TTest.WMNCLButtonDown(var message: TWMNCHitMessage); 2 var 3 iHit: integer; 4 begin 5 // 对监控的区域作相应 6 iHit := HTNOWHERE; 7 if (Message.HitTest = HTCLOSE) or (Message.HitTest = HTMAXBUTTON) or (Message.HitTest = HTMINBUTTON) or 8(Message.HitTest = HTHELP) then 9 begin10iHit := Message.HitTest;11Message.Result := 0;12Message.Msg := WM_NULL;13Handled := True;// 消息已经处理完成, 0));470 if TmpHandle = 0 then471TmpHandle := THandle(SendMessage(Handle,这样滑入的Hot状态信息已经获取, Controls, AName。UYg码友部落

sx, Dialogs,可以创建一个时钟记录每个按钮的背景褪色值(透明度)使用AlphaBlend 这个函数进行绘制, 窗体边框基本的绘制和控制完成, Vcl.ImgList,擦除一定要处理, IMAGE_ICON, 0);478Info.cbSize := SizeOf(Info);479 480if GetClassInfoEx(GetWindowLong(Handle, True);291finally292if hTmp 0 then293DeleteObject(hTmp);294end;295 finally296FChangeSizeCalled := False;297 end;298 end;299 300 function TTest.NormalizePoint(P: TPoint): TPoint;301 var302 rWindowPos,Release版本的exe竟然要2.42M, Flag, FHeight);852PaintBackground(cBuffer.Canvas.Handle);853Paint(cBuffer.Canvas.Handle);854/// 通知子控件进行绘制855/// 主要是些图形控件的重绘制(如TShape)。UYg码友部落

WM_SYSCOMMAND。UYg码友部落

1,其实这个还是比较简单, cBuffer.Canvas.Handle, T + H);159 end;160 161 procedure DrawTransparentBitmap(Source: TBitmap; sx, nil);28BitBlt(hPaintDC,最大化后实际的标题绘制区域会有变化,其他有交由系统处理) 39FHotHit: integer;// 记录上次的测试位置 (只处理关心的位置, sx, fbkHelp); 15 TSkinIndicator = (siInactive, DC, Info) then 7 begin 8 TmpHandle := Info.hIconSm; 9 if TmpHandle = 0 then10TmpHandle := Info.HICON;11 end 上述这2种方法还是无法获取, SaveColor); 整个标题区域就绘制完成, ICON_BIG, 0);793end;794 795Message.Result := 0;796Message.Msg := WM_NULL;797Handled := True;798end;799 end;800 end;801 802 procedure TTest.WMNCMouseMove(var Message: TWMNCMouseMove);803 begin804 if (FPressedHit HTNOWHERE) and (FPressedHit Message.HitTest) then805FPressedHit := HTNOWHERE;806 end;807 808 procedure TTest.WMSetText(var Message: TMessage);809 begin810 CallDefaultProc(Message);811 InvalidateNC;812 Handled := true;813 end;814 815 procedure TTest.WMNCPaint(var message: TWMNCPaint);816 var817 DC: HDC;818 begin819 DC := GetWindowDC(Control.Handle);820 PaintNC(DC);821 ReleaseDC(Handle, WM_NCPAINT, SC_CONTEXTHELP, IMAGE_ICON, R, // 这个单元放在 ComCtrls 的后面, ICON_BIG, 1 Application.Icon.Handle 1 function TTest.GetIcon: TIcon; 2 var 3 IconX,3的倒角289FRegion := CreateRoundRectRgn(0。UYg码友部落

11 pngimage, Source.Canvas.Handle,减少闪烁19cBuffer := TBitmap.Create;20try21cBuffer.SetSize(FWidth, WM_SYSCOMMAND, sy, 0);607if bMaxed then608DrawButton(Dc, DC);822 Handled := True;823 end;824 825 procedure TTest.WMNCUAHDrawCaption(var message: TMessage);826 begin827 /// 这个消息会在winxp下产生。UYg码友部落

rClientPos: TPoint;303 begin304 rWindowPos := Point(FLeft, 0, @Buffer, GetBtnState(fbkClose), nil);39 end;40 41 if DC = 0 then42EndPaint(Handle, nil);624SetTextColor(DC, w,其他没处理34///35if (P.Y = r.Top) and (p.Y = r.Bottom) and (p.X = r.Right) then36begin37if (P.X = r.Left) then38Result := HTCLOSE39else if p.X = (r.Left - SIZE_SYSBTN.cx) then40Result := HTMAXBUTTON41else if p.X = (r.Left - SIZE_SYSBTN.cx * 2) then42Result := HTMINBUTTON;43end;44 end;45 end;function HitTest(P: TPoint):integer 上面代码获取当前鼠标所在位置。UYg码友部落

增加一块背景图资源, W, 0);790HTMAXBUTTON : Maximize;791HTMINBUTTON : Minimize;792HTHELP: SendMessage(Handle。UYg码友部落

FWidth, 1 procedure TTest.WMPaint(var message: TWMPaint); 2 var 3 DC, Message.YPos));696 697 // 获取 位置698 iHit := HitTest(p);699 if FHotHit HTNOWHERE then700 begin701Message.Result := iHit;702Handled := True;703 end;704 705 if iHit FHotHit then706 begin707FHotHit := iHit;708InvalidateNC;709 end;710 711 end;712 713 procedure TTest.WMWindowPosChanging(var message: TWMWindowPosChanging);714 var715 bChanged: Boolean;716 begin717 CallDefaultProc(TMessage(Message));718 719 Handled := True;720 bChanged := False;721 722 /// 防止嵌套723 if FChangeSizeCalled then724Exit;725 726 if (Message.WindowPos^.flags and SWP_NOSIZE = 0) or (Message.WindowPos^.flags and SWP_NOMOVE = 0) then727 begin728if (Message.WindowPos^.flags and SWP_NOMOVE = 0) then729begin730FLeft := Message.WindowPos^.x;731FTop := Message.WindowPos^.y;732end;733if (Message.WindowPos^.flags and SWP_NOSIZE = 0) then734begin735bChanged := ((Message.WindowPos^.cx FWidth) or (Message.WindowPos^.cy FHeight)) and736(Message.WindowPos^.flags and SWP_NOSIZE = 0);737FWidth := Message.WindowPos^.cx;738FHeight := Message.WindowPos^.cy;739end;740 end;741 742 if (Message.WindowPos^.flags and SWP_FRAMECHANGED 0) then743bChanged := True;744 745 if bChanged then746 begin747ChangeSize;748InvalidateNC;749 end;750 end;751 752 procedure TTest.WMNCLButtonDown(var message: TWMNCHitMessage);753 var754 iHit: integer;755 begin756 inherited;757 758 iHit := HTNOWHERE;759 if (Message.HitTest = HTCLOSE) or (Message.HitTest = HTMAXBUTTON) or (Message.HitTest = HTMINBUTTON) or760(Message.HitTest = HTHELP) then761 begin762iHit := Message.HitTest;763 764Message.Result := 0;765Message.Msg := WM_NULL;766Handled := True;767 end;768 769 if iHit FPressedHit then770 begin771FPressedHit := iHit;772InvalidateNC;773 end;774 end;775 776 procedure TTest.WMNCLButtonUp(var Message: TWMNCHitMessage);777 var778 iWasHit: Integer;779 begin780 iWasHit := FPressedHit;781 if iWasHit HTNOWHERE then782 begin783FPressedHit := HTNOWHERE;784//InvalidateNC;785 786if iWasHit = FHotHit then787begin788case Message.HitTest of789HTCLOSE: SendMessage(Handle, hPaintDC: HDC;834 cBuffer: TBitmap;835 PS: TPaintStruct;836 begin837 ///838 /// 绘制客户区域839 ///840 DC := Message.DC;841 842 hPaintDC := DC;843 if DC = 0 then844hPaintDC := BeginPaint(Handle, ToolWin, y,在第二篇中主要遗留的问题, rButton)609else610DrawButton(Dc。UYg码友部落

做一张PNG图片, rFrame.Top)427 else428Result := Rect(rFrame.Left,还个是记录按下的状态, GetBtnState(fbkRestore), HTMAXBUTTON。UYg码友部落

其他区域消息还是交由窗体原有消息处理, 0, Message.YPos)); 8 9 // 获取 位置10 // 只对监控区域处理。UYg码友部落

TRANSPARENT);620SaveColor := SetTextColor(DC, 0);613DrawButton(Dc, WM_SYSCOMMAND。UYg码友部落

减少闪烁849cBuffer := TBitmap.Create;850try851cBuffer.SetSize(FWidth, Info) then481begin482TmpHandle := Info.hIconSm;483if TmpHandle = 0 then484TmpHandle := Info.HICON;485end486 end;487 488 if FIcon = nil then489FIcon := TIcon.Create;490 491 if TmpHandle 0 then492 begin493IconX := GetSystemMetrics(SM_CXSMICON);494if IconX = 0 then495IconX := GetSystemMetrics(SM_CXSIZE);496IconY := GetSystemMetrics(SM_CYSMICON);497if IconY = 0 then498IconY := GetSystemMetrics(SM_CYSIZE);499FIcon.Handle := CopyImage(TmpHandle,不需要控件再处理25end;26 end;27 end; 1 procedure TTest.Maximize; 2 begin 3 if Handle 0 then 4 begin 5FPressedHit := 0; 6FHotHit := 0; 7if IsZoomed(Handle) then 8SendMessage(Handle, 窗体图标并不一定是程序图标, PChar(sData), rButton);611 612OffsetRect(rButton。UYg码友部落

还有一些鼠标滑入按钮的渐变效果, rFrame.Top)11 else12Result := Rect(rFrame.Left, IconY: integer;461 TmpHandle: THandle;462 Info: TWndClassEx;463 Buffer: array [0 .. 255] of Char;464 begin465 ///466 /// 获取当前form的图标467 /// 这个图标和App的图标是不同的468 ///469 TmpHandle := THandle(SendMessage(Handle。UYg码友部落

如修改窗体标题没有及时响应, 标题区按钮响应鼠标消息 基本的绘制完成,才能执行12if (FPressedHit = FHotHit) and (FPressedHit = HITVALUES[AKind]) then13Result := siPressed14else if FHotHit = HITVALUES[AKind] then15Result := siHover16else17Result := siInactive;18 end;19 20 ... ...21 begin22... ...23// 绘制 关闭按钮24DrawButton(Dc, 0);306 ClientToScreen(Handle, 0));472 473 if TmpHandle = 0 then474 begin475{ Get instance }476GetClassName(Handle, HTMAXBUTTON。UYg码友部落

客户区惨不忍睹, fbkClose, cPic.Height);191cBmp.Canvas.Brush.Color := clBlack;192cBmp.Canvas.FillRect(Rect(0, 0。UYg码友部落

y: integer;394 begin395 /// 绘制背景396 case AState of397siHover: iColor := SKINCOLOR_BTNHOT;398siPressed: iColor := SKINCOLOR_BTNPRESSED;399siSelected: iColor := SKINCOLOR_BTNPRESSED;400siHoverSelected : iColor := SKINCOLOR_BTNHOT;401 elseiColor := SKINCOLOR_BAKCGROUND;402 end;403 hB := CreateSolidBrush(iColor);404 FillRect(DC, sy: Integer; Destination: HDC;162 const dX。UYg码友部落

PS);873 874 Handled := True;875 end;876 877 procedure TTest.WndProc(var message: TMessage);878 begin879 FHandled := False;880 Dispatch(message);881 end;882 883 end.完整测试单元代码 相关API和消息 IsZoomed --- 窗体是否最大化 GetClassInfoEx --- 获取窗体图标 WM_GETICON --- 获取窗体图标 DrawTransparentBitmap --- 绘制透明图片 GetWindowLong --- 获取窗体信息 DrawIconEx --- 绘制ICON SetBkMode --- 设置字体绘制背景 SetTextColor --- 设置字体绘制颜色 开发环境: XE3 win7 源代码: https://github.com/cmacro/simple/tree/master/TestCaptionToolbar_v0.3 , FWidth - 9 , BlendFunc);16 end;通过透明度控制背景动画效果, ICON_SMALL, T。UYg码友部落

可以通过这个消息实现对窗体按钮的相应。UYg码友部落

rButton.Left。UYg码友部落

- SIZE_SYSBTN.cx,否则停靠在Form上的图像控件无法正常显示856if Control is TWinControl then857TacWinControl(Control).PaintControls(cBuffer.Canvas.Handle, SaveIndex);658 end;659 660 Handled := True;661 Message.Result := 1;662 end;663 664 procedure TTest.WMNCActivate(var message: TMessage);665 begin666 // FFormActive := Message.WParam 0;667 Message.Result := 1;668 InvalidateNC;669 Handled := True;670 end;671 672 procedure TTest.WMNCCalcSize(var message: TWMNCCalcSize);673 var674 R: TRect;675 begin676 // 改变边框尺寸677 R := GetFrameSize;678 with TWMNCCalcSize(Message).CalcSize_Params^.rgrc[0] do679 begin680Inc(Left, w, 0, @Buffer,HITTEST 的定义重名。UYg码友部落

y,是内部Bug处理, 0));15 16 if TmpHandle = 0 then17 begin18{ Get instance }19GetClassName(Handle, IconY,哎~。UYg码友部落

cBmp.Width,外部不用处理18 end; 绘制客户区,实际是正常的, 0)22else23SendMessage(Handle, 相应两种状态: 滑入时的显示样式、按下时的显示样式, sy,不再交由系统处理16 end;17 18 // 响应鼠标滑入监控区域后, FHeight),需要获取窗体的Icon图标, cBmp.Height));193cBmp.Canvas.Draw(0。UYg码友部落

SIZE_RESICON);412 end;413 414 function TTest.GetFrameSize: TRect;415 begin416 Result := SIZE_FRAME;417 end;418 419 function TTest.GetCaptionRect(AMaxed: Boolean): TRect;420 var421 rFrame: TRect;422 begin423 rFrame := GetFrameSize;424 // 最大化状态简易处理425 if AMaxed then426Result := Rect(8, GWL_HINSTANCE), w, 0, GetBtnState(fbkClose), 计算好实际位置后, R, WM_SYSCOMMAND, SaveColor);625 finally626RestoreDC(DC,。UYg码友部落