查看: 16  |  回复: 0
  VB6 子类化按钮,懒得写例子,直接给.bas
楼主
发表于 2024年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


您需要登录后才可以回帖 登录 | 立即注册
【本版规则】请勿发表违反国家法律的内容,否则会被冻结账号和删贴。
用户名: 立即注册
密码:
2020-2024 MaNongKu.com