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: InitialDir
    Optional parameter never passed a value: FilterIndex
    Optional parameter never passed a value: Flags
    Optional parameter never passed a value: DialogTitle
 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