Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/appshell/appmain.frm

Visual Basic Form | 1995-09-06 | 8.8 KB | 302 lines

VERSION 2.00
Begin Form AppMain
   Caption         =   "App Shell - [untitled]"
   ClientHeight    =   5370
   ClientLeft      =   885
   ClientTop       =   1485
   ClientWidth     =   8205
   FontBold        =   0   'False
   FontItalic      =   0   'False
   FontName        =   "MS Sans Serif"
   FontSize        =   8.25
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   6060
   Icon            =   APPMAIN.FRX:0000
   Left            =   825
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   5370
   ScaleWidth      =   8205
   Top             =   855
   Width           =   8325
   Begin TextBox AppText
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Courier"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   5415
      Left            =   -45
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Top             =   -45
      Width           =   8250
   End
   Begin Menu FileMenu
      Caption         =   "&File"
      Begin Menu FileNewCmd
         Caption         =   "&New"
      End
      Begin Menu FileOpenCmd
         Caption         =   "&Open..."
      End
      Begin Menu FileSaveCmd
         Caption         =   "&Save"
      End
      Begin Menu FileSaveAsCmd
         Caption         =   "Save &As..."
      End
      Begin Menu FileSep1
         Caption         =   "-"
      End
      Begin Menu FilePrintCmd
         Caption         =   "&Print..."
      End
      Begin Menu FilePrinterSetupCmd
         Caption         =   "P&rinter Setup..."
      End
      Begin Menu FileSep2
         Caption         =   "-"
      End
      Begin Menu FileExitCmd
         Caption         =   "E&xit"
      End
   End
   Begin Menu HelpMenu
      Caption         =   "&Help"
      Begin Menu UsingHelpCmd
         Caption         =   "Using Help"
      End
      Begin Menu HelpSep2
         Caption         =   "-"
      End
      Begin Menu HelpAboutCmd
         Caption         =   "&About"
      End
   End
' ================
' Copyrights & CYA
' ================
' App Shell is freeware with the following intent:
' -  You are free to incorporate App Shell into your code that will be
'    distributed in executable form.
' -  You are free to distribute App Shell source or incorporate App Shell
'    source into your source code assuming no charge is required and this
'    copyright is maintained and acknowledged.
' -  You are free to distribute App Shell source as shareware assuming
'    you are an approved vendor and associate member of the Association
'    of Shareware Professionals (ASP).  No registration fee is required
'    but this copyright must be maintained and acknowledged.
' -  All other distribution rights are maintained by the author.
' -  The author makes NO warranties, express or implied, oral or written,
'    including any implied warranties of merchantability or fitness for
'    a particular purpose.  In no event shall the author be liable for
'    any damages whatsoever arising out of the use of the software.
' If you find any bugs, anomalies, or have any questions or suggestions,
' please send them to Jim Presley (CIS ID - 73417,2674).  Enjoy!
Sub AppText_Change ()
  App_Changed = True
  App_Data = AppText.Text
End Sub
Function CheckForChange () As Integer
  x% = 0
  If App_Changed Then
    If App_FileName = "" Then
      a$ = "[Untitled]"
    Else
      a$ = UCase$(App_FileName)
    End If
    x% = MsgBox(a$ + " has changed.  Save current changes?", MB_YESNOCANCEL + MB_ICONEXCLAMATION, APP_NAME)
    If x% = IDYES Then
      x% = SaveFile(False)
    End If
  End If
  CheckForChange = x%
End Function
Sub ExitProcessing ()
  If CheckForChange() <> IDCANCEL Then End
End Sub
Sub FileExitCmd_Click ()
  ExitProcessing
End Sub
Sub FileNewCmd_Click ()
  If CheckForChange() <> IDCANCEL Then
    LoadFileNew
    LoadMainControls
    App_Changed = False
  End If
End Sub
Sub FileOpenCmd_Click ()
  If CheckForChange() <> IDCANCEL Then
    App_OpenTitle = "Open File"
    App_OpenSaveStyle = APP_OPEN
    AppOpenSave.Show Modal
    Unload AppOpenSave
    If App_DialogReturn = IDOK Then
      '
      ' load the file
      '
      If LoadFile() Then
        LoadMainControls
        App_Changed = False
      End If
    End If
  End If
End Sub
Sub FilePrintCmd_Click ()
  Dim Win_PrinterName As String
  Dim Win_PrinterDriver As String
  Dim Win_PrinterPort As String
  Dim RestorePrinter As Integer
  ' get the print parameters
  AppPrint.Show Modal
  GetDefaultPrinter Win_PrinterName, Win_PrinterDriver, Win_PrinterPort
  ' print the document
  RestorePrinter = False
  If App_PrinterName <> Win_PrinterName Then
    '
    ' make the printer the default
    '
    WriteDefaultPrinter App_PrinterName, App_PrinterDriver, App_PrinterPort
    RestorePrinter = True
  End If
  For App_PrintCopyNumber = 1 To App_PrintCopies
    AppPrinting.Show Modal
    If App_PrintCancel Then Exit For
  Next
  If RestorePrinter Then
    '
    ' restore the default windows printer
    '
    WriteDefaultPrinter Win_PrinterName, Win_PrinterDriver, Win_PrinterPort
  End If
End Sub
Sub FilePrinterSetupCmd_Click ()
  AppPrSetup.Show Modal
End Sub
Sub FileSaveAsCmd_Click ()
  ' save the file and load main form's caption
  If SaveFile(True) Then LoadMainTitle
End Sub
Sub FileSaveCmd_Click ()
    x% = SaveFile(False)
End Sub
Sub Form_Load ()
  ' load any file specified on the command line into memory
  c$ = Command$
  If c$ <> "" Then
    If InStr(c$, ".") = 0 Then c$ = c$ + App_FileExtension
    a$ = Dir$(c$)
    If a$ = "" Then
      MsgBox "File name " + UCase$(c$) + " entered on command line not valid.", MB_ICONEXCLAMATION, APP_NAME
      LoadFileNew
    Else
      App_FullFileName = c$
      SplitFileName App_FullFileName, App_Path, App_FileName
      If Not LoadFile() Then
        LoadFileNew
      End If
    End If
  Else
    LoadFileNew
  End If
  LoadMainControls
  App_Changed = False
End Sub
Sub Form_Resize ()
  AppText.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
Sub Form_Unload (Cancel As Integer)
  ExitProcessing
  ' if processing returns that means the user cancelled
  ' the termination
  Cancel = True
End Sub
Sub HelpAboutCmd_Click ()
  AppAbout.Show Modal
End Sub
Function LoadFile () As Integer
  ' Load the file
  LoadFile = True
  Screen.MousePointer = HOURGLASS
  On Error GoTo LoadFileError
  FileNum% = FreeFile
  Open App_FullFileName For Input As FileNum%
  If LOF(FileNum%) > 60000 Then
    MsgBox "Sorry, file too large", MB_STOPICON, APP_NAME
    LoadFile = False
    Exit Function
  End If
  Do Until EOF(FileNum%)
    Line Input #FileNum%, nl$
    a$ = a$ + nl$ + CRLF
  Loop
  Close FileNum%
  App_Data = a$
  Screen.MousePointer = DEFAULT
  On Error GoTo 0
  Exit Function
LoadFileError:
  a$ = Error$(Err)
  MsgBox "Error: " + a$, MB_ICONSTOP, APP_NAME
  LoadFile = False
  On Error GoTo 0
  Screen.MousePointer = DEFAULT
  Exit Function
End Function
Sub LoadFileNew ()
  App_FileName = ""
  App_Path = CurDir$
  App_Data = ""
End Sub
Sub LoadMainControls ()
  LoadMainTitle
  AppText.Text = App_Data
End Sub
Sub LoadMainTitle ()
  If App_FileName <> "" Then
    AppMain.Caption = APP_NAME + " - " + UCase$(App_FileName)
  Else
    AppMain.Caption = APP_NAME + " - [Untitled]"
  End If
End Sub
Function SaveFile (NewName As Integer) As Integer
  ' get a file name if untitled
  If App_FileName = "" Or NewName Then
    App_SaveTitle = "Save File As"
    App_OpenSaveStyle = APP_SAVE
    AppOpenSave.Show Modal
    Unload AppOpenSave
    If App_DialogReturn = IDCANCEL Then
      SaveFile = IDCANCEL
      Exit Function
    End If
  End If
  ' Save the file
  Screen.MousePointer = HOURGLASS
  On Error GoTo SaveFileError
  FileNum% = FreeFile
  Open App_FullFileName For Output As FileNum%
  Print #FileNum%, App_Data
  Close FileNum%
  App_Changed = False
  SaveFile = True
  On Error GoTo 0
  Screen.MousePointer = DEFAULT
  Exit Function
SaveFileError:
  a$ = Error$(Err)
  MsgBox "Error: " + a$, MB_ICONEXCLAMATION, APP_NAME
  SaveFile = IDCANCEL
  On Error GoTo 0
  Screen.MousePointer = DEFAULT
  Exit Function
End Function
Sub UsingHelpCmd_Click ()
    Dim work As Integer
    Worked = WinHelp(AppMain.hWnd, "", HELP_HELPONHELP, 0)
End Sub