Multi-lingual MsgBox function? 2

[SteveGlover]

I'm developing a multi-lingual application. I've made frequent use of the MsgBox function with Yes/No/Cancel buttons. Is there anyway of getting MsgBox to display the caption for these buttons in a different language?

Also, the VB6 Resource Editor seems to reserves strings 1 to 100. What are these strings, and is there anyway of editting them? I'm hoping that some of these reserved strings are the Yes/No/Cancel strings used by MsgBox.

Thanks
Steve

 

[paulbent]

The button text should display in the O/S language. The title and message are supplied by you and a version for each language should be in the res file.

I don't know why the string ids start at 101 but there aren't any resources from 1 to 100 that you can access. If you pass an id that doesn't exist in the res file to LoadResString then you simply get a run-time error.

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[zemp]

You can always create your own custom message box. That will give you more control over what it displays. Lots of examples at

http://www.planetsourcecode.com.

As Paul said there are no resource values from 1 to 100 by default. But that doesn't mean that you can't change an existing resource value id to be between 1 and 100.

Thanks and Good Luck!

zemp

 

[Golom]

Here's a message box replacement that allows you to replace the text on the command buttons. As is, it requires you to pass the new text as an array of strings. With some minor tweaking you can pull those text strings from a resource file.

Option Explicit

Dim But(1 To 7, 1 To 2) As Integer
Dim bn(1 To 3) As String


'VBnet-defined control ID for the message prompt
Private Const IDPROMPT = &HFFFF&

'misc constants
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5

Public Type HookParms
WindowOwner As Long
xPos As Long
yPos As Long
hHook As Long
End Type

'UDT for passing data through the hook
Private Type MSGBOX_HOOK_PARAMS
hwndOwner As Long
hHook As Long
End Type

'need this declared at module level as
'it is used in the call and the hook proc
Private MSGHOOK As MSGBOX_HOOK_PARAMS

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Public Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long

Private 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 SetDlgItemText Lib "user32" _
Alias "SetDlgItemTextA" _
(ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal lpString As String) 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 SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hWnd As Long, _
ByVal lpString As String) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long


Public Function MsgBoxCaption(ByVal sCaption As String, _
Optional ByVal lParms As VbMsgBoxStyle = vbInformation, _
Optional ByVal sTitle As Variant = " ", _
Optional ByVal ButtonCount As Integer = 2, _
Optional ByRef ButtonNames As Variant, _
Optional ByVal lOwner As Variant) As Long

'Wrapper function for the MessageBox API
Dim hInstance As Long
Dim hThreadId As Long
Dim rv As Long
Dim n As Integer
Dim ButSel As Integer
Dim TheOwner As Long

On Error GoTo ErrorProc

'Figure out who owns the message box
If IsMissing(lOwner) Then
TheOwner = "&h" & Hex(0) ' Owner zero is the desktop.
ElseIf VarType(lOwner) = vbLong Then
TheOwner = "&h" & Hex(lOwner) ' Got a window handle as the owner.
ElseIf TypeOf lOwner Is Form Then
TheOwner = lOwner.hWnd ' Got a form as the owner. Pick up the handle.
End If

hInstance = GetWindowLong(TheOwner, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()

' Initialize all buttons to 'False' (i.e. not displayed)
For n = 1 To 7
But(n, 1) = False
But(n, 2) = 0
Next

' Copy the button names to a public array.
' Raise Errors if its not an array or does not have enough names.
If (VarType(ButtonNames) And vbArray) <> vbArray Then
Err.Raise 1050, &quot;modMsgBoxRev&quot;, &quot;Button Names must be an array&quot;
Else
If UBound(ButtonNames, 1) < ButtonCount Then
Err.Raise 1051, &quot;modMsgBoxRev&quot;, &quot;Not Enough Button Names Supplied&quot;
End If
End If

For n = 1 To UBound(ButtonNames, 1)
bn = ButtonNames
Next

' Figure out which buttons are displayed
If (lParms And vbRetryCancel) = vbRetryCancel Then
ButSel = vbRetryCancel
ElseIf (lParms And vbYesNo) = vbYesNo Then
ButSel = vbYesNo
ElseIf (lParms And vbYesNoCancel) = vbYesNoCancel Then
ButSel = vbYesNoCancel
ElseIf (lParms And vbAbortRetryIgnore) = vbAbortRetryIgnore Then
ButSel = vbAbortRetryIgnore
ElseIf (lParms And vbOKCancel) = vbOKCancel Then
ButSel = vbOKCancel
Else
ButSel = vbOK
End If

' Reset the parameters by removing the one they specified and
' adding one that provides 1, 2 or 3 buttons. Keep track of
' the buttons by consecutively numbering them from left to right.
If ButtonCount <= 1 Then
lParms = lParms - ButSel + vbOKOnly
But(vbOK, 1) = True
But(vbOK, 2) = 1
ElseIf ButtonCount = 2 Then
lParms = lParms - ButSel + vbYesNo
But(vbYes, 1) = True
But(vbNo, 1) = True
But(vbYes, 2) = 1
But(vbNo, 2) = 2
Else
lParms = lParms - ButSel + vbAbortRetryIgnore
But(vbAbort, 1) = True
But(vbRetry, 1) = True
But(vbIgnore, 1) = True
But(vbAbort, 2) = 1
But(vbRetry, 2) = 2
But(vbIgnore, 2) = 3
End If

'set up the MSGBOX_HOOK_PARAMS values
'By specifying a Windows hook as one
'of the params, we can intercept messages
'sent by Windows and thereby manipulate
'the dialog
With MSGHOOK
.hwndOwner = TheOwner
.hHook = SetWindowsHookEx(WH_CBT, _
AddressOf MBHooker, _
hInstance, hThreadId)
End With

' Message box returns a button number that is one of vbOK, vbYes, vbNo, etc.
' We need to translate those to the button number as displayed
' across the screen (Left = 1, Centre = 2, Right = 3)
rv = MessageBox(TheOwner, sCaption, sTitle, lParms)
MsgBoxCaption = But(rv, 2)

' If you want to return the standard Message Box button numbers then use
' MsgBoxCaption = rv

Exit Function

ErrorProc:
If Err.Number = 1050 Then
MsgBox Err.Description, vbCritical + vbOKOnly, &quot;Array Required&quot;
ElseIf Err.Number = 1051 Then
MsgBox Err.Description, vbCritical + vbOKOnly, &quot;Not Enough Names&quot;
Else
MsgBox Err.Number & &quot; - &quot; & Err.Description
End If

End Function


Public Function MBHooker(ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

Dim n As Long
Dim nBut As Integer

If uMsg = HCBT_ACTIVATE Then

' Set the caption for each of the displayed buttons
nBut = 0
For n = LBound(But, 1) To UBound(But, 1)
If But(n, 1) Then
nBut = nBut + 1
SetDlgItemText wParam, n, bn(nBut)
' Alternatively, you could load these button values from a
' resource file with a statement like:
'
' SetDlgItemText wParam, n, LoadResString (n + OffSet)
'
' Where 'OffSet' positions to the language that you are using.
End If
Next

'we're done with the dialog, so release the hook
UnhookWindowsHookEx MSGHOOK.hHook

End If

'return False to let normal processing continue
MBHooker = False

End Function
'--end block--'



Good Luck.