Position the GetOpenFileName dialog?

[utc13]

I am currently using the GetOpenFileName method to open the dialog and retrieve a path. However the dialog appears in the upper left corner of the screen. Is there a way to position it in the center of the screen?

 

[oharab]

Yes, but it's not at all pretty and definately not supported by Microsoft!
What version of access are you using?

B ----------------------------------------
Ben O'Hara

http://www.RobotParade.co.uk

----------------------------------------

 

[utc13]

I'm using Access 2002 (10.3409.3501) SP-1

 

[oharab]

ok then, I have tried this on Access 2000 running WinNT 4 and it works. There is no real reason why it shouldn't work on win 2000 or XP either.
If you want to use Access 97 you will need to ask for the replacement to the addressof command. I have that somewhere.

Here we go:

Create a module in your db called mdlHook (the name is immaterial!)
In this module paste all this code:

'--------------------------------------------------------------
' Copyright ©1996-2002 VBnet, Randy Birch, All Rights Reserved.
' Terms of use

http://www.mvps.org/vbnet/terms/pages/terms.htm

'--------------------------------------------------------------

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

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
End Type

Public OFN As OPENFILENAME

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

'new additions to original code
'supporting the Hook method
Public Const WM_INITDIALOG = &H110
Private Const SW_SHOWNORMAL = 1

Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Public Declare Function GetParent Lib "user32" _
(ByVal hwnd As Long) As Long

Public Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long

Public 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

Public Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, _
lpRect As RECT) As Long

Public Declare Function GetDesktopWindow Lib "user32" () 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


'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 = GetScreenWidth
scrHeight = GetScreenHeight

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

Function GetScreenWidth()
Dim rct As RECT
Call GetWindowRect(GetDesktopWindow(), rct)
GetScreenWidth = rct.Right
End Function

Function GetScreenHeight()
Dim rct As RECT
Call GetWindowRect(GetDesktopWindow(), rct)
GetScreenHeight = rct.Bottom
End Function


Now create another module (I've called mine mdlCall)
and paste this lot into it:

'--------------------------------------------------------------
' Copyright ©1996-2002 VBnet, Randy Birch, All Rights Reserved.
' Terms of use

http://www.mvps.org/vbnet/terms/pages/terms.htm

'--------------------------------------------------------------

Option Explicit

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


Function CallOpenSaveDialog()

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 = &quot;Visual Basic Forms&quot; & vbNullChar & &quot;*.frm&quot; & vbNullChar & _
&quot;Visual Basic Modules&quot; & vbNullChar & &quot;*.bas&quot; & vbNullChar & _
&quot;Visual Basic Projects&quot; & vbNullChar & &quot;*.vbp&quot; & vbNullChar & _
&quot;Text Files&quot; & vbNullChar & &quot;*.txt&quot; & vbNullChar & _
&quot;All Files&quot; & vbNullChar & &quot;*.*&quot; & vbNullChar & vbNullChar

'populate the structure
With OFN

.nStructSize = Len(OFN)
.hWndOwner = Access.hWndAccessApp
.sFilter = sfilters
.nFilterIndex = 2
.sFile = &quot;Untitled.bas&quot; & Space$(1024) & vbNullChar & vbNullChar
.nMaxFile = Len(.sFile)
.sDefFileExt = &quot;bas&quot; & vbNullChar & vbNullChar
.sFileTitle = vbNullChar & Space$(512) & vbNullChar & vbNullChar
.nMaxTitle = Len(OFN.sFileTitle)
.sInitialDir = &quot;d:\vb5&quot; & vbNullChar & vbNullChar
.sDialogTitle = &quot;VBnet GetOpenFileName Demo&quot;
.flags = OFS_FILE_OPEN_FLAGS Or _
OFN_ALLOWMULTISELECT 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
' Debug.Print StripDelimitedItem(buff, vbNullChar)
'Loop
'Debug.Print OFN.sFile
'Debug.Print Left$(OFN.sFile, OFN.nFileOffset)
'Debug.Print Mid$(OFN.sFile, OFN.nFileOffset + 1, Len(OFN.sFile) - OFN.nFileOffset - 1)
'Debug.Print Mid$(OFN.sFile, OFN.nFileExtension + 1, Len(OFN.sFile) - OFN.nFileExtension)
'Debug.Print OFN.sFileTitle

'Debug.Print OFN.sFileTitle
sShortname = Space$(128)
pos = GetShortPathName(sLongname, sShortname, Len(sShortname))
'Debug.Print LCase$(Left$(sShortname, pos))

sLongname = OFN.sFile
sShortname = Space$(128)
pos = GetShortPathName(sLongname, sShortname, Len(sShortname))
'Debug.Print LCase$(Left$(sShortname, pos))

'Debug.Print Abs((OFN.flags And OFN_READONLY))

CallOpenSaveDialog = TrimNull(OFN.sFile)

End If

End Function

Sub Test()
Dim strFilter As String

CallOpenSaveDialog (strFilter)
End Sub



the Function CallOpenSaveDialog is what calls the dialog box and it this you need to play with to customize your dialog.
I have to say I don't totally get what is happening here, so don't expect too much in the way of support, but if you get stuck, let me know what you want to so & I will have a go at fixing it for you.

Cheers

Ben ----------------------------------------
Ben O'Hara

http://www.RobotParade.co.uk

----------------------------------------