[VBnet Hooks] GetOpenFileName: File Dialog Centering using a Callback


	Visual Basic Hook Routines GetOpenFileName: File Dialog Centering using a Callback

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: Advanced Dialog Centering using a Callback GetOpenFileName: Customize File Open/Save Common Dialog Controls

Prerequisites

None.

The Common Dialog API provides a simple and powerful replacement to the Common Dialog control for projects using the file open or save methods. Not burdened by the baggage of properties, the API solutions also offer a significant performance increase. And all this comes in calls that still allow many of the post-call methods you may have in place to continue to work unmodified.

Yet perhaps the singly most annoying problem with the common dialog controls, API or OCX alike, is its default positioning of the control at the client window's top/left edge. Microsoft could have easily provided a method to position as desired. This page provides that method via the AddressOf function to call a user-defined hook (callback) procedure that centres on screen the common dialog created with GetOpenFileName or GetSaveFileName API.

Built on the same code base as GetOpenFileName: File Open Common Dialog Basics above, here we add two additional parameters to the OFN structure to enable the hooking ability: an additional flag to the structure's .flags member - OFN_ENABLEHOOK, and assignment of the .fhook member to the AddressOf our hook procedure.

Within the hook, we watch for the WM_INITDIALOG message to be sent. WM_INITDIALOG is sent when to the dialog box procedure immediately before a dialog box is displayed. At this point we can execute our own methods to initialize controls and affect the appearance of the final dialog.

In this demo, when the WM_INITDIALOG message is received, the window handle to the parent dialog is retrieved using GetParent. The current window rect is retrieved using GetWindowRect, and calculations are performed to determine a centred position for the dialog. Finally, MoveWindow is called to reposition the dialog to the new coordinates, and the hook ends. The dialog appears centred on-screen. Other messages are subsequently passed to the hook procedure while the user interacts with the dialog, but those are not covered in this demo.

While this code includes the complete code necessary to reproduce this demo, the original code comments that do not pertain to the newly added methods have been removed. Refer to the Overview and GetOpenFileName pages for the comments on the principles behind the various bits of common control code.

BAS Module Code

Place the following 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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

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

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   

Public 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 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



Public Function FARPROC(ByVal pfn As Long) As Long
  
  '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 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
            
   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!")
            
           'Position the dialog in the centre of
           'the screen. First get the current dialog size.
            Call GetWindowRect(hwndParent, rc)
            
           '(To show the calculations involved, I've
           'used variables instead of creating a
           'one-line MoveWindow call)
            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
            
           '..and set the new dialog position.
            Call MoveWindow(hwndParent, newLeft, newTop, dlgWidth, dlgHeight, True)
            
            OFNHookProc = 1
            
         End If
         
         Case Else
         
   End Select

End Function


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

Form Code

To a new project form add two command buttons (Command1, Command2), seven Text boxes (Text1-Text7), a List (List1) and a Checkbox (Check1).

The text boxes are oriented beginning with the first label/textbox as Text/Label #1, the next #2 and so on. Add the following code to the form:

Option Explicit

Private Sub Form_Load()

   Command1.Caption = "Get File Open"
   Command2.Caption = "Get File Save"
   
End Sub


Private Sub Command1_Click()

   Dim sFilters As String
   Dim pos As Long
   Dim buff As String
   Dim sLongname As String
   Dim sShortname As String
   
  'if first time through set the appropriate OFN size
   If OSV_VERSION_LENGTH = 0 Then Call SetOSVersion 

  '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:\vbnet" & 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
   If GetOpenFileName(OFN) Then
    
      buff = Trim$(Left$(OFN.sFile, Len(OFN.sFile) - 2))
      Do While Len(buff) > 3
         List1.AddItem StripDelimitedItem(buff, vbNullChar)
      Loop
      Text1.Text = OFN.sFile
      Text2.Text = Left$(OFN.sFile, OFN.nFileOffset)
      Text3.Text = Mid$(OFN.sFile, OFN.nFileOffset + 1, Len(OFN.sFile) - OFN.nFileOffset - 1)
      Text4.Text = Mid$(OFN.sFile, OFN.nFileExtension + 1, Len(OFN.sFile) - OFN.nFileExtension)
      Text5.Text = OFN.sFileTitle
      
      sLongname = OFN.sFileTitle
      sShortname = Space$(128)
      pos = GetShortPathName(sLongname, sShortname, Len(sShortname))
      Text6.Text = LCase$(Left$(sShortname, pos))
     
      sLongname = OFN.sFile
      sShortname = Space$(128)
      pos = GetShortPathName(sLongname, sShortname, Len(sShortname))
      Text7.Text = LCase$(Left$(sShortname, pos))
  
      Check1.Value = Abs((OFN.flags And OFN_READONLY))
  
  End If

End Sub


Private Sub Command2_Click()

   Dim sFilters As String
   Dim pos As Long
   Dim buff As String
   Dim sLongname As String
   Dim sShortname As String
   
  'if first time through set the appropriate OFN size
   If OSV_VERSION_LENGTH = 0 Then Call SetOSVersion   

  '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
 
   With OFN
   
      .nStructSize = OSV_VERSION_LENGTH
      .hWndOwner = Form1.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
   If GetSaveFileName(OFN) Then
    
      buff = Trim$(Left$(OFN.sFile, Len(OFN.sFile) - 2))

      Do While Len(buff) > 3
         List1.AddItem StripDelimitedItem(buff, vbNullChar)
      Loop
   
      Text1.Text = OFN.sFile
      Text2.Text = Left$(OFN.sFile, OFN.nFileOffset)
      Text3.Text = Mid$(OFN.sFile, OFN.nFileOffset + 1, Len(OFN.sFile) - OFN.nFileOffset - 1)
      Text4.Text = Mid$(OFN.sFile, OFN.nFileExtension + 1, Len(OFN.sFile) - OFN.nFileExtension)
      Text5.Text = OFN.sFileTitle
      
      sLongname = OFN.sFileTitle
      sShortname = Space$(128)
      pos = GetShortPathName(sLongname, sShortname, Len(sShortname))
      Text6.Text = LCase$(Left$(sShortname, pos))
     
      sLongname = OFN.sFile
      sShortname = Space$(128)
      pos = GetShortPathName(sLongname, sShortname, Len(sShortname))
      Text7.Text = LCase$(Left$(sShortname, pos))
  
      Check1.Value = Abs((OFN.flags And OFN_READONLY))
  
  End If
  
End Sub


Private Function StripDelimitedItem(startStrg As String, _
                                    delimiter As String) As String

  'take a string separated by nulls,
  'split off 1 item, and shorten the string
  'so the next item is ready for removal.
   Dim pos As Long
   
   pos = InStr(1, startStrg, delimiter)
   
   If pos Then

      StripDelimitedItem = Mid$(startStrg, 1, pos)
      startStrg = Mid$(startStrg, pos + 1, Len(startStrg))
    
   End If

End Function


Private Function TrimNull(item As String) As String

   Dim pos As Integer
   
   pos = InStr(item, Chr$(0))
   If pos Then
         TrimNull = Left$(item, pos - 1)
   Else: TrimNull = item
   End If
  
End Function

Comments

The Open or Save dialog will appear centred on-screen. Once the dialog has closed, the file details for the selected or new file(s) will be returned on the form.

Windows' New Open and Save Dialog Style

Beginning with Windows 2000, the OPENFILENAME structure was extended to include three additional parameters specific to Windows 2000 and Windows XP. These additions change the size of the structure passed as the .nStructSize member which Windows uses to determine whether it should display the old or new-style dialogs. However, passing the new extended structure on a Win9x or NT4 system will result in the Open File or Save File dialog not being displayed at all. Thankfully, because of the nStructSize parameter, you can go ahead and define the type with the new members regardless of the system, and then during the call identify the operating system in use and modify the value passed as the nStructSize parameter as appropriately.

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

 'new Win2000 / WinXP members 
  pvReserved        As Long
  dwReserved        As Long
  FlagsEx           As Long
End Type

Public OFN As OPENFILENAME

To assure that the new dialog appears as expected, you must ensure that Len(OFN) is passed as the nStructSize parameter, and likewise to ensure the dialog appears on lower versions of windows, you can pass Len(OFN - 12) (12 = 3 longs of 4 bytes each). Foremost is using OPENFILENAME successfully (when you want do display the dialog appropriate to the operating system) is making a call to the OS to determine the Windows version in use. Calling the IsWin2000Plus will return True for 2000 and XP, and False for all other versions. Based on this info the appropriate value is assigned to nStructSize.

Private Sub Command1_Click()

  '<filter setup and other pre-call methods>

  'populate the OPENFILENAME structure
   With OFN
      
      If IsWin2000Plus() Then
         .nStructSize = Len(OFN)
        '.FlagsEx=(whatever) - any FlagsEx values desired;
      Else
         .nStructSize = Len(OFN) - 12
      End If
      
      .hWndOwner = Form1.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:\vbnet" & vbNullChar & vbNullChar
      .sDialogTitle = "VBnet GetOpenFileName Demo"
      .flags = OFS_FILE_OPEN_FLAGS Or _
               OFN_ALLOWMULTISELECT Or _
               OFN_EXPLORER Or _
               OFN_ENABLEHOOK
      .fnHook = FARPROC(AddressOf OFNHookProc)
      
         
   End With
      
   Call GetOpenFileName(OFN)  

End Sub

A variation on the If .. Then test is to use an IIf() test condition instead when you only need to set .nStructSize, and not FlagsEx ...

   .nStructSize = IIf(IsWin2000Plus(), Len(OFN), Len(OFN)- 12)

IsWin2000Plus() can be found on the GetVersionEx: Windows Version Info (Wrapper Routines) page.

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.

PayPal Link