Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/tinydb/tinytst.fr_/tinytst.fr

Visual Basic Form | 1997-12-19 | 20.4 KB | 694 lines

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Sample Database with TinyDB for Visual Basic 5"
   ClientHeight    =   4140
   ClientLeft      =   3135
   ClientTop       =   2460
   ClientWidth     =   7890
   Icon            =   "TINYTST.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4140
   ScaleWidth      =   7890
   Begin VB.CommandButton Command17
      Caption         =   "About"
      Height          =   495
      Left            =   3360
      TabIndex        =   37
      Top             =   2280
      Width           =   975
   End
   Begin VB.Timer Timer1
      Interval        =   1
      Left            =   3000
      Top             =   0
   End
   Begin VB.CommandButton Command16
      Caption         =   "Show DB Struc"
      Height          =   375
      Left            =   120
      TabIndex        =   36
      Top             =   3240
      Width           =   1575
   End
   Begin VB.CommandButton Command15
      Caption         =   "Read, No Display"
      Height          =   495
      Left            =   3360
      TabIndex        =   35
      Top             =   1800
      Width           =   975
   End
   Begin VB.CheckBox Check3
      Caption         =   "Bof"
      Height          =   255
      Left            =   1800
      TabIndex        =   32
      Top             =   2880
      Width           =   615
   End
   Begin VB.CheckBox Check2
      Caption         =   "Eof"
      Height          =   255
      Left            =   1080
      TabIndex        =   31
      Top             =   2880
      Width           =   735
   End
   Begin VB.CheckBox Check1
      Caption         =   "Deleted"
      Height          =   255
      Left            =   120
      TabIndex        =   30
      Top             =   2880
      Width           =   1335
   End
   Begin VB.CommandButton Command14
      Caption         =   "Exit"
      Height          =   375
      Left            =   6600
      TabIndex        =   29
      Top             =   3720
      Width           =   1215
   End
   Begin VB.CommandButton Command13
      Caption         =   "FindPrev"
      Height          =   375
      Left            =   1800
      TabIndex        =   28
      Top             =   3240
      Width           =   975
   End
   Begin VB.CommandButton Command12
      Caption         =   "FindNext"
      Height          =   375
      Left            =   3960
      TabIndex        =   27
      Top             =   3240
      Width           =   975
   End
   Begin VB.CommandButton Command11
      Caption         =   "Random Add"
      Height          =   495
      Left            =   3360
      TabIndex        =   25
      Top             =   840
      Width           =   975
   End
   Begin VB.CommandButton Command10
      Caption         =   "Find"
      Height          =   375
      Left            =   2880
      TabIndex        =   24
      Top             =   3240
      Width           =   975
   End
   Begin VB.TextBox Text1
      Height          =   2655
      Left            =   4440
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   21
      Top             =   360
      Width           =   3375
   End
   Begin VB.CommandButton Command7
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "<"
      Height          =   375
      Left            =   480
      TabIndex        =   20
      Top             =   3720
      Width           =   375
   End
   Begin VB.CommandButton Command9
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   ">>"
      Height          =   375
      Left            =   1320
      TabIndex        =   19
      Top             =   3720
      Width           =   375
   End
   Begin VB.TextBox Text2
      Height          =   285
      Index           =   5
      Left            =   960
      TabIndex        =   12
      Top             =   2160
      Width           =   1095
   End
   Begin VB.TextBox Text2
      Height          =   285
      Index           =   4
      Left            =   960
      TabIndex        =   11
      Top             =   1800
      Width           =   495
   End
   Begin VB.TextBox Text2
      Height          =   285
      Index           =   3
      Left            =   960
      TabIndex        =   10
      Top             =   1440
      Width           =   1815
   End
   Begin VB.TextBox Text2
      Height          =   285
      Index           =   2
      Left            =   960
      TabIndex        =   9
      Top             =   1080
      Width           =   2295
   End
   Begin VB.TextBox Text2
      Height          =   285
      Index           =   1
      Left            =   960
      TabIndex        =   8
      Top             =   720
      Width           =   2295
   End
   Begin VB.TextBox Text2
      Height          =   285
      Index           =   0
      Left            =   960
      TabIndex        =   7
      Top             =   360
      Width           =   2535
   End
   Begin VB.CommandButton Command8
      Caption         =   "Update"
      Height          =   375
      Left            =   2880
      TabIndex        =   6
      Top             =   3720
      Width           =   975
   End
   Begin VB.CommandButton Command6
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   ">"
      Height          =   375
      Left            =   960
      TabIndex        =   5
      Top             =   3720
      Width           =   375
   End
   Begin VB.CommandButton Command5
      Caption         =   "Delete"
      Height          =   375
      Left            =   3960
      TabIndex        =   4
      Top             =   3720
      Width           =   975
   End
   Begin VB.CommandButton Command4
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "<<"
      Height          =   375
      Left            =   120
      TabIndex        =   3
      Top             =   3720
      Width           =   375
   End
   Begin VB.CommandButton Command3
      Caption         =   "Random Read"
      Height          =   495
      Left            =   3360
      TabIndex        =   2
      Top             =   1320
      Width           =   975
   End
   Begin VB.CommandButton Command2
      Caption         =   "Add New"
      Height          =   375
      Left            =   1800
      TabIndex        =   1
      Top             =   3720
      Width           =   975
   End
   Begin VB.CommandButton Command1
      Caption         =   "Open db"
      Height          =   375
      Left            =   5400
      TabIndex        =   0
      Top             =   3720
      Width           =   1215
   End
   Begin VB.Label Label4
      Height          =   255
      Left            =   5040
      TabIndex        =   34
      Top             =   3360
      Width           =   2775
   End
   Begin VB.Label Label3
      Height          =   255
      Left            =   5040
      TabIndex        =   33
      Top             =   3120
      Width           =   2775
   End
   Begin VB.Label Label7
      Caption         =   "Label7"
      Height          =   255
      Left            =   120
      TabIndex        =   26
      Top             =   2520
      Width           =   1455
   End
   Begin VB.Label Label6
      Caption         =   "Label6"
      Height          =   255
      Left            =   1680
      TabIndex        =   23
      Top             =   2520
      Width           =   1335
   End
   Begin VB.Label Label2
      Caption         =   "Code Executed for last command:"
      Height          =   255
      Left            =   4440
      TabIndex        =   22
      Top             =   120
      Width           =   2655
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "Name:"
      Height          =   255
      Index           =   11
      Left            =   240
      TabIndex        =   18
      Top             =   360
      Width           =   615
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "Address1:"
      Height          =   255
      Index           =   10
      Left            =   120
      TabIndex        =   17
      Top             =   720
      Width           =   735
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "Address2:"
      Height          =   255
      Index           =   9
      Left            =   120
      TabIndex        =   16
      Top             =   1080
      Width           =   735
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "City:"
      Height          =   255
      Index           =   8
      Left            =   480
      TabIndex        =   15
      Top             =   1440
      Width           =   375
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "State:"
      Height          =   255
      Index           =   7
      Left            =   360
      TabIndex        =   14
      Top             =   1800
      Width           =   495
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "Zip:"
      Height          =   255
      Index           =   6
      Left            =   480
      TabIndex        =   13
      Top             =   2160
      Width           =   375
   End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Sub ShowFields()
Text2(0) = MyDB.Field("Name")
Text2(1) = MyDB.Field("Address1")
Text2(2) = MyDB.Field("Address2")
Text2(3) = MyDB.Field("City")
Text2(4) = MyDB.Field("State")
Text2(5) = MyDB.Field("Zip")
End Sub
Sub showit(fname)
X = FreeFile
Open App.Path + "\" + fname For Input As #X
Text1.Text = ""
Do Until EOF(X)
Line Input #X, a$
Text1.Text = Text1.Text + a$ + vbCrLf
Close #X
End Sub
Sub updateflags()
If MyDB.Deleted Then Check1.Value = 1 Else Check1.Value = 0
If MyDB.EOF Then Check2.Value = 1 Else Check2.Value = 0
If MyDB.BOF Then Check3.Value = 1 Else Check3.Value = 0
Label6 = "Record:" + Str$(MyDB.Record)
Label7 = "Records:" + Str$(MyDB.RecordCount)
End Sub
Private Sub Check1_Click()
If MyDB.Deleted = True Then Check1.Value = 1 Else Check1.Value = 0
End Sub
Private Sub check2_Click()
If MyDB.EOF = True Then Check2.Value = 1 Else Check2.Value = 0
End Sub
Private Sub check3_Click()
If MyDB.BOF = True Then Check3.Value = 1 Else Check3.Value = 0
End Sub
Private Sub Command1_Click()
Text1.Text = "MyDB.Startdb App.Path + " + Chr$(34) + "\sample.sdb" + Chr$(34)
If MyDB.DBOpen = True Then MsgBox "The Database is already open": Exit Sub
MyDB.StartDb App.Path + "\sample.sdb"
End Sub
Private Sub Command10_Click()
If Not MyDB.DBOpen Then Exit Sub
Form2.Show 1
If cancelflag = True Then cancelflag = False: Exit Sub
If MyDB.NoMatch Then MsgBox "No matching records": Exit Sub
ShowFields
updateflags
End Sub
Public Sub Command11_Click()
If Not MyDB.DBOpen Then Exit Sub
' add 100 records
Dim fname(0 To 10) As String
Dim lname(0 To 10) As String
Dim street(0 To 10) As String
Dim city(0 To 10) As String
Dim state(0 To 10) As String
Dim zip(0 To 10) As String
glass
fname(0) = "Mark"
fname(1) = "Amy"
fname(2) = "Theresa"
fname(3) = "Jim"
fname(4) = "Jack"
fname(5) = "Kathy"
fname(6) = "Margie"
fname(7) = "Tom"
fname(8) = "Karen"
fname(9) = "Jamie"
fname(10) = "Denise"
lname(0) = "Smith"
lname(1) = "Jones"
lname(2) = "Jackson"
lname(3) = "Hoogen"
lname(4) = "McDonald"
lname(5) = "MacPherson"
lname(6) = "McSherra"
lname(7) = "Thorn"
lname(8) = "Akins"
lname(9) = "Dillon"
lname(10) = "Robichard"
street(0) = "Long St."
street(1) = "Hittenger St."
street(2) = "Boardman St."
street(3) = "Mill St."
street(4) = "Main St."
street(5) = "Crescent St."
street(6) = "Oak St."
street(7) = "Maple St."
street(8) = "Elm St."
street(9) = "Rohouse St."
street(10) = "Boston St."
city(0) = "Westboro"
city(1) = "Marlboro"
city(2) = "Northboro"
city(3) = "Southboro"
city(4) = "Shrewsbury"
city(5) = "Worcester"
city(6) = "Holden"
city(7) = "Hudson"
city(8) = "Framingham"
city(9) = "Belmont"
city(10) = "Burlington"
state(0) = "MA"
state(1) = "NH"
state(2) = "RI"
state(3) = "NY"
state(4) = "NJ"
state(5) = "CT"
state(6) = "VT"
state(7) = "WV"
state(8) = "WA"
state(9) = "CA"
state(10) = "DE"
zip(0) = "00000"
zip(1) = "00000"
zip(2) = "00000"
zip(3) = "00000"
zip(4) = "00000"
zip(5) = "00000"
zip(6) = "00000"
zip(7) = "00000"
zip(8) = "00000"
zip(9) = "00000"
zip(10) = "00000"
rr = Int(Rnd * 200)
Form1.Label3 = "Action Started @: " + Time$
For a = MyDB.RecordCount To MyDB.RecordCount + rr
MyDB.AddNew
Randomize
X = Int(Rnd * 10): r = Int(Rnd * 10)
MyDB.Field("name") = fname(X) + " " + lname(r)
X = Int(Rnd * 10)
MyDB.Field("address1") = Trim$(Str$(a)) + " " + street(X)
X = Int(Rnd * 10)
MyDB.Field("city") = city(X)
X = Int(Rnd * 10)
MyDB.Field("State") = state(X)
X = Int(Rnd * 10)
MyDB.Field("zip") = zip(X)
'ShowFields
Next a
Form1.Label4 = "Action  Ended @: " + Time$
Text1 = "Added" + Str$(rr) + " records."
MyDB.MoveLast
ShowFields
updateflags
regular
End Sub
Private Sub Command12_Click()
If Not MyDB.DBOpen Then Exit Sub
glass
Form1.Label3 = "Search Started @: " + Time$
MyDB.FindNext
Form1.Label4 = "Search Ended @: " + Time$
If MyDB.NoMatch Then MsgBox "No matching records": regular: Exit Sub
ShowFields
updateflags
Text1 = "MyDB.FindNext" + vbCrLf + "If MyDB.NoMatch Then MsgBox " + Chr$(34) + "No matching records" + Chr$(34) + ": Exit Sub" + vbCrLf + "ShowFields" + vbCrLf + "UpdateFlags"
regular
End Sub
Private Sub Command13_Click()
If Not MyDB.DBOpen Then Exit Sub
glass
Form1.Label3 = "Search Started @: " + Time$
MyDB.FindPrevious
Form1.Label4 = "Search Ended @: " + Time$
If MyDB.NoMatch Then MsgBox "No matching records": regular: Exit Sub
ShowFields
updateflags
regular
Text1 = "MyDB.FindPrevious" + vbCrLf + "If MyDB.NoMatch Then MsgBox " + Chr$(34) + "No matching records" + Chr$(34) + ": Exit Sub" + vbCrLf + "ShowFields" + vbCrLf + "UpdateFlags"
End Sub
Private Sub Command14_Click()
If Not MyDB.DBOpen Then Exit Sub
Text1.Text = "MyDb.StopDb"
If MyDB.DBOpen = False Then MsgBox "The Database is already stopped"
MyDB.StopDb
End Sub
Private Sub Command15_Click()
If Not MyDB.DBOpen Then Exit Sub
glass
X = Int(Rnd * 200)
Text1 = "x = Int(Rnd * 100)" + vbCrLf + "For a = 1 To x" + vbCrLf + "If MyDB.Eof Then Exit For" + vbCrLf + "MyDB.MoveNext" + vbCrLf + "Next a" + vbCrLf + vbCrLf + "X =" + Str$(X)
Form1.Label3 = "Action Started @: " + Time$
For a = 1 To X
If MyDB.EOF Then Exit For
MyDB.MoveNext
Next a
ShowFields
updateflags
Form1.Label4 = "Action  Ended @: " + Time$
regular
End Sub
Private Sub Command16_Click()
If Not MyDB.DBOpen Then Exit Sub
Text1 = ""
For a = 1 To MyDB.FieldCount
Text1.Text = Text1 + "Name: " + MyDB.FieldName(a) + vbCrLf
Text1.Text = Text1 + "Type: " + Str$(MyDB.Fieldtype(a)) + vbCrLf
Text1.Text = Text1 + "Length: " + Str$(MyDB.FieldLength(a)) + vbCrLf + vbCrLf
Next a
End Sub
Private Sub Command17_Click()
frmPlague.Show 1
End Sub
Private Sub Command2_Click()
If Not MyDB.DBOpen Then Exit Sub
MyDB.AddNew
For a = 0 To 5
Text2(a) = ""
Next a
Text1.Text = "For a = 0 to 5" + vbCrLf + "Text2 (a) =" + Chr$(34) + Chr$(34) + vbCrLf + "Next a" + vbCrLf + "MyDB.AddNew"
End Sub
Private Sub Command3_Click()
If Not MyDB.DBOpen Then Exit Sub
glass
X = Int(Rnd * 200)
Text1 = "x = Int(Rnd * 100)" + vbCrLf + "For a = 1 To x" + vbCrLf + "ShowFields" + vbCrLf + "DoEvents" + vbCrLf + "UpdateFlags" + vbCrLf + "If MyDB.Eof Then Exit For" + vbCrLf + "MyDB.MoveNext" + vbCrLf + "Next a" + vbCrLf + vbCrLf + "X =" + Str$(X)
Form1.Label3 = "Action Started @: " + Time$
For a = 1 To X
ShowFields
DoEvents
updateflags
If MyDB.EOF Then Exit For
MyDB.MoveNext
Next a
Form1.Label4 = "Action  Ended @: " + Time$
regular
End Sub
Private Sub Command4_Click()
If Not MyDB.DBOpen Then Exit Sub
MyDB.MoveFirst
ShowFields
updateflags
Text1.Text = "MyDB.MoveFirst" + vbCrLf + "ShowFields" + vbCrLf + "UpdateFlags"
End Sub
Private Sub Command5_Click()
If Not MyDB.DBOpen Then Exit Sub
MyDB.Delete
End Sub
Private Sub Command6_Click()
If Not MyDB.DBOpen Then Exit Sub
Text1.Text = "If MyDB.Eof Then Exit Sub" + vbCrLf + "MyDB.MoveNext" + vbCrLf + "ShowFields" + vbCrLf + "UpdateFlags"
If MyDB.EOF Then Exit Sub
MyDB.MoveNext
ShowFields
updateflags
End Sub
Private Sub Command6_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
comm6down = True
End Sub
Private Sub Command6_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
comm6down = False
End Sub
Private Sub Command7_Click()
If Not MyDB.DBOpen Then Exit Sub
Text1.Text = "If MyDB.bof Then Exit Sub" + vbCrLf + "MyDB.MovePrevious" + vbCrLf + "ShowFields" + vbCrLf + "UpdateFlags"
If MyDB.BOF Then Exit Sub
MyDB.MovePrevious
ShowFields
updateflags
End Sub
Private Sub Command7_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
comm7down = True
End Sub
Private Sub Command7_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
comm7down = False
End Sub
Private Sub Command8_Click()
If Not MyDB.DBOpen Then Exit Sub
MyDB.Field("Name") = Text2(0)
MyDB.Field("Address1") = Text2(1)
MyDB.Field("Address2") = Text2(2)
MyDB.Field("City") = Text2(3)
MyDB.Field("State") = Text2(4)
MyDB.Field("Zip") = Text2(5)
updateflags
Text1.Text = "MyDB.Field(" + Chr$(34) + "Name" + Chr$(34) + ") = Text2(0)"
Text1 = Text1 + vbCrLf + "MyDB.Field(" + Chr$(34) + "Address1" + Chr$(34) + ") = Text2(1)"
Text1 = Text1 + vbCrLf + "MyDB.Field(" + Chr$(34) + "Address2" + Chr$(34) + ") = Text2(2)"
Text1 = Text1 + vbCrLf + "MyDB.Field(" + Chr$(34) + "City" + Chr$(34) + ") = Text2(3)"
Text1 = Text1 + vbCrLf + "MyDB.Field(" + Chr$(34) + "State" + Chr$(34) + ") = Text2(4)"
Text1 = Text1 + vbCrLf + "MyDB.Field(" + Chr$(34) + "Zip" + Chr$(34) + ") = Text2(5)"
End Sub
Private Sub Command9_Click()
If Not MyDB.DBOpen Then Exit Sub
Text1.Text = "If MyDB.Eof Then Exit Sub" + vbCrLf + "MyDB.MoveLast" + vbCrLf + "ShowFields" + vbCrLf + "UpdateFlags"
If MyDB.EOF Then Exit Sub
MyDB.MoveLast
ShowFields
updateflags
End Sub
Private Sub Form_Load()
'Form3.Show 1
If Dir$(App.Path + "\sample.sdb") = "" Then
MyDB.StartCreate
MyDB.AddField "Name", 0, 35
MyDB.AddField "Company", 0, 35
MyDB.AddField "Address1", 0, 35
MyDB.AddField "Address2", 0, 35
MyDB.AddField "City", 0, 35
MyDB.AddField "State", 0, 2
MyDB.AddField "Zip", 0, 15
result = MyDB.CreateDb(App.Path + "\sample.sdb")
If result = False Then MsgBox "Could not create file."
Form1.Show
Form1.Refresh
MyDB.StartDb App.Path + "\sample.sdb"
Command11_Click
MyDB.StopDb
End If
MyDB.StartDb App.Path + "\sample.sdb"
If MyDB.DBOpen = False Then MsgBox "Could not open Database."
MyDB.MoveFirst
ShowFields
updateflags
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MyDB.DBOpen Then MyDB.StopDb
Set MyDB = Nothing
End Sub
Private Sub Timer1_Timer()
Static myinterval7 As Integer
Static myinterval6 As Integer
If comm7down = True Then
Text1.Text = "If MyDB.bof Then Exit Sub" + vbCrLf + "MyDB.MovePrevious" + vbCrLf + "ShowFields" + vbCrLf + "UpdateFlags"
If MyDB.BOF Then Exit Sub
MyDB.MovePrevious
ShowFields
updateflags
myinterval7 = 1
Timer1.Interval = myinterval7
Exit Sub
myinterval7 = 2000
Timer1.Interval = myinterval7
End If
If comm6down = True Then
Text1.Text = "If MyDB.Eof Then Exit Sub" + vbCrLf + "MyDB.MovePrevious" + vbCrLf + "ShowFields" + vbCrLf + "UpdateFlags"
If MyDB.EOF Then Exit Sub
MyDB.MoveNext
ShowFields
updateflags
myinterval6 = 1
Timer1.Interval = myinterval6
myinterval6 = 2000
Timer1.Interval = myinterval6
End If
End Sub