home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD Direkt 1995 #6
/
CDD_6_95.ISO
/
cdd
/
winanw
/
emedit
/
filopen.bas
< prev
next >
Wrap
BASIC Source File
|
1994-08-22
|
3KB
|
109 lines
Option Explicit
Sub FOpenProc ()
On Error Resume Next
frmMDI.CMDialog1.Filename = ""
frmMDI.CMDialog1.Action = 1
If Err <> 32755 Then 'user pressed cancel - NOT!
Dim OpenFileName As String
Dim fReadOnly As Integer
OpenFileName = frmMDI.CMDialog1.Filename
If (frmMDI.CMDialog1.Flags And OFN_READONLY) <> 0 Then fReadOnly = True
If OpenFile(OpenFileName, fReadOnly) = True Then
UpdateFileMenu (OpenFileName)
End If
End If
End Sub
Function GetFileName ()
'Displays a Save As dialog and returns a file name
'or an empty string if the user cancels
On Error Resume Next
frmMDI.CMDialog1.Filename = ""
frmMDI.CMDialog1.Action = 2
If Err <> 32755 Then 'User cancelled dialog
GetFileName = frmMDI.CMDialog1.Filename
Else
GetFileName = ""
End If
End Function
Function OnRecentFilesList (Filename) As Integer
Dim i
For i = 1 To 4
If frmMDI.mnuRecentFile(i).Caption = Filename Then
OnRecentFilesList = True
Exit Function
End If
Next i
OnRecentFilesList = False
End Function
Function OpenFile (Filename As String, fReadOnly As Integer) As Integer
On Error Resume Next
Dim fIndex As Integer
' change mousepointer to an hourglass
Screen.MousePointer = 11
' change form's caption and display new text
fIndex = FindFreeIndex()
document(fIndex).Text1.FileOpen = Filename
document(fIndex).Text1.ReadOnly = fReadOnly
' reset mouse pointer
Screen.MousePointer = 0
If Err Then
OpenFile = False
DisplayError
Unload document(fIndex)
Else
OpenFile = True
document(fIndex).Tag = fIndex
document(fIndex).Caption = UCase$(Filename)
document(fIndex).Show
UpdateToolBar
End If
End Function
Sub SaveFileAs (frmForm As Form, ByVal Filename$)
On Error Resume Next
' display hourglass
Dim OldPointer%
OldPointer% = Screen.MousePointer
Screen.MousePointer = 11
' write the text to the new file
frmForm.Text1.FileSave = Filename$
If Err Then
DisplayError
Else
' set the Notepad's caption
frmForm.Caption = UCase$(Filename$)
' reset the dirty flag
frmForm.Text1.IsDirty = False
End If
' reset the mousepointer
Screen.MousePointer = OldPointer%
End Sub
Sub UpdateFileMenu (Filename)
Dim RetVal
' Check if OpenFileName is already on MRU list.
RetVal = OnRecentFilesList(Filename)
If Not RetVal Then
' Write OpenFileName to EMEDIT.INI
WriteRecentFiles (Filename)
End If
' Update menus for most recent file list.
GetRecentFiles
End Sub