在菜单栏上实现超链接

原创 2002年03月27日 14:04:00

在菜单栏上实现超链接上


以下内容放在窗体
                  
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


 


       以上代码来自: 源代码数据库(SourceDataBase)
           当前版本: 1.0.531
               作者: Shawls
           个人主页: Http://Shawls.Yeah.Net
             E-Mail: ShawFile@163.Net
                 QQ: 9181729


 


在菜单栏上实现超链接下


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://Shawls.Yeah.Net/", "", "", vbNormalFocus
'将之送往原来的Window Procedure
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function



       以上代码来自: 源代码数据库(SourceDataBase)
           当前版本: 1.0.531
               作者: Shawls
           个人主页: Http://Shawls.Yeah.Net
             E-Mail: ShawFile@163.Net
                 QQ: 9181729

在菜单栏上实现超链接

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

在 Mockplus 设置页面链接,实现页面交互

在Mockplus中,可以轻松设置页面链接,方法有二:   一、直接拖拽 1 点击某个组件,此时组件上方出现小工具栏。 2 拖拽(点击后不放手)小工具栏上的那...
  • jongde1
  • jongde1
  • 2015年06月04日 11:46
  • 2430

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

  如何在菜单栏上实现超链接                      和尚  2001/11/13  笔者突发奇想,在菜单栏上写点版权信息多好!可是vb内置事件检测不到菜单栏消息。只好求助于win3...
  • handsomge
  • handsomge
  • 2001年11月23日 10:15
  • 4265

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

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

HTML下拉列表中加链接

第一种: ************************** Html页面代码                 ====友情链接====                 ====xxxx...
  • Hooge_BJ
  • Hooge_BJ
  • 2012年11月28日 10:23
  • 1705

微信图文消息中如何增加超链接

1,在群发的纯文本消息中嵌入《活动报名》页面超链接的方法: (1)比如群发纯文本消息如下:      。。。欢迎大家踊跃报名参加我们的活动,请点击“活动报名”,9月2日截止。。。 (2)将文本消...
  • mmpire
  • mmpire
  • 2014年08月23日 21:58
  • 18174

ASP.NET中利用DataGrid控件显示图片以及在图片和文字上加超链接

数据表:                        界面代码:
  • luyou3415
  • luyou3415
  • 2011年10月20日 20:43
  • 2937

HTML 超链接

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

DIV+CSS实操六:经管系网页添加导航栏下拉菜单

其实很久之前就想实现这个功能,一直没有去付诸行动,大早上的就开始看老师讲过的一些简单的JS下拉菜单的 知识,可能是我们基础差,老师讲的也是非常基础的一些,但是我们还是没有听懂,仔细研究了一番,反反复...
  • erlian1992
  • erlian1992
  • 2015年12月10日 10:43
  • 4052

嵌入页面的几种方法

一.应用框架技术 ---- 要在宿主页面中嵌入外部页面的方法是,在宿主页面中包含外部页面的位置插入“”语句即可(注意: 标签中的各种属性含义请查阅相关技术手册)。 ---- 如果想在嵌入的外...
  • qin_zhangyongheng
  • qin_zhangyongheng
  • 2014年08月03日 18:17
  • 49594
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:在菜单栏上实现超链接
举报原因:
原因补充:

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