|
|
![]() |
|
||
|
|
|||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
||
| Visual Basic
Hook Routines GetOpenFileName: Customize File Open/Save Common Dialog Controls |
||
| Posted: | Wednesday June 07, 2000 | |
| Updated: | Monday December 26, 2011 | |
| Applies to: | VB5, VB6 | |
| Developed with: | VB6, Windows NT4 | |
| OS restrictions: | None | |
| Author: | VBnet - Randy Birch | |
| Related: | GetOpenFileName: File Open/Save Common Dialog API - Overview GetSaveFileName: File Save Common Dialog Basics GetOpenFileName: File Open Common Dialog Basics GetOpenFileName: File Dialog Centering using a Callback GetOpenFileName: Advanced Dialog Centering using a Callback |
|
| Prerequisites |
| None. |
|
|
Now
that you're an expert at centering a common dialog using hooks its time to look at customizing other aspects of the dialog window. A frequent
request is a method to set custom captions for the various buttons and static fields (labels) on the dialog. This page addresses this
request.
Again the OFN hook procedure is used to manipulate the various fields in the dialog. The common dialog supports a special message called CDM_SETCONTROLTEXT. By specifying the parent dialog handle and the ID for the control of interest, a simple SendMessage will change the respective fields to custom strings. All code to create the demo shown is below. Note that the path extraction code from previous demos has been removed to concentrate on the customizing code. See the detailed code and descriptions in the Overview and GetOpenFileName methods above for specifics on the actual dialog calls. Nov 8.2000: Modified code for centering the dialog in parent to prevent dialog cropping if form is smaller than the open/save dialog. Tested on NT4. |
| BAS Module Code |
|
|
| Place the following common code into the general declarations area of a bas module: |
|
|
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved. ' Some pages may also contain other copyrights by the author. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Distribution: You can freely use this code in your own ' applications, but you may not reproduce ' or publish this code on any web site, ' online service, or distribute as source ' on any media without express permission. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private m_dlgPosition As Integer
Private m_dlgHideOK As Integer
Private m_OKCaption As String
Private m_CancelCaption As String
Private m_LookInCaption As String
Private m_FileNameCaption As String
Private m_FileOfTypeCaption As String
Public Const OFN_ALLOWMULTISELECT As Long = &H200
Public Const OFN_CREATEPROMPT As Long = &H2000
Public Const OFN_ENABLEHOOK As Long = &H20
Public Const OFN_ENABLETEMPLATE As Long = &H40
Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Public Const OFN_EXPLORER As Long = &H80000
Public Const OFN_EXTENSIONDIFFERENT As Long = &H400
Public Const OFN_FILEMUSTEXIST As Long = &H1000
Public Const OFN_HIDEREADONLY As Long = &H4
Public Const OFN_LONGNAMES As Long = &H200000
Public Const OFN_NOCHANGEDIR As Long = &H8
Public Const OFN_NODEREFERENCELINKS As Long = &H100000
Public Const OFN_NOLONGNAMES As Long = &H40000
Public Const OFN_NONETWORKBUTTON As Long = &H20000
Public Const OFN_NOREADONLYRETURN As Long = &H8000& '*see comments
Public Const OFN_NOTESTFILECREATE As Long = &H10000
Public Const OFN_NOVALIDATE As Long = &H100
Public Const OFN_OVERWRITEPROMPT As Long = &H2
Public Const OFN_PATHMUSTEXIST As Long = &H800
Public Const OFN_READONLY As Long = &H1
Public Const OFN_SHAREAWARE As Long = &H4000
Public Const OFN_SHAREFALLTHROUGH As Long = 2
Public Const OFN_SHAREWARN As Long = 0
Public Const OFN_SHARENOWARN As Long = 1
Public Const OFN_SHOWHELP As Long = &H10
Public Const OFN_ENABLESIZING As Long = &H800000
Public Const OFS_MAXPATHNAME As Long = 260
'OFS_FILE_OPEN_FLAGS and OFS_FILE_SAVE_FLAGS below
'are mine to save long statements; they're not
'a standard Win32 type.
Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or _
OFN_LONGNAMES Or _
OFN_CREATEPROMPT Or _
OFN_NODEREFERENCELINKS
Public Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER Or _
OFN_LONGNAMES Or _
OFN_OVERWRITEPROMPT Or _
OFN_HIDEREADONLY
'windows version constants
Private Const VER_PLATFORM_WIN32_NT As Long = 2
Private Const OSV_LENGTH As Long = 76
Private Const OSVEX_LENGTH As Long = 88
Public OSV_VERSION_LENGTH As Long
Public Const WM_INITDIALOG As Long = &H110
Private Const SW_SHOWNORMAL As Long = 1
Private Const SM_CYCAPTION As Long = 4
Private Const WM_USER As Long = &H400
Private Const CDN_FIRST As Long = (-601)
Private Const CDM_FIRST = (WM_USER + 100)
Private Const CDM_SETCONTROLTEXT As Long = CDM_FIRST + &H4
Private Const CDM_HIDECONTROL As Long = (CDM_FIRST + &H5)
Private Const IDOK As Long = 1
Private Const IDCANCEL As Long = 2
Private Const IDFILEOFTYPETEXT As Long = &H441
Private Const IDFILENAMETEXT As Long = &H442
Private Const IDLOOKINTEXT As Long = &H443
Public Type OPENFILENAME
nStructSize As Long
hWndOwner As Long
hInstance As Long
sFilter As String
sCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
sFile As String
nMaxFile As Long
sFileTitle As String
nMaxTitle As Long
sInitialDir As String
sDialogTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
sDefFileExt As String
nCustData As Long
fnHook As Long
sTemplateName As String
pvReserved As Long 'new in Windows 2000 and later
dwReserved As Long 'new in Windows 2000 and later
FlagsEx As Long 'new in Windows 2000 and later
End Type
Public OFN As OPENFILENAME
Private Type OSVERSIONINFO
OSVSize As Long
dwVerMajor As Long
dwVerMinor As Long
dwBuildNumber As Long
PlatformID As Long
szCSDVersion As String * 128
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function GetOpenFileName Lib "comdlg32" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "comdlg32" _
Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" _
(ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Declare Function GetParent Lib "user32" _
(ByVal hwnd 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 MoveWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, _
lpRect As RECT) As Long
'defined As Any to support either the
'OSVERSIONINFO or OSVERSIONINFOEX structure
Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As Any) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Function IsWin2000Plus() As Boolean
'returns True if running Windows 2000 or later
Dim osv As OSVERSIONINFO
osv.OSVSize = Len(osv)
If GetVersionEx(osv) = 1 Then
IsWin2000Plus = (osv.PlatformID = VER_PLATFORM_WIN32_NT) And _
(osv.dwVerMajor = 5 And osv.dwVerMinor >= 0)
End If
End Function
Public Sub SetOSVersion()
Select Case IsWin2000Plus()
Case True
OSV_VERSION_LENGTH = OSVEX_LENGTH '5.0+ structure size
Case Else
OSV_VERSION_LENGTH = OSV_LENGTH 'pre-5.0 structure size
End Select
End Sub
Public Function FARPROC(ByVal pfn As Long) As Long
'A dummy procedure that receives and returns
'the return value of the AddressOf operator.
'Obtain and set the address of the callback
'This workaround is needed as you can't assign
'AddressOf directly to a member of a user-
'defined type, but you can assign it to another
'long and use that (as returned here)
FARPROC = pfn
End Function
Public Property Let DialogInitPosition(ByVal vNewValue As Integer)
m_dlgPosition = vNewValue
End Property
Public Property Let DialogHideOK(ByVal vNewValue As Boolean)
m_dlgHideOK = vNewValue
End Property
Public Property Let SetOKCaption(ByVal vNewValue As String)
m_OKCaption = vNewValue
End Property
Public Property Let SetCancelCaption(ByVal vNewValue As String)
m_CancelCaption = vNewValue
End Property
Public Property Let SetLookInCaption(ByVal vNewValue As String)
m_LookInCaption = vNewValue
End Property
Public Property Let SetFileNameCaption(ByVal vNewValue As String)
m_FileNameCaption = vNewValue
End Property
Public Property Let SetFileOfTypeCaption(ByVal vNewValue As String)
m_FileOfTypeCaption = vNewValue
End Property
Public Function OFNHookProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
'On initialization, set aspects of the
'dialog that are not obtainable through
'manipulating the OPENFILENAME structure members.
Dim hwndParent As Long
Dim rc As RECT
'temporary vars for demo
Dim newLeft As Long
Dim newTop As Long
Dim dlgWidth As Long
Dim dlgHeight As Long
Dim scrWidth As Long
Dim scrHeight As Long
Dim frmLeft As Long
Dim frmTop As Long
Dim frmWidth As Long
Dim frmHeight As Long
Select Case uMsg
Case WM_INITDIALOG
'obtain the handle to the parent dialog
hwndParent = GetParent(hwnd)
If hwndParent <> 0 Then
'Just to prove the handle was obtained,
'change the dialog's caption
Call SetWindowText(hwndParent, "I'm Hooked on Hooked Dialogs!")
'Get the current dialog size and position
Call GetWindowRect(hwndParent, rc)
'Once again, to show the calculations involved
'I'll use variables instead of creating a
'one-line MoveWindow call.
Select Case m_dlgPosition
Case 0: 'normal position
OFNHookProc = 0
Case 1: 'centered on screen
dlgWidth = rc.Right - rc.Left
dlgHeight = rc.Bottom - rc.Top
scrWidth = Screen.Width \ Screen.TwipsPerPixelX
scrHeight = Screen.Height \ Screen.TwipsPerPixelY
newLeft = (scrWidth - dlgWidth) \ 2
newTop = (scrHeight - dlgHeight) \ 2
Call MoveWindow(hwndParent, newLeft, newTop, dlgWidth, dlgHeight, True)
OFNHookProc = 1
Case 2: 'centered in parent
frmLeft = Form1.Left \ Screen.TwipsPerPixelX
frmTop = Form1.Top \ Screen.TwipsPerPixelY
frmWidth = Form1.Width \ Screen.TwipsPerPixelX
frmHeight = Form1.Height \ Screen.TwipsPerPixelX
dlgWidth = rc.Right - rc.Left
dlgHeight = rc.Bottom - rc.Top
scrWidth = Screen.Width \ Screen.TwipsPerPixelX
scrHeight = Screen.Height \ Screen.TwipsPerPixelY
newLeft = frmLeft + ((frmWidth - dlgWidth) \ 2)
If dlgHeight > frmHeight Then
newTop = frmTop + GetSystemMetrics(SM_CYCAPTION) + ((frmHeight - dlgHeight) \ 2)
Else
newTop = frmTop + GetSystemMetrics(SM_CYCAPTION)
End If
Call MoveWindow(hwndParent, newLeft, newTop, dlgWidth, dlgHeight, True)
OFNHookProc = 1
End Select
'If the hide check is set, hide the OK button.
'This simply shows how easy it is to hide
'unwanted control elements.
If m_dlgHideOK = True Then
Call SendMessage(hwndParent, CDM_HIDECONTROL, _
IDOK, ByVal 0&)
End If
'If the length of the variables > 0, set
'the new text to the respective control.
If Len(m_OKCaption) > 0 Then
Call SendMessage(hwndParent, CDM_SETCONTROLTEXT, _
IDOK, ByVal m_OKCaption)
End If
If Len(m_CancelCaption) > 0 Then
Call SendMessage(hwndParent, CDM_SETCONTROLTEXT, _
IDCANCEL, ByVal m_CancelCaption)
End If
If Len(m_LookInCaption) > 0 Then
Call SendMessage(hwndParent, CDM_SETCONTROLTEXT, _
IDLOOKINTEXT, ByVal m_LookInCaption)
End If
If Len(m_FileNameCaption) > 0 Then
Call SendMessage(hwndParent, CDM_SETCONTROLTEXT, _
IDFILENAMETEXT, ByVal m_FileNameCaption)
End If
If Len(m_FileOfTypeCaption) > 0 Then
Call SendMessage(hwndParent, CDM_SETCONTROLTEXT, _
IDFILEOFTYPETEXT, ByVal m_FileOfTypeCaption)
End If
End If
Case Else
End Select
End Function |
| Form Code |
|
|
| To a new project form add two command buttons (Command1, Command2), five Text boxes (Text1-Text5), a Checkbox (Check1), and three option buttons in a control array (Option(0) - Option(2)). Add the following code to the form: |
|
|
Option Explicit
Private Sub Form_Load()
Command1.Caption = "Get File Open"
Command2.Caption = "Get File Save"
Option1(0).Caption = "Normal position"
Option1(1).Caption = "Dialog centered in screen"
Option1(2).Caption = "Dialog centered in parent"
End Sub
Private Sub Check1_Click()
DialogHideOK = Check1.Value = 1
End Sub
Private Sub Option1_Click(Index As Integer)
DialogInitPosition = Index
End Sub
Private Sub Command1_Click()
Dim sFilters As String
'if first time through set the appropriate OFN size
If OSV_VERSION_LENGTH = 0 Then Call SetOSVersion
'assign the new caption properties as needed
SetOKCaption = Text1.Text
SetCancelCaption = Text2.Text
SetLookInCaption = Text3.Text
SetFileNameCaption = Text4.Text
SetFileOfTypeCaption = Text5.Text
'filters for the dialog
sFilters = "Visual Basic Forms" & vbNullChar & "*.frm" & vbNullChar & _
"Visual Basic Modules" & vbNullChar & "*.bas" & vbNullChar & _
"Visual Basic Projects" & vbNullChar & "*.vbp" & vbNullChar & _
"Text Files" & vbNullChar & "*.txt" & vbNullChar & _
"All Files" & vbNullChar & "*.*" & vbNullChar & vbNullChar
'populate the structure
With OFN
.nStructSize = OSV_VERSION_LENGTH
.hWndOwner = Me.hwnd
.sFilter = sFilters
.nFilterIndex = 2
.sFile = "Untitled.bas" & Space$(1024) & vbNullChar & vbNullChar
.nMaxFile = Len(.sFile)
.sDefFileExt = "bas" & vbNullChar & vbNullChar
.sFileTitle = vbNullChar & Space$(512) & vbNullChar & vbNullChar
.nMaxTitle = Len(OFN.sFileTitle)
.sInitialDir = "d:\vb5" & vbNullChar & vbNullChar
.sDialogTitle = "VBnet GetOpenFileName Demo"
.flags = OFS_FILE_OPEN_FLAGS Or _
OFN_ALLOWMULTISELECT Or _
OFN_ENABLESIZING Or _
OFN_ENABLEHOOK
.fnHook = FARPROC(AddressOf OFNHookProc)
End With
'call the API
Call GetOpenFileName(OFN)
End Sub
Private Sub Command2_Click()
Dim sFilters As String
'if first time through set the appropriate OFN size
If OSV_VERSION_LENGTH = 0 Then Call SetOSVersion
'assign the new caption properties as needed
SetOKCaption = Text1.Text
SetCancelCaption = Text2.Text
SetLookInCaption = Text3.Text
SetFileNameCaption = Text4.Text
SetFileOfTypeCaption = Text5.Text
'filters for the dialog
sFilters = "Visual Basic Forms" & vbNullChar & "*.frm" & vbNullChar & _
"Visual Basic Modules" & vbNullChar & "*.bas" & vbNullChar & _
"Visual Basic Projects" & vbNullChar & "*.vbp" & vbNullChar & _
"Text Files" & vbNullChar & "*.txt" & vbNullChar & _
"All Files" & vbNullChar & "*.*" & vbNullChar & vbNullChar
'populate the structure
With OFN
.nStructSize = OSV_VERSION_LENGTH
.hWndOwner = Me.hwnd
.sFilter = sFilters
.nFilterIndex = 2
.sFile = "Untitled.bas" & Space$(1024) & vbNullChar & vbNullChar
.nMaxFile = Len(.sFile)
.sDefFileExt = "bas" & vbNullChar & vbNullChar
.sFileTitle = vbNullChar & Space$(512) & vbNullChar & vbNullChar
.nMaxTitle = Len(OFN.sFileTitle)
.sInitialDir = "d:\vb5" & vbNullChar & vbNullChar
.sDialogTitle = "VBnet GetSaveFileName Demo"
.flags = OFS_FILE_SAVE_FLAGS Or _
OFN_ENABLESIZING Or _
OFN_ENABLEHOOK
.fnHook = FARPROC(AddressOf OFNHookProc)
End With
'call the API
Call GetSaveFileName(OFN)
End Sub |
| Comments |
| Set the text for any dialog member you want to customize,
select a position and show the dialog.
For a discussion on modifying the OPENFILENAME structure in order to display the new Windows 2000 or Windows XP-style Open and Save dialogs, please see the comments section in the page GetOpenFileName: File Dialog Centering using a Callback (note: a hook is not required to display this new-style dialog - it just so happens that page is the one I chose to explain this on.) Note re: OFN_NOREADONLYRETURN: This value is define in the header files as &H8000, which unfortunately is -32768 in VB. The correct value required 32768, so an ampersand (&) must be appended to this value to force VB to cast this to a Long. This is even true if the constant is defined As Long in the declare. If you use this constant in your apps and the file dialog either does not appear or the app crashes without an error, check this value. |
|
|
|
|
|
|||||
|
|||||
|
|
|||||
|
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |
![]() |