PicMain.bas
1 ' PicInfo main module
2 ' ©2006 Aivosto Oy (www.aivosto.com)
3 '
4 ' This file is part of a sample project for Project Analyzer.
5 ' Distribution of this file is only allowed along with Project Analyzer
6 ' according to the Project Analyzer license terms.
7
8 Option Explicit
9
10 ' Global variable containing the title of this program
11 Public ProgramTitle As String
12
13
14 ' API declarations for FileDialog
15 Private Declare Function GetOpenFileNameA Lib "comdlg32.dll" (pOpenfilename As OpenFilename) As Long
16
17 ' This API Declare is dead
Dead declaration
18 Private Declare Function GetSaveFileNameA Lib "comdlg32.dll" (pOpenfilename As OpenFilename) As Long
19
20 Private Type OpenFilename
21 lStructSize As Long
22 hwndOwner As Long
23 hInstance As Long
24 lpstrFilter As String
25 lpstrCustomFilter As String
26 nMaxCustFilter As Long
27 nFilterIndex As Long
28 lpstrFile As String
29 nMaxFile As Long
30 lpstrFileTitle As String
31 nMaxFileTitle As Long
32 lpstrInitialDir As String
33 lpstrTitle As String
34 Flags As Long
35 nFileOffset As Integer
36 nFileExtension As Integer
37 lpstrDefExt As String
38 lCustData As Long
39 lpfnHook As Long
40 lpTemplateName As String
41 End Type
42
43 Public Enum EFileDlgFlags
Dead enum constant: OFN_ALLOWMULTISELECT
44 OFN_ALLOWMULTISELECT = &H200 ' box allows multiple selections
Dead enum constant: OFN_CREATEPROMPT
Line too long: 181
45 OFN_CREATEPROMPT = &H2000 ' If the user specifies a file that does not exist, this flag causes the dialog box to prompt the user for permission to create the file.
46 OFN_FILEMUSTEXIST = &H1000 ' user can type only names of existing files in the File Name entry field
47 OFN_HIDEREADONLY = &H4 ' Hides the Read Only check box.
48
Dead enum constant: OFN_NOCHANGEDIR
49 OFN_NOCHANGEDIR = &H8
50 ' Restores the current directory to its original value if the user changed the directory while searching for files.
51 ' Windows NT 4.0/2000/XP: This flag is ineffective for GetOpenFileName.
52
53
Dead enum constant: OFN_NODEREFERENCELINKS
54 OFN_NODEREFERENCELINKS = &H100000
55 ' Directs the dialog box to return the path and file name of the selected shortcut (.LNK) file.
56
Dead enum constant: OFN_NONETWORKBUTTON
57 OFN_NONETWORKBUTTON = &H20000
58 ' Hides and disables the Network button.
59
60 OFN_NOREADONLYRETURN = &H8000&
61 ' Specifies that the returned file does not have the Read Only check box selected and is not in a write-protected directory.
62
63
Dead enum constant: OFN_NOTESTFILECREATE
64 OFN_NOTESTFILECREATE = &H10000
65 ' Specifies that the file is not created before the dialog box is closed.
66 ' This flag should be specified if the application saves the file on a create-nonmodify network share.
67 ' When an application specifies this flag, the library does not check for write protection, a full disk,
68 ' an open drive door, or network protection.
69
70 OFN_OVERWRITEPROMPT = &H2
71 ' Causes the Save As dialog box to generate a message box if the selected file already exists. The user must confirm whether to overwrite the file.
72
73 OFN_PATHMUSTEXIST = &H800
74 ' Specifies that the user can type only valid paths and file names.
75
Dead enum constant: OFN_READONLY
76 OFN_READONLY = &H1
77 ' Causes the Read Only check box to be selected initially when the dialog box is created.
78 ' This flag indicates the state of the Read Only check box when the dialog box is closed.
79
Dead enum constant: OFN_SHAREAWARE
80 OFN_SHAREAWARE = &H4000
81 ' Specifies that if a call to the OpenFile function fails because of a network sharing violation, the error is ignored and the dialog box returns the selected file name.
82
83 ' Open dialog defaults:
84 ' File and path must exist
85 ' No Read Only checkbox is displayed
86 OFN_OPENDEFAULTS = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY
87
88 ' Save dialog defaults:
89 ' User must confirm overwrite
90 ' Path must exist
91 ' * Read-only files can be selected, caller must use error handling if need to kill/overwrite/append
Dead enum constant: OFN_SAVEDEFAULTS
92 OFN_SAVEDEFAULTS = OFN_OVERWRITEPROMPT Or OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY Or OFN_NOREADONLYRETURN
93
94 End Enum
95
96 Const MAXFILE = 512 ' Size of file name buffer in chars. Should be at least 256.
97
98 ' Error code retrieval
99 Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
100 Private Const CDERR_DIALOGFAILURE = &HFFFF
101 Private Const CDERR_FINDRESFAILURE = &H6
102 Private Const CDERR_NOHINSTANCE = &H4
103 Private Const CDERR_INITIALIZATION = &H2
104 Private Const CDERR_NOHOOK = &HB
105 Private Const CDERR_LOCKRESFAILURE = &H8
106 Private Const CDERR_NOTEMPLATE = &H3
107 Private Const CDERR_LOADRESFAILURE = &H7
108 Private Const CDERR_STRUCTSIZE = &H1
109 Private Const CDERR_LOADSTRFAILURE = &H5
110 Private Const FNERR_BUFFERTOOSMALL = &H3003
111 Private Const CDERR_MEMALLOCFAILURE = &H9
112 Private Const FNERR_INVALIDFILENAME = &H3002
113 Private Const CDERR_MEMLOCKFAILURE = &HA
114 Private Const FNERR_SUBCLASSFAILURE = &H3001
115
116
Too many parameters: ShowFileOpenDialog
Line too long: 296
Optional parameter never passed a value: DialogTitle
Optional parameter never passed a value: InitialDir
Optional parameter never passed a value: Flags
Optional parameter never passed a value: FilterIndex
117 Public Function ShowFileOpenDialog(ByVal hwndOwner As Long, ByVal DefaultExtension As String, ByVal Filter As String, Optional ByRef FilterIndex As Long, Optional ByVal InitialDir As String, Optional ByVal DialogTitle As String, Optional ByRef Flags As EFileDlgFlags = OFN_OPENDEFAULTS) As String
118 ' Show the Open file dialog box using comdlg32.dll
119 ' [hwndOwner] In. Window handle of owner window. Can be zero.
120 ' [DefaultExtension] In. Default file extension such as "txt".
121 ' [Filter] In. Filters in format "File type|*.ext;*.txt|All files|*.*".
122 ' [FilterIndex] In/out. Selected file type in filter. First filter is number 1.
123 ' [InitialDir] In. Initial directory. If not given or empty, uses system default initial directory. See FileDialog for explanation.
124 ' [DialogTitle] In. Dialog caption. If not given or empty, uses system default caption.
125 ' [Flags] In/out. Flags for the dialog. Should be given as "OFN_OPENDEFAULTS or ...". On return contains any altered flags.
126 ' Return value:
127 ' Selected file name if user pressed OK
128 ' Empty string if user pressed Cancel or there was an error
129 ' Caller can verify error status by calling CommDlgExtendedError
130
131 ShowFileOpenDialog = FileDialog(hwndOwner, DefaultExtension, Filter, FilterIndex, InitialDir, DialogTitle, Flags)
132
133 End Function
134
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
236 Sub Main()
237 ' PicInfo main procedure
238 ' The program starts here
239
240 ' Store program title in global variable
241 ProgramTitle = App.Title
242
243 ' Show main form
244 PicForm.Show
245
246 End Sub
247
248
249