Solved

Define own msgbox buttons

Posted on 2001-07-23
6
377 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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
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

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
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…

746 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

11 Experts available now in Live!

Get 1:1 Help Now