?
Solved

Define own msgbox buttons

Posted on 2001-07-23
6
Medium Priority
?
405 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
6 Comments
 
LVL 6

Accepted Solution

by:
JonFish85 earned 300 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 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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 53

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 28

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

Industry Leaders: 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!

Question has a verified solution.

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

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
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…
Suggested Courses
Course of the Month8 days, 22 hours left to enroll

764 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