How to implement hyperlinks on the menu bar 2001/11/13
The author suddenly wants to write some of the copyright information on the menu bar! However, the VB built-in event detects the menu bar message. Hello to Win32API. The MouseMove message other than the window workspace is represented as WM_NCMOUSEMOVE, so set the window process to intercept and process this message, and can handle the mouse click message, and you can also put the hyperlink on the title bar. Ah, anyway, the character is limited, the code is here, I believe you will understand. It takes it to take it, but if you want to reprint, you will need to pay attention to "from the monk online". Also welcome everyone to visit my homepage: http://handsomge.yeah.net is a work of monks.
Below on the form Private Sub Form_Activate () titleEnd SubPrivate Sub Form_Load () Dim ret As Long 'Window Procedure of recording the original address preWinProc = GetWindowLong (Me.hwnd, GWL_WNDPROC)' Combo1 set to the window Procedure wndprocret = SetWindowLong (Me.hwnd, GWL_WNDPROC, AddressOf wndproc) End SubPrivate Sub Form_Paint () titleEnd SubPrivate Sub Form_Resize () titleEnd SubPrivate Sub Form_Unload (cancel As Integer) Dim ret As Long 'cancel Message taken, and it is only sent to the original the Window Procedureret = SetWindowLong (Me.hwnd, GWL_WNDPROC, preWinProc) End SubSub 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, "Lishu") SelectObject D1, FON V = "Monk Online Highly recommended" 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.let / screen.twipsperpixelx, fr1.top - me.top / screen.twipsp Erpixely 26, V, LEN (V) End Sub The following content Public Declare Function getWindowdc lib "user32" (Byval HWnd As long) (Byval H AS "(Byval H AS" LONG, BYVAL E As Long, Byval Op As Long, Byval Op As Long, Byval Op As Long, Byval OP As Long Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As LongPublic Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As LongPublic Declare Function SetTextColor Lib "gdi32"
(ByVal hdc As Long, ByVal crColor As Long) As LongPublic Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As LongPublic Const WM_NCLBUTTONUP = & HA2Public Const WM_NCMOUSEMOVE = & HA0Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA "_ (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongDeclare Function GetWindowLong Lib" user32 "Alias" GetWindowLongA "_ (ByVal hwnd As Long, ByVal nIndex As Long) As LongDeclare 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 LongDeclare 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 LongDeclare Function GetMenu Lib "user32" (ByVal hwnd As Long) As LongDeclare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos AsLong) As LongPublic Const GWL_WNDPROC = (-4) Public Const WM_MENUSELECT = & H11FPublic preWinProc As LongPrivate Type tLongll As LongEnd TypePrivate Type TwoWordLowWord As IntegerHiWord As IntegerEnd TypePublic Type RECTLeft As LongTop As LongRight As LongBottom As LongEnd TypePublic Declare Function GetWindowRect Lib "user32" ( ByVal hwnd As Long, lpRect As RECT) As LongPublic 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 LongPublic Declare function selectObject lib "gdi32"
(ByVal hdc As Long, ByVal hObject As Long) As LongPublic 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 LongPublic Function wndproc (ByVal hwnd As Long, ByVal Msg As Long, _ByVal wParam As Long, ByVal lParam As Long) As LongDim MenuItemStr As String, SubMenuStr As StringDim hSubmenu As Long, menuId As Long, i As LongDim ad As tLong, tmpt2 As TwoWord 'taken WM_ncmousemove processed, and then sent to the original Window ProcedureIf Msg = WM_NCMOUSEMOVE Thenad.ll = lParamLSet tmpt2 = adIf (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) ThenScreen.MouseIcon = frMain.MouseIconScreen.MousePointer = 99ElseScreen. MousePointer = 0nd ifndiffiff If ' EPOINTER = 99 THELLEXECUTE FRMAIN.HWND, "Open", "http://handsomge.yeah.net/", "," "", VBNORMALFOCUS 'will be sent to the original Window ProCedureWndProc = CallWindowProc (PrewinProc, HWnd, MSG , WPARAM, LPARAM) End Function Details See
