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:
- You will need to copy the GetOpenFileName code
in another module.
- 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).
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
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)
Private Const cmb1 = &H470
Private Const cmb2 = &H471
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
Private Const stc1 = &H440
Private Const stc2 = &H441
Private Const stc3 = &H442
Private Const stc4 = &H443
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
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
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
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
Private Const IDOK = 1
Private Const IDCANCEL = 2
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:
Dim hWndParent As Long
hWndParent = apiGetParent(hwnd)
Call apiSendMessage(hWndParent, CDM_HIDECONTROL, _
cmb2, ByVal 0&)
Call apiSendMessage(hWndParent, CDM_HIDECONTROL, _
stc4, ByVal 0&)
Call apiSendMessage(hWndParent, CDM_HIDECONTROL, _
chx1, ByVal 0&)
Call apiSendMessage(hWndParent, CDM_SETCONTROLTEXT, _
IDOK, ByVal "AddrOf Rulez!")
Call apiSendMessage(hWndParent, CDM_SETCONTROLTEXT, _
IDCANCEL, ByVal "Doh!")
Call apiEnumChildWindows(hWndParent, _
AddressOf fEnumChildProc, 0)
blnRetVal = False
Case CDN_SELCHANGE:
Case CDN_FOLDERCHANGE:
blnRetVal = False
Case CDN_SHAREVIOLATION:
blnRetVal = False
Case CDN_HELP:
blnRetVal = False
Case CDN_FILEOK:
blnRetVal = False
Case CDN_TYPECHANGE:
blnRetVal = False
Case CDN_INCLUDEITEM:
blnRetVal = False
End Select
End If
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)
.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
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
|