用Visial Basic 在菜单栏实现超链接

原创 2001年11月23日 10:15:00

 

 


如何在菜单栏上实现超链接

                      和尚  2001/11/13

  笔者突发奇想,在菜单栏上写点版权信息多好!可是vb内置事件检测不到菜单栏消息。只好求助于win32API。窗口工作区以外的MouseMove消息表示为WM_NCMOUSEMOVE,所以设置窗口过程截取并处理这条消息,同样可以处理鼠标点击消息了,同样您也可以把超链接放在标题栏上,。啊,反正鄙人表达能力有限,代码都在这里,相信你一看就明白了。拿去用好了,不过如果你想转载的话还需要注名 "来自和尚在线" 。也欢迎大家访问我的主页:http://handsomge.yeah.net 那里都是鄙人的作品。

以下内容放在窗体
                  

Private Sub Form_Activate()
title
End Sub

Private Sub Form_Load()
Dim ret As Long
'记录原本的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_Paint()
title
End Sub

Private Sub Form_Resize()
title
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
Sub title()
 Dim fr1 As RECT
 GetWindowRect Me.hwnd, fr1
 d1 = GetWindowDC(Me.hwnd)
 SetBkMode d1, 0
 SetTextColor d1, RGB(235, 235, 235)
 fon = CreateFont(14, 8, 0, 0, 100, 0, 0, 0, 0, 0, 0, 0, 0, "隶书")
 SelectObject d1, fon
 v = "和尚在线极力推荐 "
 TextOut d1, fr1.Right - 130 - Me.Left / Screen.TwipsPerPixelX, fr1.Top -     Me.Top  / Screen.TwipsPerPixelY + 25, v, Len(v)

 SetTextColor d1, RGB(70, 70, 70)
 TextOut d1, fr1.Right - 129 - Me.Left / Screen.TwipsPerPixelX, fr1.Top -    Me.Top  / Screen.TwipsPerPixelY + 26, v, Len(v)
End Sub
以下内容放在 标准模块中

Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Public 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
Public Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Public Const WM_NCLBUTTONUP = &HA2
Public Const WM_NCMOUSEMOVE = &HA0
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 preWinProc As Long
Private Type tLong
ll As Long
End Type
Private Type TwoWord
LowWord As Integer
HiWord As Integer
End Type
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
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 ad As tLong, tmpt2 As TwoWord
'截取WM_ncmousemove处理完後,再将之送往原来的Window Procedure
If Msg = WM_NCMOUSEMOVE Then
ad.ll = lParam
LSet tmpt2 = ad
If (tmpt2.LowWord > (frMain.Left + frMain.Width) / Screen.TwipsPerPixelX - 130) And (tmpt2.HiWord > frMain.Top / Screen.TwipsPerPixelY + 25 And tmpt2.HiWord <= frMain.Top / Screen.TwipsPerPixelY + 36) Then
Screen.MouseIcon = frMain.MouseIcon
Screen.MousePointer = 99
Else
Screen.MousePointer = 0
End If
End If
'如果在超链接上空点击鼠标左键,就打开URL
If Msg = WM_NCLBUTTONUP And Screen.MousePointer = 99 Then ShellExecute frMain.hwnd, "open", "http://handsomge.yeah.net/", "", "", vbNormalFocus
'将之送往原来的Window Procedure
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function

  详细内容参看作者主页

在菜单栏上实现超链接

在菜单栏上实现超链接上以下内容放在窗体                   Private Sub Form_Activate()titleEnd SubPrivate Sub Form_Load()...
  • shawls
  • shawls
  • 2002年03月27日 14:04
  • 810

自己动手写basic解释器(七)

 自己动手写basic解释器刺猬@http://blog.csdn.net/littlehedgehog 注: 文章basic解释源码摘自梁肇新先生的《编程高手箴言》(据他所说这个代码也是网上摘录的)...
  • littlehedgehog
  • littlehedgehog
  • 2008年09月15日 13:16
  • 5127

用Js和css创建HTML导航菜单栏

 1. js+css实现的简单的下来菜单 css菜单演示
  • u010018069
  • u010018069
  • 2015年05月04日 21:04
  • 1676

一个优秀的超链接鼠标悬停提示CSS+JS

一个优秀的超链接鼠标悬停提示CSS+JS【字体:小 大】 作者:网络摘选 文章来源:互联网 点击数:125 更新时间:2006-5-22 8:54:31        超链接,一般的做法是给一个tit...
  • SmartJavaer
  • SmartJavaer
  • 2006年12月16日 16:54
  • 1179

js中实现获取当前超链接

var ss = String(window.document.location.href);
  • yinbucheng
  • yinbucheng
  • 2016年04月10日 11:13
  • 246

IOS学习:在一个UIViewController中实现侧边菜单的思路及demo

实现思路:在ViewController的view里面放一个UIScrollView,将UIScrollView的contentSize的宽度设置成屏幕宽度加上侧边菜单的宽度,点击显示菜单的按钮时滑动...
  • wu_shu_jun
  • wu_shu_jun
  • 2013年08月14日 09:18
  • 6085

超链接实现post方式提交

原文地址:http://www.cnblogs.com/qusongsong/p/5759605.html 思路:如果想要超链接实现post方式提交,必须借助表单。下面得两种方式,一种是借助显示的f...
  • yalishadaa
  • yalishadaa
  • 2017年05月06日 10:39
  • 824

自己动手写basic解释器(一)

自己动手写basic解释器刺猬@http://blog.csdn.net/littlehedgehog注: 文章basic解释源码摘自梁肇新先生的《编程高手箴言》(据他所说这个代码也是网上摘录的),源...
  • littlehedgehog
  • littlehedgehog
  • 2008年09月14日 16:14
  • 9227

HTML 超链接

一、超链接标签     在HTML中,超链接用标签和来实现,而定义源端点、目标端点、锚记等相关内容则由标签的属性完成。标签有如下几个常用属性: 1.href属性 用来定义指向链接目标端点的URL...
  • feihu19851111
  • feihu19851111
  • 2012年05月27日 21:30
  • 3879

超链接可以有javascript判断之后再决定是否跳转

今天我发现一种写法,可以实现RT功能。如下:一个输入框这样就可以了
  • dxmgood
  • dxmgood
  • 2010年08月05日 00:08
  • 2963
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:用Visial Basic 在菜单栏实现超链接
举报原因:
原因补充:

(最多只允许输入30个字)