Those who have written VB know that the MSGBox function pops up the system prompt dialog, this dialog is that we use it for us, then we can change it in other ways. Below I will call the MessageBox API to change the VB's dialog function and create our own style MSGbox! This routine is popped up to MsGbox and is always located in the center of the window; and modify the text on the "OK" button in MSGBox. Simple use of Windows hooks in the program.
1 · Join a module:
Option expedition '-------------------- API declaration section -------------------- Private const wh_cbt = 5Private const hcbt_activate = 5
Private Type Rect Left As Long Top As Long Right As Long Bottom As LONGEND TYPE
'Using the API MessageBox alternative VB system MsgBoxPrivate 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 stay) AS Long, ByVal LPSTRING AS STRING, BYVAL 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 LongPrivate hHook As LongPrivate Const IDOK = 1Private Const IDCANCEL = 2Private Const IDABORT = 3Private const idietries = 4Private const idignore = 5private const idyes = 6private const idno = 7private const idprompt = & hfff &
'---------------------- Form handles --------------------' Private HFORMHWND As Long
'' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' Replacing the msgbox function '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' ' '' '' '' '' '' '' '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 'will be paid to the current window handle variable hFormhWnd = hWnd' hook disposed hHook = SetWindowsHookEx (WH_CBT, _ Addressof CBTProc, _ hinstance, hthreadid) 'Call MessageBox API Msgbox = MessageBox (HWND, SPMPT, Stitle, DWStyle) End Function
'' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' Hook handler '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' Public Function CBTProc (Byval Ncode As Long, _ Byval WParam As Long 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' when MessageBox appears, Msgbox window located centering the box If nCode = HCBT_ACTIVATE Then 'HCBT_ACTIVATE message, the wParam parameter contains the handle MessageBox hwndMsgBox = wParam' obtained MessageBox dialog Rect Call GetWindowRect (hwndMsgBox, rc) Call GetWindowRect (hFormhWnd, rcFrm) 'Make Messagebox home frMLT = rcfrm.left fmtop = rcfrm.top frmwidth = rcfrm.right - RCFR M.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) 'modify OK button text Call SetDlgItemText (hwndMsgBox, IDOK, "it is OK")' Msgbox centrally Call MoveWindow (hwndMsgBox, newLeft, newTop, dlgWidth, dlgHeight, True) 'Uninching the hook unhookwindowshookex hHOOK end if CBTPROC = FalseEnd Function
2 · Code in the form: Form1 -----
Option Explicit Private Sub Command1_Click () 'variable declaration Dim strTitle As String Dim strPrompt As String Dim lngStyle As Long' MessageBox title strTitle = "My Application" 'MessageBox content strPrompt = "This is the hook MessageBox demo" & vbCrLf & vbCrLf & _ "MessageBox dialog box will be centered in the Form" 'MessageBox style lngStyle = vbAbortRetryIgnore Or vbInformation Select Case Msgbox (hWnd, strPrompt, lngStyle, strTitle) Case vbRetry: Text1.Text = "Retry button pressed" Case vbAbort : Text1.text = "Abort button Press" Case Vbignore: text1.text = "Ignore Button Press" End Select End Sub
Private submmand2_click () form2.show end sub
Form2 -----
Option expedition
Private submmand1_click () Call MsgBox (me.hwnd, "OK button show!", 0, ") End Sub
