Home
Home

---Soumis par Dev Ashish---

Changer le libellé du texte des boutons du dialogue  GetOpenFileName

Ok, j'étais un peu las d'avoir à couper et coller ce texte depuis mon répertoire des items envoyés, à chaque occasion que j'avais une demande en ce sens dans mon courrier, si bien que cet article, à tout le moins, m'évitera cette procédure, à tout le moins. <g>

Même si la fonction API GetOpenFileName nous permet, entre autres chose, de modifier le texte des boutons du dialogue d'ouverture de fichier, le code requis est pour le moins un petit peu tordu (du moins, la version que j'ai pondu).

On peut s'insérer avec une fonction de rappel (callback) avec une initialisation appropriée de OFN_EXPLORER et de OFN_ENABLEHOOK, définis dans la structure des l'argument. Le dialogue envoie alors une notice CDN_INITDONE quand le système a fini de disposer les contrôles dans le dialogue. Lors de la réception de ce message, dans notre fonction de rappel, nous pouvons utiliser d'autres fonctions de l'API pour cacher, modifier le texte, ou effectuer d'autres traitement qu'on désire appliquer au dialogue.

Note:  De façon à compléter sans pépin sTestCommDlgCallback :

  1. Vous devrez copier le code de  GetOpenFileName dans un autre module.
  2. Si vous utilisez Access 97, il vous faut également le code de AddrOf .  De plus, toujours dans ce cas, il vous faut également échanger les lignes, comme commentaire, entre celles qui utilisent AddressOf (VBA 6) et AddrOf (VBA 5).
'  ********* Code Start *********
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
 
'// Notices lorsque le statut du dialogue,  Open ou Save,  change
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)
 
'  ID des controles de 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 affichant le répertoire
'              ou dossier courrant et permettant à l'utilisateur
'              de le choisir ou de l'ouvrir
'  stc4  - Label pour combo box cmb2
'  lst1    - List box affichant le contenu du répertoire ou
'              dossier courrant
'  stc1  - Label pour list box lst1
'  edt1  -  Edit control affichant le nom du fichier courrant
'                ou de celui entré par l'utilisateur
'                comme fichier à ouvrir
'  stc3  - Label pour edt1 edit edt1
'  cmb1  - Drop-down combo box affichant la liste des
'                types de filtres
'  stc2  - Label pour combo box cmb1
'  chx1  - Le crochet "Lecture seulement"
'  IDOK -  Le bouton OK (push button)
'  IDCANCEL - Le bouton Cancel (push button)
'  pshHelp - Le bouton Help (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
 
                '  passer le handle du dialogue rejeton
                hWndParent = apiGetParent(hwnd)
                '  cacher le combo des Disques
                Call apiSendMessage(hWndParent, CDM_HIDECONTROL, _
                        cmb2, ByVal 0&)
                '  Cacher l'étiquette  "Look In" 
                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)
 
                ' *** Access 97, remplacer la ligne précédante par
                ' 
                '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)
        ' *** Access 97, remplacer la ligne précédante par
        ' 
        ' .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
'  Retourne le nom de la classe sous Windows
'
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 *********