VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
楼主: icecept

HtmlHelp帮助制作及调用精解示例

[复制链接]
 楼主| 发表于 2007-11-7 15:25:27 | 显示全部楼层
原帖由 nbdld 于 2007-11-6 23:17 发表


你要的应该是这种效果?

wm_menuselect


即然你要帮助楼主,为什么不帮助到底,把你的源码发上来。
回复 支持 反对

使用道具 举报

发表于 2007-11-7 15:54:34 | 显示全部楼层
原帖由 nbdld 于 2007-11-6 23:17 发表


你要的应该是这种效果?

wm_menuselect
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-12-27 19:50:44 | 显示全部楼层

回复美女宝宝:在状态栏动态显示菜单提示

在form1中:
Option Explicit
Private Sub Form_Load()
    Dim ret As Long
    hMenu = GetMenu(Me.hwnd)
    Label1.Caption = "此处为label模拟的状态栏"
    '记录原本的Window Procedure的位址
    preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
'    设定Combo1的window Procedure到wndproc
    ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc)
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
     Label1.Caption = "此处为label模拟的状态栏"
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Dim ret As Long
    '取消Message的截取,而使之又只送往原来的Window Procedure
    ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
End Sub

在模块中:
Option Explicit
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long) As Long
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
Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_MENUSELECT = &H11F
Public Const MF_BYCOMMAND = &H0&
Public Const MF_BYPOS99vION = &H400&
Public hMenu As Long
Public preWinProc As Long
Private Type tLong
    ll As Long
End Type
Private Type TwoWord
    LowWord As Integer
    HiWord As Integer
End Type
Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _
                        ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim MenuItemStr As String, SubMenuStr As String
    Dim hSubmenu As Long, MenuId As Long, i As Long
    Dim tmpl As tLong, tmpt As TwoWord
    '以下程式会截取WM_MENUSELECT处理完後,再将之送往原来的Window Procedure
    If Msg = WM_MENUSELECT Then
        SubMenuStr = String(255, 0)
        MenuItemStr = String(255, 0)
        tmpl.ll = wParam
        LSet tmpt = tmpl
        MenuId = tmpt.LowWord
        hSubmenu = GetSubMenu(lParam, MenuId)
        If hSubmenu = 0 Then '表示该item之下没有popupMenu了
            Call GetMenuString(lParam, MenuId, MenuItemStr, 256, MF_BYCOMMAND)
            MenuItemStr = Left(MenuItemStr, InStr(1, MenuItemStr, Chr(0)) - 1)
            Form1.Label1.Caption = MenuItemStr
        Else
            Form1.Label1.Caption = "此处为label模拟的状态栏"
        End If
    End If
    '将之送往原来的Window Procedure
    wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function



附件: 在状态栏动态显示菜单提示.rar
回复 支持 反对

使用道具 举报

发表于 2007-12-28 10:12:15 | 显示全部楼层
这回复间隔的够久的,美女宝宝早就忘了。
哈哈,对我还是有用的。谢啦!
回复 支持 反对

使用道具 举报

发表于 2007-12-28 10:26:10 | 显示全部楼层
不过我下载的帮助HTML WorkShop Help 学习系统.chm 提示无法显示网页;

另外您的工程中用了Label模拟状态栏,为什么不用状态栏控件啊?Label最大化不在窗体最底部,而且不好分栏显示时间等。

用状态栏控件能动态显示菜单信息吗?
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-12-28 10:41:24 | 显示全部楼层
可以的,我是为了方便,所以用label代替了一个外置控件,这只是一个演示,当正式用时,再把label换成状态栏控件就行了
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-12-28 11:10:55 | 显示全部楼层

在状态栏动态显示菜单提示最新修改


在模块中:
Option Explicit
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long) As Long
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
Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_MENUSELECT = &H11F
Public Const MF_BYCOMMAND = &H0&
Public Const MF_BYPOS99vION = &H400&
Public hMenu As Long
Public preWinProc As Long
Private Type tLong
    ll As Long
End Type
Private Type TwoWord
    LowWord As Integer
    HiWord As Integer
End Type
Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _
                        ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim MenuItemStr As String, SubMenuStr As String
    Dim hSubmenu As Long, MenuId As Long, i As Long
    Dim tmpl As tLong, tmpt As TwoWord
    '以下程式会截取WM_MENUSELECT处理完後,再将之送往原来的Window Procedure
    If Msg = WM_MENUSELECT Then
        SubMenuStr = String(255, 0)
        MenuItemStr = String(255, 0)
      
        tmpl.ll = wParam
        LSet tmpt = tmpl
        MenuId = tmpt.LowWord
        hSubmenu = GetSubMenu(lParam, MenuId)
        If hSubmenu = 0 Then '表示该item之下没有popupMenu了
            Call GetMenuString(lParam, MenuId, MenuItemStr, 256, MF_BYCOMMAND)
            MenuItemStr = Left(MenuItemStr, InStr(1, MenuItemStr, Chr(0)) - 1)
            Form1.StatusBar1.Panels(1).Text = MenuItemStr
        Else
            Form1.StatusBar1.Panels(1).Text = "此处为label模拟的状态栏"
        End If
    End If
    '将之送往原来的Window Procedure
    wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function


在form1中:
Option Explicit
Private Sub Form_Load()
    Dim ret As Long
    hMenu = GetMenu(Me.hwnd)
    StatusBar1.Panels(1).Text = "此处为label模拟的状态栏"
    '记录原本的Window Procedure的位址
    preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
'    设定Combo1的window Procedure到wndproc
    ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc)
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
     StatusBar1.Panels(1).Text = "此处为label模拟的状态栏"
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Dim ret As Long
    '取消Message的截取,而使之又只送往原来的Window Procedure
    ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
End Sub

[ 本帖最后由 icecept 于 2007-12-28 11:15 编辑 ]

在状态栏动态显示菜单提示.rar

7.84 KB, 下载次数: 286

回复 支持 反对

使用道具 举报

发表于 2007-12-28 19:57:08 | 显示全部楼层
谢谢楼主的回复和修改,很好用!
我重新下载帮助HTML WorkShop Help 学习系统.chm ,这次没有问题了!

能再问一下:菜单控件如果是vsnetmenu(就是万玉庭的那个)的还有效吗?
呵呵,我是不是有些过分了!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-12-28 20:14:48 | 显示全部楼层

回复 #18 chg0088 的帖子

应该是可以的,都是菜单吗?你试试替换一下

[ 本帖最后由 icecept 于 2009-4-21 01:06 编辑 ]
回复 支持 反对

使用道具 举报

发表于 2007-12-28 20:35:30 | 显示全部楼层
谢谢,我试了一下可以使用的。
不过,初始化后状态栏的显示有问题,不过应该是VSNETMENU的问题。

感谢楼主的热心!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2019-7-23 21:51

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表