分类
vb控件性能大扩展：如何用API函数更改VB自带的TooBar的背景颜色和字体颜色？？？！！！
我现在想为我的一个小软件做一个好看一点的界面，但没有找到好的界面控件（主要是按钮控件或标签控件），我又不想自己写控件，虽然写一个这样的控件很简单，但花时间，而且还不稳定。
我对按钮控件要求如下：
１．能改变字体颜色．
２．能有Picture属性
3. HotPicture属性（HotPicture指MouseMove时的图片）
4. MouseDownPicture属性（HotPicture指MouseDown时的图片）
5. 控件很成熟，稳定，最好是非常流行的，出自大公司的产品。
6. 控件最好是免费的（不是我舍不得出钱，主要是为了几十块钱去写汇款单非常麻烦）
我在网上找了很久，都没有找到合适的。我最后就定用VB自带的TooBar实现以上的功能，以上功能基本上可以达到，但没办法改变TooBar的背景颜色和字体颜色，因为TooBar的背景颜色是灰色的非常难看，不知哪位大侠能用用API函数更改VB自带的TooBar的背景颜色和字体颜色。
请多多指教。万分感谢。
请高手前来指教。
完全可以用VB自带的按钮做一个自己的按钮控件来做.
用ActiveBar吧.
To ansionhuang(毛毛雨-我是外星人,所以我什么都不知道) ：
ActiveBar太庞大了，也太复杂了，而且我也不知道哪个版本比较好用。
如果能改变TooBar的背景颜色和字体颜色，则TooBar可作为按钮和标签来使用，也可以作为一款极好的界面控件来使用。
不怕危险可以试试看子类
To kmzs(.:RNPA:.山水岿濛) :
使用子类太危险了， 我只是希望能用APITooBar的背景颜色和字体颜色改变就完全达到我的目的了。
ding ....
是呀！同感！半年前曾为这个问题在网上专门搜索过，无果！
现在，虽没这个需要，但还是想知道，到底有没有成功的先例！
支持。。。。
希望各位高手鼎力相助.如果能改变TooBar的背景颜色和字体颜色，则TooBar可作为按钮和标签来使用，也可以作为一款极好的界面控件来使用,这将极大的扩展TooBar的功能.
http://www.5ivb.net/down/54/5ivb_2071.asp
看看这个VB编控件怎样，有源码的。
To homezj(小吉):
谢谢你的帮助。我现在正在www.google.com上搜索相关的资料，希望能找到突破点。我是按如下方式进行逐步过滤搜索的：Toolbar API VB BackColor。
我找到几条和我的问题相同的国际网页，有空你可以看一看：
http://www.codeguru.com/forum/printthread.php?t=309893
其中有一段代码值得关注：
Below is the area where the I just can't change color and where if I change the back color of the imagelist it won't make any difference to the imagelists color :
' Mark added this in to change the color of the cool bar and menu bar 9/8/04
Private Declare Function ImageList_SetBkColor Lib "COMCTL32" (ByVal hImageList As Long, ByVal clrBk As Long) As Long
For intcount = 0 To TTDocViewer.Annotations.Tools.Count - 1
hdlImageList = imgList.hImageList
lColor = ImageList_SetBkColor(hdlImageList, RGB(9, 3, 2))
ImgList.ListImages.Add intcount + 1, , TTDocViewer.Annotations.Tools.Item(intcount).Picture
lColor = ImageList_SetBkColor(hdlImageList, RGB(9, 3, 2))
' imgList.BackColor = vbYellow
Next
对呀！这个论坛不错！你要的代码，好象也有：
http://www.codeguru.com/forum/attachment.php?attachmentid=7783
无控件改变标准ToolBar的背景色。
你下载看看，我还没细看，你有成果了，别私藏就行啦！
Mark!
哎！今晚总算有空，看一下这个类模块。
这一次接触用SubClass对CommControl进行消息处理，本就有点神秘感，可代码中偏又弄了个内套汇编，更有些头痛，一时摸不清其具体路数了。
忙了半天，好不容易才为该类加上了背景色属性。
下步打算
1、去掉不知所云的汇编，感觉那汇编没太多必要，似乎就是为了给子类过程多加三个参数，便于完全在类中解决，放在标准模块中，应该也不算失败吧！
2、看看为什么作者把按钮文本给注释掉了，没文字，也不太好呀。
不知这两项能否实现，哪位有兴趣，也弄一弄！
下载链接：
http://www.codeguru.com/forum/attachment.php?attachmentid=7783
ToolBar本身支持用户自定义界面——使用Custom Draw
只不过VB封装的太差，没有提供Custom Draw功能
而且在VB中拦截消息只能用子类，非常麻烦
MSDN:
Customizing a Control's Appearance Using Custom Draw
--------------------------------------------------------------------------------
Custom Draw is not a common control; it is a service that many common controls provide. Custom Draw services allow an application greater flexibility in customizing a control's appearance. Your application can harness custom draw notifications to easily change the font used to display items or manually draw an item without having to do a full-blown owner draw.
About Custom Draw
Custom Draw With List-View and Tree-View Controls
Using Custom Draw
Related Topics
About Custom Draw
This section contains general information about custom draw functionality and provides a conceptual overview of how an application can support custom draw.
Currently, the following controls support custom draw functionality:
Header controls
List-view controls
Rebar controls
Toolbar controls
ToolTip controls
Trackbar controls
Tree-view controls
Note Custom draw is implemented in version 4.70 and later of Comctl32.dll for all the controls previously listed. Custom draw is also supported for button controls if you are running Windows XP and have an application manifest to ensure that Comctl32.dll version 6 is available.
About Custom Draw Notification Messages
All common controls that support custom draw send NM_CUSTOMDRAW notification messages at specific points during drawing operations. These notifications describe drawing operations that apply to the entire control as well as drawing operations specific to items within the control. Like many notification messages, NM_CUSTOMDRAW notifications are sent as WM_NOTIFY messages.
The lParam parameter of a custom draw notification message will be the address of an NMCUSTOMDRAW structure or a control-specific structure that contains an NMCUSTOMDRAW structure as its first member. The following table illustrates the relationship between the controls and the structures they use.
Structure Used by
NMCUSTOMDRAW Rebar, trackbar, and header controls
NMLVCUSTOMDRAW List-view controls
NMTBCUSTOMDRAW Toolbar controls
NMTTCUSTOMDRAW ToolTip controls
NMTVCUSTOMDRAW Tree-view controls
Paint Cycles, Drawing Stages, and Notification Messages
Like all Microsoft® Windows® applications, common controls periodically paint and erase themselves based on messages received from the system or other applications. The process of a control painting or erasing itself is called a paint cycle. Controls that support custom draw send NM_CUSTOMDRAW notification messages periodically through each paint cycle. This notification message is accompanied by an NMCUSTOMDRAW structure or another structure that contains an NMCUSTOMDRAW structure as its first member.
One piece of information that the NMCUSTOMDRAW structure contains is the current stage of the paint cycle. This is referred to as the draw stage and is represented by the value in the structure's dwDrawStage member. A control informs its parent about four basic draw stages. These basic, or global, draw stages are represented in the structure by the following flag values (defined in Commctrl.h).
Global draw stage values Description
CDDS_PREPAINT Before the paint cycle begins.
CDDS_POSTPAINT After the paint cycle is complete.
CDDS_PREERASE Before the erase cycle begins.
CDDS_POSTERASE After the erase cycle is complete.
Each of the preceding values can be combined with the CDDS_ITEM flag to specify draw stages specific to items. For convenience, Commctrl.h contains the following item-specific values.
Item-specific draw stage values Description
CDDS_ITEMPREPAINT Before an item is drawn.
CDDS_ITEMPOSTPAINT After an item has been drawn.
CDDS_ITEMPREERASE Before an item is erased.
CDDS_ITEMPOSTERASE After an item has been erased.
CDDS_SUBITEM Shell and Common Controls Versions 4.71. Flag combined with CDDS_ITEMPREPAINT or CDDS_ITEMPOSTPAINT if a subitem is being drawn. This will only be set if CDRF_NOTIFYITEMDRAW is returned from CDDS_PREPAINT.
Your application must process the NM_CUSTOMDRAW notification message and then return a specific value that informs the control what it must do. See the following sections for more information about these return values.
Taking Advantage of Custom Draw Services
The key to harnessing custom draw functionality is in responding to the NM_CUSTOMDRAW notification messages that a control sends. The return values your application sends in response to these notifications determine the control's behavior for that paint cycle.
This section contains information about how your application can use NM_CUSTOMDRAW notification return values to determine the control's behavior.
Details are broken into the following topics:
Responding to the prepaint notification
Requesting item-specific notifications
Drawing the item yourself
Changing fonts and colors
Responding to the prepaint notification
At the beginning of each paint cycle, the control sends the NM_CUSTOMDRAW notification message, specifying the CDDS_PREPAINT value in the dwDrawStage member of the accompanying NMCUSTOMDRAW structure. The value that your application returns to this first notification dictates how and when the control sends subsequent custom draw notifications for the rest of that paint cycle. Your application can return a combination of the following flags in response to the first notification.
Return value Effect
CDRF_DODEFAULT The control will draw itself. It will not send additional NM_CUSTOMDRAW notifications for this paint cycle. This flag cannot be used with any other flag.
CDRF_NOTIFYITEMDRAW The control will notify the parent of any item-specific drawing operations. It will send NM_CUSTOMDRAW notification messages before and after it draws items.
CDRF_NOTIFYPOSTPAINT The control will send an NM_CUSTOMDRAW notification when the painting cycle for the entire control is complete.
CDRF_SKIPDEFAULT The control will not perform any painting at all.
Requesting item-specific notifications
If your application returns CDRF_NOTIFYITEMDRAW to the initial prepaint custom draw notification, the control will send notifications for each item it draws during that paint cycle. These item-specific notifications will have the CDDS_ITEMPREPAINT value in the dwDrawStage member of the accompanying NMCUSTOMDRAW structure. You can request that the control send another notification when it is finished drawing the item by returning CDRF_NOTIFYPOSTPAINT to these item-specific notifications. Otherwise, return CDRF_DODEFAULT and the control will not notify the parent window until it starts to draw the next item.
Drawing the item yourself
If your application draws the entire item, return CDRF_SKIPDEFAULT. This allows the control to skip items that it does not need to draw, thereby decreasing system overhead. Keep in mind that returning this value means the control will not draw any portion of the item.
To homezj(小吉) :
我也在网上找到一些有用的东西，我这几天很忙，等我忙完后我就把这些东西整理出来供大家学习和讨论。
To zyl910(910：分儿，我又来了！) ：
谢谢你的指点，现在放寒假了吧，大学里的学习和生活还好吧？
是呀！子类处理真的很烦，不好调试，不能出错，一错就退出。加上要自已定位绘按钮，总觉得自找苦吃。
昨天基本改完了，前面说到的两条也都实现了，效果还不错。就是遇到一个难题：
带菜单的按钮有点生硬，因为我不知道怎么才能获取右边小按钮按下的状态，CSDN中也没说明，Bebug一看，
鼠标移到按钮上收到CDIS_HOT状态；
鼠标点击大按钮得到CDIS_HOT or CDIS_SELECTED状态；
鼠标点击小按钮得到竟然还是CDIS_HOT状态！
困惑中...
还有一处小小不适：
设置类背景色，按钮样式，文本色等属性后，需重绘工具栏，但却不知如何通知让这位老先生重绘！发送WM_Paint消息、InvalidateRect、UpdateWindow统统上阵，都无效。还好在VB中用最简单的Toolbar1.Refresh，是可以办法的，但还没弄清VB是怎么做的。
up
大家新年好，给大家拜个晚年。
经过这一段时间的了解和测试，我还是没有找到好的解决办法，用SubClass非常麻烦，也很复杂，也很危险。我准备参照SmarkMenuXP的形式自己写一个ToolBar.
现在我把最近一段时间收集的一些资料贴出来，供大家学习和参考。另外，要特别感谢小吉的参与和帮助。
http://www.visualbasicforum.com/showthread.php?t=67007
http://planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=5839&lngWId=1
http://vbnet.mvps.org/index.html?code/comctl/toolbarinstatbar.htm
http://www.elitevb.com/content/01,0100,01/
http://www.elitevb.com/content/01,0078,01/
http://www.elitevb.com/search.aspx
http://www.elitevb.com/search.aspx/1
在google中搜索 “How to change Toolbar Backcolor in VB ”
漂亮的toolbar_5ivb_898393.zip
高级ToolBar控件源码_5ivb_775098.rar
HookMenu_116741711202003.zip
vsnetmenu.rar
wh_Menu.rar
xpcontrols.rar
以上压缩文件大家可以在网上搜索即可。
写错了是 SmartMenuXP
ToolBar的SubClass很有趣，节前我就已改好了一个这样的类模块，可定制5种按钮样式，或改变背景、前景、文本的颜色，甚至可以为ToolBar换上背景图。
其实ToolBar提供了一个CustomDraw功能，MS为你已搭好了ToolBar的框架，只是ToolBar的模样交给你自己绘，很简单地，就可以用任意你想要的模样，使用ToolBar的所有功能，这比自己做ToolBar是不是更容易更方便？
这个类代码有些多（我写的功能多了点），可能要4-5贴才能贴完。我就慢慢来，别见怪呀^_^
--------------------------------------------------------
'测试窗体中的代码：需有个ToolBar，最好有ImageList。
Option Explicit
Private Sub Command1_Click()
Dim i As Long
With oTbr
Randomize
'If .BackPicture = "" Then
' .BackPicture = "e:12.jpg"
'Else
' .BackPicture = ""
'End If
.BorderColor = vbBlue '只有BorderStyle大于3时才有效
.BackColor = Rnd * (2 ^ 24)
.TextColor = Rnd * (2 ^ 24)
.TextHiColor = Rnd * (2 ^ 24)
i = .BorderStyle + 1
If i > 4 Then i = 0
.BorderStyle = i '取值范围0-4
End With
End Sub
Private Sub Command2_Click()
If oTbr Is Nothing Then
Set oTbr = New cToolbar
With oTbr
.BindToolBar Toolbar1.hWnd
End With
Command2.Caption = "取消样式"
Command1.Enabled = True
Else
Set oTbr = Nothing
Toolbar1.Refresh
Command2.Caption = "加载样式"
Command1.Enabled = False
End If
End Sub
Private Sub Form_Load()
Command1.Caption = "随机变样"
Command2.Caption = "加载样式"
Command2.Enabled = True
Command1.Enabled = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set oTbr = Nothing
End Sub
--------------------------------------------------
--------------------------------------------------
'标准模块中的代码：
Option Explicit
Public oTbr As cToolbar
Public OldWindowProc As Long
Private Const WM_NOTIFY As Long = &H4E
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Function TBSubClass(ByVal hWnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
Dim ProcOK As Long
Static MouseDown As Boolean
If Msg = WM_NOTIFY Then
ProcOK = oTbr.MsgProc(lp, MouseDown)
ElseIf Msg = WM_LBUTTONDOWN Then
MouseDown = True
ElseIf Msg = WM_LBUTTONUP Then
MouseDown = False
End If
If ProcOK Then
TBSubClass = ProcOK
Else
TBSubClass = CallWindowProc(OldWindowProc, hWnd, Msg, wp, lp)
End If
End Function
----------------------------------------------------------------
----------------------------------------------------
'类模块中的代码:类名cToolbar
Option Explicit
Private Const CDDS_ITEM As Long = &H10000
Private Const CDDS_PREPAINT As Long = &H1
Private Const CDDS_ITEMPREPAINT As Long = (CDDS_ITEM Or CDDS_PREPAINT)
Private Const CDRF_SKIPDEFAULT As Long = &H4
Private Const CDRF_NOTIFYITEMDRAW As Long = &H20
Private Const CDIS_CHECKED As Long = &H8
Private Const CDIS_DISABLED As Long = &H4
Private Const CDIS_HOT As Long = &H40
Private Const CDIS_SELECTED As Long = &H1
Private Const GWL_WNDPROC = (-4)
Private Const WM_USER As Long = &H400
Private Const TB_GETBUTTONTEXTA As Long = (WM_USER + 45)
Private Const TB_GETIMAGELIST As Long = (WM_USER + 49)
Private Const TB_GETHOTIMAGELIST = (WM_USER + 53)
Private Const TB_GETDISABLEDIMAGELIST = (WM_USER + 55)
Private Const TB_GETBITMAP As Long = (WM_USER + 44)
Private Const TB_COMMANDTOINDEX As Long = (WM_USER + 25)
Private Const TB_GETBUTTON As Long = (WM_USER + 23)
Private Const TBSTYLE_LIST As Long = &H1000
Private Const TBSTYLE_SEP As Long = &H1
Private Const TBSTYLE_DROPDOWN As Long = &H8
Private Const ILD_NORMAL As Long = &H0
Private Const DST_TEXT = &H1&
Private Const DST_ICON As Long = &H3
Private Const DSS_DISABLED = &H20&
Private Const CLR_NONE As Long = &HFFFFFFFF
Private Const GWL_STYLE As Long = -16
Private Const PS_SOLID As Long = 0
Private Const TA_LEFT = 0
Private Const TA_RIGHT = 2
Private Const TA_CENTER = 6
Private Const BF_FLAT = &H4000
Private Const BF_BOTTOM = &H8
Private Const BF_LEFT = &H1
Private Const BF_RIGHT = &H4
Private Const BF_TOP = &H2
Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
Private Const BDR_RAISEDOUTER = &H1
Private Const BDR_RAISEDINNER = &H4
Private Const BDR_SUNKENINNER = &H8
Private Const BDR_SUNKENOUTER = &H2
Private Const BDR_OUTER = &H3
Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Private Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Private Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Type ICONINFO
fIcon As Long
xHotspot As Long
yHotspot As Long
hbmMask As Long
hbmColor As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTL
X As Long
Y As Long
End Type
Private Type Size
cx As Long
cy As Long
End Type
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 32
End Type
Private Type TBBUTTON
iBitmap As Long
idCommand As Long
fsState As Byte
fsStyle As Byte
bReserved(1) As Byte
dwData As Long
iString As Long
End Type
Private Type MemHdc
hdc As Long
Bmp As Long
obm As Long
End Type
Private Type NMHDR
hwndFrom As Long
idfrom As Long
code As Long
End Type
Private Type NMCUSTOMDRAW
hdr As NMHDR
dwDrawStage As Long
hdc As Long
rc As RECT
dwItemSpec As Long
uItemState As Long
lItemlParam As Long
End Type
Private Type NMTBCUSTOMDRAW
nmcd As NMCUSTOMDRAW
hbrMonoDither As Long
hbrLines As Long
hpenLines As Long
clrText As Long
clrMark As Long
clrTextHighlight As Long
clrBtnFace As Long
clrBtnHighlight As Long
clrHighlightHotTrack As Long
rcText As RECT
nStringBkMode As Long
nHLStringBkMode As Long
End Type
Private m_hWnd As Long
Private m_lngBackColor As Long
Private m_lngBrdStyle As Long
Private m_lngTextColor As Long
Private m_lngTextHiColor As Long
Private m_strBkPicture As String
Private m_lngBrdColor As Long
Private mpicBk As StdPicture
Private mlngImgList As Long
Private mdcWhite As MemHdc
Private mlngHotImgList As Long
Private mlngDsbImgList As Long
Private mlngBtnHiAlpha As Long
Private mlngBtnDownAlpha As Long
Private mlngIconWidth As Long
Private mlngIconHeight As Long
Private Font As LOGFONT
'消息与管理类
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ShowWindow Lib "user32" Alias "ShowWindowAsync" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'GDI对象类
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function CreatePen Lib "gdi32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
Private Declare Function GetObj Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
'区域、绘图、文本类
Private Declare Function GetClientRect Lib "user32.dll" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SetRect Lib "user32.dll" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTL, ByVal nCount As Long) As Long
Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function MoveToEx Lib "gdi32.dll" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As Any) As Long
Private Declare Function LineTo Lib "gdi32.dll" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long
Private Declare Function SetTextAlign Lib "gdi32" (ByVal hdc As Long, ByVal wFlags As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetTextColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function DrawState Lib "user32.dll" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal hIco As Long, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdcDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal hHeightDest As Long, ByVal hdcSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal blendFunction As Long) As Long
'ImageList类
Private Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal hdcDst As Long, ByVal X As Long, ByVal Y As Long, ByVal fStyle As Long) As Long
Private Declare Function ImageList_GetBkColor Lib "comctl32.dll" (ByVal himl As Long) As Long
Private Declare Function ImageList_SetBkColor Lib "comctl32.dll" (ByVal himl As Long, ByVal clrBk As Long) As Long
Private Declare Function ImageList_GetIcon Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal flags As Long) As Long
Friend Property Let BorderColor(ByVal vData As Long)
If m_lngBrdColor <> vData Then
m_lngBrdColor = vData
If m_lngBrdStyle > 3 Then Refresh
End If
End Property
Friend Property Get BorderColor() As Long
BorderColor = m_lngBrdColor
End Property
Friend Property Let BackPicture(ByVal vData As String)
If vData <> "" And Dir(vData) <> "" Then
If LCase(m_strBkPicture) <> LCase(vData) Then
m_strBkPicture = vData
Set mpicBk = LoadPicture(m_strBkPicture)
Refresh
End If
Else
Set mpicBk = Nothing
m_strBkPicture = ""
End If
End Property
Friend Property Get BackPicture() As String
BackPicture = m_strBkPicture
End Property
Friend Property Let FontUnderline(ByVal vData As Boolean)
Dim i As Long
i = IIf(vData, 1, 0)
If Font.lfUnderline <> i Then
Font.lfUnderline = i
Refresh
End If
End Property
Friend Property Get FontUnderline() As Boolean
FontUnderline = (Font.lfUnderline = 1)
End Property
Friend Property Let FontItalic(ByVal vData As Boolean)
Dim i As Long
i = IIf(vData, 1, 0)
If Font.lfItalic <> i Then
Font.lfItalic = i
Refresh
End If
End Property
Friend Property Get FontItalic() As Boolean
FontItalic = (Font.lfItalic = 1)
End Property
Friend Property Let FontBold(ByVal vData As Boolean)
Dim i As Long
i = IIf(vData, 700, 400)
If Font.lfWeight <> i Then
Font.lfWeight = i
Refresh
End If
End Property
Friend Property Get FontBold() As Boolean
FontBold = (Font.lfWeight = 700)
End Property
Friend Property Let FontSize(ByVal vData As Long)
If Font.lfHeight <> vData And vData >= 7 And vData <= 16 Then
Font.lfHeight = vData
Font.lfWidth = 0
Refresh
End If
End Property
Friend Property Get FontSize() As Long
FontSize = Font.lfHeight
End Property
Friend Property Let BorderStyle(ByVal vData As Long)
If m_lngBrdStyle <> vData Then
m_lngBrdStyle = vData
Refresh
End If
End Property
Friend Property Get BorderStyle() As Long
BorderStyle = m_lngBrdStyle
End Property
Friend Property Let TextHiColor(ByVal vData As Long)
m_lngTextHiColor = vData
End Property
Friend Property Get TextHiColor() As Long
TextHiColor = m_lngTextHiColor
End Property
Friend Property Let TextColor(ByVal vData As Long)
If m_lngTextColor <> vData Then
m_lngTextColor = vData
Refresh
End If
End Property
Friend Property Get TextColor() As Long
TextColor = m_lngTextColor
End Property
Friend Property Let BackColor(ByVal vData As Long)
If m_lngBackColor <> vData Then
m_lngBackColor = vData
If mpicBk Is Nothing Then Refresh
End If
End Property
Friend Property Get BackColor() As Long
BackColor = m_lngBackColor
End Property
Friend Sub BindToolBar(ByVal hWnd As Long)
If m_hWnd = 0 Then
m_hWnd = hWnd
If m_hWnd Then
OldWindowProc = GetWindowLong(m_hWnd, GWL_WNDPROC)
SetWindowLong m_hWnd, GWL_WNDPROC, AddressOf TBSubClass
End If
Refresh
End If
End Sub
Friend Sub Refresh()
If m_hWnd <> 0 Then
ShowWindow m_hWnd, 0
ShowWindow m_hWnd, 5
End If
End Sub
Friend Function MsgProc(lParam As Long, MouseDown As Boolean) As Long
Dim tHDR As NMHDR
Dim className As String * 32
Dim retval As Long
CopyMemory tHDR, ByVal lParam, Len(tHDR)
If tHDR.hwndFrom <> 0 Then
retval = GetClassName(tHDR.hwndFrom, className, 33)
If retval > 0 Then
If Left$(className, retval) = "msvb_lib_toolbar" Then
MsgProc = OnCustomDraw(lParam, MouseDown)
End If
End If
End If
End Function
Private Sub Class_Initialize()
Dim rc As RECT, hBrush As Long, i As Long
m_lngTextColor = vbBlack
m_lngTextHiColor = vbRed
m_lngBackColor = &HD7E9EB
m_lngBrdColor = &H0
mlngBtnHiAlpha = 96
mlngBtnDownAlpha = 192
rc.Bottom = 128
rc.Right = 128
i = GetDC(0)
mdcWhite = NewMyHdc(i, rc.Right, rc.Bottom)
ReleaseDC 0, i
hBrush = CreateSolidBrush(vbWhite)
FillRect mdcWhite.hdc, rc, hBrush
DeleteObject hBrush
With Font
.lfCharSet = 1
.lfHeight = 12
.lfWeight = 400
End With
End Sub
Private Sub Class_Terminate()
SetWindowLong m_hWnd, GWL_WNDPROC, OldWindowProc
mdcWhite = DelMyHdc(mdcWhite)
Set mpicBk = Nothing
End Sub
Private Sub DrawPloy3(hdc As Long, rcDrop As RECT, Up As Boolean)
'画下拉菜单的小三角形
Dim ploy(2) As POINTL
Dim hBrush As Long, hOldBrush As Long
Dim hPen As Long, hOldPen As Long
With rcDrop
If Up Then
.Left = .Left - 1
.Right = .Right - 1
.Top = .Top - 1
.Bottom = .Bottom - 1
hBrush = CreateSolidBrush(m_lngTextHiColor)
hPen = CreatePen(PS_SOLID, 1, m_lngTextHiColor)
Else
hBrush = CreateSolidBrush(m_lngTextColor)
hPen = CreatePen(PS_SOLID, 1, m_lngTextColor)
End If
hOldPen = SelectObject(hdc, hPen)
hOldBrush = SelectObject(hdc, hBrush)
ploy(0).X = (.Left + .Right - 5) 2
ploy(0).Y = (.Top + .Bottom) 2
ploy(1).X = ploy(0).X + 4
ploy(1).Y = ploy(0).Y
ploy(2).X = ploy(0).X + 2
ploy(2).Y = ploy(0).Y + 2
End With
Polygon hdc, ploy(0), 3
SelectObject hdc, hOldPen
SelectObject hdc, hOldBrush
DeleteObject hPen
DeleteObject hBrush
End Sub
Private Sub GetIconSize(hIcon As Long)
'取得图像列表框图标的大小
Dim Bm As BITMAP, bi As ICONINFO
GetIconInfo hIcon, bi
GetObj bi.hbmColor, Len(Bm), Bm
DeleteObject bi.hbmColor
DeleteObject bi.hbmMask
mlngIconWidth = Bm.bmWidth
mlngIconHeight = Bm.bmHeight
End Sub
Private Sub DrawRect(hdc As Long, rc As RECT, State As Long, Optional IsDrop As Boolean)
Dim hPen As Long
If (State > 0 Or IsDrop) And m_lngBrdStyle > 3 Then
hPen = CreatePen(PS_SOLID, 1, m_lngBrdColor)
If IsDrop Then rc.Left = rc.Left - 1
FrameRect hdc, rc, hPen
If IsDrop Then rc.Left = rc.Left + 1
DeleteObject hPen
Exit Sub
End If
Select Case State
Case 0 '普通状态
Select Case m_lngBrdStyle
Case 1
If IsDrop Then DrawEdge hdc, rc, BDR_OUTER, BF_RECT Or BF_FLAT
Case 2
DrawEdge hdc, rc, BDR_RAISEDOUTER, BF_RECT
Case 3
DrawEdge hdc, rc, EDGE_RAISED, BF_RECT
End Select
Case 1 '高亮状态
Select Case m_lngBrdStyle
Case 0
DrawEdge hdc, rc, BDR_RAISEDINNER, BF_RECT
Case 1, 2, 3
DrawEdge hdc, rc, EDGE_RAISED, BF_RECT
End Select
Case 2 '按下状态
Select Case m_lngBrdStyle
Case 0
DrawEdge hdc, rc, BDR_SUNKENOUTER, BF_RECT
Case 1
DrawEdge hdc, rc, BDR_SUNKENINNER, BF_RECT
Case 2, 3
DrawEdge hdc, rc, EDGE_SUNKEN, BF_RECT
End Select
End Select
End Sub
Private Function OnCustomDraw(lParam As Long, MouseDown As Boolean) As Long
Dim tTBCD As NMTBCUSTOMDRAW
Dim hBrush As Long
CopyMemory tTBCD, ByVal lParam, Len(tTBCD)
With tTBCD.nmcd
Select Case .dwDrawStage
Case CDDS_ITEMPREPAINT
OnCustomDraw = CDRF_SKIPDEFAULT
DrawToolbarButton .hdr.hwndFrom, .hdc, .dwItemSpec, .uItemState, .rc, MouseDown
Case CDDS_PREPAINT
OnCustomDraw = CDRF_NOTIFYITEMDRAW
GetClientRect .hdr.hwndFrom, .rc
If mpicBk Is Nothing Then
hBrush = CreateSolidBrush(m_lngBackColor)
Else
hBrush = CreatePatternBrush(mpicBk)
End If
FillRect .hdc, .rc, hBrush
DeleteObject hBrush
End Select
End With
End Function
Private Function NewMyHdc(dHdc As Long, w As Long, h As Long, Optional Bm As Long) As MemHdc
With NewMyHdc
.hdc = CreateCompatibleDC(dHdc)
If Bm = 0 Then
.Bmp = CreateCompatibleBitmap(dHdc, w, h)
Else
.Bmp = Bm
End If
.obm = SelectObject(.hdc, .Bmp)
End With
End Function
Private Function DelMyHdc(MyHdc As MemHdc, Optional nobmp As Boolean) As MemHdc
With MyHdc
If .hdc <> 0 Then
SelectObject .hdc, .obm
If nobmp = False Then DeleteObject .Bmp
DeleteDC .hdc
End If
End With
End Function
Private Sub DrawToolbarButton(ByVal hWnd As Long, ByVal hdc As Long, itemSpec As Long, ByVal itemState As Long, tR As RECT, MouseDown As Boolean)
Dim i As Long
Dim bPushed As Boolean, bDropDown As Boolean, bHover As Boolean
Dim bDisabled As Boolean, bChecked As Boolean
Dim bSkipped As Boolean, bBottomText As Boolean, bNoDsbIcon As Boolean
Dim hIcon As Long, hImageList As Long
Dim tTB As TBBUTTON
Dim szText As Size, rcDrop As RECT, rcIcon As RECT
Dim hOldPen As Long, hPen As Long
Dim hFont As Long, hOldFont As Long
Dim sCaption As String, bFirstSetBk As Boolean
Dim lDropWidth As Long, lTxtColor As Long
sCaption = String$(128, vbNullChar)
i = SendMessage(hWnd, TB_GETBUTTONTEXTA, itemSpec, ByVal sCaption)
If i > 0 Then
sCaption = Left$(sCaption, i)
Else
sCaption = ""
End If
i = GetWindowLong(hWnd, GWL_STYLE)
bBottomText = ((i And TBSTYLE_LIST) = 0)
i = SendMessage(hWnd, TB_COMMANDTOINDEX, itemSpec, ByVal 0)
SendMessage hWnd, TB_GETBUTTON, i, tTB
bDisabled = (itemState And CDIS_DISABLED)
bChecked = (itemState And CDIS_CHECKED)
bHover = (itemState And CDIS_HOT)
bPushed = (itemState And CDIS_SELECTED)
If tTB.fsStyle And TBSTYLE_SEP Then '分隔线按钮
hPen = CreatePen(PS_SOLID, 1, vb3DShadow)
hOldPen = SelectObject(hdc, hPen)
MoveToEx hdc, tR.Left + 2&, tR.Top + 1&, ByVal 0
LineTo hdc, tR.Left + 2&, tR.Bottom - 1&
SelectObject hdc, hOldPen
DeleteObject hPen
Exit Sub
Else
hImageList = SendMessage(hWnd, TB_GETIMAGELIST, 0, ByVal 0)
If hImageList <> 0 Then '取得主图像列表
If mlngImgList <> hImageList Then
mlngImgList = hImageList
bFirstSetBk = True
mlngIconWidth = 0
End If
If bDisabled Then '取得禁用图像列表
i = SendMessage(hWnd, TB_GETDISABLEDIMAGELIST, 0, ByVal 0)
If i <> 0 And i <> hImageList Then
hImageList = i
If mlngDsbImgList <> i Then
mlngDsbImgList = i
bFirstSetBk = True
End If
Else
bNoDsbIcon = True
End If
ElseIf bHover Then '取得热图像列表
i = SendMessage(hWnd, TB_GETHOTIMAGELIST, 0, ByVal 0)
If i <> 0 And i <> hImageList Then
hImageList = i
If mlngHotImgList <> i Then
mlngHotImgList = i
bFirstSetBk = True
End If
End If
End If
If bFirstSetBk Then '首次使用需设定背景色
If ImageList_GetBkColor(hImageList) <> -1 Then
ImageList_SetBkColor hImageList, CLR_NONE
End If
End If
hIcon = ImageList_GetIcon(hImageList, tTB.iBitmap, ILD_NORMAL)
If mlngIconWidth = 0 Then GetIconSize hIcon
End If
'根据状态创建不同刷子与画笔
lTxtColor = m_lngTextColor
If bChecked Or bPushed Then
AlphaBlend hdc, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, mdcWhite.hdc, 0, 0, tR.Right - tR.Left, tR.Bottom - tR.Top, mlngBtnDownAlpha * &H10000
ElseIf bHover Then
AlphaBlend hdc, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, mdcWhite.hdc, 0, 0, tR.Right - tR.Left, tR.Bottom - tR.Top, mlngBtnHiAlpha * &H10000
lTxtColor = m_lngTextHiColor
Else
bSkipped = True
End If
SetTextColor hdc, lTxtColor
If tTB.fsStyle And TBSTYLE_DROPDOWN Then
lDropWidth = 14
bDropDown = bHover And MouseDown And Not bPushed
SetRect rcDrop, tR.Right - lDropWidth, tR.Top, tR.Right, tR.Bottom
tR.Right = tR.Right - lDropWidth
End If
End If
SetBkMode hdc, 1 '文本背景透明
If bSkipped = False Then '根据样式不同，画不同边框并填充
If bChecked Or bPushed Then
DrawRect hdc, tR, 2
Else
DrawRect hdc, tR, 1
End If
Else
DrawRect hdc, tR, 0
End If
If tTB.fsStyle And TBSTYLE_DROPDOWN Then '处理下拉菜单的小按钮
If bSkipped = False Or m_lngBrdStyle > 0 Then
If bDropDown Then
AlphaBlend hdc, rcDrop.Left, rcDrop.Top, lDropWidth, rcDrop.Bottom - rcDrop.Top, mdcWhite.hdc, 0, 0, rcDrop.Right - rcDrop.Left, rcDrop.Bottom - rcDrop.Top, mlngBtnDownAlpha * &H10000
End If
If bDropDown Or bPushed Then
DrawRect hdc, rcDrop, 2, True
ElseIf bHover Then
DrawRect hdc, rcDrop, 1, True
Else
DrawRect hdc, rcDrop, 0, True
MouseDown = False
End If
Else
MouseDown = False
End If
DrawPloy3 hdc, rcDrop, bHover And Not (bDropDown Or bPushed)
End If
'画图标与文本
With rcIcon
'计算图标区域
.Top = tR.Top + 3
If bBottomText = False Then .Left = tR.Left + 3
If mlngIconWidth < 16 Then
If bBottomText Then .Left = tR.Left + (tR.Right - tR.Left - 16) 2
.Right = .Left + 16
Else
If bBottomText Then .Left = tR.Left + (tR.Right - tR.Left - mlngIconWidth) 2
.Right = .Left + mlngIconWidth
End If
If mlngIconHeight < 16 Then
.Bottom = .Top + 16
Else
.Bottom = .Top + mlngIconHeight
End If
If bHover And (Not (bPushed Or bChecked)) Then
.Left = .Left - 1
.Top = .Top - 1
.Right = .Right - 1
.Bottom = .Bottom - 1
End If
If hImageList <> 0 Then
If bDisabled And bNoDsbIcon Then
If hIcon Then
DrawState hdc, 0, 0, hIcon, 0, .Left, .Top, 0, 0, DST_ICON Or DSS_DISABLED
End If
Else
ImageList_Draw hImageList, tTB.iBitmap, hdc, .Left, .Top, ILD_NORMAL
End If
End If
If Len(sCaption) > 0 Then
hFont = CreateFontIndirect(Font)
hOldFont = SelectObject(hdc, hFont)
If bBottomText Then
If bDisabled Then
SetTextAlign hdc, TA_LEFT
GetTextExtentPoint32 hdc, sCaption, lstrlen(sCaption), szText
DrawState hdc, 0, 0, StrPtr(StrConv(sCaption, vbFromUnicode)), lstrlen(sCaption), (.Right + .Left - szText.cx) 2, .Bottom + 1, 0, 0, DST_TEXT Or DSS_DISABLED
Else
SetTextAlign hdc, TA_CENTER
TextOut hdc, (.Right + .Left) 2, .Bottom + 1, sCaption, lstrlen(sCaption)
End If
Else
SetTextAlign hdc, TA_LEFT
If bDisabled Then
GetTextExtentPoint32 hdc, sCaption, lstrlen(sCaption), szText
DrawState hdc, 0, 0, StrPtr(StrConv(sCaption, vbFromUnicode)), lstrlen(sCaption), .Right + 1, (.Top + .Bottom - Font.lfHeight) 2, 0, 0, DST_TEXT Or DSS_DISABLED
Else
TextOut hdc, .Right + 1, (.Top + .Bottom - Font.lfHeight) 2, sCaption, lstrlen(sCaption)
End If
End If
SelectObject hdc, hOldFont
DeleteObject hFont
End If
End With
If hIcon <> 0 Then DestroyIcon hIcon
End Sub
总算贴完了，大家可把它看成是一个改变ToolBar样式的示例，希望能起到抛砖引玉的作用。
附：对于带下拉菜单的按钮，我用的方法有点笨，我不知道有没有什么相关消息，还望知情者指点！
我的美工不好，绘图手段很传统，不过根据本类的原理，相信会有朋友可做出更加炫丽的效果来。
To homezj(小吉):
非常感谢，我先下去测试一下你的代码，再上来讨论。
To homezj(小吉):
我已经测试了你的代码，非常棒，正是我所需要的效果，非常感谢，此贴再保留几天就结贴。
另外我从网上收藏了一个XP按钮的源代码，不知你们感不感兴趣，如果需要的话，我就贴上来。
嘿嘿，正是我要的东西！就是看不明白，能不能说说原理呀？
To starofvb(VB之星):
www.vbaccelerator.com上有关于SubClass的例子
我测试了，能有很多种效果，而且不用任何控件，太神奇了，我一直想要这种东西！
我也知道这是用SubClass的，但就是不知道对于ToolBar该怎么拦截消息，都处理哪些消息？
我注意了SubClass中只处理了WM_NOTIFY、WM_LBUTTONDOWN、WM_LBUTTONUP三个消息，这就够了？
为什么呀？怎么处理呀，我看了好困惑！
请高手解释一下呀，小吉说根据本类的原理可以自己改模样，我就是想知道原理！
关注@_@
将ToolBar改成一个功能强大的界面控件是非常有用的，因为它不需要第3方控件，毕竟第3方控件用起来实在是不放心。
To Begin2008(重头再来)
贴出来看看，这个类中按钮效果都是传统风格的，很希望有朋友能把它改成XP风格。
To starofvb(VB之星)
ToolBar、ListView、TreeView等控件都有Custom Draw功能，该功能当然是通过消息机制触发，其核心就是通过WM_NOTIFY消息，这个消息的lParam参数，就是指向一个NMHDR结构的地址，通过NMHDR结构，我们可得知产生消息的hwnd等信息，确定控件类型，并进一步决定整个结构的类型是什么，进而获得NMCUSTOMDRAW和NMTBCUSTOMDRAW结构，NMTBCUSTOMDRAW最前面就是NMCUSTOMDRAW，而NMCUSTOMDRAW最前面就是NMHDR，所以一个NMHDR、NMCUSTOMDRAW，NMCUSTOMDRAW实际上都是同一个地址lParam，只是需根据前面信息，最终确定整个结构的长度而已。
WM_LBUTTONDOWN、WM_LBUTTONUP消息本应与本类无关，只是ToolBar中带菜单的样式的按钮，我一时不知如何获取其Drap消息，所以被迫采用了判断鼠标动作的权宜之计，不知哪位能把这个改改。
DrawToolbarButton过程是改变按钮样式的核心内容，在这部分下下功夫，就可以做出自己理想的ToolBar了
编写这个类，还得感谢楼主，我本来对这种东西并不了解，直到看了楼主提供的http://www.codeguru.com/forum/attachment.php?attachmentid=7783
示例，我才弄明白WM_NOTIFY的机制，受益非浅！
SubClass的危险性，只是在调试时有些麻烦，类中哪怕一个变量未定义，都不会提示，而是直接崩溃。不过调试成功后使用，还是比较安全的，楼主对这个东西不要太担心。
Mark
收藏
用API很困难，VB不支持继承，估计要硬用 子类来解决会很麻烦
up
SubClass的危险性，只是在调试时有些麻烦，类中哪怕一个变量未定义，都不会提示，而是直接崩溃。
==================================================================
这主要是因为在VB IDE下VB程序是解析运行的
当处于调试状态下，VB将不再解析执行你的程序
当你设置了子类
若此时接受到一条Windows消息的时候
由于VB不再解析你的代码
所以CPU将执行未知代码
肯定会触发保护性错误
至于编译成exe后出现“因子类化导致程序崩溃”
那完全是程序员水平、态度问题
没有认真测试代码
看来大家都不知道这一点啊：
Ctrl + F5（全编译执行）的作用是：
检查程序语法错误，将程序编译成P代码，再解析P代码执行程序
与编译成exe时选P代码编译的性能一样
其实“Ctrl + F5”最大的作用还是检查语法错误
这样可以避免出现homezj(小吉)那样的情况：类中哪怕一个变量未定义，都不会提示，而是直接崩溃
如果你嫌每次运行时多按Ctrl麻烦的话
可以关掉VB的“请求时编译”
VB菜单栏：工具->选项
切换到“通用”页
注意“编译”组框
去掉“请求时编译”的勾
这样每次按F5都是全编译执行了
是呀！真的忽略了这一点，全编译执行的确是一个预先检测语法错误的好办法。以前，我的习惯只是启动程序前自动保存。
二者结合可少吃很多后悔药！
不过，关掉VB的“请求时编译”，只能适于小程序，大程序编译是很耗时的，每次启动前都编译，我想大多数人会受不了的。
To homezj(小吉):
我从网上收藏的XP按钮的源代码，现在没有找到，因为是前年收藏的，你可以自己在网上找一找。
另外，我已经从大家的回复中收益非浅，不知大家还要不要继续讨论，如果不需要继续讨论，我就结帖了。
我也是初涉Custom Draw消息处理，ToolBar本来我就很少用，所以我的兴趣是处理过程本身，而不是应用需求，很难静心深入研究它。
前几天看过几个代码，感觉，还有其他消息处理方法，但都没离开SubClass。看来，这一点，大家还是有共识的。
好贴！我代表比尔感谢你们