Visual Basic Hook Routines
GetOpenFileName: Advanced 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: File Dialog Centering using a Callback
GetOpenFileName: Customize File Open/Save Common Dialog Controls
     
 Prerequisites
None.

GetOpenFileName: File Dialog Centering using a Callback showed just how simple implementing a window hook for the OPENFILENAME structure can be. Here we expand upon that same code to provide additional positioning options - centred to the screen, to the parent form, or allow the dialog to take its default position. The method could be further enhanced to provide the ability to specify exact coordinates, or to even restore the dialog to its position on last closing.

Again, as this code fully creates the demo routine shown the code comments are at a minimum. Detailed explanations for the primary API calls can be found in the Overview and GetOpenFileName pages above.

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 Win NT4 and Win 2000.

Jun 7.2004: Added code to display new dialog on Windows 2000 and later.

 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 Long

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

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
 
 

Public Property Let DialogInitPosition(ByVal dlgPosition As Integer)

   m_dlgPosition = dlgPosition
   
End Property


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 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
            
         End If
         
         Case Else
         
   End Select

End Function
 Form Code
To a new project form add two command buttons (Command1 and Command2), seven Text boxes (Text1-Text7), a List (List1) and a Checkbox (Check1). Add three option buttons in a control array (Option1(0) to Option1(2)) - the frame control is optional. 

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"
   Option1(0).Caption = "Normal position"
   Option1(1).Caption = "Dialog centered in screen"
   Option1(2).Caption = "Dialog centered in parent"   

End Sub


Private Sub Option1_Click(Index As Integer)

  'set the bas module's DialogInitPosition
  'to reflect the option button index chosen
   DialogInitPosition = Index
   
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 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 = 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 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

  '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 = Len(OFN)
      .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
 Comments
The Open or Save dialog will appear positioned as selected in the option buttons. Once the dialog has closed, the file details for the selected or new file(s) will be returned on the form.

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.


 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter