窗体皮肤实现 - 在标题栏上增加快速工具条（四）

  前面做的工作就是想在标题区域增加快速工具条。前续的基础工作完成，想要在标题区域增加特殊区域都非常方便。只要在绘制时控制自定义区域需要占用标题区域多少空间，然后直接在所占位置绘制。做这个事情前，稍微把代码规整了下。所以界面皮肤处理放到一个单元中。

 

 

主要处理步骤

  1、划出一个新区域（整个工具条作为一个区域）

  2、处理区域检测（HitTest）

  3、如果是新区域，把相应消息传给这个区域处理。

  4、响应鼠标点击，执行Action

 

通过上述步骤就能扩展出所想要的标题区快速工具条的。

 

标题按钮区域是作为一个整体处理，这样比较容易控制和扩展。只要当检测区域是标题工具区时，消息交由工具条实现。

 1   HTCUSTOM = 100; //HTHELP + 1;       /// 自定义区域ID
 2   HTCAPTIONTOOLBAR = HTCUSTOM + 1;    /// 标题工具区域ID
 3 
 4 
 5 ///
 6 /// 检测区域时增加自定义区域的检测
 7 function TskForm.HitTest(P: TPoint):integer;
 8 begin
 9     ... ... (代码略)  
10     ///
11     ///  标题工具区域
12     ///    需要前面扣除窗体图标区域
13     if (Result = HTNOWHERE) and (FToolbar.Visible) then
14     begin
15       r.Left := rCaptionRect.Left + 2 + GetSystemMetrics(SM_CXSMICON) + SPALCE_CAPTIONAREA;
16       R.Top := rCaptionRect.Top + (rCaptionRect.Height - FToolbar.Border.Height) div 2;
17       R.Right := R.Left + FToolbar.Border.Width;
18       R.Bottom := R.Top + FToolbar.Border.Height;
19 
20       if FToolbar.FOffset.X = -1 then
21         FToolbar.FOffset := r.TopLeft;
22 
23       if PtInRect(r, p) then
24         Result := HTCAPTIONTOOLBAR;
25     end;
26   end;
27 end;

这样做的好处就是，简化自定义皮肤TskForm内部的处理。模块化比较清晰，简化实现逻辑。

 

标题工具条实现过程

   1、准备绘制的区域

   2、确定绘制区域大小

   3、实现绘制

   4、响应消息

 

确定绘制区域大小

  考虑到按钮是动态增加上去，需要根据实际标题区域的按钮数量来确定实际大小。所有的Action存放在记录中，这样每次只要循环Action数组就可以获得相应宽度。

区域的宽度包括：两条分割线 + 下拉配置菜单 + Button * Count

 1 /// 用于保存Action的信息
 2 TcpToolButton = record
 3   Action: TBasicAction;
 4   Enabled: boolean;
 5   Visible: Boolean;
 6   ImageIndex: Integer;        // 考虑到标题功能图标和实际工具栏功能使用不同图标情况，分开图标索引
 7   Width: Word;                // 实际占用宽度，考虑后续加不同的按钮样式使用
 8   Fade: Word;                 // 褪色量 0 - 255
 9   SaveEvent: TNotifyEvent;    // 原始的Action OnChange事件
10 end;
11 
12 ///
13 /// 计算实际占用尺寸
14 function TcpToolbar.CalcSize: TRect;
15 const
16   SIZE_SPLITER = 10;
17   SIZE_POPMENU = 10;
18   SIZE_BUTTON  = 20;
19 var
20   w, h: Integer;
21   I: Integer;
22 begin
23   ///
24   ///  占用宽度
25   ///     如果考虑比较复杂的按钮样式和显示标题等功能，那么需要计算每个按钮实际占用宽度才能获得。
26 
27   w := SIZE_SPLITER * 2 + SIZE_POPMENU;
28   for I := 0 to FCount - 1 do
29     w := w + FItems[i].Width;
30   h := SIZE_BUTTON;
31   Result := Rect(0, 0, w, h);
32 end;

 

占用区域大小的问题解决，绘制问题主要考虑在什么位置绘制，怎么获得Action的图标和实际的状态。

以正常情况考虑绘制区域：从原点（0，0）开始绘制，这样比较符合一般的习惯。只要在绘制前对画布重新设置原点，就能实现。

 1 ///
 2 /// 绘制工具条
 3 if FToolbar.Visible and (rCaptionRect.Right > rCaptionRect.Left) then
 4 begin
 5   /// 防止出现绘制出多余区域，当区域不够时需要进行剪切。
 6   ///  如： 窗体缩小时
 7   CurrentIdx := 0;
 8   bClipRegion := rCaptionRect.Width < FToolbar.Border.Width;
 9   if bClipRegion then
10   begin
11     ClipRegion := CreateRectRgnIndirect(rCaptionRect);
12     CurrentIdx := SelectClipRgn(DC, ClipRegion);
13     DeleteObject(ClipRegion);
14   end;
15 
16   /// 设置原点偏移量
17   iLeftOff := rCaptionRect.Left;
18   iTopOff := rCaptionRect.Top + (rCaptionRect.Height - FToolbar.Border.Height) div 2;
19   MoveWindowOrg(DC, iLeftOff, iTopOff);
20   FToolbar.Paint(DC);
21   MoveWindowOrg(DC, -iLeftOff, -iTopOff);
22 
23   if bClipRegion then
24     SelectClipRgn(DC, CurrentIdx);
25 
26   /// 扣除工具条区域
27   rCaptionRect.Left := rCaptionRect.Left + FToolbar.Border.Width + SPALCE_CAPTIONAREA;
28 end;

 

获取Action的图标

  直接从ImageList中获取。考虑标题区域是纯色，能让标题工具条显的更美观（个人审美），能让工具条支持2中不同的图标。画了一组纯白的图标用于标题区域的显示。

 1 // 创建Bmp，支持透明
 2 // cIcon := TBitmap.Create;
 3 // cIcon.PixelFormat := pf32bit;  // 支持透明
 4 // cIcon.alphaFormat := afIgnored;
 5 
 6 function TcpToolbar.LoadActionIcon(Idx: Integer; AImg: TBitmap):Boolean;
 7 var
 8   bHasImg: Boolean;
 9 begin
10   /// 获取Action的图标
11   AImg.Canvas.Brush.Color := clBlack;
12   AImg.Canvas.FillRect(Rect(0,0, AImg.Width, AImg.Height));
13   bHasImg := False;
14   if (FImages <> nil) and (FItems[Idx].ImageIndex >= 0) then
15     bHasImg := FImages.GetBitmap(FItems[Idx].ImageIndex, AImg);
16   if not bHasImg and (FItems[Idx].Action is TCustomAction) then
17     with TCustomAction(FItems[Idx].Action) do
18       if (Images <> nil) and (ImageIndex >= 0) then
19         bHasImg := Images.GetBitmap(ImageIndex, AImg);
20   Result := bHasImg;
21 end;
获取Action的图标

 

绘制工具条

  有了尺寸和Action就可以直接进行绘制。鼠标滑过和按下状态的处理方法和系统按钮区域的方法一致。

 1 procedure TcpToolbar.Paint(DC: HDC);
 2 
 3   function GetActionState(Idx: Integer): TSkinIndicator;
 4   begin
 5     Result := siInactive;
 6     if (Idx = FPressedIndex) and (FHotIndex = FPressedIndex) then
 7       Result := siPressed
 8     else if Idx = FHotIndex then
 9       Result := siHover;
10   end;
11 
12 var
13   cIcon: TBitmap;
14   r: TRect;
15   I: Integer;
16   iOpacity: byte;
17 begin
18   ///
19   ///  工具条绘制
20   ///
21 
22   /// 分割线
23   r := Border;
24   r.Right := r.Left + RES_CAPTIONTOOLBAR.w;
25   SkinData.DrawElement(DC, steSplitter, r);
26   OffsetRect(r, r.Right - r.Left, 0);
27 
28   /// 绘制Button
29   cIcon := TBitmap.Create;
30   cIcon.PixelFormat := pf32bit;
31   cIcon.alphaFormat := afIgnored;
32   for I := 0 to FCount - 1 do
33   begin
34     r.Right := r.Left + FItems[i].Width;
35     if FItems[I].Enabled then
36       SkinData.DrawButtonBackground(DC, GetActionState(i), r, FItems[i].Fade);
37     if LoadActionIcon(i, cIcon) then
38     begin
39       iOpacity := 255;
40       /// 处理不可用状态，图标颜色变暗。
41       ///   简易处理，增加绘制透明度。
42       if not FItems[i].Enabled then
43         iOpacity := 100;
44 
45       SkinData.DrawIcon(DC, r, cIcon, iOpacity);
46     end;
47     OffsetRect(r, r.Right - r.Left, 0);
48   end;
49   cIcon.free;
50 
51   /// 分割条
52   r.Right := r.Left + RES_CAPTIONTOOLBAR.w;
53   SkinData.DrawElement(DC, steSplitter, r);
54   OffsetRect(r, r.Right - r.Left, 0);
55 
56   /// 绘制下拉菜单按钮
57   r.Right := r.Left + RES_CAPTIONTOOLBAR.w;
58   SkinData.DrawElement(DC, stePopdown, r);
59 end;

  

 相应鼠标事件

    对于一个工具条，需要相应的事件有三个鼠标滑过、按下和弹起。滑过是出现Hot效果，按下时处理Button被压下的效果，弹起时执行实际的Action事件。简单处理处理的这三种效果，如果考虑动画效果。那么需要创建一个时钟，设置个背景褪色量（其实是个Alpha透明通道值），然后根据褪色量在时钟消息中进行绘制。时钟最好设置在主皮肤类（TskForm）上，不必为每个区域创建一个句柄，这样可以减少系统资源（句柄）的占用。

    统一消息入口，如果处理了此消息就返回True。这样可以让外部知道是否此消息被处理，以便外部作进一步的响应处理。

 1 function TFormCaptionPlugin.HandleMessage(var Message: TMessage): Boolean;
 2 begin
 3   Result := True;
 4 
 5   case Message.Msg of
 6     WM_NCMOUSEMOVE    : MouseMove(ScreenToClient(TWMNCMouseMove(Message).XCursor, TWMNCMouseMove(Message).YCursor));
 7     WM_NCLBUTTONDOWN  : MouseDown(mbLeft, ScreenToClient(TWMNCLButtonDown(Message).XCursor, TWMNCLButtonDown(Message).YCursor));
 8     WM_NCHITTEST      : HitWindowTest(ScreenToClient(TWMNCHitTest(Message).XPos, TWMNCHitTest(Message).YPos));
 9     WM_NCLBUTTONUP    : MouseUp(mbLeft, ScreenToClient(TWMNCLButtonUp(Message).XCursor, TWMNCLButtonUp(Message).YCursor));
10 
11     else
12       Result := False;
13   end;
14 end;

 

 这里一个比较关键的是，鼠标在这个区域内的实际位置。一般窗体都会有Handle，所以能直接通过API转换鼠标位置。

区域需要依靠主窗口的位置才能获得。每次窗口在处理尺寸时，区域的偏移位置是可以获得的。像标题工具条这种左靠齐，其实这个偏移位置算好后就肯定是不会变的。

1 // 偏移量
2 //   = 有效标题区域 - 系统图标位置 - 区域间隙
3 r.Left := rCaptionRect.Left + 2 + GetSystemMetrics(SM_CXSMICON) + SPALCE_CAPTIONAREA;
4 r.Top := rCaptionRect.Top + (rCaptionRect.Height - FToolbar.Border.Height) div 2;
 1 function TFormCaptionPlugin.ScreenToClient(x, y: Integer): TPoint;
 2 var
 3   P: TPoint;
 4 begin
 5   /// 调整位置
 6   ///    以 FOffset 为中心位置
 7   P := FOwner.NormalizePoint(Point(x, Y));
 8   p.X := p.X - FOffset.X;
 9   p.Y := p.y - FOffset.Y;
10 
11   Result := p;
12 end;

 

 上面鼠标的消息最终通过HitTest获取，实际鼠标所在按钮位置。这个处理方法和外部的TskForm处理方法一致，检测位置设置状态参数然后再重绘。

如：鼠标滑过时的消息处理。

 1 procedure TcpToolbar.MouseMove(p: TPoint);
 2 var
 3   iIdx: Integer;
 4 begin
 5   /// 鼠标滑入时设置HotIndex值
 6   iIdx := HitTest(p);
 7   if iIdx <> FHotIndex then
 8   begin
 9     FHotIndex := iIdx;
10     Invalidate;
11   end;
12 end;

 

 1 function TcpToolbar.HitTest(P: TPoint): integer;
 2 var
 3   iOff: Integer;
 4   iIdx: integer;
 5   I: Integer;
 6 begin
 7   ///
 8   ///  检测鼠标位置
 9   ///    鼠标位置的 FCount位 为工具条系统菜单位置。
10   iIdx := -1;
11   iOff := RES_CAPTIONTOOLBAR.w;
12   if p.x > iOff then
13   begin
14     for I := 0 to FCount - 1 do
15     begin
16       if p.X < iOff then
17         Break;
18 
19       iIdx := i;
20       inc(iOff, FItems[i].Width);
21     end;
22 
23     if p.x > iOff then
24     begin
25       iIdx := -1;
26       inc(iOff, RES_CAPTIONTOOLBAR.w);
27       if p.x > iOff then
28         iIdx := FCount;  // FCount 为系统菜单按钮
29     end;
30   end;
31 
32   Result := iIdx;
33 end;
坐标所在按钮区域检测 HitTest

 

还有些细节方面的处理，如鼠标离开这个区域时的处理。这样整个工具区的基本处理完成，整个工具条区域的处理还是相对比较简单。

 

Action状态处理

  Action处理主要是考虑，当外部改变Action状态。如：无效，不可见的一些事件处理。标准的处理方法是在关联Action是创建一个ActionLink实现联动，由于TskForm没有从TControl继承，没法使用此方法进行处理。在TBasicAction改变状态时会触发一个OnChange的保护（protected）事件，可以直接把事件挂接上去，就能简单处理状态。

保护方法的访问：创建一个访问类，进行引用。

1 type
2   TacWinControl = class(TWinControl);
3   TacAction = class(TBasicAction);
1   ZeroMemory(@FItems[FCount], SizeOf(TcpToolButton));
2   FItems[FCount].Action := Action;
3   FItems[FCount].Enabled := true;       // <--- 这里应该获取Actoin的当前状态，这里简略处理。
4   FItems[FCount].Visible := True;       // <--- 同上，注：现有代码中并未处理此状态
5   FItems[FCount].ImageIndex := AImageIndex;
6   FItems[FCount].Width := 20;
7   FItems[FCount].Fade  := 255;
8   FItems[FCount].SaveEvent := TacAction(Action).OnChange;  // 保存原事件
9   TacAction(Action).OnChange := DoOnActionChange;          // 挂接事件

 

 注意：不要把原事件丢了，需要保存。防止外部有挂接的情况下出现外部无法。

根据状态的不同，直接修改记录的Enabled 和 Visible 这两个状态。绘制时可以直接使用。

 1 procedure TcpToolbar.DoOnActionChange(Sender: TObject);
 2 var
 3   idx: Integer;
 4   bResize: Boolean;
 5 begin
 6   if Sender is TBasicAction then
 7   begin
 8     idx := IndexOf(TBasicAction(Sender));
 9     if (idx >= 0) and (idx < FCount) then
10     begin
11       ///
12       ///  外部状态改变响应
13       ///
14       if FItems[idx].Action.InheritsFrom(TContainedAction) then
15       begin
16         FItems[idx].Enabled := TContainedAction(Sender).Enabled;
17         bResize := FItems[idx].Visible <> TContainedAction(Sender).Visible;
18         if bResize then
19         begin
20           FItems[idx].Visible := not FItems[idx].Visible;
21           Update
22         end
23         else
24           Invalidate;
25       end;
26 
27       /// 执行原有事件
28       if Assigned(FItems[idx].SaveEvent) then
29         FItems[idx].SaveEvent(Sender);
30     end;
31   end;
32 end;

 

 在绘制时就可以通过记录中的状态和鼠标位置状态进行判断，来绘制出所需要的效果

 1   ... ...
 2   // 如果按钮有效，那么进行按钮底色绘制。
 3   if FItems[I].Enabled then
 4     SkinData.DrawButtonBackground(DC, GetActionState(i), r, FItems[i].Fade);
 5   if LoadActionIcon(i, cIcon) then
 6   begin
 7     /// 处理不可用状态，图标颜色变暗。
 8     ///   简易处理，增加绘制透明度。
 9     iOpacity := 255;
10     if not FItems[i].Enabled then
11       iOpacity := 100;
12 
13     SkinData.DrawIcon(DC, r, cIcon, iOpacity);
14   end;
15   ... ...
16 
17   // 获取Action底色的显示状态
18   //  按下状态、滑过状态、默认状态
19   function GetActionState(Idx: Integer): TSkinIndicator;
20   begin
21     Result := siInactive;
22     if (Idx = FPressedIndex) and (FHotIndex = FPressedIndex) then
23       Result := siPressed
24     else if Idx = FHotIndex then
25       Result := siHover;
26   end;
27

 

在窗体上加入测试Action

1 procedure TForm11.FormCreate(Sender: TObject);
2 begin
3   FTest.Toolbar.Images := ImageList2;
4   FTest.Toolbar.Add(Action1, 0);
5   FTest.Toolbar.Add(Action2, 1);
6   FTest.Toolbar.Add(Action3, 2);
7 end;

 

 

 完成～～

   最终效果，就是上面的GIF效果。想做的更好，那么就需要在细节上考虑。细节是最花时间的地方。

 

单元代码

   1 unit uFormSkins;
   2 
   3 interface
   4 
   5 uses
   6   Classes, windows, Controls, Graphics, Forms, messages, pngimage, Types, ImgList, Actions, ActnList;
   7 
   8 const
   9   WM_NCUAHDRAWCAPTION = $00AE;
  10 
  11   CKM_ADD             = WM_USER + 1;  // 增加标题区域位置
  12 
  13   HTCUSTOM = 100; //HTHELP + 1;              /// 自定义区域ID
  14   HTCAPTIONTOOLBAR = HTCUSTOM + 1;    /// 标题工具区域
  15 
  16 type
  17   TskForm = class;
  18 
  19   TFormButtonKind = (fbkMin, fbkMax, fbkRestore, fbkClose, fbkHelp);
  20   TSkinIndicator = (siInactive, siHover, siPressed, siSelected, siHoverSelected);
  21 
  22   TFormCaptionPlugin = class
  23   private
  24     FOffset: TPoint;  // 实际标题区域所在的偏移位置
  25     FBorder: TRect;
  26     FOwner: TskForm;
  27     FVisible: Boolean;
  28 
  29   protected
  30     procedure Paint(DC: HDC); virtual; abstract;
  31     function  CalcSize: TRect; virtual; abstract;
  32     function  ScreenToClient(x, y: Integer): TPoint;
  33 
  34     function  HandleMessage(var Message: TMessage): Boolean; virtual;
  35 
  36     procedure HitWindowTest(P: TPoint); virtual;
  37     procedure MouseMove(p: TPoint); virtual;
  38     procedure MouseDown(Button: TMouseButton; p: TPoint); virtual;
  39     procedure MouseUp(Button: TMouseButton; p: TPoint); virtual;
  40     procedure MouseLeave; virtual;
  41 
  42     procedure Invalidate;
  43     procedure Update;
  44   public
  45     constructor Create(AOwner: TskForm); virtual;
  46 
  47     property Border: TRect read FBorder;
  48     property Visible: Boolean read FVisible;
  49   end;
  50 
  51   TcpToolButton = record
  52     Action: TBasicAction;
  53     Enabled: boolean;
  54     Visible: Boolean;
  55     ImageIndex: Integer;        // 考虑到标题功能图标和实际工具栏功能使用不同图标情况，分开图标索引
  56     Width: Word;                // 实际占用宽度，考虑后续加不同的按钮样式使用
  57     Fade: Word;                 // 褪色量 0 - 255
  58     SaveEvent: TNotifyEvent;    // 原始的Action OnChange事件
  59   end;
  60 
  61   TcpToolbar = class(TFormCaptionPlugin)
  62   private
  63     FItems: array of TcpToolButton;
  64     FCount: Integer;
  65     FHotIndex: Integer;
  66 
  67     // 考虑标题栏比较特殊，背景使用的是纯属情况。图标需要做的更符合纯属需求。
  68     FImages: TCustomImageList;
  69     FPressedIndex: Integer;
  70 
  71     procedure ExecAction(Index: Integer);
  72     procedure PopConfigMenu;
  73     function  HitTest(P: TPoint): integer;
  74     function  LoadActionIcon(Idx: Integer; AImg: TBitmap):Boolean;
  75     procedure SetImages(const Value: TCustomImageList);
  76     procedure DoOnActionChange(Sender: TObject);
  77   protected
  78     // 绘制按钮样式
  79     procedure Paint(DC: HDC); override;
  80     // 计算实际占用尺寸
  81     function  CalcSize: TRect; override;
  82 
  83     procedure HitWindowTest(P: TPoint); override;
  84     procedure MouseMove(p: TPoint); override;
  85     procedure MouseDown(Button: TMouseButton; p: TPoint); override;
  86     procedure MouseUp(Button: TMouseButton; p: TPoint); override;
  87     procedure MouseLeave; override;
  88 
  89   public
  90     constructor Create(AOwner: TskForm); override;
  91 
  92     procedure Add(Action: TBasicAction; AImageIndex: Integer = -1);
  93     procedure Delete(Index: Integer);
  94     function  IndexOf(Action: TBasicAction): Integer;
  95 
  96     property Images: TCustomImageList read FImages write SetImages;
  97   end;
  98 
  99 
 100   TskForm = class
 101   private
 102     FCallDefaultProc: Boolean;
 103     FChangeSizeCalled: Boolean;
 104     FControl: TWinControl;
 105     FHandled: Boolean;
 106 
 107     FRegion: HRGN;
 108     FLeft: integer;
 109     FTop: integer;
 110     FWidth: integer;
 111     FHeight: integer;
 112 
 113     /// 窗体图标
 114     FIcon: TIcon;
 115     FIconHandle: HICON;
 116 
 117     // 鼠标位置状态，只处理监控的位置，其他有交由系统处理
 118     FPressedHit: Integer;     // 实际按下的位置
 119     FHotHit: integer;         // 记录上次的测试位置
 120 
 121     FToolbar: TcpToolbar;
 122 
 123     function GetHandle: HWND; inline;
 124     function GetForm: TCustomForm; inline;
 125     function GetFrameSize: TRect;
 126     function GetCaptionRect(AMaxed: Boolean): TRect; inline;
 127     function GetCaption: string;
 128     function GetIcon: TIcon;
 129     function GetIconFast: TIcon;
 130 
 131     procedure ChangeSize;
 132     function  NormalizePoint(P: TPoint): TPoint;
 133     function  HitTest(P: TPoint):integer;
 134     procedure Maximize;
 135     procedure Minimize;
 136 
 137     // 第一组 实现绘制基础
 138     procedure WMNCPaint(var message: TWMNCPaint); message WM_NCPAINT;
 139     procedure WMNCActivate(var message: TMessage); message WM_NCACTIVATE;
 140     procedure WMNCLButtonDown(var message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
 141     procedure WMNCUAHDrawCaption(var message: TMessage); message WM_NCUAHDRAWCAPTION;
 142 
 143     // 第二组 控制窗体样式
 144     procedure WMNCCalcSize(var message: TWMNCCalcSize); message WM_NCCALCSIZE;
 145     procedure WMWindowPosChanging(var message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
 146 
 147     // 第三组 绘制背景和内部控件
 148     procedure WMEraseBkgnd(var message: TWMEraseBkgnd); message WM_ERASEBKGND;
 149     procedure WMPaint(var message: TWMPaint); message WM_PAINT;
 150 
 151     // 第四组 控制按钮状态
 152     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
 153     procedure WMNCLButtonUp(var Message: TWMNCLButtonUp); message WM_NCLBUTTONUP;
 154     procedure WMNCMouseMove(var Message: TWMNCMouseMove); message WM_NCMOUSEMOVE;
 155     procedure WMSetText(var Message: TMessage); message WM_SETTEXT;
 156 
 157 
 158     procedure WndProc(var message: TMessage);
 159 
 160     procedure CallDefaultProc(var message: TMessage);
 161   protected
 162     property  Handle: HWND read GetHandle;
 163     procedure InvalidateNC;
 164     procedure PaintNC(DC: HDC);
 165     procedure PaintBackground(DC: HDC);
 166     procedure Paint(DC: HDC);
 167 
 168   public
 169     constructor Create(AOwner: TWinControl);
 170     destructor Destroy; override;
 171 
 172     function DoHandleMessage(var message: TMessage): Boolean;
 173 
 174     property Toolbar: TcpToolbar read FToolbar;
 175     property Handled: Boolean read FHandled write FHandled;
 176     property Control: TWinControl read FControl;
 177     property Form: TCustomForm read GetForm;
 178   end;
 179 
 180 
 181 implementation
 182 
 183 const
 184   SPALCE_CAPTIONAREA = 3;
 185 
 186 {$R MySkin.RES}
 187 
 188 type
 189   TacWinControl = class(TWinControl);
 190   TacAction = class(TBasicAction);
 191 
 192   Res = class
 193     class procedure LoadGraphic(const AName: string; AGraphic: TGraphic);
 194     class procedure LoadBitmap(const AName: string; AGraphic: TBitmap);
 195   end;
 196 
 197   TResArea = record
 198     x: Integer;
 199     y: Integer;
 200     w: Integer;
 201     h: Integer;
 202   end;
 203 
 204   TSkinToolbarElement = (steSplitter, stePopdown);
 205 
 206   SkinData = class
 207   private
 208   class var
 209     FData: TBitmap;
 210 
 211   public
 212     class constructor Create;
 213     class destructor Destroy;
 214 
 215     class procedure DrawButtonBackground(DC: HDC; AState: TSkinIndicator; const R: TRect; const Opacity: Byte = 255); static;
 216     class procedure DrawButton(DC: HDC; AKind: TFormButtonKind; AState: TSkinIndicator; const R: TRect); static;
 217     class procedure DrawElement(DC: HDC; AItem: TSkinToolbarElement; const R: TRect);
 218     class procedure DrawIcon(DC: HDC; R: TRect; ASrc: TBitmap; const Opacity: Byte = 255);
 219   end;
 220 
 221 const
 222   SKINCOLOR_BAKCGROUND  = $00BF7B18;  // 背景色
 223   SKINCOLOR_BTNHOT      = $00F2D5C2;  // Hot 激活状态
 224   SKINCOLOR_BTNPRESSED  = $00E3BDA3;  // 按下状态
 225   SIZE_SYSBTN: TSize    = (cx: 29; cy: 18);
 226   SIZE_FRAME: TRect     = (Left: 4; Top: 29; Right: 5; Bottom: 5); // 窗体边框的尺寸
 227   SPACE_AREA            = 3;          // 功能区域之间间隔
 228   SIZE_RESICON          = 16;         // 资源中图标默认尺寸
 229   SIZE_HEIGHTTOOLBAR    = 16;
 230 
 231   RES_CAPTIONTOOLBAR: TResArea = (x: 0; y: 16; w: 9; h: 16);
 232 
 233 
 234 function BuildRect(L, T, W, H: Integer): TRect; inline;
 235 begin
 236   Result := Rect(L, T, L + W, T + H);
 237 end;
 238 
 239 procedure DrawTransparentBitmap(Source: TBitmap; sx, sy: Integer; Destination: HDC;
 240   const dX, dY: Integer;  w, h: Integer; const Opacity: Byte = 255); overload;
 241 var
 242   BlendFunc: TBlendFunction;
 243 begin
 244   BlendFunc.BlendOp := AC_SRC_OVER;
 245   BlendFunc.BlendFlags := 0;
 246   BlendFunc.SourceConstantAlpha := Opacity;
 247 
 248   if Source.PixelFormat = pf32bit then
 249     BlendFunc.AlphaFormat := AC_SRC_ALPHA
 250   else
 251     BlendFunc.AlphaFormat := 0;
 252 
 253   AlphaBlend(Destination, dX, dY, w, h, Source.Canvas.Handle, sx, sy, w, h, BlendFunc);
 254 end;
 255 
 256 
 257 procedure TskForm.CallDefaultProc(var message: TMessage);
 258 begin
 259   if FCallDefaultProc then
 260     FControl.WindowProc(message)
 261   else
 262   begin
 263     FCallDefaultProc := True;
 264     FControl.WindowProc(message);
 265     FCallDefaultProc := False;
 266   end;
 267 end;
 268 
 269 procedure TskForm.ChangeSize;
 270 var
 271   hTmp: HRGN;
 272 begin
 273   /// 设置窗体外框样式
 274   FChangeSizeCalled := True;
 275   try
 276     hTmp := FRegion;
 277     try
 278       /// 创建矩形外框，3的倒角
 279       FRegion := CreateRoundRectRgn(0, 0, FWidth, FHeight, 3, 3);
 280       SetWindowRgn(Handle, FRegion, True);
 281     finally
 282       if hTmp <> 0 then
 283         DeleteObject(hTmp);
 284     end;
 285   finally
 286     FChangeSizeCalled := False;
 287   end;
 288 end;
 289 
 290 function TskForm.NormalizePoint(P: TPoint): TPoint;
 291 var
 292   rWindowPos, rClientPos: TPoint;
 293 begin
 294   rWindowPos := Point(FLeft, FTop);
 295   rClientPos := Point(0, 0);
 296   ClientToScreen(Handle, rClientPos);
 297   Result := P;
 298   ScreenToClient(Handle, Result);
 299   Inc(Result.X, rClientPos.X - rWindowPos.X);
 300   Inc(Result.Y, rClientPos.Y - rWindowPos.Y);
 301 end;
 302 
 303 function TskForm.HitTest(P: TPoint):integer;
 304 var
 305   bMaxed: Boolean;
 306   r: TRect;
 307   rCaptionRect: TRect;
 308   rFrame: TRect;
 309 begin
 310   Result := HTNOWHERE;
 311 
 312   ///
 313   /// 检测位置
 314   ///
 315   rFrame := GetFrameSize;
 316   if p.Y > rFrame.Top then
 317     Exit;
 318 
 319   ///
 320   ///  只关心窗体按钮区域
 321   ///
 322   bMaxed := IsZoomed(Handle);
 323   rCaptionRect := GetCaptionRect(bMaxed);
 324   if PtInRect(rCaptionRect, p) then
 325   begin
 326     r.Right := rCaptionRect.Right - 1;
 327     r.Top := 0;
 328     if bMaxed then
 329       r.Top := rCaptionRect.Top;
 330     r.Top := r.Top + (rFrame.Top - r.Top - SIZE_SYSBTN.cy) div 2;
 331     r.Left := r.Right - SIZE_SYSBTN.cx;
 332     r.Bottom := r.Top + SIZE_SYSBTN.cy;
 333 
 334     ///
 335     /// 实际绘制的按钮就三个，其他没处理
 336     ///
 337     if (P.Y >= r.Top) and (p.Y <= r.Bottom) and (p.X <= r.Right) then
 338     begin
 339       if (P.X >= r.Left) then
 340         Result := HTCLOSE
 341       else if p.X >= (r.Left - SIZE_SYSBTN.cx) then
 342         Result := HTMAXBUTTON
 343       else if p.X >= (r.Left - SIZE_SYSBTN.cx * 2) then
 344         Result := HTMINBUTTON;
 345     end;
 346 
 347     ///
 348     ///  标题工具区域
 349     ///    需要前面扣除窗体图标区域
 350     if (Result = HTNOWHERE) and (FToolbar.Visible) then
 351     begin
 352       r.Left := rCaptionRect.Left + 2 + GetSystemMetrics(SM_CXSMICON) + SPALCE_CAPTIONAREA;
 353       R.Top := rCaptionRect.Top + (rCaptionRect.Height - FToolbar.Border.Height) div 2;
 354       R.Right := R.Left + FToolbar.Border.Width;
 355       R.Bottom := R.Top + FToolbar.Border.Height;
 356 
 357       if FToolbar.FOffset.X = -1 then
 358         FToolbar.FOffset := r.TopLeft;
 359 
 360       if PtInRect(r, p) then
 361         Result := HTCAPTIONTOOLBAR;
 362     end;
 363   end;
 364 end;
 365 
 366 constructor TskForm.Create(AOwner: TWinControl);
 367 begin
 368   FControl := AOwner;
 369   FRegion := 0;
 370   FChangeSizeCalled := False;
 371   FCallDefaultProc := False;
 372 
 373   FWidth := FControl.Width;
 374   FHeight := FControl.Height;
 375   FIcon := nil;
 376   FIconHandle := 0;
 377 
 378   FToolbar := TcpToolbar.Create(Self);
 379 end;
 380 
 381 destructor TskForm.Destroy;
 382 begin
 383   FToolbar.Free;
 384 
 385   FIconHandle := 0;
 386   if FIcon <> nil then      FIcon.Free;
 387   if FRegion <> 0 then      DeleteObject(FRegion);
 388   inherited;
 389 end;
 390 
 391 function TskForm.DoHandleMessage(var message: TMessage): Boolean;
 392 begin
 393   Result := False;
 394   if not FCallDefaultProc then
 395   begin
 396     FHandled := False;
 397     WndProc(message);
 398     Result := Handled;
 399   end;
 400 end;
 401 
 402 function TskForm.GetFrameSize: TRect;
 403 begin
 404   Result := SIZE_FRAME;
 405 end;
 406 
 407 function TskForm.GetCaptionRect(AMaxed: Boolean): TRect;
 408 var
 409   rFrame: TRect;
 410 begin
 411   rFrame := GetFrameSize;
 412   // 最大化状态简易处理
 413   if AMaxed then
 414     Result := Rect(8, 8, FWidth - 9 , rFrame.Top)
 415   else
 416     Result := Rect(rFrame.Left, 3, FWidth - rFrame.right, rFrame.Top);
 417 end;
 418 
 419 function TskForm.GetCaption: string;
 420 var
 421   Buffer: array [0..255] of Char;
 422   iLen: integer;
 423 begin
 424   if Handle <> 0 then
 425   begin
 426     iLen := GetWindowText(Handle, Buffer, Length(Buffer));
 427     SetString(Result, Buffer, iLen);
 428   end
 429   else
 430     Result := '';
 431 end;
 432 
 433 function TskForm.GetForm: TCustomForm;
 434 begin
 435   Result := TCustomForm(Control);
 436 end;
 437 
 438 function TskForm.GetHandle: HWND;
 439 begin
 440   if FControl.HandleAllocated then
 441     Result := FControl.Handle
 442   else
 443     Result := 0;
 444 end;
 445 
 446 function TskForm.GetIcon: TIcon;
 447 var
 448   IconX, IconY: integer;
 449   TmpHandle: THandle;
 450   Info: TWndClassEx;
 451   Buffer: array [0 .. 255] of Char;
 452 begin
 453   ///
 454   /// 获取当前form的图标
 455   /// 这个图标和App的图标是不同的
 456   ///
 457   TmpHandle := THandle(SendMessage(Handle, WM_GETICON, ICON_SMALL, 0));
 458   if TmpHandle = 0 then
 459     TmpHandle := THandle(SendMessage(Handle, WM_GETICON, ICON_BIG, 0));
 460 
 461   if TmpHandle = 0 then
 462   begin
 463     { Get instance }
 464     GetClassName(Handle, @Buffer, SizeOf(Buffer));
 465     FillChar(Info, SizeOf(Info), 0);
 466     Info.cbSize := SizeOf(Info);
 467 
 468     if GetClassInfoEx(GetWindowLong(Handle, GWL_HINSTANCE), @Buffer, Info) then
 469     begin
 470       TmpHandle := Info.hIconSm;
 471       if TmpHandle = 0 then
 472         TmpHandle := Info.HICON;
 473     end
 474   end;
 475 
 476   if FIcon = nil then
 477     FIcon := TIcon.Create;
 478 
 479   if TmpHandle <> 0 then
 480   begin
 481     IconX := GetSystemMetrics(SM_CXSMICON);
 482     if IconX = 0 then
 483       IconX := GetSystemMetrics(SM_CXSIZE);
 484     IconY := GetSystemMetrics(SM_CYSMICON);
 485     if IconY = 0 then
 486       IconY := GetSystemMetrics(SM_CYSIZE);
 487     FIcon.Handle := CopyImage(TmpHandle, IMAGE_ICON, IconX, IconY, 0);
 488     FIconHandle := TmpHandle;
 489   end;
 490 
 491   Result := FIcon;
 492 end;
 493 
 494 function TskForm.GetIconFast: TIcon;
 495 begin
 496   if (FIcon = nil) or (FIconHandle = 0) then
 497     Result := GetIcon
 498   else
 499     Result := FIcon;
 500 end;
 501 
 502 procedure TskForm.InvalidateNC;
 503 begin
 504   if FControl.HandleAllocated then
 505     SendMessage(Handle, WM_NCPAINT, 1, 0);
 506 end;
 507 
 508 procedure TskForm.Maximize;
 509 begin
 510   if Handle <> 0 then
 511   begin
 512     FPressedHit := 0;
 513     FHotHit := 0;
 514     if IsZoomed(Handle) then
 515       SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
 516     else
 517       SendMessage(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0);
 518   end;
 519 end;
 520 
 521 procedure TskForm.Minimize;
 522 begin
 523   if Handle <> 0 then
 524   begin
 525     FPressedHit := 0;
 526     FHotHit := 0;
 527     if IsIconic(Handle) then
 528       SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
 529     else
 530       SendMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
 531    end;
 532 end;
 533 
 534 procedure TskForm.PaintNC(DC: HDC);
 535 const
 536   HITVALUES: array [TFormButtonKind] of integer = (HTMINBUTTON, HTMAXBUTTON, HTMAXBUTTON, HTCLOSE, HTHELP);
 537 
 538   function GetBtnState(AKind: TFormButtonKind): TSkinIndicator;
 539   begin
 540     if (FPressedHit = FHotHit) and (FPressedHit = HITVALUES[AKind]) then
 541       Result := siPressed
 542     else if FHotHit = HITVALUES[AKind] then
 543       Result := siHover
 544     else
 545       Result := siInactive;
 546   end;
 547 
 548 var
 549   bClipRegion: boolean;
 550   hB: HBRUSH;
 551   rFrame: TRect;
 552   rButton: TRect;
 553   SaveIndex: integer;
 554   bMaxed: Boolean;
 555   ClipRegion: HRGN;
 556   CurrentIdx: Integer;
 557   rCaptionRect : TRect;
 558   sData: string;
 559   Flag: Cardinal;
 560   iLeftOff: Integer;
 561   iTopOff: Integer;
 562   SaveColor: cardinal;
 563 begin
 564   SaveIndex := SaveDC(DC);
 565   try
 566     bMaxed := IsZoomed(Handle);
 567 
 568     // 扣除客户区域
 569     rFrame := GetFrameSize;
 570     ExcludeClipRect(DC, rFrame.Left, rFrame.Top, FWidth - rFrame.Right, FHeight - rFrame.Bottom);
 571 
 572     ///
 573     ///  标题区域
 574     ///
 575     rCaptionRect := GetCaptionRect(bMaxed);
 576 
 577     // 填充整个窗体背景
 578     hB := CreateSolidBrush(SKINCOLOR_BAKCGROUND);
 579     FillRect(DC, Rect(0, 0, FWidth, FHeight), hB);
 580     DeleteObject(hB);
 581 
 582     ///
 583     /// 绘制窗体图标
 584     rButton := BuildRect(rCaptionRect.Left + 2, rCaptionRect.Top, GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON));
 585     rButton.Top := rButton.Top + (rFrame.Top - rButton.Bottom) div 2;
 586     DrawIconEx(DC, rButton.Left, rButton.Top, GetIconFast.Handle, 0, 0, 0, 0, DI_NORMAL);
 587     rCaptionRect.Left := rButton.Right + SPALCE_CAPTIONAREA; //
 588 
 589     ///
 590     /// 绘制窗体按钮区域
 591     rButton.Right := rCaptionRect.Right - 1;
 592     rButton.Top := 0;
 593     if bMaxed then
 594       rButton.Top := rCaptionRect.Top;
 595     rButton.Top := rButton.Top + (rFrame.Top - rButton.Top - SIZE_SYSBTN.cy) div 2;
 596     rButton.Left := rButton.Right - SIZE_SYSBTN.cx;
 597     rButton.Bottom := rButton.Top + SIZE_SYSBTN.cy;
 598     SkinData.DrawButton(Dc, fbkClose, GetBtnState(fbkClose), rButton);
 599 
 600     OffsetRect(rButton, - SIZE_SYSBTN.cx, 0);
 601     if bMaxed then
 602       SkinData.DrawButton(Dc, fbkRestore, GetBtnState(fbkRestore), rButton)
 603     else
 604       SkinData.DrawButton(Dc, fbkMax, GetBtnState(fbkMax), rButton);
 605 
 606     OffsetRect(rButton, - SIZE_SYSBTN.cx, 0);
 607     SkinData.DrawButton(Dc, fbkMin, GetBtnState(fbkMin), rButton);
 608     rCaptionRect.Right := rButton.Left - SPALCE_CAPTIONAREA; // 后部空出
 609 
 610     ///
 611     /// 绘制工具条
 612     if FToolbar.Visible and (rCaptionRect.Right > rCaptionRect.Left) then
 613     begin
 614       /// 防止出现绘制出多余区域，当区域不够时需要进行剪切。
 615       ///  如： 窗体缩小时
 616       CurrentIdx := 0;
 617       bClipRegion := rCaptionRect.Width < FToolbar.Border.Width;
 618       if bClipRegion then
 619       begin
 620         ClipRegion := CreateRectRgnIndirect(rCaptionRect);
 621         CurrentIdx := SelectClipRgn(DC, ClipRegion);
 622         DeleteObject(ClipRegion);
 623       end;
 624 
 625       iLeftOff := rCaptionRect.Left;
 626       iTopOff := rCaptionRect.Top + (rCaptionRect.Height - FToolbar.Border.Height) div 2;
 627       MoveWindowOrg(DC, iLeftOff, iTopOff);
 628       FToolbar.Paint(DC);
 629       MoveWindowOrg(DC, -iLeftOff, -iTopOff);
 630 
 631       if bClipRegion then
 632         SelectClipRgn(DC, CurrentIdx);
 633 
 634       /// 扣除工具条区域
 635       rCaptionRect.Left := rCaptionRect.Left + FToolbar.Border.Width + SPALCE_CAPTIONAREA;
 636     end;
 637 
 638     ///
 639     /// 绘制Caption
 640     if rCaptionRect.Right > rCaptionRect.Left then
 641     begin
 642       sData :=  GetCaption;
 643       SetBkMode(DC, TRANSPARENT);
 644       SaveColor := SetTextColor(DC, $00FFFFFF);
 645 
 646       Flag := DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;
 647       DrawTextEx(DC, PChar(sData), Length(sData), rCaptionRect, Flag, nil);
 648       SetTextColor(DC, SaveColor);
 649     end;
 650   finally
 651     RestoreDC(DC, SaveIndex);
 652   end;
 653 end;
 654 
 655 procedure TskForm.PaintBackground(DC: HDC);
 656 var
 657   hB: HBRUSH;
 658   R: TRect;
 659 begin
 660   GetClientRect(Handle, R);
 661   hB := CreateSolidBrush($00F0F0F0);
 662   FillRect(DC, R, hB);
 663   DeleteObject(hB);
 664 end;
 665 
 666 procedure TskForm.Paint(DC: HDC);
 667 begin
 668   // PaintBackground(DC);
 669   // TODO -cMM: TskForm.Paint default body inserted
 670 end;
 671 
 672 procedure TskForm.WMEraseBkgnd(var message: TWMEraseBkgnd);
 673 var
 674   DC: HDC;
 675   SaveIndex: integer;
 676 begin
 677   DC := Message.DC;
 678   if DC <> 0 then
 679   begin
 680     SaveIndex := SaveDC(DC);
 681     PaintBackground(DC);
 682     RestoreDC(DC, SaveIndex);
 683   end;
 684 
 685   Handled := True;
 686   Message.Result := 1;
 687 end;
 688 
 689 procedure TskForm.WMNCActivate(var message: TMessage);
 690 begin
 691   // FFormActive := Message.WParam > 0;
 692   Message.Result := 1;
 693   InvalidateNC;
 694   Handled := True;
 695 end;
 696 
 697 procedure TskForm.WMNCCalcSize(var message: TWMNCCalcSize);
 698 var
 699   R: TRect;
 700 begin
 701   // 改变边框尺寸
 702   R := GetFrameSize;
 703   with TWMNCCalcSize(Message).CalcSize_Params^.rgrc[0] do
 704   begin
 705     Inc(Left, R.Left);
 706     Inc(Top, R.Top);
 707     Dec(Right, R.Right);
 708     Dec(Bottom, R.Bottom);
 709   end;
 710   Message.Result := 0;
 711   Handled := True;
 712 end;
 713 
 714 procedure TskForm.WMNCHitTest(var Message: TWMNCHitTest);
 715 var
 716   P: TPoint;
 717   iHit: integer;
 718 begin
 719   // 需要把位置转换到实际窗口位置
 720   P := NormalizePoint(Point(Message.XPos, Message.YPos));
 721 
 722   // 获取 位置
 723   iHit := HitTest(p);
 724   if FHotHit > HTNOWHERE then
 725   begin
 726     Message.Result := iHit;
 727     Handled := True;
 728   end;
 729 
 730   if iHit <> FHotHit then
 731   begin
 732     if FHotHit = HTCAPTIONTOOLBAR then
 733       FToolbar.MouseLeave;
 734 
 735     FHotHit := iHit;
 736     InvalidateNC;
 737   end;
 738 
 739 end;
 740 
 741 procedure TskForm.WMWindowPosChanging(var message: TWMWindowPosChanging);
 742 var
 743   bChanged: Boolean;
 744 begin
 745   CallDefaultProc(TMessage(Message));
 746 
 747   Handled := True;
 748   bChanged := False;
 749 
 750   /// 防止嵌套
 751   if FChangeSizeCalled then
 752     Exit;
 753 
 754   if (Message.WindowPos^.flags and SWP_NOSIZE = 0) or (Message.WindowPos^.flags and SWP_NOMOVE = 0) then
 755   begin
 756     if (Message.WindowPos^.flags and SWP_NOMOVE = 0) then
 757     begin
 758       FLeft := Message.WindowPos^.x;
 759       FTop := Message.WindowPos^.y;
 760     end;
 761     if (Message.WindowPos^.flags and SWP_NOSIZE = 0) then
 762     begin
 763       bChanged := ((Message.WindowPos^.cx <> FWidth) or (Message.WindowPos^.cy <> FHeight)) and
 764         (Message.WindowPos^.flags and SWP_NOSIZE = 0);
 765       FWidth := Message.WindowPos^.cx;
 766       FHeight := Message.WindowPos^.cy;
 767     end;
 768   end;
 769 
 770   if (Message.WindowPos^.flags and SWP_FRAMECHANGED <> 0) then
 771     bChanged := True;
 772 
 773   if bChanged then
 774   begin
 775     ChangeSize;
 776     InvalidateNC;
 777   end;
 778 end;
 779 
 780 procedure TskForm.WMNCLButtonDown(var message: TWMNCLButtonDown);
 781 var
 782   iHit: integer;
 783 begin
 784   iHit := HTNOWHERE;
 785   if (Message.HitTest = HTCLOSE) or (Message.HitTest = HTMAXBUTTON) or (Message.HitTest = HTMINBUTTON) or
 786     (Message.HitTest = HTHELP) or (Message.HitTest > HTCUSTOM) then
 787     iHit := Message.HitTest;
 788 
 789 
 790   /// 只处理系统按钮和自定义区域
 791   if iHit <> HTNOWHERE then
 792   begin
 793     if iHit <> FPressedHit then
 794     begin
 795       FPressedHit := iHit;
 796       if FPressedHit = HTCAPTIONTOOLBAR then
 797         FToolbar.HandleMessage(TMessage(message));
 798       InvalidateNC;
 799     end;
 800 
 801     Message.Result := 0;
 802     Message.Msg := WM_NULL;
 803     Handled := True;
 804   end;
 805 end;
 806 
 807 procedure TskForm.WMNCLButtonUp(var Message: TWMNCLButtonUp);
 808 var
 809   iWasHit: Integer;
 810 begin
 811   iWasHit := FPressedHit;
 812   if iWasHit <> HTNOWHERE then
 813   begin
 814     FPressedHit := HTNOWHERE;
 815     //InvalidateNC;
 816 
 817     if iWasHit = FHotHit then
 818     begin
 819       case Message.HitTest of
 820         HTCLOSE           : SendMessage(Handle, WM_SYSCOMMAND, SC_CLOSE, 0);
 821         HTMAXBUTTON       : Maximize;
 822         HTMINBUTTON       : Minimize;
 823         HTHELP            : SendMessage(Handle, WM_SYSCOMMAND, SC_CONTEXTHELP, 0);
 824 
 825         HTCAPTIONTOOLBAR  : FToolbar.HandleMessage(TMessage(Message));
 826       end;
 827 
 828       Message.Result := 0;
 829       Message.Msg := WM_NULL;
 830       Handled := True;
 831     end;
 832   end;
 833 end;
 834 
 835 procedure TskForm.WMNCMouseMove(var Message: TWMNCMouseMove);
 836 begin
 837   if Message.HitTest = HTCAPTIONTOOLBAR then
 838   begin
 839     FToolbar.HandleMessage(TMessage(Message));
 840     Handled := True;
 841   end
 842   else
 843   begin
 844     if (FPressedHit <> HTNOWHERE) and (FPressedHit <> Message.HitTest) then
 845       FPressedHit := HTNOWHERE;
 846   end;
 847 end;
 848 
 849 procedure TskForm.WMSetText(var Message: TMessage);
 850 begin
 851   CallDefaultProc(Message);
 852   InvalidateNC;
 853   Handled := true;
 854 end;
 855 
 856 procedure TskForm.WMNCPaint(var message: TWMNCPaint);
 857 var
 858   DC: HDC;
 859 begin
 860   DC := GetWindowDC(Control.Handle);
 861   PaintNC(DC);
 862   ReleaseDC(Handle, DC);
 863   Handled := True;
 864 end;
 865 
 866 procedure TskForm.WMNCUAHDrawCaption(var message: TMessage);
 867 begin
 868   /// 这个消息会在winxp下产生，是内部Bug处理，直接丢弃此消息
 869   Handled := True;
 870 end;
 871 
 872 procedure TskForm.WMPaint(var message: TWMPaint);
 873 var
 874   DC, hPaintDC: HDC;
 875   cBuffer: TBitmap;
 876   PS: TPaintStruct;
 877 begin
 878   ///
 879   /// 绘制客户区域
 880   ///
 881   DC := Message.DC;
 882 
 883   hPaintDC := DC;
 884   if DC = 0 then
 885     hPaintDC := BeginPaint(Handle, PS);
 886 
 887   if DC = 0 then
 888   begin
 889     /// 缓冲模式绘制，减少闪烁
 890     cBuffer := TBitmap.Create;
 891     try
 892       cBuffer.SetSize(FWidth, FHeight);
 893       PaintBackground(cBuffer.Canvas.Handle);
 894       Paint(cBuffer.Canvas.Handle);
 895       /// 通知子控件进行绘制
 896       /// 主要是些图形控件的重绘制（如TShape），否则停靠在Form上的图像控件无法正常显示
 897       if Control is TWinControl then
 898         TacWinControl(Control).PaintControls(cBuffer.Canvas.Handle, nil);
 899       BitBlt(hPaintDC, 0, 0, FWidth, FHeight, cBuffer.Canvas.Handle, 0, 0, SRCCOPY);
 900     finally
 901       cBuffer.Free;
 902     end;
 903   end
 904   else
 905   begin
 906     Paint(hPaintDC);
 907     // 通知子控件重绘
 908     if Control is TWinControl then
 909       TacWinControl(Control).PaintControls(hPaintDC, nil);
 910   end;
 911 
 912   if DC = 0 then
 913     EndPaint(Handle, PS);
 914 
 915   Handled := True;
 916 end;
 917 
 918 procedure TskForm.WndProc(var message: TMessage);
 919 begin
 920   FHandled := False;
 921   Dispatch(message);
 922 end;
 923 
 924 class procedure Res.LoadBitmap(const AName: string; AGraphic: TBitmap);
 925 var
 926   cPic: TPngImage;
 927   cBmp: TBitmap;
 928 begin
 929   cBmp := AGraphic;
 930   cPic := TPngImage.Create;
 931   try
 932     cBmp.PixelFormat := pf32bit;
 933     cBmp.alphaFormat := afIgnored;
 934     try
 935       LoadGraphic(AName, cPic);
 936       cBmp.SetSize(cPic.Width, cPic.Height);
 937       cBmp.Canvas.Brush.Color := clBlack;
 938       cBmp.Canvas.FillRect(Rect(0, 0, cBmp.Width, cBmp.Height));
 939       cBmp.Canvas.Draw(0, 0, cPic);
 940     except
 941       // 不处理空图片
 942     end;
 943   finally
 944     cPic.Free;
 945   end;
 946 end;
 947 
 948 class procedure Res.LoadGraphic(const AName: string; AGraphic: TGraphic);
 949 var
 950   cStream: TResourceStream;
 951   h: THandle;
 952 begin
 953   ///
 954   /// 加载图片资源
 955   h := HInstance;
 956   cStream := TResourceStream.Create(h, AName, RT_RCDATA);
 957   try
 958     AGraphic.LoadFromStream(cStream);
 959   finally
 960     cStream.Free;
 961   end;
 962 end;
 963 
 964 class constructor SkinData.Create;
 965 begin
 966   // 加载资源
 967   FData := TBitmap.Create;
 968   Res.LoadBitmap('MySkin', FData);
 969 end;
 970 
 971 class destructor SkinData.Destroy;
 972 begin
 973   FData.Free;
 974 end;
 975 
 976 class procedure SkinData.DrawButton(DC: HDC; AKind: TFormButtonKind; AState:
 977     TSkinIndicator; const R: TRect);
 978 var
 979   rSrcOff: TPoint;
 980   x, y: integer;
 981 begin
 982   /// 绘制背景
 983   DrawButtonBackground(DC, AState, R);
 984 
 985   /// 绘制图标
 986   rSrcOff := Point(SIZE_RESICON * ord(AKind), 0);
 987   x := R.Left + (R.Right - R.Left - SIZE_RESICON) div 2;
 988   y := R.Top + (R.Bottom - R.Top - SIZE_RESICON) div 2;
 989   DrawTransparentBitmap(FData, rSrcOff.X, rSrcOff.Y, DC, x, y, SIZE_RESICON, SIZE_RESICON);
 990 end;
 991 
 992 class procedure SkinData.DrawButtonBackground(DC: HDC; AState: TSkinIndicator; const R: TRect; const Opacity: Byte = 255);
 993 var
 994   hB: HBRUSH;
 995   iColor: Cardinal;
 996 begin
 997   if AState <> siInactive then
 998   begin
 999     /// 绘制背景
1000     case AState of
1001       siHover         : iColor := SKINCOLOR_BTNHOT;
1002       siPressed       : iColor := SKINCOLOR_BTNPRESSED;
1003       siSelected      : iColor := SKINCOLOR_BTNPRESSED;
1004       siHoverSelected : iColor := SKINCOLOR_BTNHOT;
1005     else                iColor := SKINCOLOR_BAKCGROUND;
1006     end;
1007     hB := CreateSolidBrush(iColor);
1008     FillRect(DC, R, hB);
1009     DeleteObject(hB);
1010   end;
1011 end;
1012 
1013 class procedure SkinData.DrawElement(DC: HDC; AItem: TSkinToolbarElement; const R: TRect);
1014 var
1015   rSrc: TResArea;
1016   x, y: integer;
1017 begin
1018   rSrc := RES_CAPTIONTOOLBAR;
1019   rSrc.x :=  rSrc.x + rSrc.w * (ord(AItem) - ord(Low(TSkinToolbarElement)));
1020 
1021   /// 绘制图标
1022   x := R.Left + (R.Right - R.Left - rSrc.w) div 2;
1023   y := R.Top + (R.Bottom - R.Top - rSrc.h) div 2;
1024   DrawTransparentBitmap(FData, rSrc.x, rSrc.y, DC, x, y, rSrc.w, rSrc.h);
1025 end;
1026 
1027 class procedure SkinData.DrawIcon(DC: HDC; R: TRect; ASrc: TBitmap; const Opacity: Byte = 255);
1028 var
1029   iXOff: Integer;
1030   iYOff: Integer;
1031 begin
1032   iXOff := r.Left + (R.Right - R.Left - ASrc.Width) div 2;
1033   iYOff := r.Top + (r.Bottom - r.Top - ASrc.Height) div 2;
1034   DrawTransparentBitmap(ASrc, 0, 0, DC, iXOff, iYOff, ASrc.Width, ASrc.Height, Opacity);
1035 end;
1036 
1037 { TcpToolbar }
1038 constructor TcpToolbar.Create(AOwner: TskForm);
1039 begin
1040   inherited;
1041   FHotIndex := -1;
1042   FPressedIndex := -1;
1043 end;
1044 
1045 procedure TcpToolbar.Add(Action: TBasicAction; AImageIndex: Integer);
1046 begin
1047   if FCount >= Length(FItems) then
1048     SetLength(FItems, FCount + 5);
1049 
1050   ZeroMemory(@FItems[FCount], SizeOf(TcpToolButton));
1051   FItems[FCount].Action := Action;
1052   FItems[FCount].Enabled := true;
1053   FItems[FCount].Visible := True;
1054   FItems[FCount].ImageIndex := AImageIndex;
1055   FItems[FCount].Width := 20;
1056   FItems[FCount].Fade  := 255;
1057   FItems[FCount].SaveEvent := TacAction(Action).OnChange;
1058   TacAction(Action).OnChange := DoOnActionChange;
1059 
1060   inc(FCount);
1061 
1062   Update;
1063 end;
1064 
1065 function TcpToolbar.CalcSize: TRect;
1066 const
1067   SIZE_SPLITER = 10;
1068   SIZE_POPMENU = 10;
1069   SIZE_BUTTON  = 20;
1070 var
1071   w, h: Integer;
1072   I: Integer;
1073 begin
1074   ///
1075   ///  占用宽度
1076   ///     如果考虑比较复杂的按钮样式和显示标题等功能，那么需要计算每个按钮实际占用宽度才能获得。
1077 
1078   w := SIZE_SPLITER * 2 + SIZE_POPMENU;
1079   for I := 0 to FCount - 1 do
1080     w := w + FItems[i].Width;
1081   h := SIZE_BUTTON;
1082   Result := Rect(0, 0, w, h);
1083 end;
1084 
1085 procedure TcpToolbar.Delete(Index: Integer);
1086 begin
1087   if (Index >= 0) and (Index < FCount) then
1088   begin
1089     /// 删除时需要恢复
1090     TacAction(FItems[Index].Action).OnChange := FItems[Index].SaveEvent;
1091 
1092     if Index < (FCount - 1) then
1093       Move(FItems[Index+1], FItems[Index], sizeof(TcpToolButton) * (FCount - Index - 1));
1094     dec(FCount);
1095 
1096     Update;
1097   end;
1098 end;
1099 
1100 procedure TcpToolbar.DoOnActionChange(Sender: TObject);
1101 var
1102   idx: Integer;
1103   bResize: Boolean;
1104 begin
1105   if Sender is TBasicAction then
1106   begin
1107     idx := IndexOf(TBasicAction(Sender));
1108     if (idx >= 0) and (idx < FCount) then
1109     begin
1110       ///
1111       ///  外部状态改变响应
1112       ///
1113       if FItems[idx].Action.InheritsFrom(TContainedAction) then
1114       begin
1115         FItems[idx].Enabled := TContainedAction(Sender).Enabled;
1116         bResize := FItems[idx].Visible <> TContainedAction(Sender).Visible;
1117         if bResize then
1118         begin
1119           FItems[idx].Visible := not FItems[idx].Visible;
1120           Update
1121         end
1122         else
1123           Invalidate;
1124       end;
1125 
1126       /// 执行原有事件
1127       if Assigned(FItems[idx].SaveEvent) then
1128         FItems[idx].SaveEvent(Sender);
1129     end;
1130   end;
1131 end;
1132 
1133 function TcpToolbar.HitTest(P: TPoint): integer;
1134 var
1135   iOff: Integer;
1136   iIdx: integer;
1137   I: Integer;
1138 begin
1139   ///
1140   ///  检测鼠标位置
1141   ///    鼠标位置的 FCount位 为工具条系统菜单位置。
1142   iIdx := -1;
1143   iOff := RES_CAPTIONTOOLBAR.w;
1144   if p.x > iOff then
1145   begin
1146     for I := 0 to FCount - 1 do
1147     begin
1148       if p.X < iOff then
1149         Break;
1150 
1151       iIdx := i;
1152       inc(iOff, FItems[i].Width);
1153     end;
1154 
1155     if p.x > iOff then
1156     begin
1157       iIdx := -1;
1158       inc(iOff, RES_CAPTIONTOOLBAR.w);
1159       if p.x > iOff then
1160         iIdx := FCount;  // FCount 为系统菜单按钮
1161     end;
1162   end;
1163 
1164   Result := iIdx;
1165 end;
1166 
1167 procedure TcpToolbar.ExecAction(Index: Integer);
1168 begin
1169   ///
1170   /// 执行命令
1171   ///
1172   if (Index >= 0) and (Index < FCount) then
1173     FItems[Index].Action.Execute;
1174 
1175   // FCount位 为系统配置按钮
1176   if Index = FCount then
1177     PopConfigMenu;
1178 end;
1179 
1180 procedure TcpToolbar.PopConfigMenu;
1181 begin
1182 end;
1183 
1184 procedure TcpToolbar.SetImages(const Value: TCustomImageList);
1185 begin
1186   FImages := Value;
1187   Invalidate;
1188 end;
1189 
1190 function TcpToolbar.IndexOf(Action: TBasicAction): Integer;
1191 var
1192   I: Integer;
1193 begin
1194   Result := -1;
1195   for I := 0 to FCount - 1 do
1196     if FItems[i].Action = Action then
1197     begin
1198       Result := i;
1199       Break;
1200     end;
1201 end;
1202 
1203 procedure TcpToolbar.MouseDown(Button: TMouseButton; p: TPoint);
1204 begin
1205   if (mbLeft = Button) then
1206   begin
1207     FPressedIndex := HitTest(p);
1208     //Invalidate;
1209   end;
1210 end;
1211 
1212 procedure TcpToolbar.MouseLeave;
1213 begin
1214   if FHotIndex >= 0 then
1215   begin
1216     FHotIndex := -1;
1217     //Invalidate;
1218   end;
1219 end;
1220 
1221 procedure TcpToolbar.HitWindowTest(P: TPoint);
1222 begin
1223   FHotIndex := HitTest(P);
1224 end;
1225 
1226 procedure TcpToolbar.MouseMove(p: TPoint);
1227 var
1228   iIdx: Integer;
1229 begin
1230   iIdx := HitTest(p);
1231   if iIdx <> FHotIndex then
1232   begin
1233     FHotIndex := iIdx;
1234     Invalidate;
1235   end;
1236 end;
1237 
1238 procedure TcpToolbar.MouseUp(Button: TMouseButton; p: TPoint);
1239 var
1240   iAction: Integer;
1241 begin
1242   if (mbLeft = Button) and (FPressedIndex >= 0) and (FHotIndex = FPressedIndex) then
1243   begin
1244     iAction := FPressedIndex;
1245     FPressedIndex := -1;
1246     Invalidate;
1247 
1248     ExecAction(iAction);
1249   end;
1250 end;
1251 
1252 function TcpToolbar.LoadActionIcon(Idx: Integer; AImg: TBitmap):Boolean;
1253 var
1254   bHasImg: Boolean;
1255 begin
1256   /// 获取Action的图标
1257   AImg.Canvas.Brush.Color := clBlack;
1258   AImg.Canvas.FillRect(Rect(0,0, AImg.Width, AImg.Height));
1259   bHasImg := False;
1260   if (FImages <> nil) and (FItems[Idx].ImageIndex >= 0) then
1261     bHasImg := FImages.GetBitmap(FItems[Idx].ImageIndex, AImg);
1262   if not bHasImg and (FItems[Idx].Action is TCustomAction) then
1263     with TCustomAction(FItems[Idx].Action) do
1264       if (Images <> nil) and (ImageIndex >= 0) then
1265         bHasImg := Images.GetBitmap(ImageIndex, AImg);
1266   Result := bHasImg;
1267 end;
1268 
1269 procedure TcpToolbar.Paint(DC: HDC);
1270 
1271   function GetActionState(Idx: Integer): TSkinIndicator;
1272   begin
1273     Result := siInactive;
1274     if (Idx = FPressedIndex) and (FHotIndex = FPressedIndex) then
1275       Result := siPressed
1276     else if Idx = FHotIndex then
1277       Result := siHover;
1278   end;
1279 
1280 var
1281   cIcon: TBitmap;
1282   r: TRect;
1283   I: Integer;
1284   iOpacity: byte;
1285 begin
1286   ///
1287   ///  工具条绘制
1288   ///
1289 
1290   /// 分割线
1291   r := Border;
1292   r.Right := r.Left + RES_CAPTIONTOOLBAR.w;
1293   SkinData.DrawElement(DC, steSplitter, r);
1294   OffsetRect(r, r.Right - r.Left, 0);
1295 
1296   /// 绘制Button
1297   cIcon := TBitmap.Create;
1298   cIcon.PixelFormat := pf32bit;
1299   cIcon.alphaFormat := afIgnored;
1300   for I := 0 to FCount - 1 do
1301   begin
1302     r.Right := r.Left + FItems[i].Width;
1303     if FItems[I].Enabled then
1304       SkinData.DrawButtonBackground(DC, GetActionState(i), r, FItems[i].Fade);
1305     if LoadActionIcon(i, cIcon) then
1306     begin
1307       iOpacity := 255;
1308       /// 处理不可用状态，图标颜色变暗。
1309       ///   简易处理，增加绘制透明度。
1310       if not FItems[i].Enabled then
1311         iOpacity := 100;
1312 
1313       SkinData.DrawIcon(DC, r, cIcon, iOpacity);
1314     end;
1315     OffsetRect(r, r.Right - r.Left, 0);
1316   end;
1317   cIcon.free;
1318 
1319   /// 分割条
1320   r.Right := r.Left + RES_CAPTIONTOOLBAR.w;
1321   SkinData.DrawElement(DC, steSplitter, r);
1322   OffsetRect(r, r.Right - r.Left, 0);
1323 
1324   /// 绘制下拉菜单
1325   r.Right := r.Left + RES_CAPTIONTOOLBAR.w;
1326   SkinData.DrawElement(DC, stePopdown, r);
1327 end;
1328 
1329 constructor TFormCaptionPlugin.Create(AOwner: TskForm);
1330 begin
1331   FOwner := AOwner;
1332   FVisible := True;
1333   FBorder := CalcSize;
1334   FOffset.X := -1;
1335 end;
1336 
1337 function TFormCaptionPlugin.ScreenToClient(x, y: Integer): TPoint;
1338 var
1339   P: TPoint;
1340 begin
1341   /// 调整位置
1342   ///    以 FOffset 为中心位置
1343   P := FOwner.NormalizePoint(Point(x, Y));
1344   p.X := p.X - FOffset.X;
1345   p.Y := p.y - FOffset.Y;
1346 
1347   Result := p;
1348 end;
1349 
1350 
1351 function TFormCaptionPlugin.HandleMessage(var Message: TMessage): Boolean;
1352 begin
1353   Result := True;
1354 
1355   case Message.Msg of
1356     WM_NCMOUSEMOVE    : MouseMove(ScreenToClient(TWMNCMouseMove(Message).XCursor, TWMNCMouseMove(Message).YCursor));
1357     WM_NCLBUTTONDOWN  : MouseDown(mbLeft, ScreenToClient(TWMNCLButtonDown(Message).XCursor, TWMNCLButtonDown(Message).YCursor));
1358     WM_NCHITTEST      : HitWindowTest(ScreenToClient(TWMNCHitTest(Message).XPos, TWMNCHitTest(Message).YPos));
1359     WM_NCLBUTTONUP    : MouseUp(mbLeft, ScreenToClient(TWMNCLButtonUp(Message).XCursor, TWMNCLButtonUp(Message).YCursor));
1360 
1361     else
1362       Result := False;
1363   end;
1364 end;
1365 
1366 procedure TFormCaptionPlugin.HitWindowTest(P: TPoint);
1367 begin
1368 end;
1369 
1370 procedure TFormCaptionPlugin.Invalidate;
1371 begin
1372   FOwner.InvalidateNC;
1373 end;
1374 
1375 procedure TFormCaptionPlugin.MouseDown(Button: TMouseButton; p: TPoint);
1376 begin
1377 end;
1378 
1379 procedure TFormCaptionPlugin.MouseLeave;
1380 begin
1381 end;
1382 
1383 procedure TFormCaptionPlugin.MouseMove(p: TPoint);
1384 begin
1385 end;
1386 
1387 procedure TFormCaptionPlugin.MouseUp(Button: TMouseButton; p: TPoint);
1388 begin
1389 end;
1390 
1391 procedure TFormCaptionPlugin.Update;
1392 begin
1393   FBorder := CalcSize;
1394   Invalidate;
1395 end;
1396 
1397 end.
uFormSkins.pas
  1 unit ufrmCaptionToolbar;
  2 
  3 interface
  4 
  5 uses
  6   Messages, SysUtils, Variants, Types, Controls, Forms, Dialogs, StdCtrls,
  7   ExtCtrls, ComCtrls, Windows, Classes, Graphics, Actions, ActnList, ToolWin,
  8   Vcl.ImgList, Vcl.Buttons,
  9 
 10   uFormSkins;
 11 
 12 type
 13   TForm11 = class(TForm)
 14     Button1: TButton;
 15     Shape1: TShape;
 16     Edit1: TEdit;
 17     Edit2: TEdit;
 18     Edit3: TEdit;
 19     Edit4: TEdit;
 20     ToolBar1: TToolBar;
 21     ToolButton1: TToolButton;
 22     ToolButton2: TToolButton;
 23     ToolButton3: TToolButton;
 24     ActionList1: TActionList;
 25     Action1: TAction;
 26     Action2: TAction;
 27     Action3: TAction;
 28     ImageList1: TImageList;
 29     ImageList2: TImageList;
 30     CheckBox1: TCheckBox;
 31     procedure FormCreate(Sender: TObject);
 32     procedure Action1Execute(Sender: TObject);
 33     procedure Action2Execute(Sender: TObject);
 34     procedure Action3Execute(Sender: TObject);
 35     procedure CheckBox1Click(Sender: TObject);
 36     procedure SpeedButton1Click(Sender: TObject);
 37   private
 38     FTest: TskForm;
 39   protected
 40 
 41     procedure WndProc(var message: TMessage); override;
 42   public
 43     constructor Create(AOwner: TComponent); override;
 44     destructor Destroy; override;
 45   end;
 46 
 47 var
 48   Form11: TForm11;
 49 
 50 implementation
 51 
 52 
 53 {$R *.dfm}
 54 
 55 
 56 
 57 { TForm11 }
 58 
 59 constructor TForm11.Create(AOwner: TComponent);
 60 begin
 61   FTest := TskForm.Create(Self);
 62   inherited;
 63 end;
 64 
 65 procedure TForm11.FormCreate(Sender: TObject);
 66 begin
 67   FTest.Toolbar.Images := ImageList2;
 68   FTest.Toolbar.Add(Action1, 0);
 69   FTest.Toolbar.Add(Action2, 1);
 70   FTest.Toolbar.Add(Action3, 2);
 71 end;
 72 
 73 destructor TForm11.Destroy;
 74 begin
 75   inherited;
 76   FreeAndNil(FTest);
 77 end;
 78 
 79 procedure TForm11.Action1Execute(Sender: TObject);
 80 begin
 81   Tag := Tag + 1;
 82   Caption := format('test %d', [Tag]);
 83 end;
 84 
 85 procedure TForm11.Action2Execute(Sender: TObject);
 86 begin
 87   if Shape1.Shape <> High(TShapeType) then
 88     Shape1.Shape := Succ(Shape1.Shape)
 89   else
 90     Shape1.Shape := low(TShapeType);
 91 end;
 92 
 93 procedure TForm11.Action3Execute(Sender: TObject);
 94 begin
 95   Action1.Enabled := not Action1.Enabled;
 96 end;
 97 
 98 procedure TForm11.CheckBox1Click(Sender: TObject);
 99 begin
100   if CheckBox1.Checked then
101     FTest.Toolbar.Images := nil
102   else
103     FTest.Toolbar.Images := ImageList2;
104 end;
105 
106 procedure TForm11.SpeedButton1Click(Sender: TObject);
107 begin
108   Caption := format('test %d', [1]);
109 end;
110 
111 procedure TForm11.WndProc(var message: TMessage);
112 begin
113   if not FTest.DoHandleMessage(Message) then
114     inherited;
115 end;
116 
117 end.
ufrmCaptionToolbar.pas

  

相关API

  MoveWindowOrg                ---- 设置绘制原点

  CreateRectRgnIndirect        ---- 创建区域

  SelectClipRgn                     ---- 剪切绘制区域

 

相关功能实现：

  其实这个功能在Win7下已经有此接口可以实现（很久以前用过具体名字忘记了，没写日志的后果-_-），系统自带的画图就是使用此接口实现的。但有个问题就是XP下木有此功能。感兴趣的可以Google一下。   

 

开发环境

   XE3

   Win7

完整源代码

    https://github.com/cmacro/simple/tree/master/TestCaptionToolbar

 

蘑菇房 (moguf.com)

posted @ 2014-09-17 22:18  cmacro  阅读(3637)  评论(6)  编辑  收藏  举报