|
| | | |
 • III.5. API - Okna dialogowe:
- Otwórz plik / Zapisz plik •
- 5.1 Jak wyświetlić okno dialogowe " Otwórz plik " (możliwy wybór wielokrotny) lub
" Zapisz plik " i pobrać elementy składowe ścieżki pliku (przy wyborze jednego pliku) ?
- 5.2 Jak wyświetlić okno dialogowe " Otwórz plik " lub " Zapisz plik " - wersja uproszczona
(wybór tylko jednego pliku) ?
- 5.3 Jak wyświetlić okno dialogowe " Wybierz kolor " ?
- 5.4 Jak wyświetlić okno dialogowe " Wybierz folder " i pobrać nazwę pliku ?
| | | | |
 |
| | |
|
5.1 Jak wyświetlić okno dialogowe " Otwórz plik " (możliwy wybór wielokrotny) lub " Zapisz plik " i pobrać elementy składowe ścieżki pliku (przy wyborze jednego pliku) ?
Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
| lStructSize As Long | 'wielkość struktury w bajtach |
| hwndOwner As Long | 'uchwyt okna, z poziomu którego otwierane jest okno dialogowe, jeżeli 0 to okno dialogowe nie ma właściciela |
| hInstance As Long | |
| lpstrFilter As String | 'wskaźnik do bufora zawierającego ułożone parami i zakończone znakiem vbNullChar ciągi znaków: "nazwa opisowa" & vbNullChar & "maska" & vbNullChar, łańcuch musi kończyć się podwójnym znakiem vbNullChar |
| lpstrCustomFilter As Long | |
| nMaxCustrFilter As Long | |
| nFilterIndex As Long | 'jaki typ pliku z listy w lpstrFilter ma być domyślnym (pary ciągów numerowne są od 1) |
| lpstrFile As String | 'kompletna ścieżka z nazwami wybranych plików. Poszczególne nazwy plików są oddzielane od siebie znakiem vbNullChar, a cały łańcuch kończy podwójny vbNullChar |
| nMaxFile As Long | 'maksymalny rozmiar zwracanego ciągu lpstrFile |
| lpstrFileTitle As String | 'nazwy wybranego pliku |
| nMaxFileTitle As Long | 'maksymalny rozmiar zwracanego ciągu lpstrFileTitle |
| lpstrInitialDir As String | 'domyślny katalog wyboru |
| lpstrTitle As String | 'tekst tytułu okna |
| flags As Long | 'flagi określających właściwości wyświetlanego okna dialogowego |
| nFileOffset As Integer | 'przesunięcie do bajtów nazwy pliku |
| nFileExtension As Integer | 'przesunięcie do bajtów rozszerzenia pliku pliku |
| lpstrDefExt As String | 'domyślne rozszerzenie pliku |
| lCustrData As Long | |
| lpfnHook As Long | |
| lpTemplateName As Long | |
End Type
| Public Const OFN_READONLY = &H1 | 'zaznacz opcję CheckBox'a: "Otwórz tylko do odczytu" |
| Public Const OFN_OVERWRITEPROMPT = &H2 | 'tylko " Zapisz plik " - przy wyborze istniejącego pliku wyświetlaj komunikat: "Czy zamienić istniejący plik ?" |
| Public Const OFN_HIDEREADONLY = &H4 | 'niewidoczny jest CheckBox: "Otwórz tylko do odczytu" |
| Public Const OFN_NOCHANGEDIR = &H8 | 'nie zmieniaj bieżącej ścieżki Windows na wybraną w oknie dialogowym |
| Public Const OFN_SHOWHELP = &H10 | 'pokaz przycisk pomocy. |
| Public Const OFN_NOVALIDATE = &H100 | 'nie sprawdzaj poprawności wybranego pliku. |
| Public Const OFN_ALLOWMULTISELECT = &H200 | 'tylko w " Otwórz plik " - zezwól na wybieranie wielu plików |
| Public Const OFN_PATHMUSTEXIST = &H800 | 'wybór możliwy tylko dla istniejącej ścieżki |
| Public Const OFN_FILEMUSTEXIST = &H1000 | 'pozwól wybrać tylko istniejące pliki |
| Public Const OFN_CREATEPROMPT = &H2000 | 'tylko w " Otwórz plik " - pytaj przed utworzeniem nowego pliku |
| Public Const OFN_SHAREAWARE = &H4000 | 'ignoruj błędy współużytkowania plików |
| Public Const OFN_NONETWORKBUTTON = &H20000 | 'nie pokazuj przycisku sieć |
| Public Const OFN_NODEREFERENCELINKS = &H100000 | 'po wybrania skrótu'(.lnk lub .pif), zwracaj skrót, a nie związany plik |
| Public Const OFN_EXPLORER = &H80000 | 'otworz okno dialogowe typu Explorer dla "Otwórz plik" - opcja wyboru wielokrotnego |
Private Const MY_TITLE_SAVE As String = " Zapisz jako: "
Private Const MY_TITLE_OPEN As String = " Otwórz plik: "
Private Const MY_MAX_LEN As Long = 260
' powiększony buffor dla przypadku wielokrotnego wyboru plików
Private Const MY_MAX_BUFFER As Long = &H4000 ' 256 * 64
Public Const MY_FLAGS_SAVE As Long = _
OFN_NOCHANGEDIR Or _
OFN_PATHMUSTEXIST Or _
OFN_HIDEREADONLY Or _
OFN_NONETWORKBUTTON Or _
OFN_OVERWRITEPROMPT Or _
OFN_READONLY Or _
OFN_EXPLORER
Public Const MY_FLAGS_OPEN As Long = _
OFN_NOCHANGEDIR Or _
OFN_PATHMUSTEXIST Or _
OFN_HIDEREADONLY Or _
OFN_FILEMUSTEXIST Or _
OFN_NONETWORKBUTTON Or _
OFN_READONLY Or _
OFN_EXPLORER
Public Type MY_PATHTYPE
sPath As String
sDir As String
sFile As String
sExt As String
fCancel As Boolean
End Type
' otwiera okno dialogowe " Otwórz plik: " lub " Zapisz jako: "
' zwraca strukturę MY_PATHTYPE
' po anulowaniu wyboru pliku MY_PATHTYPE.fCancel = True
Public Function zbDlgSaveOpenFile(fSave As Boolean, _
Optional hOwner As Long = 0, _
Optional sTitle As String = "", _
Optional sInitDir As String = "", _
Optional sFilter As String = "", _
Optional lFilterIndex As Long = 0, _
Optional lFlags As Long = 0) As MY_PATHTYPE
On Error GoTo Err_Handler
Dim ofn As OPENFILENAME
Dim pt As MY_PATHTYPE
With ofn
.hwndOwner = hOwner
.hInstance = 0
.lpstrInitialDir = sInitDir
If Len(sTitle) = 0 Then
If fSave Then
.lpstrTitle = MY_TITLE_SAVE
Else
.lpstrTitle = MY_TITLE_OPEN
End If
Else
.lpstrTitle = sTitle
End If
If Len(sFilter) = 0 Then
.lpstrFilter = "Wszystkie (*.*)" & vbNullChar & "*.*" & _
vbNullChar & vbNullChar
Else
.lpstrFilter = sFilter & vbNullChar
End If
If lFlags = 0 Then
If fSave = True Then
.flags = MY_FLAGS_SAVE
Else
.flags = MY_FLAGS_OPEN
End If
Else
.flags = lFlags
End If
.nMaxFile = MY_MAX_LEN
' powiększ buffor dla wyboru wielokrotnego (tylko Otwórz pliki)
If lFlags And OFN_ALLOWMULTISELECT = _
OFN_ALLOWMULTISELECT Then
If fSave = False Then
.nMaxFile = MY_MAX_BUFFER
Else
.flags = MY_FLAGS_SAVE Or _
(.flags And Not OFN_ALLOWMULTISELECT)
End If
End If
.nFilterIndex = lFilterIndex
.lpstrFile = String(.nMaxFile, vbNullChar)
.nMaxFileTitle = MY_MAX_LEN
.lpstrFileTitle = String(.nMaxFileTitle, vbNullChar)
' określ długość zmiennej
.lStructSize = Len(ofn)
If fSave = True Then
pt.fCancel = Not CBool(GetSaveFileName(ofn))
Else
pt.fCancel = Not CBool(GetOpenFileName(ofn))
End If
If pt.fCancel = False Then
' składowe elementy ścieżki:
pt.sPath = Left$(.lpstrFile, _
InStr(.lpstrFile, vbNullChar & vbNullChar) - 1)
pt.sDir = Left$(.lpstrFile, .nFileOffset - 1)
pt.sFile = Left$(.lpstrFileTitle, _
InStr(.lpstrFileTitle, vbNullChar) - 1)
If .nFileExtension > 0 Then
pt.sExt = Right$(pt.sPath, Len(pt.sPath) - .nFileExtension)
End If
End If
End With
zbDlgSaveOpenFile = pt
Err_Exit:
Exit Function
Err_Handler:
MsgBox "Błąd nr " & Err.Number & vbNewLine & _
"Funkcja zbDlgSaveOpenFile" & vbNewLine & _
Err.Description
Resume Err_Exit
End Function
' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim ptRet As MY_PATHTYPE
Dim sFilter As String
Dim arrFiles() As String
Static sCurDir As String
Dim i As Long
' pobierz ścieżkę folderu bazy
If Len(sCurDir) = 0 Then
sCurDir = CurrentDb.Name
sCurDir = Left$(sCurDir, Len(sCurDir) - Len(Dir$(sCurDir)))
End If
sFilter = "Baza danych (*.mdb,*.mde)" & vbNullChar & _
"*.mdb;*.mde" & vbNullChar & _
"Tekstowe (*.txt)" & vbNullChar & "*.txt" & vbNullChar & _
"Wszystkie (*.*)" & vbNullChar & "*.*" & vbNullChar
' okno dialogowe - " Zapisz jako: "
' ptRet = zbDlgSaveOpenFile(True, , , sCurDir, sFilter)
' okno dialogowe - " Otwórz plik: " pliki *.txt z opcją wyboru wielokrotnego
ptRet = zbDlgSaveOpenFile(False, , , sCurDir, sFilter, , _
MY_FLAGS_OPEN Or OFN_ALLOWMULTISELECT)
With ptRet
If .fCancel = False Then
' zapamiętaj katalog
sCurDir = .sDir
' wybór wielokrotny: arrFiles(0) jest katalogiem,
' pozostałe elementy są plikami,
If Len(.sFile) = 0 Then
' Acc2000+
' arrFiles = Split(.sPath, vbNullChar, , vbBinaryCompare)
' Acc'97
zbSplit .sPath, arrFiles(), vbNullChar
Debug.Print i; ". Katalog: "; arrFiles(0)
For i = LBound(arrFiles) + 1 To UBound(arrFiles)
Debug.Print i; ". Pliki: "; arrFiles(i)
Next
Else
ReDim arrFiles(0 To 1)
arrFiles(0) = .sDir
arrFiles(1) = .sFile
Debug.Print 0; ". Katalog: "; arrFiles(0)
Debug.Print 1; ". Plik: "; arrFiles(1)
' szczegółowe informacje o pliku
Debug.Print "Pełna nazwa: " & .sPath & vbNewLine & _
"Katalog: " & .sDir & vbNewLine & _
"Plik: " & .sFile & vbNewLine & _
"Rozszerzenie: " & .sExt
End If
Else
Debug.Print "Anulowano wybór pliku(ów) !"
End If
End With
DoCmd.RunCommand acCmdDebugWindow
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
5.2 Jak wyświetlić okno dialogowe " Otwórz plik " lub " Zapisz plik "
- wersja uproszczona (wybór tylko jednego pliku) ?
Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
nMaxCustrFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustrData As Long
lpfnHook As Long
lpTemplateName As Long
End Type
Private Const OFN_ALLOWMULTISELECT = &H200
' otwiera okno dialogowe " Otwórz plik: " lub " Zapisz jako: " - tylko wybór jednego pliku
' zwraca pełną ścieżkę pliku, po anulowaniu wyboru pliku zwraca ciąg zerowej długości ""
Public Function zbDlgSaveOpenFileBis(fSave As Boolean, _
Optional hOwner As Long = 0, _
Optional sTitle As String = "", _
Optional sInitDir As String = "", _
Optional sFilter As String = "", _
Optional lFilterIndex As Long = 0, _
Optional lFlags As Long = 0) As String
Dim ofn As OPENFILENAME
With ofn
.hwndOwner = hOwner
.hInstance = 0
.lpstrInitialDir = sInitDir
If Len(sTitle) = 0 Then
If fSave Then
.lpstrTitle = " Zapisz jako: "
Else
.lpstrTitle = " Otwórz plik: "
End If
Else
.lpstrTitle = sTitle
End If
If Len(sFilter) = 0 Then
.lpstrFilter = "Wszystkie (*.*)" & vbNullChar & "*.*" & _
vbNullChar & vbNullChar
Else
.lpstrFilter = sFilter & vbNullChar
End If
.nFilterIndex = lFilterIndex
.nMaxFile = 260
.lpstrFile = String(.nMaxFile, vbNullChar)
.nMaxFileTitle = 260
.lpstrFileTitle = String(.nMaxFileTitle, vbNullChar)
If lFlags = 0 Then
If fSave = True Then
.flags = &HA080F
Else
.flags = &HA180D
End If
Else
.flags = lFlags
End If
' nie pozwól na wybór wielokrotny
If (lFlags And OFN_ALLOWMULTISELECT) = _
OFN_ALLOWMULTISELECT Then
.flags = .flags And (Not OFN_ALLOWMULTISELECT)
End If
' określ długość zmiennej
.lStructSize = Len(ofn)
If fSave = True Then
GetSaveFileName ofn
Else
GetOpenFileName ofn
End If
zbDlgSaveOpenFileBis = Left$(.lpstrFile, _
InStr(.lpstrFile, vbNullChar) - 1)
End With
End Function
' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim sFilter As String
Dim sRet As String
sFilter = "Baza danych (*.mdb,*.mde)" & vbNullChar & _
"*.mdb;*.mde" & vbNullChar & _
"Tekstowe (*.txt)" & vbNullChar & "*.txt" & vbNullChar & _
"Wszystkie (*.*)" & vbNullChar & "*.*" & vbNullChar
' okno dialogowe - " Zapisz jako: ""
sRet = zbDlgSaveOpenFileBis(True, , , "C:\", sFilter)
' okno dialogowe - " Otwórz plik: "
' sRet = zbDlgSaveOpenFileBis(False, , , "C:\", sFilter)
If Len(sRet) = 0 Then
MsgBox "Anulowano"
Else
MsgBox sRet
End If
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
5.3 Jak wyświetlić okno dialogowe "Wybierz kolor" ?
Private Declare Function ChooseColor Lib "comdlg32.dll" _
Alias "ChooseColorA" _
(pChoosecolor As CHOSECOLOR_TYPE) As Long
Private Type CHOSECOLOR_TYPE
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Const CC_RGBINIT = &H1
Private Const CC_FULLOPEN = &H2
' zwraca kolor wybrany przez użytkownika, jeżeli użytkownik nacisnął przycik Anuluj lub zamknął okno "X"-em - zwraca lDefColor, a zwracana ByRef zmienna lRetCancel = 0,
Private Function zbChooseColor(lRetCancel As Long, _
Optional lDefColor As Long = 0) As Long
Dim cc As CHOSECOLOR_TYPE
With cc
.lStructSize = Len(cc)
.flags = CC_FULLOPEN Or CC_RGBINIT
' zainicjuj kolory niestandardowe jako szare
.lpCustColors = String(16 * 4, 192)
.rgbResult = lDefColor
lRetCancel = ChooseColor(cc)
zbChooseColor = .rgbResult
End With
End Function
' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim lRetCanceled As Long
Dim lColor As Long
' UWAGA: po anulowaniu, funkcja ChooseColor zwraca domyślny kolor (tutaj vbRed), lub 0 (vbBlack) jeżeli nie był inicjowany kolor domyślny, jeżeli użytkownik anulował wybór koloru, wartość zmiennej ByRef lRetCanceled = 0
lColor = zbChooseColor(lRetCanceled, vbRed)
If lRetCanceled = 0 Then
MsgBox "Anulowano"
Else
MsgBox "Wybrano kolor: " & lColor
End If
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
5.4 Jak wyświetlić okno dialogowe "Wybierz folder" i pobrać nazwę pliku ?
Private Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Private Type BROWSEINFO
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Const CSIDL_DESKTOP = &H0
Private Const CSIDL_FAVORITES = &H6
Private Const SHGFP_TYPE_CURRENT = &H0
Private Const SHGFP_TYPE_DEFAULT = &H1
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_DONTGOBELOWDOMAIN = &H2
Private Const BIF_STATUSTEXT = &H4
Private Const BIF_RETURNFSANCESTORS = &H8
Private Const BIF_EDITBOX = &H10
Private Const BIF_VALIDATE = &H20
Private Const BIF_BROWSEFORCOMPUTER = &H1000
Private Const BIF_BROWSEFORPRINTER = &H2000
Private Const BIF_BROWSEINCLUDEFILES = &H4000
Private Const MY_MAX_LEN As Long = 260
' zwraca ścieżkę wybranego folderu (pliku), przy błędzie lub anulowaniu wyboru, zwraca ciąg zerowej długości,
Private Function zbBrowseFolder(lCSIDL As Long, _
sDialogTitle As String, _
lFlags As Long) As String
Dim lpIDList As Long
Dim sBff As String
Dim bi As BROWSEINFO
With bi
.pIDLRoot = lCSIDL
.hWndOwner = Me.hwnd
.lpszTitle = sDialogTitle
.ulFlags = lFlags
End With
lpIDList = SHBrowseForFolder(bi)
If (lpIDList) Then
sBff = String(MY_MAX_LEN, vbNullChar)
SHGetPathFromIDList lpIDList, sBff
zbBrowseFolder = Left$(sBff, InStr(sBff, vbNullChar) - 1)
End If
End Function
' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim sRet As String
sRet = zbBrowseFolder(CSIDL_FAVORITES, _
"Pokaż z plikami:", _
BIF_BROWSEINCLUDEFILES)
' sRet = zbBrowseFolder(CSIDL_DESKTOP, _
"Pokaż bez plików:", _
BIF_RETURNONLYFSDIRS)
If Len(sRet) = 0 Then
MsgBox "Anulowano"
Else
MsgBox "Wybrano: " & sRet
End If
End Sub
ΔΔΔ | | | | |
|
| |
