Liren Large Software Subsidy 10/10.iso/l/l406/1.ddi/RECEDIT.FR_/RECEDIT.bin

Visual Basic Form | 1992-10-21 | 10.9 KB | 383 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Record Editor"
   ClipControls    =   0   'False
   Height          =   5460
   Left            =   915
   LinkTopic       =   "Form1"
   ScaleHeight     =   5055
   ScaleWidth      =   6375
   Top             =   1170
   Width           =   6495
   Begin TextBox FieldBoxes
      Height          =   2415
      Index           =   6
      Left            =   240
      MaxLength       =   50
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   19
      Top             =   2400
      Width           =   3735
   End
   Begin TextBox FieldBoxes
      Height          =   375
      Index           =   5
      Left            =   2280
      TabIndex        =   18
      Top             =   1680
      Width           =   1695
   End
   Begin TextBox FieldBoxes
      Height          =   375
      Index           =   4
      Left            =   240
      TabIndex        =   17
      Top             =   1680
      Width           =   1695
   End
   Begin CommandButton ExitButton
      Caption         =   "Exit"
      Height          =   495
      Left            =   4440
      TabIndex        =   9
      Top             =   4320
      Width           =   1695
   End
   Begin CommandButton DeleteRecord
      Caption         =   "Delete Record"
      Height          =   495
      Left            =   4440
      TabIndex        =   8
      Top             =   960
      Width           =   1695
   End
   Begin CommandButton AddRecord
      Caption         =   "Add Record"
      Height          =   495
      Left            =   4440
      TabIndex        =   7
      Top             =   240
      Width           =   1695
   End
   Begin CommandButton OpenFile
      Caption         =   "Open File"
      Height          =   495
      Left            =   4440
      TabIndex        =   6
      Top             =   3600
      Width           =   1695
   End
   Begin CommandButton PreviousRecord
      Caption         =   "Previous Record"
      Height          =   495
      Left            =   4440
      TabIndex        =   5
      Top             =   1920
      Width           =   1695
   End
   Begin CommandButton NextRecord
      Caption         =   "Next Record"
      Height          =   495
      Left            =   4440
      TabIndex        =   4
      Top             =   2640
      Width           =   1695
   End
   Begin TextBox FieldBoxes
      Height          =   375
      Index           =   3
      Left            =   2280
      MaxLength       =   15
      TabIndex        =   3
      Top             =   960
      Width           =   1695
   End
   Begin TextBox FieldBoxes
      Height          =   375
      Index           =   2
      Left            =   240
      TabIndex        =   2
      Top             =   960
      Width           =   1695
   End
   Begin TextBox FieldBoxes
      Height          =   375
      Index           =   1
      Left            =   2280
      MaxLength       =   15
      TabIndex        =   1
      Top             =   240
      Width           =   1695
   End
   Begin TextBox FieldBoxes
      Height          =   375
      Index           =   0
      Left            =   240
      MaxLength       =   15
      TabIndex        =   0
      Top             =   240
      Width           =   1695
   End
   Begin Label Label9
      Caption         =   "Last Review Comments"
      Height          =   255
      Left            =   240
      TabIndex        =   16
      Top             =   4800
      Width           =   2055
   End
   Begin Label Label8
      Caption         =   "Last Review Date"
      Height          =   255
      Left            =   2280
      TabIndex        =   15
      Top             =   2040
      Width           =   1575
   End
   Begin Label Label7
      Caption         =   "Monthly Salary"
      Height          =   255
      Left            =   240
      TabIndex        =   14
      Top             =   2040
      Width           =   1335
   End
   Begin Label Label4
      Caption         =   "Title"
      Height          =   255
      Left            =   2280
      TabIndex        =   13
      Top             =   1320
      Width           =   375
   End
   Begin Label Label3
      Caption         =   "ID #"
      Height          =   255
      Left            =   240
      TabIndex        =   12
      Top             =   1320
      Width           =   495
   End
   Begin Label Label2
      Caption         =   "Last Name"
      Height          =   255
      Left            =   2280
      TabIndex        =   11
      Top             =   600
      Width           =   975
   End
   Begin Label Label1
      Caption         =   "First Name"
      Height          =   255
      Left            =   240
      TabIndex        =   10
      Top             =   600
      Width           =   975
   End
Option Explicit
Dim Employee As Person
Dim OldContents As Person
Dim Position As Long         ' Position describes presentation order.
Dim LastRecord As Long
Dim FileName As String
Dim FileNum As Integer
Sub AddRecord_Click ()
    Dim Ind As Integer
    SaveRecordChanges
    For Ind = 0 To 6
    Form1.FieldBoxes(Ind).Text = ""
    Next Ind
    GetFields
    LastRecord = LastRecord + 1
    Put #FileNum, LastRecord, Employee
    Position = LastRecord
    ShowRecord
End Sub
Sub CleanUpFile ()
    Dim CleanFileNum As Integer
    Dim Ind As Long
    Dim Confirm As Integer
    Confirm = False
    CleanFileNum = FileOpener("~~Tmp~~.Tmp", RANDOMFILE, Len(Employee), Confirm)
    For Ind = 1 To LastRecord
    Get #FileNum, Ind, Employee
    Put #CleanFileNum, Ind, Employee
    Next Ind
    Close ' Close all files.
    FileCopy "~~Tmp~~.Tmp", FileName
    FileNum = FileOpener(FileName, RANDOMFILE, Len(Employee), Confirm)
    Kill "~~Tmp~~.Tmp"
End Sub
Sub DeleteRecord_Click ()
    Dim TempVar As Person
    Dim Ind As Integer
    Dim Msg As String
    If LastRecord = 1 Then
    Msg = "This is the last record in the file. Deleting it will destroy"
    Msg = Msg + " the whole file."
    Msg = Msg + " Record Editor will also be closed."
    Msg = Msg + " Choose OK to destroy file."
    If MsgBox(Msg, 65, "About to delete file!") = 1 Then
        Close (FileNum)
        Kill FileName
    End If
    End If
    For Ind = Position To LastRecord - 1
    Get #FileNum, Ind + 1, TempVar
    Put #FileNum, Ind, TempVar
    Next Ind
    LastRecord = LastRecord - 1
    If Position > LastRecord Then
    Position = LastRecord
    End If
    CleanUpFile
    ShowRecord                          ' Note that this displays record
End Sub                                 ' following deleted record.
Sub ExitButton_Click ()
    CleanUpFile
    End
End Sub
Sub FieldBoxes_GotFocus (Index As Integer)
    FieldBoxes(Index).SelStart = 0
    FieldBoxes(Index).SelLength = Len(FieldBoxes(Index).Text)
End Sub
Sub Form_Load ()
    Dim BoxCaption As String
    Dim NL As String
    Dim Msg As String
    ChDrive App.Path
    ChDir App.Path
    Form1.Show
    OpenFile_Click
End Sub
Sub Form_Unload (Cancel As Integer)
    End
End Sub
Sub GetFields ()
    Employee.FirstName = Form1.FieldBoxes(0).Text
    Employee.LastName = Form1.FieldBoxes(1).Text
    If IsNumeric(Form1.FieldBoxes(2).Text) Then
    Employee.ID = CInt(Form1.FieldBoxes(2).Text)
    Else
    Employee.ID = 0
    End If
    Employee.Title = Form1.FieldBoxes(3).Text
    If IsNumeric(Form1.FieldBoxes(4).Text) Then
    Employee.MonthlySalary = CDbl(CCur(Form1.FieldBoxes(4).Text))
    Else
    Employee.MonthlySalary = CDbl(CCur(0))
    End If
    If IsDate(Form1.FieldBoxes(5).Text) Then
    Employee.LastReviewDate = CLng(DateValue(Form1.FieldBoxes(5).Text))
    Else
    Employee.LastReviewDate = CLng(DateValue("1/1/1753"))
    End If
    Employee.ReviewComments = Form1.FieldBoxes(6).Text
End Sub
Sub Initialize ()
    LastRecord = LOF(FileNum) \ Len(Employee)
    Position = 1
    If LastRecord < 1 Then
    GetFields
    OldContents = Employee
    AddRecord_Click
    Else
    ShowRecord
    End If
End Sub
Sub NextRecord_Click ()
    Dim Msg As String
    SaveRecordChanges
    If Position = LastRecord Then
    Msg = "There are no records greater than " + Str$(LastRecord) + "."
    MsgBox (Msg)
    Else
    Position = Position + 1
    End If
    ShowRecord
End Sub
Sub OpenFile_Click ()
    Dim Confirm As Integer
    Confirm = True
    If LastRecord > 0 Then
    SaveRecordChanges
    CleanUpFile
    End If
    FileNum = 0
    Do While FileNum = 0
    FileName = GetFileName("Enter the name of a file to create or open.")
    If FileName = "" Then
        If LastRecord > 0 Then
        Exit Sub
        Else
        End
        End If
    Else
        FileNum = FileOpener(FileName, RANDOMFILE, Len(Employee), Confirm)
    End If
    Loop
    Initialize
End Sub
Sub PreviousRecord_Click ()
    SaveRecordChanges
    If Position = 1 Then
    MsgBox ("There are no records less than 1.")
    Else
    Position = Position - 1
    End If
    ShowRecord
End Sub
Sub SaveRecordChanges ()
    Dim ConvertVariant As Variant
    Dim Equal As Integer
    Equal = True
    GetFields
    If Employee.FirstName <> OldContents.FirstName Then Equal = False
    If Employee.LastName <> OldContents.LastName Then Equal = False
    If Employee.ID <> OldContents.ID Then Equal = False
    If Employee.Title <> OldContents.Title Then Equal = False
    If Employee.MonthlySalary <> OldContents.MonthlySalary Then Equal = False
    If Employee.LastReviewDate <> OldContents.LastReviewDate Then Equal = False
    If Employee.ReviewComments <> OldContents.ReviewComments Then Equal = False
    If Not Equal Then
    Put #FileNum, Position, Employee
    End If
End Sub
Sub ShowRecord ()
    Get #FileNum, Position, Employee
    Dim ConvertVariant As Variant
    Form1.FieldBoxes(0).Text = Trim(Employee.FirstName)
    Form1.FieldBoxes(1).Text = Trim(Employee.LastName)
    If Employee.ID > 0 Then
    Form1.FieldBoxes(2).Text = LTrim(Str(Employee.ID))
    Else
    Form1.FieldBoxes(2).Text = ""
    End If
    Form1.FieldBoxes(3) = Trim(Employee.Title)
    ConvertVariant = Employee.MonthlySalary
    ConvertVariant = CCur(ConvertVariant)
    If ConvertVariant > 0 Then
    Form1.FieldBoxes(4) = Format(ConvertVariant, "$#,##0.00;(#,##0.00)")
    Else
    Form1.FieldBoxes(4) = ""
    End If
    ConvertVariant = CVDate(Employee.LastReviewDate)
    If ConvertVariant <> DateValue("1/1/1753") Then
    Form1.FieldBoxes(5).Text = ConvertVariant
    Else
    FieldBoxes(5) = ""
    End If
    Form1.FieldBoxes(6) = Trim(Employee.ReviewComments)
    GetFields
    OldContents = Employee
    UpdateCaption
    FieldBoxes(0).SetFocus
End Sub
Sub UpdateCaption ()
    Dim Caption As String
    Caption = FileName + ": Record " + Str$(Position)
    Caption = Caption + " of " + Str$(LastRecord)
    Form1.Caption = Caption
End Sub