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

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