Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/btrtest/btrtest.frm

Visual Basic Form | 1995-09-06 | 14.8 KB | 491 lines

VERSION 2.00
Begin Form EmpMst
   BackColor       =   &H00C0C0C0&
   Caption         =   "Btrieve Test Program"
   ClientHeight    =   3420
   ClientLeft      =   1140
   ClientTop       =   1470
   ClientWidth     =   7635
   Height          =   3825
   Icon            =   BTRTEST.FRX:0000
   Left            =   1080
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3420
   ScaleWidth      =   7635
   Top             =   1125
   Width           =   7755
   Begin TextBox HPhone
      Height          =   285
      Left            =   3600
      TabIndex        =   26
      Top             =   3015
      Width           =   1860
   End
   Begin TextBox WPhone
      Height          =   285
      Left            =   3600
      TabIndex        =   25
      Top             =   2655
      Width           =   1860
   End
   Begin TextBox ZipCod
      Height          =   285
      Left            =   3600
      TabIndex        =   4
      Top             =   2295
      Width           =   1095
   End
   Begin TextBox SocSec
      Height          =   285
      Left            =   3600
      TabIndex        =   3
      Top             =   1935
      Width           =   2175
   End
   Begin TextBox FstNam
      Height          =   285
      Left            =   3600
      TabIndex        =   2
      Top             =   1575
      Width           =   2190
   End
   Begin TextBox LstNam
      Height          =   285
      Left            =   3600
      TabIndex        =   1
      Top             =   1215
      Width           =   2190
   End
   Begin ListBox EmpList
      Height          =   2370
      Left            =   90
      TabIndex        =   10
      Top             =   900
      Width           =   2265
   End
   Begin TextBox EmpNum
      Height          =   285
      Left            =   3600
      TabIndex        =   0
      Top             =   855
      Width           =   735
   End
   Begin Frame Frame3
      BackColor       =   &H00C0C0C0&
      Caption         =   "Data Access"
      Height          =   3210
      Left            =   5895
      TabIndex        =   16
      Top             =   90
      Width           =   1680
      Begin Frame Frame4
         BackColor       =   &H00C0C0C0&
         Caption         =   "Select By"
         Height          =   1230
         Left            =   90
         TabIndex        =   21
         Top             =   1845
         Width           =   1500
         Begin OptionButton SelectByFirst
            BackColor       =   &H00C0C0C0&
            Caption         =   "First Name"
            Height          =   240
            Left            =   90
            TabIndex        =   23
            Top             =   900
            Width           =   1365
         End
         Begin OptionButton SelectByLast
            BackColor       =   &H00C0C0C0&
            Caption         =   "Last Name"
            Height          =   240
            Left            =   90
            TabIndex        =   22
            Top             =   585
            Width           =   1365
         End
         Begin OptionButton SelectByNum
            BackColor       =   &H00C0C0C0&
            Caption         =   "Employee #"
            Height          =   240
            Left            =   90
            TabIndex        =   24
            Top             =   270
            Width           =   1320
         End
      End
      Begin CommandButton LastCommand
         Caption         =   "Last"
         Height          =   330
         Left            =   315
         TabIndex        =   18
         Top             =   1485
         Width           =   1050
      End
      Begin CommandButton PreviousCommand
         Caption         =   "Previous"
         Height          =   330
         Left            =   315
         TabIndex        =   17
         Top             =   1080
         Width           =   1050
      End
      Begin CommandButton NextCommand
         Caption         =   "Next"
         Height          =   330
         Left            =   315
         TabIndex        =   19
         Top             =   675
         Width           =   1050
      End
      Begin CommandButton FirstCommand
         Caption         =   "First"
         Height          =   330
         Left            =   315
         TabIndex        =   20
         Top             =   270
         Width           =   1050
      End
   End
   Begin Frame Frame2
      BackColor       =   &H00C0C0C0&
      Caption         =   " Action"
      Height          =   690
      Left            =   90
      TabIndex        =   11
      Top             =   90
      Width           =   5685
      Begin CommandButton ExitCommand
         Caption         =   "Exit"
         Height          =   330
         Left            =   4500
         TabIndex        =   15
         Top             =   270
         Width           =   1050
      End
      Begin CommandButton DeleteCommand
         Caption         =   "Delete"
         Height          =   330
         Left            =   3060
         TabIndex        =   14
         Top             =   270
         Width           =   1050
      End
      Begin CommandButton ChangeCommand
         Caption         =   "Change"
         Height          =   330
         Left            =   1620
         TabIndex        =   13
         Top             =   270
         Width           =   1050
      End
      Begin CommandButton AddCommand
         Caption         =   "Add"
         Height          =   330
         Left            =   135
         TabIndex        =   12
         Top             =   270
         Width           =   1050
      End
   End
   Begin Label Label5
      BackColor       =   &H00C0C0C0&
      Caption         =   "Home Phone"
      Height          =   195
      Left            =   2430
      TabIndex        =   28
      Top             =   3060
      Width           =   1140
   End
   Begin Label Label12
      BackColor       =   &H00C0C0C0&
      Caption         =   "Work Phone"
      Height          =   195
      Left            =   2430
      TabIndex        =   27
      Top             =   2700
      Width           =   1095
   End
   Begin Label Label4
      BackColor       =   &H00C0C0C0&
      Caption         =   "Zip Code"
      Height          =   210
      Left            =   2430
      TabIndex        =   9
      Top             =   2340
      Width           =   975
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "SSN"
      Height          =   210
      Left            =   2430
      TabIndex        =   8
      Top             =   1980
      Width           =   960
   End
   Begin Label Label2
      BackColor       =   &H00C0C0C0&
      Caption         =   "First Name"
      Height          =   210
      Left            =   2430
      TabIndex        =   5
      Top             =   1620
      Width           =   1005
   End
   Begin Label Label6
      BackColor       =   &H00C0C0C0&
      Caption         =   "Last Name"
      Height          =   210
      Left            =   2430
      TabIndex        =   7
      Top             =   1260
      Width           =   1020
   End
   Begin Label Label7
      BackColor       =   &H00C0C0C0&
      Caption         =   "Employee #"
      Height          =   210
      Left            =   2430
      TabIndex        =   6
      Top             =   900
      Width           =   1095
   End
Sub AddCommand_Click ()
    KeyBufLen% = Len(KeyBuff)
    SetBuff
    BufLen% = Len(DataBuff)
    Status% = BTRCALL(BINSERT, POSBLOCK, DataBuff, BufLen%, KeyBuff, KeyBufLen%, KeyNum%)
    If Status% <> 0 Then
        BtrErr (Status%)
      Else
        PaintData
        Response% = MsgBox("Add Action Successful", 64, "File Action Message")
    End If
    SetEmpList
End Sub
Sub ChangeCommand_Click ()
    KeyBufLen% = Len(KeyBuff)
    BufLen% = Len(DataBuff)
    SetBuff
    Status% = BTRCALL(BUpdate, POSBLOCK, DataBuff, BufLen%, KeyBuff, KeyBufLen%, KeyNum%)
    If Status% <> 0 Then
        BtrErr (Status%)
      Else
        Response% = MsgBox("Change SuccessFul", 64, "File Action Message")
    End If
    SetEmpList
End Sub
Sub ClearData ()
    'Clear Screen Data
    LstNam.Text = ""
    SocSec.Text = ""
    FstNam.Text = ""
    WPhone.Text = ""
    EmpNum.Text = ""
    ZipCod.Text = ""
    HPhone.Text = ""
End Sub
Sub CommandsOff ()

        AddCommand.Enabled = False
        ChangeCommand.Enabled = False
        DeleteCommand.Enabled = False
        FirstCommand.Enabled = False
        LastCommand.Enabled = False
        NextCommand.Enabled = False
        PreviousCommand.Enabled = False
End Sub
Sub DeleteCommand_Click ()
    BufLen% = Len(DataBuff)
    KeyBufLen% = Len(KeyBuff)
    Status% = BTRCALL(BDELETE, POSBLOCK, DataBuff, BufLen%, KeyBuff, KeyBufLen%, KeyNum%)
    Response% = MsgBox("Are you Sure?", 32, "File Action Message")
    If Response% = 1 Then
        If Status% <> 0 Then
            BtrErr (Status%)
          Else
            PaintData
            Response% = MsgBox("Delete SuccessFul", 64, "File Action Message")
            ClearData
        End If
    End If
    SetEmpList
End Sub
Sub EmpList_Click ()
    'Set Select Box
    SelectByLast.Value = True
    SetSelectBy
    'Get First by EmpNum
    BufLen% = Len(DataBuff)
    KeyBufLen% = Len(KeyBuff)
    Status% = BTRCALL(BGET_FIRST, POSBLOCK, DataBuff, BufLen%, KeyBuff, KeyBufLen%, KeyNum%)
    Index% = 1
    While Index% <= EmpList.ListIndex And Status% <> 9
        Status% = BTRCALL(BGET_NEXT, POSBLOCK, DataBuff, BufLen%, KeyBuff, KeyBufLen%, KeyNum%)
        If Status% <> 0 Then
            BtrErr (Status%)
          Else
            'MsgBox DataBuff.LstNam + DataBuff.EmpNum, 0
            Index% = Index% + 1
        End If
    Wend
    PaintData
    PreviousCommand.Enabled = True
    NextCommand.Enabled = True
    DeleteCommand.Enabled = True
    ChangeCommand.Enabled = True
End Sub
Sub ExitCommand_Click ()
    Status% = WBTRVSTOP
    If Status% <> 0 Then
        BtrErr (Status%)
      Else
        End   'Quit App
    End If
End Sub
Sub FirstCommand_Click ()
    BufLen% = Len(DataBuff)
    KeyBufLen% = Len(KeyBuff)
    Status% = BTRCALL(BGET_FIRST, POSBLOCK, DataBuff, BufLen%, KeyBuff, KeyBufLen%, KeyNum%)
    If Status% <> 0 Then
        BtrErr (Status%)
        ClearData
        CommandsOff
      Else
        AddCommand.Enabled = True
        ChangeCommand.Enabled = True
        DeleteCommand.Enabled = True
        FirstCommand.Enabled = True
        LastCommand.Enabled = True
        NextCommand.Enabled = True
        PreviousCommand.Enabled = True
        PaintData
        NextCommand.SetFocus
    End If
End Sub
Sub Form_Load ()
    StartUp             'Execute StartUp Routine
    ExitCommand.Enabled = True
    SelectByLast.Value = True
    SelectByFirst.Value = False
    SelectByNum.Value = False
    SetSelectBy

    'Open EmpMst.Dat File
    KeyBuff.FILENAME = "C:\VB\BtrTest\EmpMsts.Dat"
    BufLen% = Len(DataBuff)
    KeyBufLen% = Len(KeyBuff)
    Status% = BTRCALL(BOPEN, POSBLOCK, DataBuff, BufLen%, KeyBuff, KeyBufLen%, KeyNum%)
    If Status% <> 0 Then
        BtrErr (Status%)
        CommandsOff
    Else
        CommandsOff
        AddCommand.Enabled = True
        FirstCommand.Enabled = True
        LastCommand.Enabled = True
    End If
    SetEmpList
    ClearData
End Sub
Sub LastCommand_Click ()
    BufLen% = Len(DataBuff)
    KeyBufLen% = Len(KeyBuff)
    Status% = BTRCALL(BGET_LAST, POSBLOCK, DataBuff, BufLen%, KeyBuff, KeyBufLen%, KeyNum%)
    If Status% <> 0 Then
        BtrErr (Status%)
        ClearData
        CommandsOff
    Else
        AddCommand.Enabled = True
        ChangeCommand.Enabled = True
        DeleteCommand.Enabled = True
        FirstCommand.Enabled = True
        LastCommand.Enabled = True
        NextCommand.Enabled = True
        PreviousCommand.Enabled = True
        PaintData
        PreviousCommand.SetFocus
    End If
End Sub
Sub NextCommand_Click ()
    BufLen% = Len(DataBuff)
    KeyBufLen% = Len(KeyBuff)
    Status% = BTRCALL(BGET_NEXT, POSBLOCK, DataBuff, BufLen%, KeyBuff, KeyBufLen%, KeyNum%)
    If Status% <> 0 Then
        BtrErr (Status%)
      Else
        PaintData
    End If
    NextCommand.SetFocus
End Sub
Sub PaintData ()
    'Paint Screen Data after file I/O
    LstNam.Text = DataBuff.LstNam
    ZipCod.Text = DataBuff.ZipCod
    SocSec.Text = DataBuff.SocSec
    FstNam.Text = DataBuff.FstNam
    WPhone.Text = DataBuff.WPhone
    EmpNum.Text = DataBuff.EmpNum
    HPhone.Text = DataBuff.HPhone
End Sub
Sub PreviousCommand_Click ()
    BufLen% = Len(DataBuff)
    KeyBufLen% = Len(KeyBuff)
    Status% = BTRCALL(BGET_PREV, POSBLOCK, DataBuff, BufLen%, KeyBuff, KeyBufLen%, KeyNum%)
    If Status% <> 0 Then
        BtrErr (Status%)
      Else
        PaintData
    End If
    PreviousCommand.SetFocus
End Sub
Sub SelectByFirst_Click ()
    SetSelectBy
End Sub
Sub SelectByLast_Click ()
    SetSelectBy
End Sub
Sub SelectByNum_Click ()
    SetSelectBy
End Sub
Sub SetBuff ()
    'Set data buffer to the field values
    DataBuff.SocSec = SocSec.Text
    DataBuff.FstNam = FstNam.Text
    DataBuff.WPhone = WPhone.Text
    DataBuff.ZipCod = ZipCod.Text
    DataBuff.EmpNum = EmpNum.Text
    DataBuff.HPhone = HPhone.Text
    DataBuff.LstNam = LstNam.Text
End Sub
Sub SetEmpList ()
    'Load EmpList Listbox with Employee Data
    BufLen% = Len(DataBuff)
    KeyBufLen% = Len(KeyBuff)
    Status% = BTRCALL(BGET_FIRST, POSBLOCK, DataBuff, BufLen%, KeyBuff, KeyBufLen%, KeyNum%)
    If Status% <> 0 Then
        BtrErr (Status%)
      Else
        EmpList.List(0) = RTrim$(DataBuff.LstNam) + ", " + RTrim$(DataBuff.FstNam) '+ "  #" + DataBuff.EmpNum
    End If
    Index% = 0
    While Status% = 0
        Status% = BTRCALL(BGET_NEXT, POSBLOCK, DataBuff, BufLen%, KeyBuff, KeyBufLen%, KeyNum%)
        If Status% = 0 Then
            Index% = Index% + 1
            EmpList.List(Index%) = RTrim$(DataBuff.LstNam) + ", " + RTrim$(DataBuff.FstNam) '+ " #" + DataBuff.EmpNum
        End If
    Wend
End Sub
Sub SetSelectBy ()
    If SelectByNum.Value = True Then KeyNum% = 0
    If SelectByLast.Value = True Then KeyNum% = 1
    If SelectByFirst.Value = True Then KeyNum% = 2
    NextCommand.Enabled = False
    PreviousCommand.Enabled = False
End Sub