forked from WindowStations/VB6NameSpaces
-
Notifications
You must be signed in to change notification settings - Fork 0
/
OpenFileDialog.cls
287 lines (283 loc) · 10.3 KB
/
OpenFileDialog.cls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
VERSION 1.0 CLASS
BEGIN
MultiUse = -1
Persistable = 0
DataBindingBehavior = 0
DataSourceBehavior = 0
MTSTransactionMode = 0
END
Attribute VB_Name = "OpenFileDialog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'VERSION 1.0 CLASS
'BEGIN
' MultiUse = -1 'True
' Persistable = 0 'NotPersistable
' DataBindingBehavior = 0 'vbNone
' DataSourceBehavior = 0 'vbNone
' MTSTransactionMode = 0 'NotAnMTSObject
'END
'Attribute VB_Name = "OpenFileDialog"
'Attribute VB_GlobalNameSpace = False
'Attribute VB_Creatable = True
'Attribute VB_PredeclaredId = False
'Attribute VB_Exposed = False
'Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
'Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'Option Explicit
Private Const OFN_ALLOWMULTISELECT As Long = &H200
Private Const OFN_CREATEPROMPT As Long = &H2000
Private Const OFN_ENABLEHOOK As Long = &H20
Private Const OFN_ENABLETEMPLATE As Long = &H40
Private Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Private Const OFN_EXPLORER As Long = &H80000 ' new look commdlg
Private Const OFN_EXTENSIONDIFFERENT As Long = &H400
Private Const OFN_FILEMUSTEXIST As Long = &H1000
Private Const OFN_HIDEREADONLY As Long = &H4
Private Const OFN_LONGNAMES As Long = &H200000
Private Const OFN_NOCHANGEDIR As Long = &H8
Private Const OFN_NODEREFERENCELINKS As Long = &H100000
Private Const OFN_NOLONGNAMES As Long = &H40000
Private Const OFN_NONETWORKBUTTON As Long = &H20000
Private Const OFN_NOREADONLYRETURN As Long = &H8000& '*see comments
Private Const OFN_NOTESTFILECREATE As Long = &H10000
Private Const OFN_NOVALIDATE As Long = &H100
Private Const OFN_OVERWRITEPROMPT As Long = &H2
Private Const OFN_PATHMUSTEXIST As Long = &H800
Private Const OFN_READONLY As Long = &H1
Private Const OFN_SHAREAWARE As Long = &H4000
Private Const OFN_SHAREFALLTHROUGH As Long = 2
Private Const OFN_SHAREWARN As Long = 0
Private Const OFN_SHARENOWARN As Long = 1
Private Const OFN_SHOWHELP As Long = &H10
Private Const OFN_ENABLESIZING As Long = &H800000
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustomFilter 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
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare Function apiGetOpenFileName Lib "comdlg32" Alias "GetOpenFileNameA" (ByRef lpofn As OPENFILENAME) As Long
Private mvarAddExtension As Boolean
Private mvarAutoUpgradeEnabled As Boolean
Private mvarCheckFileExists As Boolean
Private mvarCheckPathExists As Boolean
Private mvarDefaultExt As String
Private mvarDereferenceLinks As Boolean
Private mvarFileName As String
Private mvarFileNames() As String
Private mvarFilter As String
Private mvarFilterIndex As Long
Private mvarInitialDirectory As String
Private mvarReadOnlyChecked As Boolean
Private mvarRestoreDirectory As Boolean
Private mvarSafeFileName As String
Private mvarSafeFileNames() As String
Private mvarShowHelp As Boolean
Private mvarShowReadOnly As Boolean
Private mvarSupportMultiDottedExtensions As Boolean
Private mvarTag As Object
Private mvarTitle As String
Private mvarValidateNames As Boolean
Friend Property Let AddExtension(ByVal vData As Boolean)
mvarAddExtension = vData
End Property
Friend Property Get AddExtension() As Boolean
AddExtension = mvarAddExtension
End Property
Friend Property Let AutoUpgradeEnabled(ByVal vData As Boolean)
mvarAutoUpgradeEnabled = vData
End Property
Friend Property Get AutoUpgradeEnabled() As Boolean
AutoUpgradeEnabled = mvarAutoUpgradeEnabled
End Property
Friend Property Let CheckFileExists(ByVal vData As Boolean)
mvarCheckFileExists = vData
End Property
Friend Property Get CheckFileExists() As Boolean
CheckFileExists = mvarCheckFileExists
End Property
Friend Property Let CheckPathExists(ByVal vData As Boolean)
mvarCheckPathExists = vData
End Property
Friend Property Get CheckPathExists() As Boolean
CheckPathExists = mvarCheckPathExists
End Property
Friend Property Let DefaultExt(ByVal vData As String)
mvarDefaultExt = vData
End Property
Friend Property Get DefaultExt() As String
DefaultExt = mvarDefaultExt
End Property
Friend Property Let DereferenceLinks(ByVal vData As Boolean)
mvarDereferenceLinks = vData
End Property
Friend Property Get DereferenceLinks() As Boolean
DereferenceLinks = mvarDereferenceLinks
End Property
Friend Property Let FileName(ByVal vData As String)
mvarFileName = vData
End Property
Friend Property Get FileName() As String
FileName = mvarFileName
End Property
Friend Property Let FileNames(ByVal vData As Variant)
mvarFileNames = vData
End Property
Friend Property Get FileNames() As Variant
FileNames = mvarFileNames
End Property
Friend Property Let Filter(ByVal vData As String)
mvarFilter = vData
End Property
Friend Property Get Filter() As String
Filter = mvarFilter
End Property
Friend Property Let FilterIndex(ByVal vData As Long)
mvarFilterIndex = vData
End Property
Friend Property Get FilterIndex() As Long
FilterIndex = mvarFilterIndex
End Property
Friend Property Let InitialDirectory(ByVal vData As String)
mvarInitialDirectory = vData
End Property
Friend Property Get InitialDirectory() As String
InitialDirectory = mvarInitialDirectory
End Property
Friend Property Let ReadOnlyChecked(ByVal vData As Boolean)
mvarReadOnlyChecked = vData
End Property
Friend Property Get ReadOnlyChecked() As Boolean
ReadOnlyChecked = mvarReadOnlyChecked
End Property
Friend Property Let RestoreDirectory(ByVal vData As Boolean)
mvarRestoreDirectory = vData
End Property
Friend Property Get RestoreDirectory() As Boolean
RestoreDirectory = mvarRestoreDirectory
End Property
Friend Property Let SafeFileName(ByVal vData As String)
mvarSafeFileName = vData
End Property
Friend Property Get SafeFileName() As String
SafeFileName = mvarSafeFileName
End Property
Friend Property Let SafeFileNames(ByVal vData As Variant)
mvarSafeFileNames = vData
End Property
Friend Property Get SafeFileNames() As Variant
SafeFileNames = mvarSafeFileNames
End Property
Friend Property Let ShowHelp(ByVal vData As Boolean)
mvarShowHelp = vData
End Property
Friend Property Get ShowHelp() As Boolean
ShowHelp = mvarShowHelp
End Property
Friend Property Let ShowReadOnly(ByVal vData As Boolean)
mvarShowReadOnly = vData
End Property
Friend Property Get ShowReadOnly() As Boolean
ShowReadOnly = mvarShowReadOnly
End Property
Friend Property Let SupportMultiDottedExtensions(ByVal vData As Boolean)
mvarSupportMultiDottedExtensions = vData
End Property
Friend Property Get SupportMultiDottedExtensions() As Boolean
SupportMultiDottedExtensions = mvarSupportMultiDottedExtensions
End Property
Friend Property Let Tag(ByVal vData As Object)
mvarTag = vData
End Property
Friend Property Get Tag() As Object
Tag = mvarTag
End Property
Friend Property Let title(ByVal vData As String)
mvarTitle = vData
End Property
Friend Property Get title() As String
title = mvarTitle
End Property
Friend Property Let ValidateNames(ByVal vData As Boolean)
mvarValidateNames = vData
End Property
Friend Property Get ValidateNames() As Boolean
ValidateNames = mvarValidateNames
End Property
Friend Function ShowDialog() As DialogResult
Dim ofn As OPENFILENAME
Dim FileName As String
Dim ret As Long
With ofn
.lStructSize = Len(ofn)
If Me.FileName <> "" Then .lpstrFile = Me.FileName & Space(260 - Len(Me.FileName)) & vbNullChar
If Me.FileName = "" Then .lpstrFile = Space(260) & vbNullChar
.lpstrInitialDir = Me.InitialDirectory '= "C:\" & vbNullChar
.lpstrTitle = Me.title & vbNullChar ' "Select a File" & vbNullChar
.lpstrFilter = Me.Filter '"Text Files (*.txt)" & vbNullChar & "*.txt" & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*" & vbNullChar & vbNullChar
.nFilterIndex = Me.FilterIndex
If Me.CheckFileExists = True Then .Flags = .Flags Or OFN_FILEMUSTEXIST
If Me.CheckPathExists = True Then .Flags = .Flags Or OFN_PATHMUSTEXIST
If Me.ShowHelp = True Then .Flags = .Flags Or OFN_SHOWHELP
If Me.ReadOnlyChecked = True Then .Flags = .Flags Or OFN_READONLY
If Me.ReadOnlyChecked = False Then .Flags = .Flags Or OFN_HIDEREADONLY
If Me.DereferenceLinks = False Then .Flags = .Flags Or OFN_NODEREFERENCELINKS
.nMaxFile = Len(.lpstrFile)
.lpstrFileTitle = Space(260) & vbNullChar
.nMaxFileTitle = Len(.lpstrFileTitle)
.nMaxCustomFilter = 0
.hwndOwner = 0
.hInstance = 0
.nFileOffset = 0
.nFileExtension = 0
.lCustData = 0
.lpfnHook = 0
End With
ret = apiGetOpenFileName(ofn)
ShowDialog = ret
If ret = DialogResult.IOK Then
mvarFileName = Left(ofn.lpstrFile, InStr(ofn.lpstrFile, vbNullChar) - 1)
Else
mvarFileName = ""
End If
End Function
Friend Function Reset()
Me = New OpenFileDialog
With Me
.AddExtension = True
.AutoUpgradeEnabled = True
.CheckFileExists = True
.CheckPathExists = True
.DefaultExt = ".txt"
.FileName = ""
.InitialDirectory = ""
.title = ""
.Tag = Nothing
.Filter = ""
.FilterIndex = 1
'todo
End With
End Function
Friend Function Dispose()
Me = Nothing
End Function