home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Visual Basic new SourceCode and Projects / Adventure game / filopen.bas < prev    next >
Encoding:
BASIC Source File  |  1999-05-16  |  3.7 KB  |  122 lines
  1. Attribute VB_Name = "Module2"
  2. '*** Standard module with procedures for working with   ***
  3. '*** files. Part of the MDI Notepad sample application. ***
  4. '**********************************************************
  5. Option Explicit
  6.  
  7. Sub FileOpenProc()
  8.     Dim intRetVal
  9.     On Error Resume Next
  10.     Dim strOpenFileName As String
  11.     frmMDI.CMDialog1.Filename = ""
  12.     frmMDI.CMDialog1.ShowOpen
  13.     If Err <> 32755 Then    ' User chose Cancel.
  14.         strOpenFileName = frmMDI.CMDialog1.Filename
  15.         ' If the file is larger than 65K, it can't
  16.         ' be opened, so cancel the operation.
  17.         If FileLen(strOpenFileName) > 100000000 Then
  18.             MsgBox "The file is too large to open."
  19.             Exit Sub
  20.         End If
  21.         
  22.         OpenFile (strOpenFileName)
  23.         UpdateFileMenu (strOpenFileName)
  24.         ' Show the toolbar if they aren't already visible.
  25.         If gToolsHidden Then
  26.             frmMDI.imgCutButton.Visible = True
  27.             frmMDI.imgCopyButton.Visible = True
  28.             frmMDI.imgPasteButton.Visible = True
  29.             gToolsHidden = False
  30.         End If
  31.     End If
  32. End Sub
  33.  
  34. Function GetFileName(Filename As Variant)
  35.     ' Display a Save As dialog box and return a filename.
  36.     ' If the user chooses Cancel, return an empty string.
  37.     On Error Resume Next
  38.     frmMDI.CMDialog1.Filename = Filename
  39.     frmMDI.CMDialog1.ShowSave
  40.     If Err <> 32755 Then    ' User chose Cancel.
  41.         GetFileName = frmMDI.CMDialog1.Filename
  42.     Else
  43.         GetFileName = ""
  44.     End If
  45. End Function
  46.  
  47. Function OnRecentFilesList(Filename) As Integer
  48.   Dim i         ' Counter variable.
  49.  
  50.   For i = 1 To 4
  51.     If frmMDI.mnuRecentFile(i).Caption = Filename Then
  52.       OnRecentFilesList = True
  53.       Exit Function
  54.     End If
  55.   Next i
  56.     OnRecentFilesList = False
  57. End Function
  58.  
  59. Sub OpenFile(Filename)
  60.     Dim fIndex As Integer
  61.     
  62.     On Error Resume Next
  63.     ' Open the selected file.
  64.     Open Filename For Input As #1
  65.     If Err Then
  66.         MsgBox "Can't open file: " + Filename
  67.         Exit Sub
  68.     End If
  69.     ' Change the mouse pointer to an hourglass.
  70.     Screen.MousePointer = 11
  71.     
  72.     ' Change the form's caption and display the new text.
  73.     fIndex = FindFreeIndex()
  74.     Document(fIndex).Tag = fIndex
  75.     Document(fIndex).Caption = UCase(Filename)
  76.     Document(fIndex).Text1.Text = StrConv(InputB(LOF(1), 1), vbUnicode)
  77.     FState(fIndex).Dirty = False
  78.     Document(fIndex).Show
  79.     Close #1
  80.     ' Reset the mouse pointer.
  81.     Screen.MousePointer = 0
  82.     
  83. End Sub
  84.  
  85. Sub SaveFileAs(Filename)
  86.     On Error Resume Next
  87.     Dim strContents As String
  88.  
  89.     ' Open the file.
  90.     Open Filename For Output As #1
  91.     ' Place the contents of the notepad into a variable.
  92.     strContents = frmMDI.ActiveForm.Text1.Text
  93.     ' Display the hourglass mouse pointer.
  94.     Screen.MousePointer = 11
  95.     ' Write the variable contents to a saved file.
  96.     Print #1, strContents
  97.     Close #1
  98.     ' Reset the mouse pointer.
  99.     Screen.MousePointer = 0
  100.     ' Set the form's caption.
  101.     If Err Then
  102.         MsgBox Error, 48, App.Title
  103.     Else
  104.         frmMDI.ActiveForm.Caption = UCase(Filename)
  105.         ' Reset the dirty flag.
  106.         FState(frmMDI.ActiveForm.Tag).Dirty = False
  107.     End If
  108. End Sub
  109.  
  110. Sub UpdateFileMenu(Filename)
  111.         Dim intRetVal As Integer
  112.         ' Check if the open filename is already in the File menu control array.
  113.         intRetVal = OnRecentFilesList(Filename)
  114.         If Not intRetVal Then
  115.             ' Write open filename to the registry.
  116.             WriteRecentFiles (Filename)
  117.         End If
  118.         ' Update the list of the most recently opened files in the File menu control array.
  119.         GetRecentFiles
  120. End Sub
  121.  
  122.