写过VB的人都知道Msgbox函数弹出系统提示对话框,这个对话框既然是Windows给我们使用的那么我们就可以通过别的方式改变它。 下面我就会调用MessageBox的Api来改变VB的对话框函数,创造出我们自己风格的Msgbox! 该例程是将Msgbox弹出,并且总是位于窗口的中央;而且修改了Msgbox中的“确定”按钮上的文字。程序中简单的使用了Windows的钩子。
1·加入一个模块:
Option Explicit ''''--------------------API声明部分-------------------- Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5
Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type
''''使用API的MessageBox替代VB系统的MsgBox Private Declare Function MessageBox Lib "user32" _ Alias "MessageBoxA" _ (ByVal hWnd As Long, _ ByVal lpText As String, _ ByVal lpCaption As String, _ ByVal wType As Long) As Long Private 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 Private Declare Function UnhookWindowsHookEx Lib "user32" _ (ByVal hHook As Long) As Long
Private Declare Function MoveWindow Lib "user32" _ (ByVal hWnd As Long, _ ByVal X As Long, _ ByVal Y As Long, _ ByVal nWidth As Long, _ ByVal nHeight As Long, _ ByVal bRepaint As Long) As Long Private Declare Function GetWindowRect Lib "user32" _ (ByVal hWnd As Long, _ lpRect As RECT) As Long Public Declare Function GetDlgItem Lib "user32" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
Private Declare Function GetDlgItemText Lib "user32" Alias "GetDlgItemTextA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Private hHook As Long Private Const IDOK = 1 Private Const IDCANCEL = 2 Private Const IDABORT = 3 Private Const IDRETRY = 4 Private Const IDIGNORE = 5 Private Const IDYES = 6 Private Const IDNO = 7 Private Const IDPROMPT = &HFFFF&
''''----------------------窗体句柄----------------------'''' Private hFormhWnd As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''替代VB中的Msgbox函数 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Function Msgbox(hWnd As Long, sPrompt As String, _ Optional dwStyle As Long, _ Optional sTitle As String) As Long Dim hInstance As Long Dim hThreadId As Long hInstance = App.hInstance hThreadId = App.ThreadID If dwStyle = 0 Then dwStyle = vbOKOnly If Len(sTitle) = 0 Then sTitle = App.EXEName ''''将当前窗口的句柄付给变量 hFormhWnd = hWnd ''''设置钩子 hHook = SetWindowsHookEx(WH_CBT, _ AddressOf CBTProc, _ hInstance, hThreadId) ''''调用MessageBox API Msgbox = MessageBox(hWnd, sPrompt, sTitle, dwStyle)
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''HOOK处理 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Function CBTProc(ByVal nCode As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long ''''变量声明 Dim rc As RECT Dim rcFrm As RECT Dim newLeft As Long Dim newTop As Long Dim dlgWidth As Long Dim dlgHeight As Long Dim scrWidth As Long Dim scrHeight As Long Dim frmLeft As Long Dim frmTop As Long Dim frmWidth As Long Dim frmHeight As Long Dim hwndMsgBox As Long '''' Dim lngHwnd As Long ''''当MessageBox出现时,将Msgbox对话框居中与所在的窗口 If nCode = HCBT_ACTIVATE Then ''''消息为HCBT_ACTIVATE时,参数wParam包含的是MessageBox的句柄 hwndMsgBox = wParam ''''得到MessageBox对话框的Rect Call GetWindowRect(hwndMsgBox, rc) Call GetWindowRect(hFormhWnd, rcFrm) ''''使MessageBox居中 frmLeft = rcFrm.Left frmTop = rcFrm.Top frmWidth = rcFrm.Right - rcFrm.Left frmHeight = rcFrm.Bottom - rcFrm.Top
dlgWidth = rc.Right - rc.Left dlgHeight = rc.Bottom - rc.Top scrWidth = Screen.Width \ Screen.TwipsPerPixelX scrHeight = Screen.Height \ Screen.TwipsPerPixelY newLeft = frmLeft + ((frmWidth - dlgWidth) \ 2) newTop = frmTop + ((frmHeight - dlgHeight) \ 2) ''''修改确定按钮的文字 Call SetDlgItemText(hwndMsgBox, IDOK, "这是确定按钮") ''''Msgbox居中 Call MoveWindow(hwndMsgBox, newLeft, newTop, dlgWidth, dlgHeight, True) ''''卸载钩子 UnhookWindowsHookEx hHook End If CBTProc = False
End Function
2·窗体中的代码: Form1中的-----
Option Explicit Private Sub Command1_Click() ''''变量声明 Dim strTitle As String Dim strPrompt As String Dim lngStyle As Long ''''MessageBox的标题 strTitle = "我的应用" ''''MessageBox的内容 strPrompt = "这是 hook MessageBox 的演示" & vbCrLf & vbCrLf & _ "MessageBox的对话框将会居中在Form中" ''''MessageBox样式 lngStyle = vbAbortRetryIgnore Or vbInformation Select Case Msgbox(hWnd, strPrompt, lngStyle, strTitle) Case vbRetry: Text1.Text = "Retry button 按下" Case vbAbort: Text1.Text = "Abort button 按下" Case vbIgnore: Text1.Text = "Ignore button 按下" End Select End Sub
Private Sub Command2_Click() Form2.Show End [1] [2] 下一页 没有相关教程
|