自绘顶级菜单将StatusBar的内容屏蔽了,求解

[蜂歌]

实例自绘顶级菜单能做出想要的效果,但屏蔽了StatusBar控件中的文本内容,求能显视StatusBar控件文本内容的方法
运行前:
运行后:
窗体
Option Explicit
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Const SB_SETBKCOLOR = 8193

Private Sub Command1_Click()
Print "点到按钮"
End Sub

Private Sub Form_Load()
Dim hMainMenu As Long, hSubMenu As Long
Dim i As Integer

'全局变量的初始化,菜单项的颜色设置
g_clrFrame = RGB(10, 10, 10)
g_clrBkgSelect = RGB(255, 231, 162)
g_clrBkgNormal = RGB(224, 234, 240)
g_clrTxtSelect = vbRed
g_clrTxtNormal = vbBlack
'g_clrLeft = RGB(200, 238, 238)
g_clrLeft = RGB(236, 233, 216)
g_clrSep = RGB(236, 53, 200)

hMainMenu = GetMenu(Me.hwnd) '得到窗体顶级菜单句柄
hSubMenu = GetSubMenu(hMainMenu, 0) '得到文件菜单的句柄
'保存第一个菜单项的信息
RegisterMenu hSubMenu, 0, "新建", 120, 20, pic(1)
RegisterMenu hSubMenu, 1, "打开", 120, 20, pic(2)
'保存打开的下级菜单项的信息
RegisterMenu GetSubMenu(hSubMenu, 1), 0, "打开音乐文件", 120, 20, pic(2)
RegisterMenu GetSubMenu(hSubMenu, 1), 1, "打开视频文件", 120, 20, pic(2)
RegisterMenu hSubMenu, 2, "", 120, 5
RegisterMenu hSubMenu, 3, "退出", 120, 20, pic(3)

'保存第二个菜单项的信息
hSubMenu = GetSubMenu(hMainMenu, 1)
RegisterMenu hSubMenu, 0, "复制", 120, 20, pic(4)
RegisterMenu hSubMenu, 1, "剪切", 120, 20, pic(5)
RegisterMenu hSubMenu, 2, "粘贴", 120, 20, pic(6)

Call SubClassWindow(Me)
End Sub

Private Sub mnuNew_Click()
Print "点到新建"
End Sub

问题模块
Option Explicit
Private Const GWL_WNDPROC = (-4)
Private Const WM_MEASUREITEM = &H2C
Private Const WM_DRAWITEM = &H2B
Private Const ODT_MENU = 1
Private Const ODT = 0

Private Const WM_DESTROY = &H2

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Type DRAWITEMSTRUCT
CtlType As Long '控件类型
CtlID As Long '控件id
itemID As Long '菜单项、列表框或组合框中某一项的索引值
itemAction As Long '控件行为
itemState As Long '控件状态
hwndItem As Long '父窗口句柄或菜单句柄
hdc As Long '控件对应的绘图设备句柄
rcItem As RECT '控件所占据的矩形区域
ItemData As Long '列表框或组合框中某一项的值
End Type

Private Type MEASUREITEMSTRUCT
CtlType As Long
CtlID As Long
itemID As Long
itemWidth As Long
itemHeight As Long
ItemData As Long
End Type

Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData 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 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
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Sub SubClassWindow(frm As Form)
If GetProp(frm.hwnd, "OrigProcAddr") = 0 Then
'SetProp frm.hwnd, "OrigProcAddr", SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
SetProp frm.hwnd, "OrigProcAddr", SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End If
End Sub

Private Function NewWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim origProc As Long
Dim isSubclassed As Long
Dim DrawInfo As DRAWITEMSTRUCT
Dim MeasureInfo As MEASUREITEMSTRUCT
Dim i As Integer

origProc = GetProp(hwnd, "OrigProcAddr")

If origProc <> 0 Then

If uMsg = WM_MEASUREITEM Then '在控件或菜单被创建的时候,向自绘按钮,组合框,列表框,列表视图(list view)
'或菜单项的所有者发送WM_MEASUREITEM消息

CopyMemory MeasureInfo, ByVal lParam, Len(MeasureInfo)
If MeasureInfo.CtlType <> ODT_MENU Then Exit Function
For i = 0 To g_CntOfTopMenu - 1
If MyTopMenu(i).MenuID = MeasureInfo.itemID Then
MeasureInfo.itemWidth = MyTopMenu(i).Width
MeasureInfo.itemHeight = MyTopMenu(i).Height
Exit For
End If
Next i
CopyMemory ByVal lParam, MeasureInfo, Len(MeasureInfo)

ElseIf uMsg = WM_DRAWITEM Then '当具有自绘风格的按钮、组合框、列表框或者菜单的可见部分发生改变时，
'就会发送WM_DRAWITEM消息给自绘控件所在的窗体

CopyMemory DrawInfo, ByVal lParam, Len(DrawInfo)
If DrawInfo.CtlType <> ODT_MENU Then Exit Function
For i = 0 To g_CntOfTopMenu - 1
If MyTopMenu(i).MenuID = DrawInfo.itemID Then
MyTopMenu(i).InitStruct DrawInfo.hdc, DrawInfo.itemAction, DrawInfo.itemID, DrawInfo.itemState, DrawInfo.rcItem.Left, DrawInfo.rcItem.Top, DrawInfo.rcItem.Bottom, DrawInfo.rcItem.Right
MyTopMenu(i).DrawMenu
Exit For
End If
Next i

ElseIf uMsg = WM_DESTROY Then
SetWindowLong hwnd, GWL_WNDPROC, origProc
NewWindowProc = CallWindowProc(origProc, hwnd, uMsg, wParam, lParam)
RemoveProp hwnd, "OrigProcAddr"
ReleaseObj_TopMenu
Else
NewWindowProc = CallWindowProc(origProc, hwnd, uMsg, wParam, lParam)
End If
Else
'如果有意外发生的话
NewWindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
End If

End Function

[蜂歌]

资源 http://pan.baidu.com/s/1skOtHLF

[舉杯邀明月]

你这个工程稍微有点复杂，虽然代码贴出来了，别人“构建”也还是有点费事。 建议你把整个工程打包发出来，才便于别人帮你调试。 可以通过网盘分享，或者上传到资源。 不过目前CSDN没有“免费资源”了，建议最好用网盘分享。 操作方法，参考这个帖子中，9楼的回复： http://bbs.csdn.net/topics/392193811

[赵4老师]

关键的地方添加必要的DoEvents语句。我建议。

[蜂歌]

问题解决,谢谢

[舉杯邀明月]

引用 3 楼 huangjingfeng88 的回复:

资源 http://pan.baidu.com/s/1skOtHLF

把它的子类化消息处理函数：Private Function NewWindowProc( )　修正一下就行了。 注意修改这一段代码：

' 与本贴问题不相关的代码就不贴出来了
'    . . . . . . . . . . . . .
ElseIf uMsg = WM_DRAWITEM Then      '当具有自绘风格的按钮、组合框、列表框或者菜单的可见部分发生改变时，
                                    '就会发送WM_DRAWITEM消息给自绘控件所在的窗体

   CopyMemory DrawInfo, ByVal lParam, Len(DrawInfo)
   'If DrawInfo.CtlType <> ODT_MENU Then Exit Function
   ' ↑　关键是在这儿 ！！！
   If DrawInfo.CtlType = ODT_MENU Then
      For i = 0 To g_CntOfTopMenu - 1
         If MyTopMenu(i).MenuID = DrawInfo.itemID Then
            MyTopMenu(i).InitStruct DrawInfo.hdc, DrawInfo.itemAction, …………    ' 本行其它内容略
            MyTopMenu(i).DrawMenu
            Exit For
         End If
      Next
   Else
      NewWindowProc = CallWindowProc(origProc, hWnd, uMsg, wParam, lParam)
   End If
ElseIf uMsg = WM_DESTROY Then
'　　. . . . . . . . . . . . .