首页 > 代码库 > 窗体皮肤实现 - 重绘窗体非客户区（三）
窗体皮肤实现 - 重绘窗体非客户区（三）
窗体边框基本的绘制和控制完成，在第二篇中主要遗留的问题。
- 标题区域图标和按钮没绘制
- 缩放时客户区显示有问题
解决完下面的问题，皮肤处理基本完整。大致的效果GIF
GIF中TShape的颜色表现有些问题，实际是正常的。
绘制标题区域内容
- 获取标题有效区域
- 绘制窗体图标
- 绘制按钮
- 绘制标题
标题区域主要考虑窗体是否在最大化状态，最大化后实际的标题绘制区域会有变化。可以通过 IsZoomed 或 GetWindowLong(Handle, GWL_STYLE) and WS_MAXIMIZE = WS_MAXIMIZE 的方式获取。
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 then10 Result := Rect(8, 8, FWidth - 9 , rFrame.Top)11 else12 Result := Rect(rFrame.Left, 3, FWidth - rFrame.right, rFrame.Top);13 end;
绘制窗体图标稍微有些麻烦，需要获取窗体的Icon图标。窗体图标并不一定是程序图标。主要过程通过WM_GETICON 这个消息获取图标。
1 TmpHandle := THandle(SendMessage(Handle, WM_GETICON, ICON_SMALL, 0));2 if TmpHandle = 0 then3 TmpHandle := THandle(SendMessage(Handle, WM_GETICON, ICON_BIG, 0));
如果上述方法无法获得，需要通过GetClassName 和 GetClassInfoEx 这2个API获取。
1 { Get instance } 2 GetClassName(Handle, @Buffer, SizeOf(Buffer)); 3 FillChar(Info, SizeOf(Info), 0); 4 Info.cbSize := SizeOf(Info); 5 6 if GetClassInfoEx(GetWindowLong(Handle, GWL_HINSTANCE), @Buffer, Info) then 7 begin 8 TmpHandle := Info.hIconSm; 9 if TmpHandle = 0 then10 TmpHandle := Info.HICON;11 end
上述这2种方法还是无法获取。那～～ 就没有办法了。如果非要绘制图标可以使用Application的图标进行代替。
1 Application.Icon.Handle
1 function TTest.GetIcon: TIcon; 2 var 3 IconX, 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, WM_GETICON, ICON_SMALL, 0));13 if TmpHandle = 0 then14 TmpHandle := THandle(SendMessage(Handle, WM_GETICON, ICON_BIG, 0));15 16 if TmpHandle = 0 then17 begin18 { Get instance }19 GetClassName(Handle, @Buffer, SizeOf(Buffer));20 FillChar(Info, SizeOf(Info), 0);21 Info.cbSize := SizeOf(Info);22 23 if GetClassInfoEx(GetWindowLong(Handle, GWL_HINSTANCE), @Buffer, Info) then24 begin25 TmpHandle := Info.hIconSm;26 if TmpHandle = 0 then27 TmpHandle := Info.HICON;28 end29 end;30 31 if FIcon = nil then32 FIcon := TIcon.Create;33 34 if TmpHandle <> 0 then35 begin36 IconX := GetSystemMetrics(SM_CXSMICON);37 if IconX = 0 then38 IconX := GetSystemMetrics(SM_CXSIZE);39 IconY := GetSystemMetrics(SM_CYSMICON);40 if IconY = 0 then41 IconY := GetSystemMetrics(SM_CYSIZE);42 FIcon.Handle := CopyImage(TmpHandle, IMAGE_ICON, IconX, IconY, 0);43 FIconHandle := TmpHandle;44 end;45 46 Result := FIcon;47 end;
绘制系统最小化、最大化和关闭按钮直接使用贴图的方法。做一张PNG图片，做成资源文件加入到单元中。
注：图标是白色的没底色看不见，所以在贴的图上加了个黑底。
计算好实际位置后，直接把从资源中加载的图标绘制上去。
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, y: integer; 7 begin 8 /// 绘制背景 9 case AState of10 siHover : iColor := SKINCOLOR_BTNHOT;11 siPressed : iColor := SKINCOLOR_BTNPRESSED;12 siSelected : iColor := SKINCOLOR_BTNPRESSED;13 siHoverSelected : iColor := SKINCOLOR_BTNHOT;14 else iColor := SKINCOLOR_BAKCGROUND;15 end;16 hB := CreateSolidBrush(iColor);17 FillRect(DC, R, hB);18 DeleteObject(hB);19 20 /// 绘制图标21 rSrcOff := Point(SIZE_RESICON * ord(AKind), 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, rSrcOff.X, rSrcOff.Y, DC, x, y, SIZE_RESICON, SIZE_RESICON);25 end;
最后绘制标题，设置背景SetBkMode透明，设置字体颜色SetTextColor为白色。
1 /// 绘制Caption2 sData := GetCaption;3 SetBkMode(DC, TRANSPARENT);4 SaveColor := SetTextColor(DC, $00FFFFFF);5 Flag := DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;6 DrawTextEx(DC, PChar(sData), Length(sData), rCaptionRect, Flag, nil);7 SetTextColor(DC, SaveColor);
整个标题区域就绘制完成。
标题区按钮响应鼠标消息
基本的绘制完成，鼠标滑到窗体按钮区域（最大化、最小化和关闭）和点击并不会相应。需要自己处理相应的消息。WM_NCHITTEST 消息是系统用来确定鼠标位置对应的窗体区域，可以通过这个消息实现对窗体按钮的相应。
为实现窗体按钮的响应，只要处理这个区域。其他区域消息还是交由窗体原有消息处理。
相应两种状态： 滑入时的显示样式、按下时的显示样式。
1 procedure TTest.WMNCHitTest(var Message: TWMNCHitTest); 2 var 3 P: TPoint; 4 iHit: integer; 5 begin 6 // 需要把位置转换到实际窗口位置 7 P := NormalizePoint(Point(Message.XPos, Message.YPos)); 8 9 // 获取 位置10 // 只对监控区域处理，其他由系统处理11 iHit := HitTest(p);12 if FHotHit > HTNOWHERE then13 begin14 Message.Result := iHit;15 Handled := True; // 处理完成，不再交由系统处理16 end;17 18 // 响应鼠标滑入监控区域后，通知非客户区重绘19 if iHit <> FHotHit then20 begin21 FHotHit := iHit;22 InvalidateNC;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 then15 Exit;16 17 ///18 /// 只关心窗体按钮区域19 ///20 bMaxed := IsZoomed(Handle);21 rCaptionRect := GetCaptionRect(bMaxed);22 if PtInRect(rCaptionRect, p) then23 begin24 r.Right := rCaptionRect.Right - 1;25 r.Top := 0;26 if bMaxed then27 r.Top := rCaptionRect.Top;28 r.Top := r.Top + (rFrame.Top - r.Top - SIZE_SYSBTN.cy) div 2;29 r.Left := r.Right - SIZE_SYSBTN.cx;30 r.Bottom := r.Top + SIZE_SYSBTN.cy;31 32 ///33 /// 实际绘制的按钮就三个，其他没处理34 ///35 if (P.Y >= r.Top) and (p.Y <= r.Bottom) and (p.X <= r.Right) then36 begin37 if (P.X >= r.Left) then38 Result := HTCLOSE39 else if p.X >= (r.Left - SIZE_SYSBTN.cx) then40 Result := HTMAXBUTTON41 else if p.X >= (r.Left - SIZE_SYSBTN.cx * 2) then42 Result := HTMINBUTTON;43 end;44 end;45 end;
上面代码获取当前鼠标所在位置，这样滑入的Hot状态信息已经获取。还个是记录按下的状态，需要使用WM_NCLBUTTONDOWN消息获得鼠标按下后的位置来实现。
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 begin10 iHit := Message.HitTest;11 Message.Result := 0;12 Message.Msg := WM_NULL;13 Handled := True; // 消息已经处理完成，不再交由系统处理14 end;15 16 // 如果按下的位置发生变化，重绘标题区17 if iHit <> FPressedHit then18 begin19 FPressedHit := iHit;20 InvalidateNC;21 end;22 end;
通过上述两个消息，获取到鼠标所在按钮的位置。在绘制标题区函数中直接使用。
1 // 注意： 2 // 按钮样式枚举的顺序不要颠倒，这个和资源图标的排列顺序是一致的 3 TFormButtonKind = (fbkMin, fbkMax, fbkRestore, fbkClose, fbkHelp); 4 5 procedure TTest.PaintNC(DC: HDC); 6 const 7 HITVALUES: array [TFormButtonKind] of integer = (HTMINBUTTON, HTMAXBUTTON, HTMAXBUTTON, HTCLOSE, HTHELP); 8 9 function GetBtnState(AKind: TFormButtonKind): TSkinIndicator;10 begin11 // 按下区域 一定和 Hot区域一致，保证鼠标点击到弹起的区域是一致，才能执行12 if (FPressedHit = FHotHit) and (FPressedHit = HITVALUES[AKind]) then13 Result := siPressed14 else if FHotHit = HITVALUES[AKind] then15 Result := siHover16 else17 Result := siInactive;18 end;19 20 ... ...21 begin22 ... ...23 // 绘制 关闭按钮24 DrawButton(Dc, fbkClose, GetBtnState(fbkClose), rButton);25 26 ... ...27 end;
上述的绘制相应已经完成，但鼠标点击是不会有任何反应的。需要处理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 begin10 FPressedHit := HTNOWHERE;11 //InvalidateNC;12 13 if iWasHit = FHotHit then14 begin15 case Message.HitTest of16 HTCLOSE : SendMessage(Handle, WM_SYSCOMMAND, SC_CLOSE, 0);17 HTMAXBUTTON : Maximize;18 HTMINBUTTON : Minimize;19 HTHELP : SendMessage(Handle, WM_SYSCOMMAND, SC_CONTEXTHELP, 0);20 end;21 22 Message.Result := 0;23 Message.Msg := WM_NULL;24 Handled := True; // 消息已经处理完成，不需要控件再处理25 end;26 end;27 end;
1 procedure TTest.Maximize; 2 begin 3 if Handle <> 0 then 4 begin 5 FPressedHit := 0; 6 FHotHit := 0; 7 if IsZoomed(Handle) then 8 SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 0) 9 else10 SendMessage(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0);11 end;12 end;13 14 procedure TTest.Minimize;15 begin16 if Handle <> 0 then17 begin18 FPressedHit := 0;19 FHotHit := 0;20 if IsIconic(Handle) then21 SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 0)22 else23 SendMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);24 end;25 end;
整个标题区的消息基本处理完成，能正常相应标题区应有的功能。还有些细节上面需要处理一下，如修改窗体标题没有及时响应。WM_SETTEXT消息用于处理标题修改。
1 procedure TTest.WMSetText(var Message: TMessage);2 begin3 CallDefaultProc(Message); // 优先有系统处理此消息4 InvalidateNC; // 重绘标题区5 Handled := true;6 end;
绘制客户区
还有最后一个问题。在缩放窗体时，客户区惨不忍睹。其实这个还是比较简单，处理擦除背景（WM_ERASEBKGND）和响应绘制（WM_PAINT）消息就能完成。
擦除处理
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 // 如果是容器控件，擦除一定要处理。填色也行。10 // 否则会出现因主绘制延迟，出现短暂的未刷新色块残留。特别在使用Buffer方式绘制时常出现11 SaveIndex := SaveDC(DC);12 PaintBackground(DC);13 RestoreDC(DC, SaveIndex);14 end;15 16 Handled := True; // 消息处理完成，控件不再处理17 Message.Result := 1; // 绘制结束，外部不用处理18 end;
绘制客户区，需要通知子控件刷新。
1 procedure TTest.WMPaint(var message: TWMPaint); 2 var 3 DC, 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 then14 hPaintDC := BeginPaint(Handle, PS);15 16 if DC = 0 then17 begin18 /// 缓冲模式绘制，减少闪烁19 cBuffer := TBitmap.Create;20 try21 cBuffer.SetSize(FWidth, FHeight);22 PaintBackground(cBuffer.Canvas.Handle);23 Paint(cBuffer.Canvas.Handle);24 /// 通知子控件进行绘制25 /// 主要是些图形控件的重绘制（如TShape），否则停靠在Form上的图像控件无法正常显示26 if Control is TWinControl then27 TacWinControl(Control).PaintControls(cBuffer.Canvas.Handle, nil);28 BitBlt(hPaintDC, 0, 0, FWidth, FHeight, cBuffer.Canvas.Handle, 0, 0, SRCCOPY);29 finally30 cBuffer.Free;31 end;32 end33 else34 begin35 Paint(hPaintDC);36 // 通知子控件重绘37 if Control is TWinControl then38 TacWinControl(Control).PaintControls(hPaintDC, nil);39 end;40 41 if DC = 0 then42 EndPaint(Handle, PS);43 44 Handled := True;45 end;
其中的Paint不需要处理任何代码。
procedure TTest.Paint(DC: HDC);begin // 不需要处理。end;
基本的窗体绘制控制基本完成。
现在时下流行的换肤，还是比较容易实现。增加一块背景图资源，在绘制时算好位置贴上去就OK。还有一些鼠标滑入按钮的渐变效果，可以创建一个时钟记录每个按钮的背景褪色值（透明度）使用AlphaBlend 这个函数进行绘制，或是用混色的方法处理。
1 procedure DrawTransparentBitmap(Source: TBitmap; sx, sy: Integer; Destination: HDC; 2 const dX, dY: Integer; w, 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 then11 BlendFunc.AlphaFormat := AC_SRC_ALPHA12 else13 BlendFunc.AlphaFormat := 0;14 15 AlphaBlend(Destination, dX, dY, w, h, Source.Canvas.Handle, sx, sy, w, h, BlendFunc);16 end;
感觉XE3有些伤不起，Release版本的exe竟然要2.42M。哎～。看来要搞个C版的。
1 unit ufrmCaptionToolbar; 2 3 interface 4 5 uses 6 Messages, SysUtils, Variants, Types, Controls, Forms, Dialogs, StdCtrls, 7 ExtCtrls, 8 ComCtrls, 9 Windows, // 这个单元放在 ComCtrls 的后面，HITTEST 的定义重名。大小写不敏感真的很不方便 10 Classes, Graphics, 11 pngimage, Actions, ActnList, ToolWin, Vcl.ImgList, Vcl.Buttons; 12 13 type 14 TFormButtonKind = (fbkMin, fbkMax, fbkRestore, fbkClose, fbkHelp); 15 TSkinIndicator = (siInactive, siHover, siPressed, siSelected, siHoverSelected); 16 17 TTest = class 18 strict private 19 const 20 WM_NCUAHDRAWCAPTION = $00AE; 21 private 22 FCallDefaultProc: Boolean; 23 FChangeSizeCalled: Boolean; 24 FControl: TWinControl; 25 FHandled: Boolean; 26 27 FRegion: HRGN; 28 FLeft: integer; 29 FTop: integer; 30 FWidth: integer; 31 FHeight: integer; 32 33 /// 窗体图标 34 FIcon: TIcon; 35 FIconHandle: HICON; 36 37 // 38 FPressedHit: Integer; // 实际按下的位置, (只处理关心的位置，其他有交由系统处理) 39 FHotHit: integer; // 记录上次的测试位置 (只处理关心的位置，其他有交由系统处理) 40 41 // skin 42 // 这个内容应独立出来，作为单独一份配置应用于所有窗体。 43 FSkinData: TBitmap; 44 procedure DrawButton(DC: HDC; AKind: TFormButtonKind; AState: TSkinIndicator; const R: TRect); 45 46 function GetHandle: HWND; inline; 47 function GetForm: TCustomForm; inline; 48 function GetFrameSize: TRect; 49 function GetCaptionRect(AMaxed: Boolean): TRect; inline; 50 function GetCaption: string; 51 function GetIcon: TIcon; 52 function GetIconFast: TIcon; 53 54 procedure ChangeSize; 55 function NormalizePoint(P: TPoint): TPoint; 56 function HitTest(P: TPoint):integer; 57 procedure Maximize; 58 procedure Minimize; 59 60 // 第一组 实现绘制基础 61 procedure WMNCPaint(var message: TWMNCPaint); message WM_NCPAINT; 62 procedure WMNCActivate(var message: TMessage); message WM_NCACTIVATE; 63 procedure WMNCLButtonDown(var message: TWMNCHitMessage); message WM_NCLBUTTONDOWN; 64 procedure WMNCUAHDrawCaption(var message: TMessage); message WM_NCUAHDRAWCAPTION; 65 66 // 第二组 控制窗体样式 67 procedure WMNCCalcSize(var message: TWMNCCalcSize); message WM_NCCALCSIZE; 68 procedure WMWindowPosChanging(var message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING; 69 70 // 第三组 绘制背景和内部控件 71 procedure WMEraseBkgnd(var message: TWMEraseBkgnd); message WM_ERASEBKGND; 72 procedure WMPaint(var message: TWMPaint); message WM_PAINT; 73 74 // 第四组 控制按钮状态 75 procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; 76 procedure WMNCLButtonUp(var Message: TWMNCHitMessage); message WM_NCLBUTTONUP; 77 procedure WMNCMouseMove(var Message: TWMNCMouseMove); message WM_NCMOUSEMOVE; 78 79 procedure WMSetText(var Message: TMessage); message WM_SETTEXT; 80 81 procedure WndProc(var message: TMessage); 82 procedure CallDefaultProc(var message: TMessage); 83 84 protected 85 property Handle: HWND read GetHandle; 86 procedure InvalidateNC; 87 procedure PaintNC(DC: HDC); 88 procedure PaintBackground(DC: HDC); 89 procedure Paint(DC: HDC); 90 91 public 92 constructor Create(AOwner: TWinControl); 93 destructor Destroy; override; 94 95 property Handled: Boolean read FHandled write FHandled; 96 property Control: TWinControl read FControl; 97 property Form: TCustomForm read GetForm; 98 99 end;100 101 TForm11 = class(TForm)102 Button1: TButton;103 Shape1: TShape;104 Edit1: TEdit;105 Edit2: TEdit;106 Edit3: TEdit;107 Edit4: TEdit;108 ToolBar1: TToolBar;109 ToolButton1: TToolButton;110 ToolButton2: TToolButton;111 ToolButton3: TToolButton;112 ActionList1: TActionList;113 Action1: TAction;114 Action2: TAction;115 Action3: TAction;116 ImageList1: TImageList;117 procedure Action1Execute(Sender: TObject);118 procedure Action2Execute(Sender: TObject);119 procedure SpeedButton1Click(Sender: TObject);120 private121 FTest: TTest;122 protected123 function DoHandleMessage(var message: TMessage): Boolean;124 procedure WndProc(var message: TMessage); override;125 public126 constructor Create(AOwner: TComponent); override;127 destructor Destroy; override;128 end;129 130 Res = class131 class procedure LoadGraphic(const AName: string; AGraphic: TGraphic);132 class 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, T, W, H: Integer): TRect; inline;157 begin158 Result := Rect(L, T, L + W, T + H);159 end;160 161 procedure DrawTransparentBitmap(Source: TBitmap; sx, sy: Integer; Destination: HDC;162 const dX, dY: Integer; w, 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 then171 BlendFunc.AlphaFormat := AC_SRC_ALPHA172 else173 BlendFunc.AlphaFormat := 0;174 175 AlphaBlend(Destination, dX, dY, w, h, Source.Canvas.Handle, sx, sy, w, h, 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 try186 cBmp.PixelFormat := pf32bit;187 cBmp.alphaFormat := afIgnored;188 try189 LoadGraphic(AName, cPic);190 cBmp.SetSize(cPic.Width, cPic.Height);191 cBmp.Canvas.Brush.Color := clBlack;192 cBmp.Canvas.FillRect(Rect(0, 0, cBmp.Width, cBmp.Height));193 cBmp.Canvas.Draw(0, 0, cPic);194 except195 // 不处理空图片196 end;197 finally198 cPic.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, AName, RT_RCDATA);211 try212 AGraphic.LoadFromStream(cStream);213 finally214 cStream.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‘, [Tag]);236 end;237 238 procedure TForm11.Action2Execute(Sender: TObject);239 begin240 if Shape1.Shape <> High(TShapeType) then241 Shape1.Shape := Succ(Shape1.Shape)242 else243 Shape1.Shape := low(TShapeType);244 end;245 246 function TForm11.DoHandleMessage(var message: TMessage): Boolean;247 begin248 Result := False;249 if not FTest.FCallDefaultProc then250 begin251 FTest.WndProc(message);252 Result := FTest.Handled;253 end;254 end;255 256 procedure TForm11.SpeedButton1Click(Sender: TObject);257 begin258 Caption := format(‘test %d‘, [1]);259 end;260 261 procedure TForm11.WndProc(var message: TMessage);262 begin263 if not DoHandleMessage(Message) then264 inherited;265 end;266 267 procedure TTest.CallDefaultProc(var message: TMessage);268 begin269 if FCallDefaultProc then270 FControl.WindowProc(message)271 else272 begin273 FCallDefaultProc := True;274 FControl.WindowProc(message);275 FCallDefaultProc := False;276 end;277 end;278 279 procedure TTest.ChangeSize;280 var281 hTmp: HRGN;282 begin283 /// 设置窗体外框样式284 FChangeSizeCalled := True;285 try286 hTmp := FRegion;287 try288 /// 创建矩形外框，3的倒角289 FRegion := CreateRoundRectRgn(0, 0, FWidth, FHeight, 3, 3);290 SetWindowRgn(Handle, FRegion, True);291 finally292 if hTmp <> 0 then293 DeleteObject(hTmp);294 end;295 finally296 FChangeSizeCalled := False;297 end;298 end;299 300 function TTest.NormalizePoint(P: TPoint): TPoint;301 var302 rWindowPos, rClientPos: TPoint;303 begin304 rWindowPos := Point(FLeft, FTop);305 rClientPos := Point(0, 0);306 ClientToScreen(Handle, rClientPos);307 Result := P;308 ScreenToClient(Handle, Result);309 Inc(Result.X, rClientPos.X - rWindowPos.X);310 Inc(Result.Y, 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 then327 Exit;328 329 ///330 /// 只关心窗体按钮区域331 ///332 bMaxed := IsZoomed(Handle);333 rCaptionRect := GetCaptionRect(bMaxed);334 if PtInRect(rCaptionRect, p) then335 begin336 r.Right := rCaptionRect.Right - 1;337 r.Top := 0;338 if bMaxed then339 r.Top := rCaptionRect.Top;340 r.Top := r.Top + (rFrame.Top - r.Top - SIZE_SYSBTN.cy) div 2;341 r.Left := r.Right - SIZE_SYSBTN.cx;342 r.Bottom := r.Top + SIZE_SYSBTN.cy;343 344 ///345 /// 实际绘制的按钮就三个，其他没处理346 ///347 if (P.Y >= r.Top) and (p.Y <= r.Bottom) and (p.X <= r.Right) then348 begin349 if (P.X >= r.Left) then350 Result := HTCLOSE351 else if p.X >= (r.Left - SIZE_SYSBTN.cx) then352 Result := HTMAXBUTTON353 else if p.X >= (r.Left - SIZE_SYSBTN.cx * 2) then354 Result := HTMINBUTTON;355 end;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‘, FSkinData);374 end;375 376 destructor TTest.Destroy;377 begin378 FIconHandle := 0;379 if FSkinData <> nil then380 FreeAndNil(FSkinData);381 if FIcon <> nil then382 FreeAndNil(FIcon);383 if FRegion <> 0 then384 DeleteObject(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, y: integer;394 begin395 /// 绘制背景396 case AState of397 siHover : iColor := SKINCOLOR_BTNHOT;398 siPressed : iColor := SKINCOLOR_BTNPRESSED;399 siSelected : iColor := SKINCOLOR_BTNPRESSED;400 siHoverSelected : iColor := SKINCOLOR_BTNHOT;401 else iColor := SKINCOLOR_BAKCGROUND;402 end;403 hB := CreateSolidBrush(iColor);404 FillRect(DC, R, hB);405 DeleteObject(hB);406 407 /// 绘制图标408 rSrcOff := Point(SIZE_RESICON * ord(AKind), 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, rSrcOff.X, rSrcOff.Y, DC, x, y, SIZE_RESICON, 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 then426 Result := Rect(8, 8, FWidth - 9 , rFrame.Top)427 else428 Result := Rect(rFrame.Left, 3, FWidth - rFrame.right, 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 begin438 iLen := GetWindowText(Handle, Buffer, Length(Buffer));439 SetString(Result, Buffer, iLen);440 end441 else442 Result := ‘‘;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 then453 Result := FControl.Handle454 else455 Result := 0;456 end;457 458 function TTest.GetIcon: TIcon;459 var460 IconX, 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, WM_GETICON, ICON_SMALL, 0));470 if TmpHandle = 0 then471 TmpHandle := THandle(SendMessage(Handle, WM_GETICON, ICON_BIG, 0));472 473 if TmpHandle = 0 then474 begin475 { Get instance }476 GetClassName(Handle, @Buffer, SizeOf(Buffer));477 FillChar(Info, SizeOf(Info), 0);478 Info.cbSize := SizeOf(Info);479 480 if GetClassInfoEx(GetWindowLong(Handle, GWL_HINSTANCE), @Buffer, Info) then481 begin482 TmpHandle := Info.hIconSm;483 if TmpHandle = 0 then484 TmpHandle := Info.HICON;485 end486 end;487 488 if FIcon = nil then489 FIcon := TIcon.Create;490 491 if TmpHandle <> 0 then492 begin493 IconX := GetSystemMetrics(SM_CXSMICON);494 if IconX = 0 then495 IconX := GetSystemMetrics(SM_CXSIZE);496 IconY := GetSystemMetrics(SM_CYSMICON);497 if IconY = 0 then498 IconY := GetSystemMetrics(SM_CYSIZE);499 FIcon.Handle := CopyImage(TmpHandle, IMAGE_ICON, IconX, IconY, 0);500 FIconHandle := TmpHandle;501 end;502 503 Result := FIcon;504 end;505 506 function TTest.GetIconFast: TIcon;507 begin508 if (FIcon = nil) or (FIconHandle = 0) then509 Result := GetIcon510 else511 Result := FIcon;512 end;513 514 procedure TTest.InvalidateNC;515 begin516 if FControl.HandleAllocated then517 SendMessage(Handle, WM_NCPAINT, 1, 0);518 end;519 520 procedure TTest.Maximize;521 begin522 if Handle <> 0 then523 begin524 FPressedHit := 0;525 FHotHit := 0;526 if IsZoomed(Handle) then527 SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 0)528 else529 SendMessage(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0);530 end;531 end;532 533 procedure TTest.Minimize;534 begin535 if Handle <> 0 then536 begin537 FPressedHit := 0;538 FHotHit := 0;539 if IsIconic(Handle) then540 SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 0)541 else542 SendMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);543 end;544 end;545 546 procedure TTest.PaintNC(DC: HDC);547 const548 HITVALUES: array [TFormButtonKind] of integer = (HTMINBUTTON, HTMAXBUTTON, HTMAXBUTTON, HTCLOSE, HTHELP);549 550 function GetBtnState(AKind: TFormButtonKind): TSkinIndicator;551 begin552 if (FPressedHit = FHotHit) and (FPressedHit = HITVALUES[AKind]) then553 Result := siPressed554 else if FHotHit = HITVALUES[AKind] then555 Result := siHover556 else557 Result := 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 try573 bMaxed := IsZoomed(Handle);574 575 // 扣除客户区域576 rFrame := GetFrameSize;577 ExcludeClipRect(DC, rFrame.Left, rFrame.Top, FWidth - rFrame.Right, FHeight - rFrame.Bottom);578 579 ///580 /// 标题区域581 ///582 rCaptionRect := GetCaptionRect(bMaxed);583 584 // 填充整个窗体背景585 hB := CreateSolidBrush(SKINCOLOR_BAKCGROUND);586 FillRect(DC, Rect(0, 0, FWidth, FHeight), hB);587 DeleteObject(hB);588 589 /// 绘制窗体图标590 rButton := BuildRect(rCaptionRect.Left + 2, rCaptionRect.Top, GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON));591 rButton.Top := rButton.Top + (rFrame.Top - rButton.Bottom) div 2;592 DrawIconEx(DC, rButton.Left, rButton.Top, GetIconFast.Handle, 0, 0, 0, 0, DI_NORMAL);593 594 rCaptionRect.Left := rButton.Right + 5; // 前部留白595 596 /// 绘制窗体按钮区域597 rButton.Right := rCaptionRect.Right - 1;598 rButton.Top := 0;599 if bMaxed then600 rButton.Top := rCaptionRect.Top;601 rButton.Top := rButton.Top + (rFrame.Top - rButton.Top - SIZE_SYSBTN.cy) div 2;602 rButton.Left := rButton.Right - SIZE_SYSBTN.cx;603 rButton.Bottom := rButton.Top + SIZE_SYSBTN.cy;604 DrawButton(Dc, fbkClose, GetBtnState(fbkClose), rButton);605 606 OffsetRect(rButton, - SIZE_SYSBTN.cx, 0);607 if bMaxed then608 DrawButton(Dc, fbkRestore, GetBtnState(fbkRestore), rButton)609 else610 DrawButton(Dc, fbkMax, GetBtnState(fbkMax), rButton);611 612 OffsetRect(rButton, - SIZE_SYSBTN.cx, 0);613 DrawButton(Dc, fbkMin, GetBtnState(fbkMin), rButton);614 615 rCaptionRect.Right := rButton.Left - 3; // 后部空出616 617 /// 绘制Caption618 sData := GetCaption;619 SetBkMode(DC, TRANSPARENT);620 SaveColor := SetTextColor(DC, $00FFFFFF);621 622 Flag := DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;623 DrawTextEx(DC, PChar(sData), Length(sData), rCaptionRect, Flag, nil);624 SetTextColor(DC, SaveColor);625 finally626 RestoreDC(DC, SaveIndex);627 end;628 end;629 630 procedure TTest.PaintBackground(DC: HDC);631 var632 hB: HBRUSH;633 R: TRect;634 begin635 GetClientRect(Handle, R);636 hB := CreateSolidBrush($00F0F0F0);637 FillRect(DC, R, 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 begin655 SaveIndex := SaveDC(DC);656 PaintBackground(DC);657 RestoreDC(DC, 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 begin680 Inc(Left, R.Left);681 Inc(Top, R.Top);682 Dec(Right, R.Right);683 Dec(Bottom, 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, Message.YPos));696 697 // 获取 位置698 iHit := HitTest(p);699 if FHotHit > HTNOWHERE then700 begin701 Message.Result := iHit;702 Handled := True;703 end;704 705 if iHit <> FHotHit then706 begin707 FHotHit := iHit;708 InvalidateNC;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 then724 Exit;725 726 if (Message.WindowPos^.flags and SWP_NOSIZE = 0) or (Message.WindowPos^.flags and SWP_NOMOVE = 0) then727 begin728 if (Message.WindowPos^.flags and SWP_NOMOVE = 0) then729 begin730 FLeft := Message.WindowPos^.x;731 FTop := Message.WindowPos^.y;732 end;733 if (Message.WindowPos^.flags and SWP_NOSIZE = 0) then734 begin735 bChanged := ((Message.WindowPos^.cx <> FWidth) or (Message.WindowPos^.cy <> FHeight)) and736 (Message.WindowPos^.flags and SWP_NOSIZE = 0);737 FWidth := Message.WindowPos^.cx;738 FHeight := Message.WindowPos^.cy;739 end;740 end;741 742 if (Message.WindowPos^.flags and SWP_FRAMECHANGED <> 0) then743 bChanged := True;744 745 if bChanged then746 begin747 ChangeSize;748 InvalidateNC;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 begin762 iHit := Message.HitTest;763 764 Message.Result := 0;765 Message.Msg := WM_NULL;766 Handled := True;767 end;768 769 if iHit <> FPressedHit then770 begin771 FPressedHit := iHit;772 InvalidateNC;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 begin783 FPressedHit := HTNOWHERE;784 //InvalidateNC;785 786 if iWasHit = FHotHit then787 begin788 case Message.HitTest of789 HTCLOSE : SendMessage(Handle, WM_SYSCOMMAND, SC_CLOSE, 0);790 HTMAXBUTTON : Maximize;791 HTMINBUTTON : Minimize;792 HTHELP : SendMessage(Handle, WM_SYSCOMMAND, SC_CONTEXTHELP, 0);793 end;794 795 Message.Result := 0;796 Message.Msg := WM_NULL;797 Handled := True;798 end;799 end;800 end;801 802 procedure TTest.WMNCMouseMove(var Message: TWMNCMouseMove);803 begin804 if (FPressedHit <> HTNOWHERE) and (FPressedHit <> Message.HitTest) then805 FPressedHit := 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, DC);822 Handled := True;823 end;824 825 procedure TTest.WMNCUAHDrawCaption(var message: TMessage);826 begin827 /// 这个消息会在winxp下产生，是内部Bug处理，直接丢弃此消息828 Handled := True;829 end;830 831 procedure TTest.WMPaint(var message: TWMPaint);832 var833 DC, hPaintDC: HDC;834 cBuffer: TBitmap;835 PS: TPaintStruct;836 begin837 ///838 /// 绘制客户区域839 ///840 DC := Message.DC;841 842 hPaintDC := DC;843 if DC = 0 then844 hPaintDC := BeginPaint(Handle, PS);845 846 if DC = 0 then847 begin848 /// 缓冲模式绘制，减少闪烁849 cBuffer := TBitmap.Create;850 try851 cBuffer.SetSize(FWidth, FHeight);852 PaintBackground(cBuffer.Canvas.Handle);853 Paint(cBuffer.Canvas.Handle);854 /// 通知子控件进行绘制855 /// 主要是些图形控件的重绘制（如TShape），否则停靠在Form上的图像控件无法正常显示856 if Control is TWinControl then857 TacWinControl(Control).PaintControls(cBuffer.Canvas.Handle, nil);858 BitBlt(hPaintDC, 0, 0, FWidth, FHeight, cBuffer.Canvas.Handle, 0, 0, SRCCOPY);859 finally860 cBuffer.Free;861 end;862 end863 else864 begin865 Paint(hPaintDC);866 // 通知子控件重绘867 if Control is TWinControl then868 TacWinControl(Control).PaintControls(hPaintDC, nil);869 end;870 871 if DC = 0 then872 EndPaint(Handle, 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
窗体皮肤实现 - 重绘窗体非客户区（三）
声明：以上内容来自用户投稿及互联网公开渠道收集整理发布，本网站不拥有所有权，未作人工编辑处理，也不承担相关法律责任，若内容有误或涉及侵权可进行投诉： 投诉/举报 工作人员会在5个工作日内联系你，一经查实，本站将立刻删除涉嫌侵权内容。