近日见到广大的爱好者对菜单或各个控件的样式和效果产生很多的问题，于是就把自己所写的菜单类加上大量的注释，希望帮助大家能明白到其实各种多姿多彩的控件究竟是怎样生成的，其实最主要的就是把控件标志为自绘就行了然后就到自己绘制这个控件，而可以定为“自绘”的控件有LISTBOX，TEXT，LABEL，LISTVIEW，TAB，MENU等等，而且自要学会了自绘菜单的话要完成像OUTLOOK那样的界面就马上变得一点难度都没有了（其实也还是有一点点的）好了废话小说现在就开始自绘的旅程吧    __________________欢迎交流，QQ：234693669 群:9891420,18小时OnLine 返回页首   UpU@Com版主 VB技巧 版主注册时间: 2003-12-20来自: China 在线状态: 离线发贴数: 457 发表于: 2004-07-27 at 22:53 | IP已记录 标准模块里：Option ExplicitPublic Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic 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 LongPublic Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPublic Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As LongPublic 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 LongPublic 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 LongPublic Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPublic Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As LongPublic Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As LongPublic 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 LongPublic Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As LongPublic Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As LongPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPublic Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As LongPublic Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As LongPublic Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As LongPublic Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As LongPublic Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPublic Type LOGBRUSH '画册信息的结构        lbStyle As Long        lbColor As Long        lbHatch As LongEnd TypePublic Type RECT        Left As Long        Top As Long        Right As Long        Bottom As LongEnd TypePublic Type POINTAPI        x As Long        y As LongEnd TypePublic Type DRAWITEMSTRUCT '自绘菜单的绘图（控件）结构，另外由于它在VC里面是指向这个结构的菜单，所以在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 LongEnd TypePublic Type MEASUREITEMSTRUCT '自绘菜单时候获取菜单的大小（自定义）        CtlType As Long        CtlID As Long        ItemID As Long        itemWidth As Long        itemHeight As Long        itemData As LongEnd TypePublic Const GWL_STYLE = (-16)Public Const DT_CENTER = &H1 '文字显示的方式Public Const DT_RIGHT = &H2 '同上Public Const DT_SINGLELINE = &H20 '同上Public Const DT_VCENTER = &H4 '同上Public Const DT_LEFT = &H0 '同上Public Const GWL_WNDPROC = (-4)Public Const WM_DRAWITEM = &H2BPublic Const WM_MEASUREITEM = &H2CPublic Const WM_MOUSEMOVE = &H200Public Const LR_LOADFROMFILE = &H10Public Const IMAGE_BITMAP = 0Public Const IMAGE_ICON = 1Public Const SRCCOPY = &HCC0020  ' (DWORD) dest = sourcePublic MyPoint As POINTAPIPublic Menu As New CMenu '把自绘菜单类对象化Public List As New CListPublic OldWinProc As LongPublic a As StringPublic Sub CallWinProc() '把窗口消息交给自己处理（NewWinProc)OldWinProc = SetWindowLong(Form1.hwnd, GWL_WNDPROC, AddressOf NewWinProc)End SubPublic Function NewWinProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long '自定义窗口过程（处理消息）  Select Case Msg    Case WM_DRAWITEM      Menu.OnDrawItem lParam      List.OnDrawItem lParam      Exit Function    Case WM_MEASUREITEM      Menu.OnMeasureItem lParam      Exit Function  End SelectNewWinProc = CallWindowProc(OldWinProc, hwnd, Msg, wParam, lParam)End Function__________________欢迎交流，QQ：234693669 群:9891420,18小时OnLine 返回页首   UpU@Com版主 VB技巧 版主注册时间: 2003-12-20来自: China 在线状态: 离线发贴数: 457 发表于: 2004-07-27 at 22:54 | IP已记录 然后新建一个菜单类（CMenu）： Option ExplicitOption Base 1Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As LongPrivate Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As LongPrivate Declare Function CreatePopupMenu Lib "user32" () As LongPrivate Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As LongPrivate Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As LongPrivate Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As LongPrivate Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As LongPrivate Declare Function InsertMenuItem Lib "user32" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO) As LongPrivate Type TMenuItem '自定义结构        ItemID As Long '菜单ID        ItemText As String '菜单名称        SubMenu As Long '菜单的类型        AttachMenu As Long '所依附的自菜单ID        DrawSubMenuItem As Boolean '重新绘制子菜单项        ItemCount As Integer '菜单条目总数End TypePrivate Type MENUITEMINFO '菜单结构    cbSize As Long    fMask As Long    fType As Long    fState As Long    wID As Long    hSubMenu As Long    hbmpChecked As Long    hbmpUnchecked As Long    dwItemData As Long    dwTypeData As String    cch As LongEnd TypePrivate Const HS_CROSS = 4                   '  +++++Private Const BS_HATCHED = 2Private Const DI_MASK = &H1Private Const DI_IMAGE = &H2Private Const DI_NORMAL = &H3Private Const DI_DEFAULTSIZE = &H8Private Const TRANSPARENT = 1Private Const MIIM_STATE = &H1Private Const MIIM_ID = &H2Private Const MIIM_SUBMENU = &H4Private Const MIIM_CHECKMARKS = &H8Private Const MIIM_TYPE = &H10Private Const MIIM_DATA = &H20Private Const MIIM_STRING = &H40Private Const MIIM_BITMAP = &H80Private Const MIIM_FTYPE = &H100Private Const BDR_SUNKENOUTER = &H2Private Const BDR_RAISEDINNER = &H4Private Const BF_LEFT = &H1Private Const BF_TOP = &H2Private Const BF_RIGHT = &H4Private Const BF_BOTTOM = &H8Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)Private Const ODT_MENU = 1Private Const TPM_RIGHTBUTTON = &H2&Private Const MF_BYCOMMAND = &H0&Private Const MF_STRING = &H0&Private Const MF_OWNERDRAW = &H100& '标志为自绘类型Private Const MFT_OWNERDRAW = &H100& '同上Private Const ODS_CHECKED = &H8 '菜单状态Private Const ODS_FOCUS = &H10 '同上Private Const ODS_SELECTED = &H1 '同上Private Const IsSubMenu = 1 '自定义常数：为菜单项标志为子菜单Private Const IsSubMenuItem = 2 '自定义常数：所依附的子菜单的IDPrivate LB As LOGBRUSHPrivate MyRect As RECTPrivate hMenu As LongPrivate MenuItemCount As LongPrivate MenuItem(8) As TMenuItemPrivate IconhInst(8) As LongPrivate MenuItemEx As MENUITEMINFOPrivate Text(8) As StringPrivate hBrush As LongPublic Sub CMenu_Initialize() '初始化Dim I As Integer'设置菜单项的名称MenuItem(1).ItemCount = 8MenuItem(1).ItemText = "显示桌面"MenuItem(2).ItemText = "运行游戏"MenuItem(3).ItemText = "浏览教程"MenuItem(4).ItemText = "任意程序"MenuItem(5).ItemText = "打开"MenuItem(6).ItemText = "聆听音乐"MenuItem(7).ItemText = "弹出CD"MenuItem(8).ItemText = "调教闹钟"'为子菜单和子菜单项添上标记MenuItem(3).SubMenu = IsSubMenuMenuItem(4).SubMenu = IsSubMenuMenuItem(5).SubMenu = IsSubMenuItemMenuItem(5).AttachMenu = 4MenuItem(5).DrawSubMenuItem = TrueMenuItem(6).SubMenu = IsSubMenuItemMenuItem(6).AttachMenu = 3MenuItem(6).DrawSubMenuItem = True'为所有菜单项加上ID  For I = 1 To MenuItem(1).ItemCount    MenuItem(I).ItemID = I  NextIconhInst(1) = LoadImage(App.hInstance, App.Path & "\" & "1.ico", IMAGE_ICON, 0, 0, LR_LOADFROMFILE)IconhInst(2) = LoadImage(App.hInstance, App.Path & "\" & "2.ico", IMAGE_ICON, 0, 0, LR_LOADFROMFILE)IconhInst(3) = LoadImage(App.hInstance, App.Path & "\" & "3.ico", IMAGE_ICON, 0, 0, LR_LOADFROMFILE)IconhInst(4) = LoadImage(App.hInstance, App.Path & "\" & "4.ico", IMAGE_ICON, 0, 0, LR_LOADFROMFILE)IconhInst(5) = LoadImage(App.hInstance, App.Path & "\" & "8.ico", IMAGE_ICON, 0, 0, LR_LOADFROMFILE)IconhInst(6) = LoadImage(App.hInstance, App.Path & "\" & "5.ico", IMAGE_ICON, 0, 0, LR_LOADFROMFILE)IconhInst(7) = LoadImage(App.hInstance, App.Path & "\" & "6.ico", IMAGE_ICON, 0, 0, LR_LOADFROMFILE)IconhInst(8) = LoadImage(App.hInstance, App.Path & "\" & "7.ico", IMAGE_ICON, 0, 0, LR_LOADFROMFILE)End SubPublic Sub CreatePopMenu() '创造空的自绘弹出式菜单hMenu = CreatePopupMenu()End SubPublic Sub OnAppendPopMenu() '为菜单添加条目Dim I As LongDim C As LongDim Skip As Long  For I = 1 To 8    Select Case MenuItem(I).SubMenu    Case IsSubMenu      SetMenu hMenu, MenuItem(I).ItemText, MenuItem(I).ItemID    Case IsSubMenuItem    Case 0        AppendMenu hMenu, MF_STRING Or MF_BYCOMMAND Or MF_OWNERDRAW, I, MenuItem(I).ItemText    End Select  NextEnd SubPublic Sub SetMenu(hMenu As Long, Text As String, MenuIndex As Long) '设置为二级或更高的菜单Dim MenuItemEx As MENUITEMINFODim hMenu2 As LonghMenu2 = CreatePopupMenu() '创造新的空的自绘弹出式菜单  With MenuItemEx    .cbSize = Len(MenuItemEx)    .cch = Len(Text) * 2    .dwItemData = False    .dwTypeData = Text    .fMask = MIIM_STRING Or MIIM_FTYPE Or MIIM_STATE Or MIIM_SUBMENU Or MIIM_ID Or MIIM_DATA    .fType = MFT_OWNERDRAW    .wID = MenuIndex    .hSubMenu = hMenu2    End With    InsertMenuItem hMenu, MenuIndex, False, MenuItemEx      Dim I As Integer        For I = 1 To MenuItem(1).ItemCount          If MenuItem(I).AttachMenu = MenuIndex Then            AppendMenu hMenu2, MF_STRING Or MF_BYCOMMAND Or MF_OWNERDRAW, MenuItem(I).ItemID, MenuItem(I).ItemText          End If        NextEnd SubPublic Sub TrackMenu(x As Long, y As Long) '弹出菜单TrackPopupMenu hMenu, TPM_RIGHTBUTTON, x, y, 0, Form1.hwnd, MyRectEnd SubPublic Sub OnMeasureItem(lParam As Long)  '设置菜单的大小On Error GoTo MyExitSubDim lpMIS As MEASUREITEMSTRUCTDim I As Long  CopyMemory lpMIS, ByVal lParam, Len(lpMIS)    If MenuItem(lpMIS.ItemID).DrawSubMenuItem = True Then      lpMIS.itemHeight = 20      lpMIS.itemWidth = 80    Else      lpMIS.itemHeight = 26      lpMIS.itemWidth = 118    End If CopyMemory ByVal lParam, lpMIS, Len(lpMIS)   Exit SubMyExitSub:  Exit Sub:End SubPublic Sub OnDrawItem(lParam As Long)  '为菜单绘制样貌Dim lpDIS As DRAWITEMSTRUCTCopyMemory lpDIS, ByVal lParam, Len(lpDIS)  Dim DC As Long  Dim Mem As Long  Dim Obj As Long  Dim BitmaphInst As Long  Dim Color As Long  Dim MenuRect As RECT  Dim MenuRect2 As RECT  Dim TextLen As Long  Dim hBrush As Long   If lpDIS.CtlType = ODT_MENU Then     If MenuItem(lpDIS.ItemID).DrawSubMenuItem = False Then       MenuRect = lpDIS.rcItem       MenuRect.Left = 20       Color = RGB(255, 149, 149)       LB.lbColor = Color       hBrush = CreateBrushIndirect(LB)       FillRect lpDIS.hdc, MenuRect, hBrush       Mem = CreateCompatibleDC(lpDIS.hdc)       BitmaphInst = LoadImage(App.hInstance, App.Path & "\" & "1.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE) '读取菜单左边图案       Obj = SelectObject(Mem, BitmaphInst)       MenuRect = lpDIS.rcItem       SetBkMode lpDIS.hdc, TRANSPARENT '让背景色为透明色       BitBlt lpDIS.hdc, 0, 0, 20, MenuRect.Left + MenuRect.Bottom, Mem, 0, 0, SRCCOPY       MenuRect.Top = lpDIS.rcItem.Top + 6       DrawText lpDIS.hdc, MenuItem(lpDIS.ItemID).ItemText, Len(MenuItem(lpDIS.ItemID).ItemText) * 2, MenuRect, DT_CENTER Or DT_SINGLELINE       DrawIconEx lpDIS.hdc, 20, lpDIS.rcItem.Top, IconhInst(lpDIS.ItemID), 20, 20, 0, 0, DI_NORMAL         If lpDIS.itemState And ODS_SELECTED Then '当菜单项被选中时重绘菜单项           MenuRect2 = lpDIS.rcItem           MenuRect2.Left = 20           MenuRect2.Bottom = MenuRect2.Bottom           DrawEdge lpDIS.hdc, MenuRect2, BDR_SUNKENOUTER, BF_RECT '选中时有凹进去的效果           MenuRect2.Top = lpDIS.rcItem.Top + 6           MenuRect2.Left = lpDIS.rcItem.Left           DrawText lpDIS.hdc, MenuItem(lpDIS.ItemID).ItemText, Len(MenuItem(lpDIS.ItemID).ItemText) * 2, MenuRect2, DT_CENTER Or DT_SINGLELINE Or DT_RIGHT         End If       Else           DrawText lpDIS.hdc, MenuItem(lpDIS.ItemID).ItemText, Len(MenuItem(lpDIS.ItemID).ItemText) * 2, lpDIS.rcItem, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER           DrawIconEx lpDIS.hdc, 0, lpDIS.rcItem.Top, IconhInst(lpDIS.ItemID), 20, 20, 0, 0, DI_NORMAL     End If   End IfDeleteObject BitmaphInstEnd Sub__________________欢迎交流，QQ：234693669 群:9891420,18小时OnLine 返回页首   UpU@Com版主 VB技巧 版主注册时间: 2003-12-20来自: China 在线状态: 离线发贴数: 457 发表于: 2004-07-27 at 22:55 | IP已记录 最后就是在窗口代码里面的： Option ExplicitPrivate Sub Form_Load()CallWinProcMenu.CMenu_InitializeMenu.CreatePopMenuMenu.OnAppendPopMenuList.OnCreate Me.hwndEnd Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)If Button = 2 Then  GetCursorPos MyPoint  Menu.TrackMenu MyPoint.x, MyPoint.yEnd IfEnd Sub  __________________欢迎交流，QQ：234693669 群:9891420,18小时OnLine 返回页首   UpU@Com版主 VB技巧 版主注册时间: 2003-12-20来自: China 在线状态: 离线发贴数: 457 发表于: 2004-07-27 at 22:59 | IP已记录 以上的代码可以直接COPY到阁下的程序里面直接运行的，还有的就是因为这个菜单里面是用到八个图标和一幅位图的，请大家自己找一些图标放在程序的当前目录里面而且改为跟上面相应的名称就行的了，好了有什么不明白再Q我吧

评论