终于搞定了，分享--》API打造浮动按钮

Question

Option Base 1
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public 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 Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Public Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As Long
'--------------------------------------------------------------------------------------------GDI相关函数
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public 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, ByVal dwRop As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
'--------------------------------------------------------------------------------------------
Public Const TME_LEAVE = &H2&
Public Const ODS_SELECTED = &H1
Public Const ODT_BUTTON = 4
Public Const WM_DRAWITEM = &H2B
Public Const WM_MEASUREITEM = &H2C
Public Const IMAGE_BITMAP = 0
Public Const LR_LOADFROMFILE = &H10
Public Const BS_OWNERDRAW = &HB&
Public Const GWL_WNDPROC = (-4)
Public Const WM_MOUSEMOVE = &H200
Public Const WM_MOUSELEAVE = &H2A3
Public Const WM_LBUTTONUP = &H202
Public Const WS_CHILD = &H40000000
Public Const WS_VISIBLE = &H10000000
Public Const SRCCOPY = &HCC0020  ' (DWORD) dest = source
'-------------------------以下是自定义按钮状态常数
Public Const Leave = 1 '离开按钮范围
Public Const Click = 2 ' 按下按钮
Public Const Undo = 3 '松开按钮
Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Public Type DRAWITEMSTRUCT '自绘控件的绘图结构，另外由于它在WIN32里面是唯一的结构，所以在VB里面要用到CopyMemory这个API函数直接指向它的地址
        CtlType As Long
        CtlID As Long
        ItemID As Long
        itemAction As Long
        itemState As Long
        hwndItem As Long
        hdc As Long
        rcItem As RECT
        itemData As Long
End Type
Public Type MEASUREITEMSTRUCT '自绘时候设置控件的大小'同上
        CtlType As Long
        CtlID As Long
        ItemID As Long
        itemWidth As Long
        itemHeight As Long
        itemData As Long
End Type
Public Type TRACKMOUSEEVENTTYPE
    cbSize As Long
    dwFlags As Long
    hwndTrack As Long
    dwHoverTime As Long
End Type
Public ImageHandle(3) As Long
Public OldMainProc As Long
Public OldButtonProc As Long
Public CmdHwnd As Long
Public MouseLeave As Boolean
Public Sub Initialize() '初始化
LoadPic
MouseLeave = True
MainProc
CreateOwnerDrawButton
ButtonProc
End Sub
Public Sub MainProc() '窗口自类化（NewMainProc)
OldMainProc = SetWindowLong(Form1.hwnd, GWL_WNDPROC, AddressOf NewMainProc)
End Sub
Public Sub ButtonProc() '按钮自类化(NewButtonProc)
OldButtonProc = SetWindowLong(CmdHwnd, GWL_WNDPROC, AddressOf NewButtonProc)
End Sub
Public Sub CreateOwnerDrawButton() '创造一个自绘按钮
CmdHwnd = CreateWindowEx(0, "Button", "", WS_CHILD Or BS_OWNERDRAW Or WS_VISIBLE, 50, 60, 70, 25, Form1.hwnd, 0, App.hInstance, 0)
Dim dc As Long
dc = GetDC(CmdHwnd)
drawPic LeaveEnd Sub
Public Function NewMainProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long '处理主窗口消息
  Select Case Msg
    Case WM_DRAWITEM
      OnDrawItem lParam
      Exit Function
    Case WM_MEASUREITEM
      OnMeasureItem lParam
  End Select
    NewMainProc = CallWindowProc(OldMainProc, hwnd, Msg, wParam, lParam)
End Function
Public Function NewButtonProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long '处理按钮消息
Select Case Msg
  Case WM_MOUSELEAVE
   Button_MouseLeave
   MouseLeave = True
  Case WM_MOUSEMOVE
    Button_MouseMove
  Case WM_LBUTTONUP
    Button_MouseLButtonUp
  End Select
    NewButtonProc = CallWindowProc(OldButtonProc, hwnd, Msg, wParam, lParam)
End Function
Public Sub Button_MouseMove() '鼠标移动事件
drawPic Undo
  If MouseLeave = True Then
    MouseLeave = False
    Dim MouseTrack As TRACKMOUSEEVENTTYPE
     With MouseTrack
      .cbSize = Len(MouseTrack)
      .dwFlags = TME_LEAVE
      .hwndTrack = CmdHwnd
     End With
       TrackMouseEvent MouseTrack
  End If
End Sub
Public Sub Button_MouseLButtonUp() '左键按下事件
Debug.Print "已按下左键"
End Sub
Public Sub Button_MouseLeave() '离开事件
drawPic Leave
Debug.Print "已离开按钮的范围"
End Sub
Public Sub OnMeasureItem(lParam As Long)  '设置的大小
Dim lpMIS As MEASUREITEMSTRUCT
  CopyMemory lpMIS, ByVal lParam, Len(lpMIS)
  lpMIS.itemHeight = 25
  lpMIS.itemWidth = 70
 CopyMemory ByVal lParam, lpMIS, Len(lpMIS)
End Sub
Public Sub OnDrawItem(lParam As Long)  '为按钮绘制样貌
Dim lpDIS As DRAWITEMSTRUCT
CopyMemory lpDIS, ByVal lParam, Len(lpDIS)
Dim mem As Long
Dim Object As Long
  mem = CreateCompatibleDC(hdc)
    If lpDIS.CtlType = ODT_BUTTON Then
         If lpDIS.itemState And ODS_SELECTED Then '按下时外貌
           drawPic Click
         Else '松开时外貌
           If MouseLeave = True Then
             drawPic Leave
           Else
             drawPic Undo
           End If
         End If
    End If
CopyMemory ByVal lParam, lpDIS, Len(lpDIS)
End Sub
Public Sub LoadPic() '读取图片
   ImageHandle(1) = LoadImage(App.hInstance, App.Path & "\" & "1.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
   ImageHandle(2) = LoadImage(App.hInstance, App.Path & "\" & "2.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
   ImageHandle(3) = LoadImage(App.hInstance, App.Path & "\" & "3.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
End Sub
Public Sub drawPic(State As Long) '为按钮绘制不同状态的图案
Dim hdc As Long
Dim mem As Long
Dim Object As Long
  hdc = GetDC(CmdHwnd)
  mem = CreateCompatibleDC(hdc)
  Object = SelectObject(mem, ImageHandle(State))
  BitBlt hdc, 0, 0, 70, 25, mem, 0, 0, SRCCOPY
  DeleteObject Object
  DeleteDC mem
End Sub

Answer 1

to: laviewpbt(人一定要靠自己) ,没有下载的连接啊，请把以上的代码放在新的模块里面就行的了，已经调试过，多谢支持

Answer 2

呵呵，那我详细地说明一下了，首先把新建一个工程并为该工程添加一个模块，然后再找三幅分别代表三种状态的按钮的图片放在该工程的当前目录下并把它们改名为1.BMP，2.BMP，3.BMP，跟着就是把上面的代码COPY到模块里面，最后就是FORM1代码里面：Private Sub Form_Load()
Initialize
End Sub

Answer 3

mem = CreateCompatibleDC(hdc)
HDC的变量没有定义

Answer 4

哦，不好意思啊，因为在我那里是没有要求一定要显式声明变量的所以没有报错，各位可以把ONDRAWITEM这个函数里面的
Dim mem As Long
Dim Object As Long
mem = CreateCompatibleDC(hdc)
这三句都删掉，那样就应该运行成功的了，实在不好意思，我实在太大意了

Answer 5

顺带问一句，jpg图片不支持吗？我选了jpg的图片没有反应

Answer 6

第一次开源就这么多打击，楼主辛苦了，楼上的JPG应该好用吧。
   ImageHandle(1) = LoadImage(App.hInstance, App.Path & "\" & "1.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
把1.BMP换成1.JPG看看。

Answer 7

唉。原来就是全部用api的方法，生成自定义外观的按纽的程序嘛我回去测试了。还是没有解决问题啊！！    结果跟用普通image啊、或picturebox控件做的按纽一样。可以这样测试， 鼠标按下左键、弹起，反复做，速度稍微慢些。这时很正常。
但是一旦加快速度。以极快的速度点饥按纽，就会出问题。
在极快的点饥速度下，你会看到，按纽外观图片的更换速度远远跟不上点饥速度！！！
而windows的标准控件是没有这样的问题的！！各位可以去试试。这个问题就是创建自己外观的按纽遇到的最大郁闷问题啊 ~~~~~~~~~~~~！！！有人解决这个问题了么？

Answer 8

http://community.csdn.net/Expert/topic/3704/3704400.xml?temp=.1405756这个是偶的图形界面代码，大家多多捧场！小弟新来的，第一次发代码，呵呵

Answer 9

to  JustStruggle:没有用的。速度还是跟不上。不信你自己试试吧。