Attribute VB_Name = "PicMain" ' PicInfo main module ' ©2006 Aivosto Oy (www.aivosto.com) ' ' This file is part of a sample project for Project Analyzer. ' Distribution of this file is only allowed along with Project Analyzer ' according to the Project Analyzer license terms. Option Explicit ' Global variable containing the title of this program Public ProgramTitle As String ' API declarations for FileDialog Private Declare Function GetOpenFileNameA Lib "comdlg32.dll" (pOpenfilename As OpenFilename) As Long ' This API Declare is dead Private Declare Function GetSaveFileNameA Lib "comdlg32.dll" (pOpenfilename As OpenFilename) As Long Private Type OpenFilename lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter 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 Public Enum EFileDlgFlags OFN_ALLOWMULTISELECT = &H200 ' box allows multiple selections 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. OFN_FILEMUSTEXIST = &H1000 ' user can type only names of existing files in the File Name entry field OFN_HIDEREADONLY = &H4 ' Hides the Read Only check box. OFN_NOCHANGEDIR = &H8 ' Restores the current directory to its original value if the user changed the directory while searching for files. ' Windows NT 4.0/2000/XP: This flag is ineffective for GetOpenFileName. OFN_NODEREFERENCELINKS = &H100000 ' Directs the dialog box to return the path and file name of the selected shortcut (.LNK) file. OFN_NONETWORKBUTTON = &H20000 ' Hides and disables the Network button. OFN_NOREADONLYRETURN = &H8000& ' Specifies that the returned file does not have the Read Only check box selected and is not in a write-protected directory. OFN_NOTESTFILECREATE = &H10000 ' Specifies that the file is not created before the dialog box is closed. ' This flag should be specified if the application saves the file on a create-nonmodify network share. ' When an application specifies this flag, the library does not check for write protection, a full disk, ' an open drive door, or network protection. OFN_OVERWRITEPROMPT = &H2 ' 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. OFN_PATHMUSTEXIST = &H800 ' Specifies that the user can type only valid paths and file names. OFN_READONLY = &H1 ' Causes the Read Only check box to be selected initially when the dialog box is created. ' This flag indicates the state of the Read Only check box when the dialog box is closed. OFN_SHAREAWARE = &H4000 ' 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. ' Open dialog defaults: ' File and path must exist ' No Read Only checkbox is displayed OFN_OPENDEFAULTS = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY ' Save dialog defaults: ' User must confirm overwrite ' Path must exist ' * Read-only files can be selected, caller must use error handling if need to kill/overwrite/append OFN_SAVEDEFAULTS = OFN_OVERWRITEPROMPT Or OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY Or OFN_NOREADONLYRETURN End Enum Const MAXFILE = 512 ' Size of file name buffer in chars. Should be at least 256. ' Error code retrieval Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long Private Const CDERR_DIALOGFAILURE = &HFFFF Private Const CDERR_FINDRESFAILURE = &H6 Private Const CDERR_NOHINSTANCE = &H4 Private Const CDERR_INITIALIZATION = &H2 Private Const CDERR_NOHOOK = &HB Private Const CDERR_LOCKRESFAILURE = &H8 Private Const CDERR_NOTEMPLATE = &H3 Private Const CDERR_LOADRESFAILURE = &H7 Private Const CDERR_STRUCTSIZE = &H1 Private Const CDERR_LOADSTRFAILURE = &H5 Private Const FNERR_BUFFERTOOSMALL = &H3003 Private Const CDERR_MEMALLOCFAILURE = &H9 Private Const FNERR_INVALIDFILENAME = &H3002 Private Const CDERR_MEMLOCKFAILURE = &HA Private Const FNERR_SUBCLASSFAILURE = &H3001 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 ' Show the Open file dialog box using comdlg32.dll ' [hwndOwner] In. Window handle of owner window. Can be zero. ' [DefaultExtension] In. Default file extension such as "txt". ' [Filter] In. Filters in format "File type|*.ext;*.txt|All files|*.*". ' [FilterIndex] In/out. Selected file type in filter. First filter is number 1. ' [InitialDir] In. Initial directory. If not given or empty, uses system default initial directory. See FileDialog for explanation. ' [DialogTitle] In. Dialog caption. If not given or empty, uses system default caption. ' [Flags] In/out. Flags for the dialog. Should be given as "OFN_OPENDEFAULTS or ...". On return contains any altered flags. ' Return value: ' Selected file name if user pressed OK ' Empty string if user pressed Cancel or there was an error ' Caller can verify error status by calling CommDlgExtendedError ShowFileOpenDialog = FileDialog(hwndOwner, DefaultExtension, Filter, FilterIndex, InitialDir, DialogTitle, Flags) End Function 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 ' Implementation of ShowFileOpenDialog (see it for description) Dim OFN As OpenFilename ' Structure with dialog information Dim Result As Long ' API return value Dim indNull As Long ' Index of Null character (ASCII 0) Dim ErrMsg As String, ErrCode As Long ' Error information ' Populate OFN structure with dialog initialization information With OFN .lStructSize = Len(OFN) ' Length of structure .hwndOwner = hwndOwner ' Owner window handle .lpstrFilter = Replace(Filter, "|", vbNullChar) & vbNullChar & vbNullChar ' Filters .nFilterIndex = FilterIndex ' Selected filter .lpstrFile = String(MAXFILE, 0) ' Filename .nMaxFile = MAXFILE ' Max length of filename ' Initial directory If LenB(InitialDir) = 0 Then .lpstrInitialDir = CurDir ' No initial directory given, use current directory Else .lpstrInitialDir = InitialDir ' Use given initial directory End If .lpstrTitle = DialogTitle ' Title of dialog .Flags = Flags ' Various flags passed by caller .lpstrDefExt = DefaultExtension ' Default file extension End With ' Show the Open dialog Result = GetOpenFileNameA(OFN) If Result <> 0 Then ' Success With OFN ' Retrieve selected filename and set it as the function return value indNull = InStr(.lpstrFile, vbNullChar) If indNull > 0 Then FileDialog = Left$(.lpstrFile, indNull - 1) ' Get rid of terminating null character Else FileDialog = .lpstrFile ' No terminating null End If Flags = .Flags ' Return flags to caller - they may have changed FilterIndex = .nFilterIndex ' Return selected filter to caller End With Else ' Error or cancel ' Call CommDlgExtendedError to get error code ErrCode = CommDlgExtendedError() ' Select error message Select Case ErrCode Case 0 ' Cancel pressed, no error Case CDERR_DIALOGFAILURE ErrMsg = "Dialog box could not be created." Case CDERR_FINDRESFAILURE ErrMsg = "Failed to find a resource." Case CDERR_NOHINSTANCE ErrMsg = "Instance handle missing." Case CDERR_INITIALIZATION ErrMsg = "Failure during initialization. Possibly out of memory." Case CDERR_NOHOOK ErrMsg = "Hook procedure missing." Case CDERR_LOCKRESFAILURE ErrMsg = "Failed to lock a resource." Case CDERR_NOTEMPLATE ErrMsg = "Template missing." Case CDERR_LOADRESFAILURE ErrMsg = "Failed to load a resource." Case CDERR_STRUCTSIZE ErrMsg = "Internal error - invalid struct size." Case CDERR_LOADSTRFAILURE ErrMsg = "Failed to load a string." Case FNERR_BUFFERTOOSMALL ErrMsg = "File name buffer too small" Case CDERR_MEMALLOCFAILURE ErrMsg = "Unable to allocate memory for internal dialog structures." Case FNERR_INVALIDFILENAME ErrMsg = "Invalid file name." Case CDERR_MEMLOCKFAILURE ErrMsg = "Unable to lock memory." Case FNERR_SUBCLASSFAILURE ErrMsg = "Subclass failure, out of memory." Case Else ErrMsg = "Unknown error." End Select If LenB(ErrMsg) Then ' An error occurred. Display it. If LenB(DialogTitle) Then ErrMsg = "Error #" & ErrCode & " with dialog " & DialogTitle & vbCrLf & ErrMsg Else ErrMsg = "Error #" & ErrCode & " with file open dialog" & vbCrLf & ErrMsg End If MsgBox ErrMsg, vbExclamation End If End If End Function Sub Main() ' PicInfo main procedure ' The program starts here ' Store program title in global variable ProgramTitle = App.Title ' Show main form PicForm.Show End Sub
Hide code	Visustin flow chart for VB