Programming Tool Box/SIMS_2.iso/code/database/dbase/dbsample.frm

Visual Basic Form | 1995-02-27 | 10.7 KB | 328 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Dbase -III Sample"
   ClientHeight    =   3525
   ClientLeft      =   870
   ClientTop       =   1845
   ClientWidth     =   7920
   Height          =   4455
   Left            =   810
   LinkTopic       =   "Form1"
   ScaleHeight     =   3525
   ScaleWidth      =   7920
   Top             =   975
   Width           =   8040
   Begin ListBox List1
      Height          =   1560
      Index           =   2
      Left            =   6132
      TabIndex        =   16
      Top             =   216
      Width           =   1668
   End
   Begin ListBox List1
      Height          =   1560
      Index           =   1
      Left            =   4476
      TabIndex        =   15
      Top             =   216
      Width           =   1668
   End
   Begin ListBox List1
      Height          =   1560
      Index           =   0
      Left            =   2832
      TabIndex        =   14
      Top             =   216
      Width           =   1668
   End
   Begin Frame Frame1
      Caption         =   "Sort by:"
      Height          =   1428
      Left            =   2868
      TabIndex        =   7
      Top             =   2004
      Width           =   1584
      Begin OptionButton Option3
         Caption         =   "P.O. Box"
         Height          =   192
         Left            =   108
         TabIndex        =   10
         Top             =   1080
         Width           =   1450
      End
      Begin OptionButton Option2
         Caption         =   "First name"
         Height          =   288
         Left            =   96
         TabIndex        =   9
         Top             =   672
         Width           =   1450
      End
      Begin OptionButton Option1
         Caption         =   "Name"
         Height          =   192
         Left            =   108
         TabIndex        =   8
         Top             =   372
         Value           =   -1  'True
         Width           =   1450
      End
   End
   Begin CommandButton Command4
      Caption         =   "Delete"
      Height          =   252
      Left            =   192
      TabIndex        =   3
      Top             =   3048
      Width           =   900
   End
   Begin CommandButton Command3
      Caption         =   "Add"
      Height          =   252
      Left            =   192
      TabIndex        =   6
      Top             =   2772
      Width           =   900
   End
   Begin CommandButton Command2
      Caption         =   "<< Prev."
      Height          =   264
      Left            =   204
      TabIndex        =   5
      Top             =   2112
      Width           =   900
   End
   Begin CommandButton Command1
      Caption         =   "Next>>"
      Height          =   264
      Left            =   1716
      TabIndex        =   4
      Top             =   2112
      Width           =   876
   End
   Begin Line Line2
      X1              =   2712
      X2              =   2712
      Y1              =   3456
      Y2              =   24
   End
   Begin Line Line1
      X1              =   24
      X2              =   7860
      Y1              =   1932
      Y2              =   1932
   End
   Begin Label datalabel3
      BorderStyle     =   1  'Fixed Single
      Height          =   324
      Left            =   156
      TabIndex        =   13
      Top             =   1524
      Width           =   2460
   End
   Begin Label datalabel2
      BorderStyle     =   1  'Fixed Single
      Height          =   324
      Left            =   156
      TabIndex        =   12
      Top             =   864
      Width           =   2460
   End
   Begin Label datalabel1
      BorderStyle     =   1  'Fixed Single
      Height          =   324
      Left            =   180
      TabIndex        =   11
      Top             =   216
      Width           =   2460
   End
   Begin Label Label3
      Caption         =   "P.O.Box:"
      Height          =   276
      Left            =   204
      TabIndex        =   2
      Top             =   1272
      Width           =   2496
   End
   Begin Label Label2
      Caption         =   "First Name:"
      Height          =   276
      Left            =   204
      TabIndex        =   1
      Top             =   600
      Width           =   2496
   End
   Begin Label Label1
      Caption         =   "Name:"
      Height          =   192
      Left            =   204
      TabIndex        =   0
      Top             =   -12
      Width           =   2496
   End
   Begin Menu FILE
      Caption         =   "File"
      Begin Menu about
         Caption         =   "About"
      End
      Begin Menu separator
         Caption         =   "-"
      End
      Begin Menu endprogram
         Caption         =   "End"
      End
   End
Dim database As database  'declare DATABASE as a databasevariable
Dim table1 As table       'declare TABLE1 as table variable
Sub about_Click ()
tex$ = "DBASE-III File and Index access with VB-3." + Chr$(13) + Chr$(10) + "Little demoprogram by Peter Schulze, TY1PS. 72253,[e-mail]"
s% = MsgBox(tex$, 64, "Dbase-III Sample")
End Sub
Sub Command1_Click ()
'this moves to the next record in the database according to the current index
On Error Resume Next
table1.MoveNext
refresh_display
End Sub
Sub Command2_Click ()
'this moves to the previous record in the database according to the current index
On Error Resume Next
table1.MovePrevious
refresh_display
End Sub
Sub Command3_Click ()
'this adds a new record to the table
' all index files will be updated automatically
table1.AddNew
table1("NAME") = InputBox("Name")
datalabel1.Caption = table1("NAME")
table1("FIRST_NAME") = InputBox("First Name")
datalabel2.Caption = table1("FIRST_NAME")
table1("POBOX") = InputBox("PO BOX")
datalabel3.Caption = table1("POBOX")
table1.Update
refresh_list
End Sub
Sub Command4_Click ()
' this removes the current record from the database
On Error Resume Next
table1.Delete
table1.MoveFirst
refresh_list
refresh_display
End Sub
Sub endprogram_Click ()
Unload form1  'END the program
End Sub
Sub Form_Load ()
On Error Resume Next
' We first have to open the database.
' VB-3 treats the directory containing all database file as 'The Database'
' therefore the OpenDatabase command points to a disk directory
' make sure to have the DBF and NDX files in the c:\dbsample directory
' the two 'false', 'false' declarations assure that the file is open
' in multiuser mode and for read and write operations
pat$ = "C:\DBSAMPLE"
newpat:
Set database = OpenDatabase(pat$, False, False, "Dbase III;")
If Err Then
catcherror:
    pat$ = InputBox("Please indicate the path where the BBS.DBF file can be found", pat$)
        If Len(pat$) = 0 Then End
    Err = 0
    GoTo newpat
End If
' now VB knows where to find all information releated to the database. All DBF and NDX files
' must be in the same directory.
' Next we select the data we want to work with. This is called a table.
' Each table is represented as a .DBF file. You can have as many tables as you like in
' a database (=disk directory).
' Each table is kept in a seperate .DBF file.
' in this example we access a Table called BBS.DBF
' A table contains the actual data as well as the field structures.
' You can create new tables using VB commands but it is much easier
' to use the Datamgr.Exe program that comes with VB for this purpose.
' To create a new table (DBF) file with datamgr select 'Open Database' from the 'FILE' menu.
' Yes this is a bit strange, the 'new database' menu will not allow for the
' creation of new tables in dbase format, but' 'Open Database' does
' now select 'DBASE-III' and then choose the directory where you want to create the files.
' The 'new table' button now creates new DBF files, whereas you can add .NDX index files with the
' 'ADD/DELETE INDEXES' options. More about indexs later.
Err = 0
Set table1 = database.OpenTable("BBS")
If Err Then GoTo catcherror
' now we have opened the BBS.DBF datafile and it is ready for use
' in order to speed up searches in a database, we have to use what is called Indexes.
' a index is nothing else but sort key for your data.
' This allows us to quickly change the sort order and search for records without
' the need to call a lenghtly sort routine.
' Dbase uses .NDX files to keep indexes. Each index has its own .NDX file.
' You can have as many NDX files as you wish, but you should keep them to the minimum needed
' as otherwise keeping track of all the .NDX files will slow your program down.
' in this sample i have declared 3 Indexes:
' NAME (NAME.NDX) contains the data sorted by name
' FIRSTNAM (FIRSTNAM.NDX) sorts by the first name
' POBOX (POBOX.NDX) sorts by the boxnumber
' with these 3 indexes avaiable i can easily change the order of my records by changing
' the index used, without the need to re-sort all data.
' at startup i select 'name' as index. this means the data will be sorted by name.
' indexing is also essential to quickly find data in the database.
' with indexes i can use the very quick 'SEEK' command.
' without indexes i woul have to use 'Findfirst' which is a lot slower.
table1.Index = "NAME"
' now i want to have something on the screen at program start, so i call the
' routine that refreshes
' my screen
refresh_display
refresh_list
' this ends the initialisation
End Sub
Sub Form_Unload (Cancel As Integer)
' before ending i have to close my tables and database
' this assures that all is written to disk and no data lost
table1.Close
database.Close
End Sub
Sub Option1_Click ()
' i want the data to be sorted by name.
' setting the index to "NAME" does the job
table1.Index = "NAME"
refresh_list
refresh_display
End Sub
Sub Option2_Click ()
' i want the data to be sorted by First name.
' setting the index to "FIRSTNAM" does the job
table1.Index = "FIRSTNAM"
refresh_list
refresh_display
End Sub
Sub Option3_Click ()
' i want the data to be sorted by PO-BOX number
' setting the index to "POBOX" does the job
table1.Index = "POBOX"
refresh_list
refresh_display
End Sub
Sub refresh_display ()
'this updates my screen
On Error Resume Next
datalabel1.Caption = table1("NAME")
datalabel2.Caption = table1("FIRST_NAME")
datalabel3.Caption = table1("POBOX")
End Sub
Sub refresh_list ()
' this updates the list boxes
list1(0).Clear
list1(1).Clear
list1(2).Clear
table1.MoveFirst
Do While Not table1.EOF
list1(0).AddItem table1("NAME")
list1(1).AddItem table1("FIRST_NAME")
list1(2).AddItem table1("POBOX")
table1.MoveNext
table1.MoveFirst
End Sub