[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 430
  • Last Modified:

Define own msgbox buttons

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
robhas
Asked:
robhas
1 Solution
 
JonFish85Commented:
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
 
Aaron_YoungCommented:
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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
Ryan ChongCommented:
Hi robhas,

Modifying a Message Box with SetWindowsHookEx:

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

'Hope will help.
0
 
ArkCommented:
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
 
robhasAuthor Commented:
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

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now