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

时间：2014-09-12 01:07:32 阅读：703 评论：0 收藏：0 [点我收藏+]

标签：des style blog http color io os 使用 ar

窗体边框基本的绘制和控制完成，在第二篇中主要遗留的问题。

标题区域图标和按钮没绘制
缩放时客户区显示有问题

解决完下面的问题，皮肤处理基本完整。大致的效果GIF

bubuko.com,布布扣

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 then
10     Result := Rect(8, 8, FWidth - 9 , rFrame.Top)
11   else
12     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 then
3     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 then
10     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 then
14     TmpHandle := THandle(SendMessage(Handle, WM_GETICON, ICON_BIG, 0));
15 
16   if TmpHandle = 0 then
17   begin
18     { 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) then
24     begin
25       TmpHandle := Info.hIconSm;
26       if TmpHandle = 0 then
27         TmpHandle := Info.HICON;
28     end
29   end;
30 
31   if FIcon = nil then
32     FIcon := TIcon.Create;
33 
34   if TmpHandle <> 0 then
35   begin
36     IconX := GetSystemMetrics(SM_CXSMICON);
37     if IconX = 0 then
38       IconX := GetSystemMetrics(SM_CXSIZE);
39     IconY := GetSystemMetrics(SM_CYSMICON);
40     if IconY = 0 then
41       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图片，做成资源文件加入到单元中。

bubuko.com,布布扣

注：图标是白色的没底色看不见，所以在贴的图上加了个黑底。

计算好实际位置后，直接把从资源中加载的图标绘制上去。

 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 of
10     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 /// 绘制Caption
2 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 then
13   begin
14     Message.Result := iHit;
15     Handled := True;            // 处理完成，不再交由系统处理
16   end;
17   
18   // 响应鼠标滑入监控区域后，通知非客户区重绘
19   if iHit <> FHotHit then
20   begin
21     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 then
15     Exit;
16 
17   ///
18   ///  只关心窗体按钮区域
19   ///
20   bMaxed := IsZoomed(Handle);
21   rCaptionRect := GetCaptionRect(bMaxed);
22   if PtInRect(rCaptionRect, p) then
23   begin
24     r.Right := rCaptionRect.Right - 1;
25     r.Top := 0;
26     if bMaxed then
27       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) then
36     begin
37       if (P.X >= r.Left) then
38         Result := HTCLOSE
39       else if p.X >= (r.Left - SIZE_SYSBTN.cx) then
40         Result := HTMAXBUTTON
41       else if p.X >= (r.Left - SIZE_SYSBTN.cx * 2) then
42         Result := HTMINBUTTON;
43     end;
44   end;
45 end;

function HitTest(P: TPoint):integer

上面代码获取当前鼠标所在位置，这样滑入的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   begin
10     iHit := Message.HitTest;
11     Message.Result := 0;
12     Message.Msg := WM_NULL;
13     Handled := True;           // 消息已经处理完成，不再交由系统处理
14   end;
15 
16   // 如果按下的位置发生变化，重绘标题区
17   if iHit <> FPressedHit then
18   begin
19     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   begin
11     // 按下区域 一定和 Hot区域一致，保证鼠标点击到弹起的区域是一致，才能执行
12     if (FPressedHit = FHotHit) and (FPressedHit = HITVALUES[AKind]) then
13       Result := siPressed
14     else if FHotHit = HITVALUES[AKind] then
15       Result := siHover
16     else
17       Result := siInactive;
18   end;
19 
20   ... ...
21 begin
22     ... ...
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   begin
10     FPressedHit := HTNOWHERE;
11     //InvalidateNC;
12 
13     if iWasHit = FHotHit then
14     begin
15       case Message.HitTest of
16         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     else
10       SendMessage(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0);
11   end;
12 end;
13 
14 procedure TTest.Minimize;
15 begin
16   if Handle <> 0 then
17   begin
18     FPressedHit := 0;
19     FHotHit := 0;
20     if IsIconic(Handle) then
21       SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
22     else
23       SendMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
24    end;
25 end;

fun Maximize Minimize

整个标题区的消息基本处理完成，能正常相应标题区应有的功能。还有些细节上面需要处理一下，如修改窗体标题没有及时响应。WM_SETTEXT消息用于处理标题修改。

1 procedure TTest.WMSetText(var Message: TMessage);
2 begin
3   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 then
14     hPaintDC := BeginPaint(Handle, PS);
15 
16   if DC = 0 then
17   begin
18     /// 缓冲模式绘制，减少闪烁
19     cBuffer := TBitmap.Create;
20     try
21       cBuffer.SetSize(FWidth, FHeight);
22       PaintBackground(cBuffer.Canvas.Handle);
23       Paint(cBuffer.Canvas.Handle);
24       /// 通知子控件进行绘制
25       /// 主要是些图形控件的重绘制（如TShape），否则停靠在Form上的图像控件无法正常显示
26       if Control is TWinControl then
27         TacWinControl(Control).PaintControls(cBuffer.Canvas.Handle, nil);
28       BitBlt(hPaintDC, 0, 0, FWidth, FHeight, cBuffer.Canvas.Handle, 0, 0, SRCCOPY);
29     finally
30       cBuffer.Free;
31     end;
32   end
33   else
34   begin
35     Paint(hPaintDC);
36     // 通知子控件重绘
37     if Control is TWinControl then
38       TacWinControl(Control).PaintControls(hPaintDC, nil);
39   end;
40 
41   if DC = 0 then
42     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 then
11     BlendFunc.AlphaFormat := AC_SRC_ALPHA
12   else
13     BlendFunc.AlphaFormat := 0;
14 
15   AlphaBlend(Destination, dX, dY, w, h, Source.Canvas.Handle, sx, sy, w, h, BlendFunc);
16 end;

通过透明度控制背景动画效果，参考DrawTransparentBitmap

感觉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   private
121     FTest: TTest;
122   protected
123     function DoHandleMessage(var message: TMessage): Boolean;
124     procedure WndProc(var message: TMessage); override;
125   public
126     constructor Create(AOwner: TComponent); override;
127     destructor Destroy; override;
128   end;
129 
130   Res = class
131     class procedure LoadGraphic(const AName: string; AGraphic: TGraphic);
132     class procedure LoadBitmap(const AName: string; AGraphic: TBitmap);
133   end;
134 
135 var
136   Form11: TForm11;
137 
138 implementation
139 
140 const
141   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 type
154   TacWinControl = class(TWinControl);
155 
156 function BuildRect(L, T, W, H: Integer): TRect; inline;
157 begin
158   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 var
164   BlendFunc: TBlendFunction;
165 begin
166   BlendFunc.BlendOp := AC_SRC_OVER;
167   BlendFunc.BlendFlags := 0;
168   BlendFunc.SourceConstantAlpha := Opacity;
169 
170   if Source.PixelFormat = pf32bit then
171     BlendFunc.AlphaFormat := AC_SRC_ALPHA
172   else
173     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 var
180   cPic: TPngImage;
181   cBmp: TBitmap;
182 begin
183   cBmp := AGraphic;
184   cPic := TPngImage.Create;
185   try
186     cBmp.PixelFormat := pf32bit;
187     cBmp.alphaFormat := afIgnored;
188     try
189       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     except
195       // 不处理空图片
196     end;
197   finally
198     cPic.Free;
199   end;
200 end;
201 
202 class procedure Res.LoadGraphic(const AName: string; AGraphic: TGraphic);
203 var
204   cStream: TResourceStream;
205   h: THandle;
206 begin
207   ///
208   /// 加载图片资源
209   h := HInstance;
210   cStream := TResourceStream.Create(h, AName, RT_RCDATA);
211   try
212     AGraphic.LoadFromStream(cStream);
213   finally
214     cStream.Free;
215   end;
216 end;
217 
218 { TForm11 }
219 
220 constructor TForm11.Create(AOwner: TComponent);
221 begin
222   FTest := TTest.Create(Self);
223   inherited;
224 end;
225 
226 destructor TForm11.Destroy;
227 begin
228   inherited;
229   FreeAndNil(FTest);
230 end;
231 
232 procedure TForm11.Action1Execute(Sender: TObject);
233 begin
234   Tag := Tag + 1;
235   Caption := format(‘test %d‘, [Tag]);
236 end;
237 
238 procedure TForm11.Action2Execute(Sender: TObject);
239 begin
240   if Shape1.Shape <> High(TShapeType) then
241     Shape1.Shape := Succ(Shape1.Shape)
242   else
243     Shape1.Shape := low(TShapeType);
244 end;
245 
246 function TForm11.DoHandleMessage(var message: TMessage): Boolean;
247 begin
248   Result := False;
249   if not FTest.FCallDefaultProc then
250   begin
251     FTest.WndProc(message);
252     Result := FTest.Handled;
253   end;
254 end;
255 
256 procedure TForm11.SpeedButton1Click(Sender: TObject);
257 begin
258   Caption := format(‘test %d‘, [1]);
259 end;
260 
261 procedure TForm11.WndProc(var message: TMessage);
262 begin
263   if not DoHandleMessage(Message) then
264     inherited;
265 end;
266 
267 procedure TTest.CallDefaultProc(var message: TMessage);
268 begin
269   if FCallDefaultProc then
270     FControl.WindowProc(message)
271   else
272   begin
273     FCallDefaultProc := True;
274     FControl.WindowProc(message);
275     FCallDefaultProc := False;
276   end;
277 end;
278 
279 procedure TTest.ChangeSize;
280 var
281   hTmp: HRGN;
282 begin
283   /// 设置窗体外框样式
284   FChangeSizeCalled := True;
285   try
286     hTmp := FRegion;
287     try
288       /// 创建矩形外框，3的倒角
289       FRegion := CreateRoundRectRgn(0, 0, FWidth, FHeight, 3, 3);
290       SetWindowRgn(Handle, FRegion, True);
291     finally
292       if hTmp <> 0 then
293         DeleteObject(hTmp);
294     end;
295   finally
296     FChangeSizeCalled := False;
297   end;
298 end;
299 
300 function TTest.NormalizePoint(P: TPoint): TPoint;
301 var
302   rWindowPos, rClientPos: TPoint;
303 begin
304   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 var
315   bMaxed: Boolean;
316   r: TRect;
317   rCaptionRect: TRect;
318   rFrame: TRect;
319 begin
320   Result := HTNOWHERE;
321 
322   ///
323   /// 检测位置
324   ///
325   rFrame := GetFrameSize;
326   if p.Y > rFrame.Top then
327     Exit;
328 
329   ///
330   ///  只关心窗体按钮区域
331   ///
332   bMaxed := IsZoomed(Handle);
333   rCaptionRect := GetCaptionRect(bMaxed);
334   if PtInRect(rCaptionRect, p) then
335   begin
336     r.Right := rCaptionRect.Right - 1;
337     r.Top := 0;
338     if bMaxed then
339       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) then
348     begin
349       if (P.X >= r.Left) then
350         Result := HTCLOSE
351       else if p.X >= (r.Left - SIZE_SYSBTN.cx) then
352         Result := HTMAXBUTTON
353       else if p.X >= (r.Left - SIZE_SYSBTN.cx * 2) then
354         Result := HTMINBUTTON;
355     end;
356   end;
357 end;
358 
359 constructor TTest.Create(AOwner: TWinControl);
360 begin
361   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 begin
378   FIconHandle := 0;
379   if FSkinData <> nil then
380     FreeAndNil(FSkinData);
381   if FIcon <> nil then
382     FreeAndNil(FIcon);
383   if FRegion <> 0 then
384     DeleteObject(FRegion);
385   inherited;
386 end;
387 
388 procedure TTest.DrawButton(DC: HDC; AKind: TFormButtonKind; AState: TSkinIndicator; const R: TRect);
389 var
390   hB: HBRUSH;
391   iColor: Cardinal;
392   rSrcOff: TPoint;
393   x, y: integer;
394 begin
395   /// 绘制背景
396   case AState of
397     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 begin
416   Result := SIZE_FRAME;
417 end;
418 
419 function TTest.GetCaptionRect(AMaxed: Boolean): TRect;
420 var
421   rFrame: TRect;
422 begin
423   rFrame := GetFrameSize;
424   // 最大化状态简易处理
425   if AMaxed then
426     Result := Rect(8, 8, FWidth - 9 , rFrame.Top)
427   else
428     Result := Rect(rFrame.Left, 3, FWidth - rFrame.right, rFrame.Top);
429 end;
430 
431 function TTest.GetCaption: string;
432 var
433   Buffer: array [0..255] of Char;
434   iLen: integer;
435 begin
436   if Handle <> 0 then
437   begin
438     iLen := GetWindowText(Handle, Buffer, Length(Buffer));
439     SetString(Result, Buffer, iLen);
440   end
441   else
442     Result := ‘‘;
443 end;
444 
445 function TTest.GetForm: TCustomForm;
446 begin
447   Result := TCustomForm(Control);
448 end;
449 
450 function TTest.GetHandle: HWND;
451 begin
452   if FControl.HandleAllocated then
453     Result := FControl.Handle
454   else
455     Result := 0;
456 end;
457 
458 function TTest.GetIcon: TIcon;
459 var
460   IconX, IconY: integer;
461   TmpHandle: THandle;
462   Info: TWndClassEx;
463   Buffer: array [0 .. 255] of Char;
464 begin
465   ///
466   /// 获取当前form的图标
467   /// 这个图标和App的图标是不同的
468   ///
469   TmpHandle := THandle(SendMessage(Handle, WM_GETICON, ICON_SMALL, 0));
470   if TmpHandle = 0 then
471     TmpHandle := THandle(SendMessage(Handle, WM_GETICON, ICON_BIG, 0));
472 
473   if TmpHandle = 0 then
474   begin
475     { 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) then
481     begin
482       TmpHandle := Info.hIconSm;
483       if TmpHandle = 0 then
484         TmpHandle := Info.HICON;
485     end
486   end;
487 
488   if FIcon = nil then
489     FIcon := TIcon.Create;
490 
491   if TmpHandle <> 0 then
492   begin
493     IconX := GetSystemMetrics(SM_CXSMICON);
494     if IconX = 0 then
495       IconX := GetSystemMetrics(SM_CXSIZE);
496     IconY := GetSystemMetrics(SM_CYSMICON);
497     if IconY = 0 then
498       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 begin
508   if (FIcon = nil) or (FIconHandle = 0) then
509     Result := GetIcon
510   else
511     Result := FIcon;
512 end;
513 
514 procedure TTest.InvalidateNC;
515 begin
516   if FControl.HandleAllocated then
517     SendMessage(Handle, WM_NCPAINT, 1, 0);
518 end;
519 
520 procedure TTest.Maximize;
521 begin
522   if Handle <> 0 then
523   begin
524     FPressedHit := 0;
525     FHotHit := 0;
526     if IsZoomed(Handle) then
527       SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
528     else
529       SendMessage(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0);
530   end;
531 end;
532 
533 procedure TTest.Minimize;
534 begin
535   if Handle <> 0 then
536   begin
537     FPressedHit := 0;
538     FHotHit := 0;
539     if IsIconic(Handle) then
540       SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
541     else
542       SendMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
543    end;
544 end;
545 
546 procedure TTest.PaintNC(DC: HDC);
547 const
548   HITVALUES: array [TFormButtonKind] of integer = (HTMINBUTTON, HTMAXBUTTON, HTMAXBUTTON, HTCLOSE, HTHELP);
549 
550   function GetBtnState(AKind: TFormButtonKind): TSkinIndicator;
551   begin
552     if (FPressedHit = FHotHit) and (FPressedHit = HITVALUES[AKind]) then
553       Result := siPressed
554     else if FHotHit = HITVALUES[AKind] then
555       Result := siHover
556     else
557       Result := siInactive;
558   end;
559 
560 var
561   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 begin
571   SaveIndex := SaveDC(DC);
572   try
573     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 then
600       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 then
608       DrawButton(Dc, fbkRestore, GetBtnState(fbkRestore), rButton)
609     else
610       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     /// 绘制Caption
618     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   finally
626     RestoreDC(DC, SaveIndex);
627   end;
628 end;
629 
630 procedure TTest.PaintBackground(DC: HDC);
631 var
632   hB: HBRUSH;
633   R: TRect;
634 begin
635   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 begin
643   // PaintBackground(DC);
644   // TODO -cMM: TTest.Paint default body inserted
645 end;
646 
647 procedure TTest.WMEraseBkgnd(var message: TWMEraseBkgnd);
648 var
649   DC: HDC;
650   SaveIndex: integer;
651 begin
652   DC := Message.DC;
653   if DC <> 0 then
654   begin
655     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 begin
666   // FFormActive := Message.WParam > 0;
667   Message.Result := 1;
668   InvalidateNC;
669   Handled := True;
670 end;
671 
672 procedure TTest.WMNCCalcSize(var message: TWMNCCalcSize);
673 var
674   R: TRect;
675 begin
676   // 改变边框尺寸
677   R := GetFrameSize;
678   with TWMNCCalcSize(Message).CalcSize_Params^.rgrc[0] do
679   begin
680     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 var
691   P: TPoint;
692   iHit: integer;
693 begin
694   // 需要把位置转换到实际窗口位置
695   P := NormalizePoint(Point(Message.XPos, Message.YPos));
696 
697   // 获取 位置
698   iHit := HitTest(p);
699   if FHotHit > HTNOWHERE then
700   begin
701     Message.Result := iHit;
702     Handled := True;
703   end;
704 
705   if iHit <> FHotHit then
706   begin
707     FHotHit := iHit;
708     InvalidateNC;
709   end;
710 
711 end;
712 
713 procedure TTest.WMWindowPosChanging(var message: TWMWindowPosChanging);
714 var
715   bChanged: Boolean;
716 begin
717   CallDefaultProc(TMessage(Message));
718 
719   Handled := True;
720   bChanged := False;
721 
722   /// 防止嵌套
723   if FChangeSizeCalled then
724     Exit;
725 
726   if (Message.WindowPos^.flags and SWP_NOSIZE = 0) or (Message.WindowPos^.flags and SWP_NOMOVE = 0) then
727   begin
728     if (Message.WindowPos^.flags and SWP_NOMOVE = 0) then
729     begin
730       FLeft := Message.WindowPos^.x;
731       FTop := Message.WindowPos^.y;
732     end;
733     if (Message.WindowPos^.flags and SWP_NOSIZE = 0) then
734     begin
735       bChanged := ((Message.WindowPos^.cx <> FWidth) or (Message.WindowPos^.cy <> FHeight)) and
736         (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) then
743     bChanged := True;
744 
745   if bChanged then
746   begin
747     ChangeSize;
748     InvalidateNC;
749   end;
750 end;
751 
752 procedure TTest.WMNCLButtonDown(var message: TWMNCHitMessage);
753 var
754   iHit: integer;
755 begin
756   inherited;
757 
758   iHit := HTNOWHERE;
759   if (Message.HitTest = HTCLOSE) or (Message.HitTest = HTMAXBUTTON) or (Message.HitTest = HTMINBUTTON) or
760     (Message.HitTest = HTHELP) then
761   begin
762     iHit := Message.HitTest;
763 
764     Message.Result := 0;
765     Message.Msg := WM_NULL;
766     Handled := True;
767   end;
768 
769   if iHit <> FPressedHit then
770   begin
771     FPressedHit := iHit;
772     InvalidateNC;
773   end;
774 end;
775 
776 procedure TTest.WMNCLButtonUp(var Message: TWMNCHitMessage);
777 var
778   iWasHit: Integer;
779 begin
780   iWasHit := FPressedHit;
781   if iWasHit <> HTNOWHERE then
782   begin
783     FPressedHit := HTNOWHERE;
784     //InvalidateNC;
785 
786     if iWasHit = FHotHit then
787     begin
788       case Message.HitTest of
789         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 begin
804   if (FPressedHit <> HTNOWHERE) and (FPressedHit <> Message.HitTest) then
805     FPressedHit := HTNOWHERE;
806 end;
807 
808 procedure TTest.WMSetText(var Message: TMessage);
809 begin
810   CallDefaultProc(Message);
811   InvalidateNC;
812   Handled := true;
813 end;
814 
815 procedure TTest.WMNCPaint(var message: TWMNCPaint);
816 var
817   DC: HDC;
818 begin
819   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 begin
827   /// 这个消息会在winxp下产生，是内部Bug处理，直接丢弃此消息
828   Handled := True;
829 end;
830 
831 procedure TTest.WMPaint(var message: TWMPaint);
832 var
833   DC, hPaintDC: HDC;
834   cBuffer: TBitmap;
835   PS: TPaintStruct;
836 begin
837   ///
838   /// 绘制客户区域
839   ///
840   DC := Message.DC;
841 
842   hPaintDC := DC;
843   if DC = 0 then
844     hPaintDC := BeginPaint(Handle, PS);
845 
846   if DC = 0 then
847   begin
848     /// 缓冲模式绘制，减少闪烁
849     cBuffer := TBitmap.Create;
850     try
851       cBuffer.SetSize(FWidth, FHeight);
852       PaintBackground(cBuffer.Canvas.Handle);
853       Paint(cBuffer.Canvas.Handle);
854       /// 通知子控件进行绘制
855       /// 主要是些图形控件的重绘制（如TShape），否则停靠在Form上的图像控件无法正常显示
856       if Control is TWinControl then
857         TacWinControl(Control).PaintControls(cBuffer.Canvas.Handle, nil);
858       BitBlt(hPaintDC, 0, 0, FWidth, FHeight, cBuffer.Canvas.Handle, 0, 0, SRCCOPY);
859     finally
860       cBuffer.Free;
861     end;
862   end
863   else
864   begin
865     Paint(hPaintDC);
866     // 通知子控件重绘
867     if Control is TWinControl then
868       TacWinControl(Control).PaintControls(hPaintDC, nil);
869   end;
870 
871   if DC = 0 then
872     EndPaint(Handle, PS);
873 
874   Handled := True;
875 end;
876 
877 procedure TTest.WndProc(var message: TMessage);
878 begin
879   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

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

标签：des style blog http color io os 使用 ar

原文地址：http://www.cnblogs.com/gleam/p/3966841.html

踩

(0)

评论一句话评论（0）

分享档案

更多>

2021年07月29日 (22)
2021年07月28日 (40)
2021年07月27日 (32)
2021年07月26日 (79)
2021年07月23日 (29)
2021年07月22日 (30)
2021年07月21日 (42)
2021年07月20日 (16)
2021年07月19日 (90)
2021年07月16日 (35)

周排行