FileDialog
In Module PicMain
Too many parameters: FileDialog
Line too long: 234
135 Private Function FileDialog(ByVal hwndOwner As Long, ByVal DefaultExtension As String, ByVal Filter As String, ByRef FilterIndex As Long, ByVal InitialDir As String, ByVal DialogTitle As String, ByRef Flags As EFileDlgFlags) As String
136 ' Implementation of ShowFileOpenDialog (see it for description)
137
138 Dim OFN As OpenFilename ' Structure with dialog information
139 Dim Result As Long ' API return value
140 Dim indNull As Long ' Index of Null character (ASCII 0)
141
142 Dim ErrMsg As String, ErrCode As Long ' Error information
143
144 ' Populate OFN structure with dialog initialization information
145 With OFN
146 .lStructSize = Len(OFN) ' Length of structure
147 .hwndOwner = hwndOwner ' Owner window handle
148 .lpstrFilter = Replace(Filter, "|", vbNullChar) & vbNullChar & vbNullChar ' Filters
149 .nFilterIndex = FilterIndex ' Selected filter
150 .lpstrFile = String(MAXFILE, 0) ' Filename
151 .nMaxFile = MAXFILE ' Max length of filename
152
153 ' Initial directory
154 If LenB(InitialDir) = 0 Then
155 .lpstrInitialDir = CurDir ' No initial directory given, use current directory
156 Else
157 .lpstrInitialDir = InitialDir ' Use given initial directory
158 End If
159 .lpstrTitle = DialogTitle ' Title of dialog
160 .Flags = Flags ' Various flags passed by caller
161 .lpstrDefExt = DefaultExtension ' Default file extension
162 End With
163
164 ' Show the Open dialog
165 Result = GetOpenFileNameA(OFN)
166
167 If Result <> 0 Then
168 ' Success
169 With OFN
170 ' Retrieve selected filename and set it as the function return value
171 indNull = InStr(.lpstrFile, vbNullChar)
172 If indNull > 0 Then
173 FileDialog = Left$(.lpstrFile, indNull - 1) ' Get rid of terminating null character
174 Else
175 FileDialog = .lpstrFile ' No terminating null
176 End If
177
178 Flags = .Flags ' Return flags to caller - they may have changed
179 FilterIndex = .nFilterIndex ' Return selected filter to caller
180 End With
181 Else
182 ' Error or cancel
183 ' Call CommDlgExtendedError to get error code
184 ErrCode = CommDlgExtendedError()
185
186 ' Select error message
187 Select Case ErrCode
188 Case 0
189 ' Cancel pressed, no error
Too many uncommented lines: 34
190 Case CDERR_DIALOGFAILURE
191 ErrMsg = "Dialog box could not be created."
192 Case CDERR_FINDRESFAILURE
193 ErrMsg = "Failed to find a resource."
194 Case CDERR_NOHINSTANCE
195 ErrMsg = "Instance handle missing."
196 Case CDERR_INITIALIZATION
197 ErrMsg = "Failure during initialization. Possibly out of memory."
198 Case CDERR_NOHOOK
199 ErrMsg = "Hook procedure missing."
200 Case CDERR_LOCKRESFAILURE
201 ErrMsg = "Failed to lock a resource."
202 Case CDERR_NOTEMPLATE
203 ErrMsg = "Template missing."
204 Case CDERR_LOADRESFAILURE
205 ErrMsg = "Failed to load a resource."
206 Case CDERR_STRUCTSIZE
207 ErrMsg = "Internal error - invalid struct size."
208 Case CDERR_LOADSTRFAILURE
209 ErrMsg = "Failed to load a string."
210 Case FNERR_BUFFERTOOSMALL
211 ErrMsg = "File name buffer too small"
212 Case CDERR_MEMALLOCFAILURE
213 ErrMsg = "Unable to allocate memory for internal dialog structures."
214 Case FNERR_INVALIDFILENAME
215 ErrMsg = "Invalid file name."
216 Case CDERR_MEMLOCKFAILURE
217 ErrMsg = "Unable to lock memory."
218 Case FNERR_SUBCLASSFAILURE
219 ErrMsg = "Subclass failure, out of memory."
220 Case Else
221 ErrMsg = "Unknown error."
222 End Select
223 If LenB(ErrMsg) Then
224 ' An error occurred. Display it.
225 If LenB(DialogTitle) Then
226 ErrMsg = "Error #" & ErrCode & " with dialog " & DialogTitle & vbCrLf & ErrMsg
227 Else
228 ErrMsg = "Error #" & ErrCode & " with file open dialog" & vbCrLf & ErrMsg
229 End If
230 MsgBox ErrMsg, vbExclamation
231 End If
232 End If
233
234 End Function
235
Called by
– ShowFileOpenDialogCalls
> GetOpenFileNameA> CommDlgExtendedError