Using Visual Basic 5 (Platinum Edition)/vb5.iso/Code/ch12/ImageViewer.frm

Visual Basic Form | 1997-06-15 | 7.6 KB | 232 lines

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
Begin VB.Form Form1
   Caption         =   "Image Viewer"
   ClientHeight    =   4275
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   7455
   LinkTopic       =   "Form1"
   ScaleHeight     =   4275
   ScaleWidth      =   7455
   StartUpPosition =   3  'Windows Default
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   240
      Top             =   3720
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   327680
   End
   Begin VB.PictureBox Picture1
      Height          =   3495
      Left            =   720
      ScaleHeight     =   3435
      ScaleWidth      =   4995
      TabIndex        =   0
      Top             =   240
      Width           =   5055
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileNew
         Caption         =   "&New"
         Shortcut        =   ^N
      End
      Begin VB.Menu mnuFileOpen
         Caption         =   "&Open ..."
         Index           =   2
         Shortcut        =   ^O
      End
      Begin VB.Menu mnuFileList
         Caption         =   "-"
         Index           =   0
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFileBar
         Caption         =   "-"
         Index           =   6
      End
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
         Index           =   9
      End
   End
   Begin VB.Menu mnuEdit
      Caption         =   "&Edit"
      Begin VB.Menu mnuEditCopy
         Caption         =   "&Copy"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuEditPaste
         Caption         =   "&Paste"
         Shortcut        =   ^V
      End
   End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' max length of the recent files list (should be <= 9)
Const RECENTFILES_MAX = 9
Dim recentFiles(RECENTFILES_MAX) As String
Private Sub Form_Load()
    ' load the list of recent files
    ReadRecentFiles
End Sub
Private Sub Form_Resize()
    ' resize the picture box along with the form
    Picture1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
Private Sub Form_Unload(Cancel As Integer)
    ' on exit, save the list of recent files to disk
    WriteRecentFiles
End Sub
Private Sub mnuFileList_Click(Index As Integer)
    ' load a file from the list of recent files
    OpenFile recentFiles(Index)
End Sub
Private Sub mnuFileNew_Click()
    ' clear the picture box
    Set Picture1.Picture = Nothing
End Sub
Private Sub mnuFileOpen_Click(Index As Integer)
    ' query the user for a new picture
    With CommonDialog1
        .Filter = "All Picture Files|*.bmp;*.dib:*.gif;*.wmf;*.emf;*.jpg;*ico;*.cur|" _
            & "Bitmaps (*.bmp;*.dib)|*.bmp;*.dib|" _
            & "Icons (*.ico;*.cur)|*.ico;*.cur|" _
            & "GIF images (*.gif)|*.gif|" _
            & "JPEG images (*.jpg)|*.jpg|" _
            & "Metafiles (*.wmf;*.emf)|*.wmf;*.emf" _
            & "All Files|*.*"
        .Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
        .filename = ""
        .ShowOpen
        If .filename <> "" Then
            ' if the user didn't cancel the command, open the image
            OpenFile .filename
        End If
    End With
End Sub
Private Sub mnuFileExit_Click(Index As Integer)
    ' exit the program
    Unload Me
End Sub
Private Sub mnuEditCopy_Click()
    ' copy the current image to the clipboard
    Clipboard.SetData Picture1.Picture
End Sub
Private Sub mnuEditPaste_Click()
    ' paste the image currently in the clipboard
    Set Picture1.Picture = Clipboard.GetData
End Sub
Private Sub OpenFile(filename As String)
    ' load the picture
    Picture1.Picture = LoadPicture(filename)
    ' update the recent file list
    AddToRecentFileList filename
End Sub
Private Function RecentFilePath() As String
    ' return the path of the text file that holds the list
    ' of most recently opened files
    RecentFilePath = App.Path & IIf(Right$(App.Path, 1) <> "\", "\", "") & App.EXEName & ".mru"
End Function
Private Sub ReadRecentFiles()
    ' read the list of recent files, and update the File menu
    Dim fnum As Integer
    Dim fileIsOpened As Boolean
    Dim Index As Integer
    Dim item As String
    On Error GoTo ReadRecentFiles_Err
    fnum = FreeFile()
    Open RecentFilePath For Input As #fnum
    fileIsOpened = True
    Do Until EOF(fnum)
        Line Input #fnum, item
        ' only store non-null strings
        If item <> "" Then
            Index = Index + 1
            recentFiles(Index) = item
        End If
    Loop
ReadRecentFiles_Err:
    If fileIsOpened Then Close #fnum

    ' build the menu
    UpdateRecentFileMenu
End Sub
Private Sub WriteRecentFiles()
    ' write the list of recent files
    Dim fnum As Integer
    Dim fileIsOpened As Boolean
    Dim Index As Integer
    On Error GoTo WriteRecentFiles_Err
    fnum = FreeFile()
    Open RecentFilePath For Output As #fnum
    fileIsOpened = True
    For Index = 1 To RECENTFILES_MAX
        ' only store non-blank items
        If recentFiles(Index) <> "" Then
            Print #fnum, recentFiles(Index)
        End If
    Next
WriteRecentFiles_Err:
    If fileIsOpened Then Close #fnum
End Sub
Private Sub UpdateRecentFileMenu()
    ' update the menu with the list of recent files
    Dim Index As Integer
    ' unload any loaded items
    ' except the first one (index=0) that is a static element
    Do While mnuFileList.UBound > 0
        Unload mnuFileList(mnuFileList.UBound)
    Loop
    ' temporarily hide the separator at the
    ' beginning of the list
    mnuFileList(0).Visible = False
    ' load filenames into the menu array
    For Index = 1 To RECENTFILES_MAX
        ' take only non-null items into account
        If recentFiles(Index) = "" Then Exit For

        ' load the array item
        Load mnuFileList(Index)
        ' set its caption and hotkey
        mnuFileList(Index).Caption = "&" & Format$(Index) & ". " + recentFiles(Index)
        ' make it visible
        mnuFileList(Index).Visible = True
        ' if at least one item is visible, also the separator
        ' at the beginning of the list should be visible
        mnuFileList(0).Visible = True
    Next
End Sub
Private Sub AddToRecentFileList(ByVal filename As String)
    ' add a new file to the list of the recently opened files
   Dim found As Integer
   Dim Index As Integer
   Dim ercode As Integer
   ' do nothing if the file is already on top of the list
   If filename <> recentFiles(1) Then
        ' check if the file is already in the list
        ' if not found, use the last item of the list
        found = RECENTFILES_MAX
        For Index = 1 To RECENTFILES_MAX - 1
            If recentFiles(Index) = filename Or recentFiles(Index) = "" Then
                found = Index
                Exit For
            End If
        Next
        ' move all items in the range [1, found] one
        ' position toward higher indexes
        For Index = found To 2 Step -1
            recentFiles(Index) = recentFiles(Index - 1)
        Next
        ' store the file in the first position
        recentFiles(1) = filename
        ' update the menu
        UpdateRecentFileMenu
   End If
End Sub