OpenFile - WIN API

Отварям с API диалоговия прозорец за избор на файл. Как да направя така че той да се появява винаги в центъра на екрана.

nqkyde trqbva da ima kato property 'StartUpPosition', kato 'vbStartUpScreen' vizualizira formata v centera na ekrana

това е кода който ползвам. някой неща съм взел готови.



Option Explicit

Private strDialogTitle As String ' Dialogtitel
Private strFilter As String ' Filter kann man sowohl wie gehabt definieren als
' auch ьber die folgenden Paare Text/Suffix
Private lngFlags As Long ' Flags
Private strDefaultExt As String ' Standard-Endung
Private strInitDir As String ' Start-Verzeichnis
Private strFilterText(5) As String ' z.B. "Text-Dateien"
Private strFilterSuffix(5) As String ' z.B. "*.txt"
Private strDateiName As String ' zurьckgegebener Dateiname
Private cnstNull As String * 1 ' NULL-String
Private oFileList As Collection

Private Type TOpenFileName
lStructSize As Long ' Lдnge des Datentyps OPENFILENAME
hwndOwner As Long ' Fenster, unter dem Dialog erscheint
hInstance As Long ' nicht verwendet
lpstrFilter As String ' Zeichenkette von Anzeigenfiltern im Dialog
lpstrCustomFilter As String ' nicht verwendet
nMaxCustFilter As Long ' nicht verwendet
nFilterIndex As Long ' 1 zum Benutzen des ersten Filters, 2 zum zweiten usw.
lpstrFile As String ' String, der ausgewдhlte Datei bekommt
nMaxFile As Long ' Lдnge von lpstrFile
lpstrFileTitle As String ' Dateiname ohne Pfad (kann auch mit VBA ermittelt werden, also weglassen)
nMaxFileTitle As Long ' nicht verwendet
lpstrInitialDir As String ' Ordner, in dem Dialog sich zuerst befinden soll
lpstrTitle As String ' Titel des eigentlichen Dialogfensters
Flags As Long ' verschiedene Optionen, die durch Konstanten eingestellt werden
nFileOffset As Integer ' nicht verwendet
nFileExtension As Integer ' nicht verwendet
lpstrDefExt As String ' Erweiterung, die genommen wird, wenn keine eingegeben wurde
lCustData As Long ' nicht verwendet
lpfnHook As Long ' nicht verwendet
lpTemplateName As Long ' nicht verwendet
End Type

Private Declare Function APT_GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As TOpenFileName) As Long
Private Declare Function APT_GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As TOpenFileName) As Long


Private Function BuildFilter() As String

Dim MyFilter As String
Dim i As Integer

For i = 1 To UBound(strFilterText)
If strFilterText(i) <> "" And strFilterSuffix(i) <> "" Then
MyFilter = MyFilter & strFilterText(i) & cnstNull & strFilterSuffix(i) & cnstNull
End If
Next

If strFilter <> "" Then
Do While Right(strFilter, 1) = cnstNull
strFilter = Left(strFilter, Len(strFilter) - 1)
Loop

MyFilter = strFilter & cnstNull & MyFilter
End If

If MyFilter = "" Then MyFilter = "All Files" & cnstNull & "*.*"

MyFilter = MyFilter & cnstNull & cnstNull

BuildFilter = MyFilter

End Function

Private Sub CheckFlags(Intention As String)

If lngFlags <> 0 Then Exit Sub

Select Case Intention:
Case "Open":
'lngFlags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST Or OFN_READONLY
Case "Save":
'lngFlags = OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT
Case Else:
MsgBox "Unbekannte Intention: " & Intention, vbOKOnly + vbCritical, "CheckFlags"
End Select
End Sub

Property Let DefaultExt(strAktDefaultExt As String)
strDefaultExt = strAktDefaultExt & cnstNull
End Property

Property Let DialogTitle(Title As String)
strDialogTitle = Title & cnstNull
End Property

Property Get fileName()
fileName = strDateiName
End Property

Property Let Filter(aktFilter As String)
If Len(aktFilter) >= 2 And Right(aktFilter, 2) = cnstNull & cnstNull Then
strFilter = aktFilter
Else
strFilter = aktFilter & cnstNull & cnstNull
End If

End Property

Property Let Filter1Text(FilterText As String)
strFilterText(1) = FilterText
End Property
Property Let Filter2Text(FilterText As String)
strFilterText(2) = FilterText
End Property
Property Let Filter3Text(FilterText As String)
strFilterText(3) = FilterText
End Property

Property Let Filter4Text(FilterText As String)
strFilterText(4) = FilterText
End Property

Property Let Filter5Text(FilterText As String)
strFilterText(5) = FilterText
End Property

Property Let Filter1Suffix(FilterSuffix As String)
strFilterSuffix(1) = FilterSuffix
End Property

Property Let Filter2Suffix(FilterSuffix As String)
strFilterSuffix(2) = FilterSuffix
End Property
Property Let Filter3Suffix(FilterSuffix As String)
strFilterSuffix(3) = FilterSuffix
End Property
Property Let Filter4Suffix(FilterSuffix As String)
strFilterSuffix(4) = FilterSuffix
End Property
Property Let Filter5Suffix(FilterSuffix As String)
strFilterSuffix(5) = FilterSuffix
End Property

Property Get FileList() As Collection
Set FileList = oFileList
End Property

Property Let Flags(lngAktFlags As Long)
lngFlags = lngAktFlags
End Property

Property Let InitDir(strAktInitDir As String)
strInitDir = strAktInitDir & cnstNull
End Property

Function ShowOpen() As String
On Error GoTo Error_ShowOpen

Dim MyFilter As String
Dim OpenDlg As TOpenFileName
Dim lEndPos As Long
Dim lCurBegPos As Long
Dim lCurEndPos As Long
Dim sDelimiter As String

MyFilter = BuildFilter()
Call CheckFlags("Open")

If strDialogTitle = "" Then
strDialogTitle = "Open Files" & cnstNull
End If

With OpenDlg
.lStructSize = Len(OpenDlg)
.lpstrFilter = MyFilter
.nFilterIndex = 1
.lpstrFile = strDateiName
.nMaxFile = Len(strDateiName)
.lpstrInitialDir = strInitDir
.lpstrTitle = strDialogTitle
.Flags = lngFlags
.lpstrDefExt = strDefaultExt

If APT_GetOpenFileName(OpenDlg) <> 0 Then
strDateiName = Left$(.lpstrFile, InStr(.lpstrFile, cnstNull) - 1)

Set oFileList = New Collection
lEndPos = InStr(1, .lpstrFile, cnstNull + cnstNull, vbBinaryCompare)
lCurBegPos = InStr(1, .lpstrFile, cnstNull, vbBinaryCompare)
lCurEndPos = InStr(lCurBegPos + 1, .lpstrFile, cnstNull, vbBinaryCompare)

If lEndPos <= lCurEndPos Then
sDelimiter = ""
Else
sDelimiter = "\"
End If

Do
oFileList.Add strDateiName & sDelimiter & Mid(.lpstrFile, lCurBegPos + 1, lCurEndPos - lCurBegPos)
lCurBegPos = lCurEndPos
lCurEndPos = InStr(lCurBegPos + 1, .lpstrFile, cnstNull, vbBinaryCompare)
Loop Until lEndPos <= lCurBegPos


ShowOpen = strDateiName
Else
strDateiName = ""
ShowOpen = ""
End If
End With

Exit_ShowOpen:
Exit Function
Error_ShowOpen:
MsgBox Error$, , "Грешка при Open File Dialog"
Resume Exit_ShowOpen
End Function


Function ShowSave() As String
On Error GoTo Error_ShowSave

Dim MyFilter As String
Dim OpenDlg As TOpenFileName

MyFilter = BuildFilter()
Call CheckFlags("Save")

If strDialogTitle = "" Then
strDialogTitle = "Datei speichern unter" & cnstNull
End If

With OpenDlg
.lStructSize = Len(OpenDlg)
.lpstrFilter = MyFilter
.nFilterIndex = 1
.lpstrFile = strDateiName
.nMaxFile = Len(strDateiName)
.lpstrInitialDir = strInitDir
.lpstrTitle = strDialogTitle
.Flags = lngFlags
.lpstrDefExt = strDefaultExt

If APT_GetSaveFileName(OpenDlg) <> 0 Then
strDateiName = Left$(.lpstrFile, InStr(.lpstrFile, cnstNull) - 1) ' restliche NUL-Werte abschneiden
ShowSave = strDateiName
Else
strDateiName = ""
ShowSave = ""
End If
End With

Exit_ShowSave:
Exit Function
Error_ShowSave:
MsgBox Error$, , "Грешка при Show Save Dialog"
Resume Exit_ShowSave
End Function

Private Sub Class_Initialize()
On Error GoTo Error_Class_Initialize

cnstNull = Chr$(0)
strDateiName = String$(512, 0)
strDialogTitle = ""
strFilter = ""
lngFlags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST
strDefaultExt = cnstNull
strInitDir = CurDir$ & cnstNull

Exit_Class_Initialize:
Exit Sub
Error_Class_Initialize:
MsgBox Error$, , "Грешка при инициализация на клас"
Resume Exit_Class_Initialize
End Sub