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


