VB6 子类化按钮，懒得写例子，直接给.bas2024年11月19日 17:48
新建模块 mod子类化按钮.bas，代码：
'BitBlt,StretchBlt绘图的API
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, Optional ByVal dwRop As Long = vbSrcCopy) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, Optional ByVal dwRop As Long = vbSrcCopy) As Long
'给指定的窗口消息处理过程传递消息需要的API
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
'创建内存位图的API
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long
'释放DC,对象的API
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'获取对象的API
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
'装载对象到设备的API
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
'设置一个新的窗口消息处理过程的地址需要的API
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'捕捉鼠标事件的API
Private Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As Long
'获取窗口客户区坐标的API
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
'获取窗口标题的API
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
'绘制文本的API
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
'指定阴影刷子、虚线画笔以及字符中的空隙的填充方式
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
'设置指定矩形的内容
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
'向指定窗口发送消息
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'获取指定窗口的DC(有DC才能画东东,O(∩_∩)O)
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
'画焦点焦点矩形的API
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
'创建圆角矩形区域的API
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
'设置窗口区域的API
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
'在设备场景描点的API
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
'MoveToEx,LineTo组合用来画线
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Any) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
'创建设备场景画笔的API
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
'创建字体的API
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal i As Long, ByVal u As Long, ByVal s As Long, ByVal c As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
'HFONT CreateFont(
' int nHeight, 字体的高度
' int nWidth, 字体的宽度
' int nEscapement, 字体显示的角度
' int nOrientation, 字体的角度
' int nWeight, 字体的磅数
' BYTE bItalic, 斜体字体
' BYTE bUnderline, 带下划线的字体
' BYTE cStrikeOut, 带删除线的字体
' BYTE nCharSet, 所需的字符集
' BYTE nOutPrecision, 输出的精度
' BYTE nClipPrecision, 裁减的精度
' BYTE nQuality, 逻辑字体与输出设备的实际
' 字体之间的精度
' BYTE nPitchAndFamily, 字体间距和字体集
' LPCTSTR lpszFacename 字体名称
' );
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'WM_DRAWITEM需要处理的结构体
Private Type DRAWITEMSTRUCT
CtlType As Long '控件类型
CtlID As Long
itemID As Long
itemAction As Long
itemState As Long
hwndItem As Long '控件句柄
hdc As Long '控件Hdc
rcItem As RECT
itemData As Long
End Type
'TrackMouseEvent需要的结构体
Public Type TRACKMOUSEEVENTTYPE
cbSize As Long
dwFlags As Long
hwndTrack As Long
dwHoverTime As Long
End Type
'Owner draw 常量
Private Const ODT_BUTTON = 4
Private Const ODT_COMBOBOX = 3
Private Const ODT_HEADER = 100
Private Const ODT_LISTBOX = 2
Private Const ODT_LISTVIEW = 102
'Owner draw 状态
Private Const ODS_DISABLED = &H4 'Enabled = False 状态
Private Const ODS_FOCUS = &H10 '获得焦点状态
Private Const ODS_DOWN = &H11 '自定义状态：按下状态
Private Const ODS_UP = &H12 '自定义状态：弹起状态
Private Const ODS_HOVER = &H13 '自定义状态：鼠标在按钮上的状态
Private Const GWL_WNDPROC = (-4)
Private Const TME_HOVER = &H1& 'TrackMouseEvent(捕获鼠标盘旋)用到的消息
Private Const TME_LEAVE = &H2& 'TrackMouseEvent(捕获鼠标离开)用到的消息
Private Const WM_MOUSEMOVE = &H200 '鼠标移动消息
Private Const WM_MOUSELEAVE = &H2A3& '鼠标离开消息(由TrackMouseEvent捕获发出)
Private Const WM_MOUSEHOVER = &H2A1 '鼠标离开消息(由TrackMouseEvent捕获发出)
Private Const WM_DRAWITEM = &H2B '画控件时触发的消息
Private Const WM_LBUTTONUP = &H202 '鼠标(左键)弹起消息
Private Const BM_GETSTATE = &HF2 '(ButtonMessage)该消息用来获取按钮状态
Private Const BST_FOCUS = &H8 '由BM_GETSTATE获得,表示按钮处于焦点状态
'DrawText用到的常数
Private Const DT_LEFT = &H0 '正文左对齐
Private Const DT_TOP = &H0 '正文顶端对齐
Private Const DT_RIGHT = &H2 '正文右对齐
Private Const DT_BOTTOM = &H8 '正文低端对齐
Private Const DT_CENTER = &H1 '正文水平居中对齐
Private Const DT_SINGLELINE = &H20 '正文显示在同一行，遇到回车和换行符不换行
Private Const DT_VCENTER = &H4 '正文垂直居中对齐
Private Const TRANSPARENT = 1 'SetBkMode用的参数
Private Const FW_THIN = 100 '细字体
Private Const ANSI_CHARSET = 0 'ANSI字符集
Private Const FF_MODERN = 48 '笔划宽度固定的字体，有或者无衬线。如Pica、Elite和Courier New
Private bTracking As Boolean '是否捕获鼠标事件
Private PrevWndProc As Long '窗口消息地址
Private PrevSubProc As Long '按钮消息地址
Private ItemIDstr As String '用来保存xx信息
Private ImgBtn_dc As Long '按钮图片DC
Private btn_state As Long '当前按钮状态
Private btn_font As Long '按钮字体
Private btn_hover As Boolean '鼠标是否在按钮上
Public Function 子类化按钮(hwnd As Long)
'子类化开始
PrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWndProc)
'画图,装载进内存DC
DrawImage ImgBtn_dc
StretchBlt Form1.hdc, 10, 10, 20, 126, ImgBtn_dc, 0, 0, 20, 126 '预览图片
'创建字体
btn_font = CreateFont(12, 6, 0, 0, FW_THIN, False, False, False, ANSI_CHARSET, O, 0, 0, FF_MODERN, "宋体")
End Function
Private Function NewWndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim dItem As DRAWITEMSTRUCT
'处理自绘消息
If Msg = WM_DRAWITEM Then
'装载参数到结构体dItem(DRAWITEMSTRUCT)
CopyMemory dItem, ByVal lParam, Len(dItem)
'下面这段用来防止重复子类化按钮,这里采用了这种笨方法,也可以用SetProp,GetProp等方法
If dItem.CtlType = ODT_BUTTON And InStr(ItemIDstr, dItem.hwndItem) = 0 Then
'子类化按钮,目的用来捕捉鼠标在按钮上的Hover和Leave事件
PrevSubProc = SetWindowLong(dItem.hwndItem, GWL_WNDPROC, AddressOf SubWndProc)
'记录子类化过的按钮的信息
ItemIDstr = ItemIDstr & Chr(32) & dItem.hwndItem
End If
'判断是否是Button
If dItem.CtlType = ODT_BUTTON Then
'绘制按钮
DrawButton dItem.hwndItem, dItem.hdc, dItem.itemState
End If
'避免让系统绘制默认Button
NewWndProc = 1
Exit Function
End If
'调用默认的窗口处理过程
NewWndProc = CallWindowProc(PrevWndProc, hwnd, Msg, wParam, lParam)
End Function
Private Function SubWndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim btn_dc As Long
'获得按钮DC
btn_dc = GetDC(hwnd)
If Msg = WM_MOUSEMOVE Then
If bTracking = False Then
bTracking = True
Dim ET As TRACKMOUSEEVENTTYPE
ET.cbSize = Len(ET)
ET.hwndTrack = hwnd
ET.dwFlags = TME_LEAVE
TrackMouseEvent ET
'绘制鼠标在按钮上的状态
DrawButton hwnd, btn_dc, ODS_HOVER
End If
End If
'处理捕捉到的WM_MOUSELEAVE
If Msg = WM_MOUSELEAVE Then
bTracking = False
'绘制鼠标离开时的状态还要考虑按钮是否有焦点
btn_state = SendMessage(hwnd, BM_GETSTATE, 0, 0&)
If btn_state <> BST_FOCUS Then
DrawButton hwnd, btn_dc, 123456789
Else
DrawButton hwnd, btn_dc, ODS_UP
End If
End If
If Msg = WM_LBUTTONUP Then
btn_hover = True
End If
'调用默认的窗口处理过程
SubWndProc = CallWindowProc(PrevSubProc, hwnd, Msg, wParam, lParam)
'这句很重要,如果你不想你的程序内存膨胀的话....
DeleteDC btn_dc
End Function
Private Function DrawButton(ByVal hwnd As Long, ByVal hdc As Long, ByVal iState As Long) As Long
Dim btn_dc As Long
Dim btn_bmp As Long
Dim btn_Rect As RECT
Dim dcc As Long
Dim W As Long
Dim H As Long
Dim btn_cap As String
Dim nState As Integer
'获取按钮坐标
GetClientRect hwnd, btn_Rect
W = btn_Rect.Right '按钮长度
H = btn_Rect.Bottom '按钮宽度
'创建圆角
SetWindowRgn hwnd, CreateRoundRectRgn(0, 0, W + 1, H + 1, 3, 3), True
dcc = CreateDC("DISPLAY", vbNullString, vbNullString, 0&)
btn_dc = CreateCompatibleDC(0)
btn_bmp = CreateCompatibleBitmap(dcc, W, H)
SelectObject btn_dc, btn_bmp
'判断需要绘制的状态
Select Case iState
Case ODS_DISABLED: nState = 3
Case ODS_FOCUS: nState = IIf(btn_hover, 1, 4)
Case ODS_DOWN: nState = 2
Case ODS_UP: nState = 4
Case ODS_HOVER: nState = 1
End Select
'绘制按钮
StretchBlt btn_dc, 0, 0, 3, 3, ImgBtn_dc, 0, 0 + 21 * nState, 3, 3
StretchBlt btn_dc, 3, 0, W - 6, 3, ImgBtn_dc, 9, 0 + 21 * nState, 1, 3
StretchBlt btn_dc, W - 3, 0, 3, 3, ImgBtn_dc, 17, 0 + 21 * nState, 3, 3
StretchBlt btn_dc, 0, 3, 3, H - 6, ImgBtn_dc, 0, 9 + 21 * nState, 3, 1
StretchBlt btn_dc, 0, H - 3, 3, 3, ImgBtn_dc, 0, 18 + 21 * nState, 3, 3
StretchBlt btn_dc, 3, H - 3, W - 3, 3, ImgBtn_dc, 3, 18 + 21 * nState, 1, 3
StretchBlt btn_dc, W - 3, H - 3, 3, 3, ImgBtn_dc, 17, 18 + 21 * nState, 3, 3
StretchBlt btn_dc, W - 3, 3, 3, H - 6, ImgBtn_dc, 17, 3 + 21 * nState, 3, 1
StretchBlt btn_dc, 2, 2, W - 4, H - 4, ImgBtn_dc, 3, 3 + 21 * nState, 14, 15
'绘制焦点矩形
SetRect btn_Rect, 2.3, 2.3, W - 2.3, H - 2.3
Select Case nState
Case 1
btn_state = SendMessage(hwnd, BM_GETSTATE, 0, 0&)
If btn_state = BST_FOCUS Or btn_state = 104 Then DrawFocusRect btn_dc, btn_Rect 'What's 104
Case 2, 4
DrawFocusRect btn_dc, btn_Rect
End Select
'绘制文本
SetBkMode btn_dc, TRANSPARENT '画文字时背景为透明状
btn_cap = String(255, 0)
btn_cap = Left(btn_cap, GetWindowText(hwnd, btn_cap, 255))
SetRect btn_Rect, 0, 0, W, H
SelectObject btn_dc, btn_font
DrawText btn_dc, btn_cap, Len(btn_cap), btn_Rect, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER
'复制到设备场景
BitBlt hdc, 0, 0, W, H, btn_dc, 0, 0
'释放内存
DeleteDC btn_dc
DeleteDC dcc
DeleteObject btn_bmp
End Function
Private Function mColor(Mode As Long, ByVal Index As Integer) As Long
Dim c(126) As Long, c2(1 To 19, 5)
c(0) = &H707070: c(1) = &HFCFCFC: c(2) = &HF2F2F2: c(3) = &HF2F2F2: c(4) = &HF1F1F1
c(5) = &HF0F0F0: c(6) = &HEFEFEF: c(7) = &HEDEDED: c(8) = &HECECEC: c(9) = &HEBEBEB
c(10) = &HDDDDDD: c(11) = &HDBDBDB: c(12) = &HDADADA: c(13) = &HD8D8D8: c(14) = &HD6D6D6
c(15) = &HD4D4D4: c(16) = &HD2D2D2: c(17) = &HD1D1D1: c(18) = &HCFCFCF: c(19) = &HF3F3F3
c(20) = &H707070: c(21) = &HB17F3C: c(22) = &HFEFDFA: c(23) = &HFDF6EA: c(24) = &HFDF6E8
c(25) = &HFDF5E6: c(26) = &HFCF4E4: c(27) = &HFCF3E1: c(28) = &HFCF2DE: c(29) = &HFCF1DC
c(30) = &HFCF0D9: c(31) = &HFDE6BE: c(32) = &HFCE5BC: c(33) = &HFBE3B9: c(34) = &HFAE2B5
c(35) = &HF9E0B2: c(36) = &HF8DEAF: c(37) = &HF7DCAC: c(38) = &HF6DBA9: c(39) = &HF5D9A7
c(40) = &HFCF5E8: c(41) = &HB17F3C: c(42) = &H8B622C: c(43) = &HBAB09E: c(44) = &HFCF4E5
c(45) = &HFCF4E5: c(46) = &HFBF2E1: c(47) = &HFAF0DD: c(48) = &HFAEED8: c(49) = &HF9ECD3
c(50) = &HF8E9CE: c(51) = &HF7E7C9: c(52) = &HF6E5C4: c(53) = &HEFD198: c(54) = &HEDCE93
c(55) = &HEBCA8C: c(56) = &HE8C686: c(57) = &HE5C27F: c(58) = &HE2BD78: c(59) = &HDFB972
c(60) = &HDDB66D: c(61) = &HDBB368: c(62) = &H8B622C: c(63) = &HB5B2AD: c(64) = &HFCFCFC
c(65) = &HF4F4F4: c(66) = &HF4F4F4: c(67) = &HF4F4F4: c(68) = &HF4F4F4: c(69) = &HF4F4F4
c(70) = &HF4F4F4: c(71) = &HF4F4F4: c(72) = &HF4F4F4: c(73) = &HF4F4F4: c(74) = &HF4F4F4
c(75) = &HF4F4F4: c(76) = &HF4F4F4: c(77) = &HF4F4F4: c(78) = &HF4F4F4: c(79) = &HF4F4F4
c(80) = &HF4F4F4: c(81) = &HF4F4F4: c(82) = &HFCFCFC: c(83) = &HB5B2AD: c(84) = &HB17F3C
c(85) = &HFBD848: c(86) = &HF2F2F2: c(87) = &HF2F2F2: c(88) = &HF1F1F1: c(89) = &HF0F0F0
c(90) = &HEFEFEF: c(91) = &HEDEDED: c(92) = &HECECEC: c(93) = &HEBEBEB: c(94) = &HDDDDDD
c(95) = &HDBDBDB: c(96) = &HDADADA: c(97) = &HD8D8D8: c(98) = &HD6D6D6: c(99) = &HD4D4D4
c(100) = &HD2D2D2: c(101) = &HD1D1D1: c(102) = &HCFCFCF: c(103) = &HF0CD3D: c(104) = &HB17F3C
c(105) = &HB17F3C: c(106) = &HFFD42D: c(107) = &HFEE68C: c(108) = &HFDF6EA: c(109) = &HFDF6E9
c(110) = &HFDF6E9: c(111) = &HFDF6E8: c(112) = &HFDF5E6: c(113) = &HFDF5E5: c(114) = &HFDF4E4
c(115) = &HFCEAC9: c(116) = &HFBE8C7: c(117) = &HFBE7C4: c(118) = &HFAE5C0: c(119) = &HF9E4BD
c(120) = &HF8E2BA: c(121) = &HF8E1B7: c(122) = &HF7DFB4: c(123) = &HFAD76A: c(124) = &HFDCF22
c(125) = &HB17F3C: c(126) = &HFFFFFFFF
c2(1, 0) = &HF6F6F6: c2(1, 1) = &HF7FCFE: c2(1, 2) = &HC7BCAA
c2(1, 3) = &HFCFCFC: c2(1, 4) = &HFBD748: c2(1, 5) = &HFED126
c2(2, 0) = &H707070: c2(2, 1) = &HB17F3C: c2(2, 2) = &H8B622C
c2(2, 3) = &HB5B2AD: c2(2, 4) = &HB17F3C: c2(2, 5) = &HB17F3C
c2(3, 0) = &H939393: c2(3, 1) = &HB89669: c2(3, 2) = &H725A3A
c2(3, 3) = &HC4C1BD: c2(3, 4) = &HDCC6A8: c2(3, 5) = &HDCC6A8
c2(4, 0) = &H777777: c2(4, 1) = &HB38342: c2(4, 2) = &H86602E
c2(4, 3) = &HB7B4AF: c2(4, 4) = &HBC9158: c2(4, 5) = &HBC9158
c2(5, 0) = &H8A8A89: c2(5, 1) = &HB18C5A: c2(5, 2) = &H725734
c2(5, 3) = &HBDBAB6: c2(5, 4) = &HDBC4A6: c2(5, 5) = &HDBC4A6
c2(6, 0) = &H919191: c2(6, 1) = &HC39D69: c2(6, 2) = &H8A683A
c2(6, 3) = &HC6C3C0: c2(6, 4) = &HC2943F: c2(6, 5) = &HC3912E
c2(7, 0) = &HE8E8E8: c2(7, 1) = &HF3EBDF: c2(7, 2) = &HAB9D86
c2(7, 3) = &HF2F2F1: c2(7, 4) = &HF1CB46: c2(7, 5) = &HF4C623
c2(8, 0) = &H757575: c2(8, 1) = &HB2803E: c2(8, 2) = &H865F2C
c2(8, 3) = &HB6B3AE: c2(8, 4) = &HBB9055: c2(8, 5) = &HBB9055
c2(9, 0) = &HEAEAEA: c2(9, 1) = &HF4EDE1: c2(9, 2) = &HAB9D86
c2(9, 3) = &HF3F2F2: c2(9, 4) = &HF1CC46: c2(9, 5) = &HF5C724
c2(10, 0) = &HFAFAFA: c2(10, 1) = &HFEFBF7: c2(10, 2) = &HD5CBBA
c2(10, 3) = &HFBFBFB: c2(10, 4) = &HF9DD6A: c2(10, 5) = &HFEE06B
c2(11, 0) = &H888888: c2(11, 1) = &HB18C59: c2(11, 2) = &H95774D
c2(11, 3) = &HBDBAB5: c2(11, 4) = &HDAC3A3: c2(11, 5) = &HDAC3A3
c2(12, 0) = &H757575: c2(12, 1) = &HB2803E: c2(12, 2) = &H8C642E
c2(12, 3) = &HB6B3AE: c2(12, 4) = &HBA8E53: c2(12, 5) = &HBA8E53
c2(13, 0) = &H8A8A8A: c2(13, 1) = &HB28D5C: c2(13, 2) = &H8E7049
c2(13, 3) = &HBEBBB6: c2(13, 4) = &HDBC4A6: c2(13, 5) = &HDBC4A6
c2(14, 0) = &H8F8F8F: c2(14, 1) = &HC39B64: c2(14, 2) = &H8A642F
c2(14, 3) = &HC6C3C0: c2(14, 4) = &HC0913C: c2(14, 5) = &HC3912E
c2(15, 0) = &HE4E4E4: c2(15, 1) = &HF3E7D4: c2(15, 2) = &HD3AC63
c2(15, 3) = &HF4F3F3: c2(15, 4) = &HE9C43D: c2(15, 5) = &HF5C51D
c2(16, 0) = &H757575: c2(16, 1) = &HB2813E: c2(16, 2) = &H88612D
c2(16, 3) = &HB6B3AE: c2(16, 4) = &HBB9055: c2(16, 5) = &HBB9055
c2(17, 0) = &HE2E2E2: c2(17, 1) = &HF2E6D3: c2(17, 2) = &HB59255
c2(17, 3) = &HF3F2F2: c2(17, 4) = &HE9C33E: c2(17, 5) = &HF4C41D
c2(18, 0) = &HECECEC: c2(18, 1) = &HFBF0DC: c2(18, 2) = &HDCB56D
c2(18, 3) = &HFBFBFB: c2(18, 4) = &HEACD5B: c2(18, 5) = &HFBD451
Select Case Mode
Case 0
mColor = c(Index)
Case Else
mColor = c2(Mode, Index)
End Select
End Function
'画 线
Private Function DrawLine(ByVal hdc As Long, x1 As Long, y1 As Long, x2 As Long, y2 As Long, color As Long)
Dim pen As Long
pen = CreatePen(0, 1, color)
SelectObject hdc, pen
MoveToEx hdc, x1, y1, 0&
LineTo hdc, x2, y2
DeleteObject pen
End Function
'Download by http://wdown.liehuo.net
'绘制按钮图片
Private Function DrawImage(hdc As Long)
Dim dcc As Long
Dim bmp As Long
Dim i As Long
dcc = CreateDC("DISPLAY", vbNullString, vbNullString, 0&)
hdc = CreateCompatibleDC(0)
bmp = CreateCompatibleBitmap(dcc, 20, 126)
SelectObject hdc, bmp
For i = 0 To 126
DrawLine hdc, 1, i, 19, i, mColor(0, i)
Next
For i = 0 To 5
SetPixelV hdc, 0, i * 21, &HFFFFFF
SetPixelV hdc, 19, i * 21, &HFFFFFF
SetPixelV hdc, 0, 20 + i * 20 + i, &HFFFFFF
SetPixelV hdc, 19, 20 + i * 20 + i, &HFFFFFF
DrawLine hdc, 1, i * 21 + 3, 1, i * 21 + 18, mColor(1, i)
DrawLine hdc, 18, i * 21 + 3, 18, i * 21 + 18, mColor(1, i)
DrawLine hdc, 0, i * 21 + 3, 0, i * 21 + 18, mColor(2, i)
DrawLine hdc, 19, i * 21 + 3, 19, i * 21 + 18, mColor(2, i)
SetPixelV hdc, 1, i * 21, mColor(3, i)
SetPixelV hdc, 18, i * 21, mColor(3, i)
SetPixelV hdc, 2, i * 21, mColor(4, i)
SetPixelV hdc, 17, i * 21, mColor(4, i)
SetPixelV hdc, 0, i * 21 + 1, mColor(5, i)
SetPixelV hdc, 19, i * 21 + 1, mColor(5, i)
SetPixelV hdc, 1, i * 21 + 1, mColor(6, i)
SetPixelV hdc, 18, i * 21 + 1, mColor(6, i)
SetPixelV hdc, 2, i * 21 + 1, mColor(7, i)
SetPixelV hdc, 17, i * 21 + 1, mColor(7, i)
SetPixelV hdc, 0, i * 21 + 2, mColor(8, i)
SetPixelV hdc, 19, i * 21 + 2, mColor(8, i)
SetPixelV hdc, 1, i * 21 + 2, mColor(9, i)
SetPixelV hdc, 18, i * 21 + 2, mColor(9, i)
SetPixelV hdc, 2, i * 21 + 2, mColor(10, i)
SetPixelV hdc, 17, i * 21 + 2, mColor(10, i)
SetPixelV hdc, 1, 20 + i * 20 + i, mColor(11, i)
SetPixelV hdc, 18, 20 + i * 20 + i, mColor(11, i)
SetPixelV hdc, 2, 20 + i * 20 + i, mColor(12, i)
SetPixelV hdc, 17, 20 + i * 20 + i, mColor(12, i)
SetPixelV hdc, 0, 20 + i * 20 + i - 1, mColor(13, i)
SetPixelV hdc, 19, 20 + i * 20 + i - 1, mColor(13, i)
SetPixelV hdc, 1, 20 + i * 20 + i - 1, mColor(14, i)
SetPixelV hdc, 18, 20 + i * 20 + i - 1, mColor(14, i)
SetPixelV hdc, 2, 20 + i * 20 + i - 1, mColor(15, i)
SetPixelV hdc, 17, 20 + i * 20 + i - 1, mColor(15, i)
SetPixelV hdc, 0, 20 + i * 20 + i - 2, mColor(16, i)
SetPixelV hdc, 19, 20 + i * 20 + i - 2, mColor(16, i)
SetPixelV hdc, 1, 20 + i * 20 + i - 2, mColor(17, i)
SetPixelV hdc, 18, 20 + i * 20 + i - 2, mColor(17, i)
SetPixelV hdc, 2, 20 + i * 20 + i - 2, mColor(18, i)
SetPixelV hdc, 17, 20 + i * 20 + i - 2, mColor(18, i)
Next
DeleteDC dcc
DeleteObject bmp
End Function
全部回复（0）