VB 中自定义弹出提示框的位置

窗体代码：

Private Sub Command1_Click() 
Dim hInst As Long 
Dim Thread As Long 

'Set up the CBT hook 
hInst = GetWindowLong(Me.hWnd, GWL_HINSTANCE) 
Thread = GetCurrentThreadId() 
hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProc1, hInst, _ 
Thread) 

'Display the message box 
MsgBox "This message box has been positioned at (0,0)." 
End Sub 

Private Sub Command2_Click() 
Dim hInst As Long 
Dim Thread As Long 

'Set up the CBT hook 
hInst = GetWindowLong(Me.hWnd, GWL_HINSTANCE) 
Thread = GetCurrentThreadId() 
hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProc2, hInst, Thread) 

'Display the message box 
MsgBox "This message box is centered over Form1." 
End Sub

模块代码：

Option Explicit 

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

Public Declare Function UnhookWindowsHookEx Lib "user32" ( _ 
ByVal hHook As Long ) As Long 
Public Declare Function GetWindowLong Lib "user32" Alias _ 
"GetWindowLongA" ( ByVal hwnd As Long , ByVal nIndex As Long ) _ 
As Long 
Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long 
Public Declare Function SetWindowsHookEx Lib "user32" Alias _ 
"SetWindowsHookExA" ( ByVal idHook As Long , ByVal lpfn As Long , _ 
ByVal hmod As Long , ByVal dwThreadId As Long ) As Long 
Public Declare Function SetWindowPos Lib "user32" ( _ 
ByVal hwnd As Long , ByVal hWndInsertAfter As Long , _ 
ByVal x As Long , ByVal y As Long , ByVal cx As Long , _ 
ByVal cy As Long , ByVal wFlags As Long ) As Long 
Public Declare Function GetWindowRect Lib "user32" ( ByVal hwnd _ 
As Long , lpRect As RECT) As Long 

Public Const GWL_HINSTANCE = (- 6 ) 
Public Const SWP_NOSIZE = &H1 
Public Const SWP_NOZORDER = &H4 
Public Const SWP_NOACTIVATE = &H10 
Public Const HCBT_ACTIVATE = 5 
Public Const WH_CBT = 5 

Public hHook As Long 

Function WinProc1( ByVal lMsg As Long , ByVal wParam As Long , _ 
ByVal lParam As Long ) As Long 

If lMsg = HCBT_ACTIVATE Then 
'Show the MsgBox at a fixed location (0,0) 
SetWindowPos wParam, 0 , 0 , 0 , 0 , 0 , _ 
SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE 
'Release the CBT hook 
UnhookWindowsHookEx hHook 
End If 
WinProc1 = False 

End Function 

Function WinProc2( ByVal lMsg As Long , ByVal wParam As Long , _ 
ByVal lParam As Long ) As Long 

Dim rectForm As RECT, rectMsg As RECT 
Dim x As Long , y As Long 

'On HCBT_ACTIVATE, show the MsgBox centered over Form1 
If lMsg = HCBT_ACTIVATE Then 
'Get the coordinates of the form and the message box so that 
'you can determine where the center of the form is located 
GetWindowRect Form1.hwnd, rectForm 
GetWindowRect wParam, rectMsg 
x = (rectForm.Left + (rectForm.Right - rectForm.Left) / 2 ) - _ 
((rectMsg.Right - rectMsg.Left) / 2 ) 
y = (rectForm.Top + (rectForm.Bottom - rectForm.Top) / 2 ) - _ 
((rectMsg.Bottom - rectMsg.Top) / 2 ) 
'Position the msgbox 
SetWindowPos wParam, 0 , x, y, 0 , 0 , _ 
SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE 
'Release the CBT hook 
UnhookWindowsHookEx hHook 
End If 
WinProc2 = False 

End Function

• 点赞
• 收藏
• 分享
• 文章举报