Solved

Define own msgbox buttons

Posted on 2001-07-23
6
379 Views
Last Modified: 2007-12-19
Is there a way to define your own buttons for a msgbox. I would like to have 2 buttons but different captions. Would it be used in the same way.
Thanks
robhas
0
Comment
Question by:robhas
6 Comments
 
LVL 6

Accepted Solution

by:
JonFish85 earned 100 total points
ID: 6308830
you would have to create your own Messagebox window (Project -> Add Form -> Dialog). Then set that up how you want it, and call it like this:

Dialog.lblYourInformation = "Whatever"
Dialog.Show vbModal, Me

hope this helps!
0
 
LVL 8

Expert Comment

by:Dave_Greene
ID: 6309216
0
 
LVL 1

Expert Comment

by:Aaron_Young
ID: 6310350
If you don't want to create a separate Form and don't want to include another control, then here's a method I wrote which wrappers to Messagebox using the API's and allows the button captions to be altered to anything you like:


'---------------------------------------------------------
' In a Standard Module:
'
'*********************************************************
'* MsgBoxEx() - Written by Aaron Young, February 7th 2000
'*
Option Explicit

Private Type CWPSTRUCT
        lParam As Long
        wParam As Long
        message As Long
        hwnd As Long
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Const WH_CALLWNDPROC = 4
Private Const GWL_WNDPROC = (-4)
Private Const WM_CTLCOLORBTN = &H135
Private Const WM_DESTROY = &H2
Private Const WM_SETTEXT = &HC
Private Const WM_CREATE = &H1

Private lHook As Long
Private lPrevWnd As Long

Private bCustom As Boolean
Private sButtons() As String
Private lButton As Long
Private sHwnd As String

Public Function SubMsgBox(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim sText As String
   
    Select Case Msg
    Case WM_CTLCOLORBTN
        'Customize the MessageBox Buttons if neccessary..
        'First Process the Default Action of the Message (Draw the Button)
        SubMsgBox = CallWindowProc(lPrevWnd, hwnd, Msg, wParam, ByVal lParam)
        'Now Change the Button Text if Required
        If Not bCustom Then Exit Function
        If lButton = 0 Then sHwnd = ""
        'If this Button has Been Modified Already then Exit
        If InStr(sHwnd, " " & Trim(Str(lParam)) & " ") Then Exit Function
        sText = sButtons(lButton)
        sHwnd = sHwnd & " " & Trim(Str(lParam)) & " "
        lButton = lButton + 1
        'Modify the Button Text
        SendMessage lParam, WM_SETTEXT, Len(sText), ByVal sText
        Exit Function
       
    Case WM_DESTROY
        'Remove the MsgBox Subclassing
        Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevWnd)
    End Select
    SubMsgBox = CallWindowProc(lPrevWnd, hwnd, Msg, wParam, ByVal lParam)
End Function

Private Function HookWindow(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tCWP As CWPSTRUCT
    Dim sClass As String
    'This is where you need to Hook the Messagebox
    CopyMemory tCWP, ByVal lParam, Len(tCWP)
    If tCWP.message = WM_CREATE Then
        sClass = Space(255)
        sClass = Left(sClass, GetClassName(tCWP.hwnd, ByVal sClass, 255))
        If sClass = "#32770" Then
            'Subclass the Messagebox as it's created
            lPrevWnd = SetWindowLong(tCWP.hwnd, GWL_WNDPROC, AddressOf SubMsgBox)
        End If
    End If
    HookWindow = CallNextHookEx(lHook, nCode, wParam, ByVal lParam)
End Function

Public Function MsgBoxEx(ByVal Prompt As String, Optional ByVal Buttons As Long = vbOKOnly, Optional ByVal Title As String, Optional ByVal HelpFile As String, Optional ByVal Context As Long, Optional ByRef CustomButtons As Variant) As Long
    Dim lReturn As Long
    Dim lStyle As Long
   
    If Buttons >= vbCustom Then
        bCustom = True
        lStyle = Buttons - vbCustom
    End If
   
    If bCustom And IsMissing(CustomButtons) Then
        MsgBox "When using the Custom option you need to supply some Buttons in the ""CustomButtons"" Argument.", vbExclamation + vbOKOnly, "Error"
        Exit Function
    End If
   
    lHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookWindow, App.hInstance, App.ThreadID)
    'Set the Defaults
    If Len(Title) = 0 Then Title = App.Title
    If bCustom Then
        'User wants to use own Button Titles..
        If TypeName(CustomButtons) = "String" Then
            ReDim sButtons(0)
            sButtons(0) = CustomButtons
            Buttons = 0
        Else
            sButtons = CustomButtons
            Buttons = UBound(sButtons)
            Buttons = IIf(Buttons > 2, 2, Buttons)
        End If
    End If
    lButton = 0
   
    'Show the Modified MsgBox
    lReturn = MsgBox(Prompt, Buttons + lStyle, Title, HelpFile, Context)
    Call UnhookWindowsHookEx(lHook)
    'If it's a Custom Button MsgBox, Alter the Return Value,
    'to return the Index to the button caption in the array.
    If bCustom Then lReturn = Choose(Buttons + 1, 0, lReturn - 1, lReturn - 3)
    bCustom = False
    MsgBoxEx = lReturn
End Function
'--------------------------------------------------------


Example Usage:
'--------------------------------------------------------
Private Sub Command1_Click()
    Dim aButtons(2) As String
    aButtons(0) = "&Continue"
    aButtons(1) = "E&xit"
    aButtons(2) = "&Retry"
    Caption = aButtons(MsgBoxEx("Text", vbCustom + vbInformation + vbDefaultButton3, "Title", , , aButtons))
End Sub
'--------------------------------------------------------

Regards,

- Aaron.
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 49

Expert Comment

by:Ryan Chong
ID: 6310777
Hi robhas,

Modifying a Message Box with SetWindowsHookEx:

http://www.mvps.org/vbnet/code/hooks/messageboxhook.htm

'Hope will help.
0
 
LVL 27

Expert Comment

by:Ark
ID: 6310892
Hi
'===Bas module code====
Public Const NV_DLG As Long = &H5000&
Public Declare Function SetTimer& Lib "user32" (ByVal hwnd&, ByVal nIDEvent&, ByVal uElapse&, ByVal lpTimerFunc&)
Public Declare Function KillTimer& Lib "user32" (ByVal hwnd&, ByVal nIDEvent&)
Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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
Const WM_SETFOCUS = &H7
Const WM_ENABLE = &HA
Const GWL_STYLE = (-16)
Const WS_DISABLED = &H8000000

Dim hDlg As Long
Public sOKText As String, sCancelText As String

Public Sub TimerProc(ByVal hwnd&, ByVal uMsg&, ByVal idEvent&, ByVal dwTime&)
  hDlg = FindWindow("#32770", vbNullString)
  If hDlg Then
     KillTimer hwnd, idEvent
     ModifyCtrl 1, sOKText
     ModifyCtrl 2, sCancelText
  End If
End Sub

Private Sub ModifyCtrl(nItem As Long, Optional sNewText As String = "", Optional bEnabled As Boolean = True, Optional bVisible As Boolean = True)
   Dim hItem As Long
   hItem = GetDlgItem(hDlg, nItem)
   Debug.Print hItem
   If sNewText <> "" Then SetWindowText hItem, sNewText
   If Not bEnabled Then
      SetWindowLong hItem, GWL_STYLE, GetWindowLong(hItem, GWL_STYLE) Or WS_DISABLED
      SendMessage hItem, WM_ENABLE, 0&, 0&
      SendMessage hDlg, WM_SETFOCUS, hItem, 0&
   End If
   If bVisible = False Then MoveWindow hItem, 0, 0, 0, 0, 1
End Sub


'=====Form code===
Private Sub Command1_Click()
   Dim ret As Long
   sOKText = "&Hello"
   sCancelText = "&World"
   SetTimer hwnd, NV_DLG, 10, AddressOf TimerProc
   ret = MsgBox("These buttons are custom defined!", vbOKCancel, "Custom buttons")
   If ret = vbOK Then
     Caption = "You press Hello!"
   Else
     Caption = "You press World!"
   End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call KillTimer(hwnd, idEvent)
End Sub

Cheers

0
 

Author Comment

by:robhas
ID: 6313534
I assumed this would be the easist way, so this is it. To the other answers: I will try them out and I appreciate the help.
Thanks
robhas
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Add a task in Outlook from access 11 35
How to produce a SHA-1 hash function in vb6 in order to save it to a table 8 36
Add and format columns in vb6 7 46
TT Auto Dashboard 13 82
If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

910 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now