Solved

Captions for Buttons in API MessageBoxIndirect

Posted on 2004-03-21
3
664 Views
Last Modified: 2007-12-19
I need to retrieve the localized strings that are used to populate the buttons in  MessageBoxIndirectA, MessageBoxIndirectW. I can't find them as resources in system Dlls'. In English they would be "OK", "Cancel", "Abort", "Retry", "Ignore", "Yes", "No", "TryAgain", "Continue" but may be in another language depending on LCID.  
   
0
Comment
Question by:danaseaman
  • 2
3 Comments
 
LVL 22

Author Comment

by:danaseaman
Comment Utility
Found these in WinXP-SP1 User32.Dll (Brazilian Portuguese)
800,       "OK"
801,       "Cancelar"
802,       "&Anular"
803,       "&Repetir"
804,       "&Ignorar"
805,       "&Sim"
806,       "&Não"
807,       "&Fechar"
808,       "Ajuda"
809,       "Te&ntar novamente"
810,       "&Continuar"

Win98/Win2000 User32.Dll doesn't have these resource strings.
0
 
LVL 27

Accepted Solution

by:
Ark earned 125 total points
Comment Utility
Hi

'=============Bas module code=============
Option Explicit
' ===============MessageBoxIndirect staff===============
Public Enum LANG_VALUES
      LANG_BULGARIAN = &H2
      LANG_CHINESE = &H4
      LANG_CROATIAN = &H1A
      LANG_CZECH = &H5
      LANG_DANISH = &H6
      LANG_DUTCH = &H13
      LANG_ENGLISH = &H9
      LANG_FINNISH = &HB
      LANG_FRENCH = &HC
      LANG_GERMAN = &H7
      LANG_GREEK = &H8
      LANG_HUNGARIAN = &HE
      LANG_ICELANDIC = &HF
      LANG_ITALIAN = &H10
      LANG_JAPANESE = &H11
      LANG_KOREAN = &H12
      LANG_NEUTRAL = &H0
      LANG_NORWEGIAN = &H14
      LANG_POLISH = &H15
      LANG_PORTUGUESE = &H16
      LANG_ROMANIAN = &H18
      LANG_RUSSIAN = &H19
      LANG_SLOVAK = &H1B
      LANG_SLOVENIAN = &H24
      LANG_SPANISH = &HA
      LANG_SWEDISH = &H1D
      LANG_TURKISH = &H1F
End Enum

Public Enum SUBLANG_VALUES
     SUBLANG_CHINESE_HONGKONG = &H1D
     SUBLANG_CHINESE_SIMPLIFIED = &H2
     SUBLANG_CHINESE_SINGAPORE = &H4
     SUBLANG_CHINESE_TRADITIONAL = &H1
     SUBLANG_DEFAULT = &H1
     SUBLANG_DUTCH = &H1
     SUBLANG_DUTCH_BELGIAN = &H2
     SUBLANG_ENGLISH_AUS = &H3
     SUBLANG_ENGLISH_CAN = &H4
     SUBLANG_ENGLISH_EIRE = &H6
     SUBLANG_ENGLISH_NZ = &H5
     SUBLANG_ENGLISH_UK = &H2
     SUBLANG_ENGLISH_US = &H1
     SUBLANG_FRENCH = &H1
     SUBLANG_FRENCH_BELGIAN = &H2
     SUBLANG_FRENCH_CANADIAN = &H3
     SUBLANG_FRENCH_SWISS = &H4
     SUBLANG_GERMAN = &H1
     SUBLANG_GERMAN_AUSTRIAN = &H3
     SUBLANG_GERMAN_SWISS = &H2
     SUBLANG_ITALIAN = &H1
     SUBLANG_ITALIAN_SWISS = &H2
     SUBLANG_NEUTRAL = &H0
     SUBLANG_NORWEGIAN_BOKMAL = &H1
     SUBLANG_NORWEGIAN_NYNORSK = &H2
     SUBLANG_PORTUGUESE = &H2
     SUBLANG_PORTUGUESE_BRAZILIAN = &H1
     SUBLANG_SPANISH = &H1
     SUBLANG_SPANISH_MEXICAN = &H2
     SUBLANG_SPANISH_MODERN = &H3
     SUBLANG_SYS_DEFAULT = &H2
End Enum

Private Type MSGBOXPARAMS
   cbSize As Long
   hWndOwner As Long
   hInstance As Long
   lpszText As String
   lpszCaption As String
   dwStyle As Long
   lpszIcon As String
   dwContextHelpId As Long
   lpfnMsgBoxCallback As Long
   dwLanguageId As Long
End Type
Private Declare Function MessageBoxIndirect Lib "user32" Alias "MessageBoxIndirectA" (lpMsgBoxParams As MSGBOXPARAMS) As Long
Private Const MB_OKCANCEL = &H1&
Private Const MB_ABORTRETRYIGNORE = &H2&
'Private Const MB_YESNOCANCEL = &H3& 'no need (all values can be retrived from MB_OKCANCEL and VB_YESNO)
Private Const MB_YESNO = &H4&
'Private Const MB_RETRYCANCEL = &H5& 'no need (all values can be retrived from MB_OKCANCEL and VB_ABORTRETRYIGNORE)
Private Const MB_CANCELTRYCONTINUE = &H6& 'w2000/XP only
Private Const MB_HELP = &H4000

'=====================CWP Hook staff============================
Type CWPSTRUCT
    lParam As Long
    wParam As Long
    message As Long
    hWnd As Long
End Type
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
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
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Const WH_CALLWNDPROC = 4

'====================Checking OS staff============================
Public Enum OS_VER
    Win32
    Win95
    Win98
    WinME
    WinNT
    Win2K
    WinXP
    Win2003
End Enum
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long

Declare Function GetDlgItemText Lib "user32" Alias "GetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Private Declare Function EndDialog Lib "user32" (ByVal hDlg As Long, ByVal nResult As Long) As Long
Private Const WM_INITDIALOG = &H110

Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Const LOCALE_SLANGUAGE             As Long = &H2
Private Const LOCALE_SENGLANGUAGE          As Long = &H1001

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Dim hHook As Long
Dim WinVer As OS_VER
Public sButtonText(1 To 11) As String
Public sLang As String

Public Function AppHook(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim CWP As CWPSTRUCT
    Dim iLength As Integer, i As Integer
    Dim sText As String
    CopyMemory CWP, ByVal lParam, Len(CWP)
    Select Case CWP.message
        Case WM_INITDIALOG
            For i = 1 To 11
                sText = String(256, 0)
                iLength = GetDlgItemText(CWP.hWnd, i, sText, 256)
                If iLength Then
                    sButtonText(i) = Left(sText, iLength)
'                    Debug.Print i, sButtonText(i)
                End If
            Next i
            AppHook = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
            UnhookWindowsHookEx hHook
            EndDialog CWP.hWnd, 0
            hHook = 0
            Exit Function
    End Select
    AppHook = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
End Function

Public Sub GetLocaleButtonsText(Optional ByVal language As LANG_VALUES = LANG_NEUTRAL, _
                                Optional ByVal sublanguage As SUBLANG_VALUES = SUBLANG_DEFAULT)
   Dim mbp As MSGBOXPARAMS
   Dim LangId As Long
   LangId = MakeLangID(language, sublanguage)
   LangId = MakeLangID(language, sublanguage)
   sLang = GetlanguageInfo(LangId, LOCALE_SENGLANGUAGE)
   mbp.cbSize = Len(mbp)
   mbp.dwLanguageId = LangId
   
   mbp.dwStyle = MB_OKCANCEL Or MB_HELP
   hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf AppHook, App.hInstance, App.ThreadID)
   MessageBoxIndirect mbp
   If hHook Then UnhookWindowsHookEx hHook
   
   mbp.dwStyle = MB_ABORTRETRYIGNORE
   hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf AppHook, App.hInstance, App.ThreadID)
   MessageBoxIndirect mbp
   If hHook Then UnhookWindowsHookEx hHook
   
   mbp.dwStyle = MB_YESNO
   hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf AppHook, App.hInstance, App.ThreadID)
   MessageBoxIndirect mbp
   If hHook Then UnhookWindowsHookEx hHook
   GetWinVer
   If WinVer >= Win2K Then
      mbp.dwStyle = MB_CANCELTRYCONTINUE
      hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf AppHook, App.hInstance, App.ThreadID)
      MessageBoxIndirect mbp
      If hHook Then UnhookWindowsHookEx hHook
   End If
End Sub

Function MakeLangID(ByVal usPrimaryLanguage As Integer, ByVal usSubLanguage As Long) As Long
    MakeLangID = usSubLanguage * 2 ^ 10 + usPrimaryLanguage
End Function

Private Sub GetWinVer()
   Dim verinfo As OSVERSIONINFO
   verinfo.dwOSVersionInfoSize = Len(verinfo)
   If (GetVersionEx(verinfo)) = 0 Then Exit Sub
   With verinfo
      Select Case .dwPlatformId
         Case 0: WinVer = Win32
         Case 1 'Win9x
             Select Case .dwMinorVersion
                Case 0:  WinVer = Win95
                Case 10: WinVer = Win98
                Case 90: WinVer = WinME
             End Select
         Case 2
             If .dwMajorVersion < 5 Then
                WinVer = WinNT
             Else
                Select Case .dwMinorVersion
                   Case 0: WinVer = Win2K
                   Case 1: WinVer = WinXP
                   Case 2: WinVer = Win2003
                End Select
             End If
      End Select
   End With
End Sub

Private Function GetlanguageInfo(ByVal dwLocaleID As Long, ByVal dwLCType As Long) As String
   Dim sReturn As String, nRet As Long
   sReturn = String$(128, 0)
   nRet = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
   If nRet > 1 Then GetlanguageInfo = Left$(sReturn, nRet - 1)
End Function

'===============Form code===========
Private Sub Command1_Click()
   Dim sText As String
   Dim sTab As String
   Dim vCaption As Variant
   Dim i As Integer
   
   vCaption = Array("ID_OK", "ID_CANCEL", "ID_ABORT", "ID_RETRY", "ID_IGNORE", _
                    "ID_YES", "ID_NO", "ID_CLOSE", "ID_HELP", "ID_TRYAGAIN", "ID_CONTINUE")
   GetLocaleButtonsText LANG_NEUTRAL, SUBLANG_DEFAULT
   sText = "MessageBoxIndirect buttons captions for " & sLang & " language:" & vbCrLf
   For i = 1 To 11
       If Len(vCaption(i - 1)) < 8 Then sTab = vbTab & vbTab Else sTab = vbTab
       sText = sText & vbCrLf & vCaption(i - 1) & sTab & " = " & sButtonText(i)
   Next i
   MsgBox sText, vbInformation, "Locale info"
End Sub

Regards
Ark
0
 
LVL 22

Author Comment

by:danaseaman
Comment Utility
Works but I'll have to figure out a way to eliminate the flicker and beeping. Also tried a Hook with HCBT_ACTIVATE, getting the Buttons with FindWindowExA and finally the captions with GetWindowTextA.
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

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…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
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…

772 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

15 Experts available now in Live!

Get 1:1 Help Now