Home  |   French  |   About  |   Search  | mvps.org  

What's New
Table Of Contents
Credits
Netiquette
10 Commandments 
Bugs
Tables
Queries
Forms
Reports
Modules
APIs
Strings
Date/Time
General
Downloads
Resources
Search
Feedback
mvps.org

In Memoriam

Terms of Use


VB Petition

API: Changing button captions in GetOpenFileName dialog

Author(s)
Dev Ashish

Although GetOpenFileName API allows us to, amongst other things, change the caption of buttons in the open file dialog, the code required is a bit tricky (at least the version I came up with).

We can hook a custom callback function by setting the OFN_EXPLORER and OFN_ENABLEHOOK in the Flags member of the structure. The dialog then will send a CDN_INITDONE notification message when the system has finished arranging the controls in the dialog box.  When we receive this message in our callback function, we can use few other API functions to hide the controls,  change the caption, and do other things with the dialog.

Note:  In order to successfully run sTestCommDlgCallback procedure:

  1. You will need to copy the GetOpenFileName code in another module.
  2. If you are trying this in Access 97, you will have to get AddrOf code as well.  In this case, you will also need to swap the commented lines of code that use AddressOf (VBA 6) and AddrOf (VBA 5).
'  ********* Code Start *********
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Private Type tagNMHDR
    hWndFrom As Long
    idFrom As Long
    code As Long
End Type
 
Private Type OFNOTIFY
    hdr As tagNMHDR
    lpOFN As Long
    pszFile As Long
End Type
 
Private Const OFN_ENABLEHOOK = &H20
Private Const CDN_FIRST = -601&
Private Const CDN_LAST = -699&
 
Private Const WM_USER = &H400
Private Const WM_NOTIFY = &H4E
 
'// Notifications when Open or Save dialog status changes
Private Const CDN_INITDONE = (CDN_FIRST - 0&)
Private Const CDN_SELCHANGE = (CDN_FIRST - 1&)
Private Const CDN_FOLDERCHANGE = (CDN_FIRST - 2&)
Private Const CDN_SHAREVIOLATION = (CDN_FIRST - 3&)
Private Const CDN_HELP = (CDN_FIRST - 4&)
Private Const CDN_FILEOK = (CDN_FIRST - 5&)
Private Const CDN_TYPECHANGE = (CDN_FIRST - 6&)
Private Const CDN_INCLUDEITEM = (CDN_FIRST - 7&)
 
Private Const CDM_FIRST = (WM_USER + 100)
Private Const CDM_LAST = (WM_USER + 200)
Private Const CDM_GETSPEC = (CDM_FIRST + &H0)
Private Const CDM_GETFILEPATH = (CDM_FIRST + &H1)
Private Const CDM_GETFOLDERPATH = (CDM_FIRST + &H2)
Private Const CDM_GETFOLDERIDLIST = (CDM_FIRST + &H3)
Private Const CDM_SETCONTROLTEXT = (CDM_FIRST + &H4)
Private Const CDM_HIDECONTROL = (CDM_FIRST + &H5)
Private Const CDM_SETDEFEXT = (CDM_FIRST + &H6)
 
'  Control IDs from dlgs.h
'
'//
'//  Combo boxes.
'//
Private Const cmb1 = &H470  '  File Types combo 
Private Const cmb2 = &H471  '  Drives combo
Private Const cmb3 = &H472
Private Const cmb4 = &H473
Private Const cmb5 = &H474
Private Const cmb6 = &H475
Private Const cmb7 = &H476
Private Const cmb8 = &H477
Private Const cmb9 = &H478
Private Const cmb10 = &H479
Private Const cmb11 = &H47A
Private Const cmb12 = &H47B
Private Const cmb13 = &H47C
Private Const cmb14 = &H47D
Private Const cmb15 = &H47E
Private Const cmb16 = &H47F
 
'//
'//  Static text.
'//
Private Const stc1 = &H440
Private Const stc2 = &H441      ' Files of Type
Private Const stc3 = &H442      ' File Name
Private Const stc4 = &H443      ' Look In
Private Const stc5 = &H444
Private Const stc6 = &H445
Private Const stc7 = &H446
Private Const stc8 = &H447
Private Const stc9 = &H448
Private Const stc10 = &H449
Private Const stc11 = &H44A
Private Const stc12 = &H44B
Private Const stc13 = &H44C
Private Const stc14 = &H44D
Private Const stc15 = &H44E
Private Const stc16 = &H44F
Private Const stc17 = &H450
Private Const stc18 = &H451
Private Const stc19 = &H452
Private Const stc20 = &H453
Private Const stc21 = &H454
Private Const stc22 = &H455
Private Const stc23 = &H456
Private Const stc24 = &H457
Private Const stc25 = &H458
Private Const stc26 = &H459
Private Const stc27 = &H45A
Private Const stc28 = &H45B
Private Const stc29 = &H45C
Private Const stc30 = &H45D
Private Const stc31 = &H45E
Private Const stc32 = &H45F
 
'//
'//  Push buttons.
'//
Private Const psh1 = &H400
Private Const psh2 = &H401
Private Const psh3 = &H402
Private Const psh4 = &H403
Private Const psh5 = &H404
Private Const psh6 = &H405
Private Const psh7 = &H406
Private Const psh8 = &H407
Private Const psh9 = &H408
Private Const psh10 = &H409
Private Const psh11 = &H40A
Private Const psh12 = &H40B
Private Const psh13 = &H40C
Private Const psh14 = &H40D
Private Const psh15 = &H40E
Private Const pshHelp = psh15
Private Const psh16 = &H40F
 
'//
'//  Groups, frames, rectangles, and icons.
'//
Private Const grp1 = &H430
Private Const grp2 = &H431
Private Const grp3 = &H432
Private Const grp4 = &H433
Private Const frm1 = &H434
Private Const frm2 = &H435
Private Const frm3 = &H436
Private Const frm4 = &H437
Private Const rct1 = &H438
Private Const rct2 = &H439
Private Const rct3 = &H43A
Private Const rct4 = &H43B
Private Const ico1 = &H43C
Private Const ico2 = &H43D
Private Const ico3 = &H43E
Private Const ico4 = &H43F
 
'//
'//  Checkboxes.
'//
Private Const chx1 = &H410
Private Const chx2 = &H411
Private Const chx3 = &H412
Private Const chx4 = &H413
Private Const chx5 = &H414
Private Const chx6 = &H415
Private Const chx7 = &H416
Private Const chx8 = &H417
Private Const chx9 = &H418
Private Const chx10 = &H419
Private Const chx11 = &H41A
Private Const chx12 = &H41B
Private Const chx13 = &H41C
Private Const chx14 = &H41D
Private Const chx15 = &H41E
Private Const chx16 = &H41F
 
'/*
' * Dialog Box Command IDs
' */
Private Const IDOK = 1
Private Const IDCANCEL = 2
 
'  Identifiers
'  cmb2 - Drop-down combo box that displays the current
'              drive or folder, and that allows the user to
'              select a drive or folder to open
'  stc4  - Label for the cmb2 combo box
'  lst1    - List box that displays the contents of the
'              current drive or folder
'  stc1  - Label for the lst1 list box
'  edt1  -  Edit control that displays the name of the
'                current file, or in which the user can type
'                the name of the file to open
'  stc3  - Label for the edt1 edit control
'  cmb1  - Drop-down combo box that displays the
'                list of file type filters
'  stc2  - Label for the cmb1 combo box
'  chx1  - The read-only check box
'  IDOK -  The OK command button (push button)
'  IDCANCEL - The Cancel command button (push button)
'  pshHelp - The Help command button (push button)
 
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
Private Const GWL_STYLE = (-16)
Private Const MAX_LEN = 255
Private Const WS_VISIBLE = &H10000000
 
Private Declare Sub sapiCopyMem Lib "Kernel32" _
    Alias "RtlMoveMemory" _
    (pDest As Any, _
    pSource As Any, _
    ByVal ByteLen As Long)
 
Private Declare Sub sapiZeroMem Lib "Kernel32" _
    Alias "RtlZeroMemory" _
    (Destination As Any, _
    ByVal length As Long)
 
Private Declare Function apiSendMessage Lib "user32" _
    Alias "SendMessageA" _
    (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
    As Long
 
Private Declare Function apiGetParent Lib "user32" _
    Alias "GetParent" _
    (ByVal hwnd As Long) _
    As Long
 
Private Declare Function apiEnumChildWindows Lib "user32" _
    Alias "EnumChildWindows" _
    (ByVal hWndParent As Long, _
    ByVal lpEnumFunc As Long, _
    ByVal lParam As Long) _
    As Long
 
Private Declare Function apiGetClassName Lib "user32" _
    Alias "GetClassNameA" _
    (ByVal hwnd As Long, _
    ByVal lpClassname As String, _
    ByVal nMaxCount As Long) _
    As Long
 
Private Declare Function apiGetWindow Lib "user32" _
    Alias "GetWindow" _
    (ByVal hwnd As Long, _
    ByVal wCmd As Long) _
    As Long
 
Private Declare Function apiGetWindowLong Lib "user32" _
    Alias "GetWindowLongA" _
    (ByVal hwnd As Long, _
    ByVal nIndex As Long) _
    As Long
 
Private Declare Function apiSetWindowLong Lib "user32" _
    Alias "SetWindowLongA" _
    (ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) _
    As Long
 
Function fOFNHookProc( _
                    ByVal hwnd As Long, _
                    ByVal uiMsg As Long, _
                    ByVal wParam As Long, _
                    ByVal lParam As Long) _
                    As Long
Static tofNotify As OFNOTIFY
Static blnRetVal As Boolean
 
    If uiMsg = WM_NOTIFY Then
        Call sapiZeroMem(tofNotify, Len(tofNotify))
        Call sapiCopyMem(tofNotify, ByVal lParam, Len(tofNotify))
 
        Select Case tofNotify.hdr.code
            Case CDN_INITDONE:
                'Debug.Print "CDN_INITDONE"
                Dim hWndParent As Long
 
                '  The handle is of the child dialog
                hWndParent = apiGetParent(hwnd)
                '  hide the Drives combo
                Call apiSendMessage(hWndParent, CDM_HIDECONTROL, _
                        cmb2, ByVal 0&)
                '  hide the "Look In" label
                Call apiSendMessage(hWndParent, CDM_HIDECONTROL, _
                        stc4, ByVal 0&)
 
                Call apiSendMessage(hWndParent, CDM_HIDECONTROL, _
                        chx1, ByVal 0&)
 
                '  heh heh!
                Call apiSendMessage(hWndParent, CDM_SETCONTROLTEXT, _
                        IDOK, ByVal "AddrOf Rulez!")
                
                Call apiSendMessage(hWndParent, CDM_SETCONTROLTEXT, _
                        IDCANCEL, ByVal "Doh!")
 
                Call apiEnumChildWindows(hWndParent, _
                        AddressOf fEnumChildProc, 0)
 
                ' For Access 97, you need the AddrOf code and the line above
                ' should read
                'Call apiEnumChildWindows(hWndParent, _
                        AddrOf("fEnumChildProc"), 0)

 
                blnRetVal = False
 
            Case CDN_SELCHANGE:
                'Debug.Print "CDN_SELCHANGE"
            Case CDN_FOLDERCHANGE:
                'can't do that
                ' blnRetVal = True 
                blnRetVal = False
 
                'Debug.Print "CDN_FOLDERCHANGE"
            Case CDN_SHAREVIOLATION:
                blnRetVal = False
                'Debug.Print "CDN_SHAREVIOLATION"
            Case CDN_HELP:
                blnRetVal = False
                'Debug.Print "CDN_HELP"
            Case CDN_FILEOK:
                blnRetVal = False
                'Debug.Print "CDN_FILEOK"
            Case CDN_TYPECHANGE:
                blnRetVal = False
                'Debug.Print "CDN_TYPECHANGE"
            Case CDN_INCLUDEITEM:
                blnRetVal = False
                'Debug.Print "CDN_INCLUDEITEM"
        End Select
    End If
    'returning 0 let's the dialog handle the default proc
    fOFNHookProc = blnRetVal
End Function
 
Function fEnumChildProc(ByVal hwnd As Long, _
                                        ByVal lParam As Long) _
                                        As Long
Dim lngStyle As Long
Const TOOLBAR_CLASS = "ToolBarWindow32"
    If fGetClassName(hwnd) = TOOLBAR_CLASS Then
        lngStyle = apiGetWindowLong(hwnd, GWL_STYLE)
        lngStyle = lngStyle And Not WS_VISIBLE
        Call apiSetWindowLong(hwnd, GWL_STYLE, lngStyle)
    End If
    fEnumChildProc = True
End Function
 
Private Function fFuncPtr(pFunc As Long) As Long
    fFuncPtr = pFunc
End Function
 
Sub sTestCommDlgCallback()
Dim strFilter As String
Dim lngRet As Long
Dim tOFN As tagOPENFILENAME
 
    strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", _
                            "*.MDA;*.MDB")
    strFilter = ahtAddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF")
    strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
    strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
 
    With tOFN
        .hwndOwner = hWndAccessApp
        .lStructSize = Len(tOFN)
        .Flags = OFN_ENABLEHOOK Or ahtOFN_EXPLORER
        
        .lpfnHook = fFuncPtr(AddressOf fOFNHookProc)
        ' For Access 97, you need the AddrOf code and the line above
        ' should read
        ' .lpfnHook = AddrOf("fOFNHookProc")
        
        .strInitialDir = CurDir
        .hInstance = 0
        .strCustomFilter = String$(255, vbNullChar)
        .nMaxCustFilter = 255
        .strFilter = strFilter
        .nFilterIndex = 1
        .strFile = String$(255, vbNullChar)
        .nMaxFile = 256
        .strFileTitle = String$(255, vbNullChar)
        .nMaxFileTitle = 256
        .strTitle = "Callback test"
        .strDefExt = vbNullString
    End With
    lngRet = aht_apiGetOpenFileName(tOFN)
    If lngRet Then Debug.Print _
        Left$(tOFN.strFile, InStr(1, tOFN.strFile, vbNullChar) - 1)
    End Sub
 
Private Function fGetClassName(hwnd As Long) As String
'  Returns the classname of a Window
'
Dim strBuffer As String
Dim lngCount As Long
    strBuffer = String$(MAX_LEN + 1, 0)
    lngCount = apiGetClassName(hwnd, strBuffer, MAX_LEN)
    If lngCount > 0 Then fGetClassName = Left$(strBuffer, lngCount)
End Function
'  ********* Code End *********

© 1998-2010, Dev Ashish & Arvin Meyer, All rights reserved. Optimized for Microsoft Internet Explorer