Visual Basic Programmer'…arterly (Limited Edition)/Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso/code/ch08code/address.frm

Text File | 1994-09-19 | 13KB | 431 lines

VERSION 4.00
Begin VB.Form Address
   Caption         =   "Sample Address Book Application"
   ClientHeight    =   5235
   ClientLeft      =   1365
   ClientTop       =   1500
   ClientWidth     =   8325
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   Height          =   5640
   Left            =   1305
   LinkTopic       =   "Form1"
   ScaleHeight     =   5235
   ScaleWidth      =   8325
   Top             =   1155
   Width           =   8445
   Begin VB.CommandButton ImportDbase
      Caption         =   "Import Dbase"
      Height          =   255
      Left            =   120
      TabIndex        =   26
      Top             =   3960
      Width           =   1935
   End
   Begin VB.TextBox AddressCtl
      Height          =   375
      Index           =   1
      Left            =   1320
      TabIndex        =   25
      Top             =   120
      Width           =   3375
   End
   Begin VB.CommandButton Command1
      Caption         =   "Clear"
      Height          =   615
      Left            =   2280
      TabIndex        =   1
      Top             =   4440
      Width           =   1095
   End
   Begin VB.CommandButton FindPrevious
      Caption         =   "Find Previous"
      Height          =   615
      Left            =   6840
      TabIndex        =   24
      Top             =   4440
      Width           =   1335
   End
   Begin VB.CommandButton FindNext
      Caption         =   "Find Next"
      Height          =   615
      Left            =   5520
      TabIndex        =   23
      Top             =   4440
      Width           =   1335
   End
   Begin VB.CommandButton FindFirst
      Caption         =   "Find First"
      Height          =   615
      Left            =   4200
      TabIndex        =   22
      Top             =   4440
      Width           =   1335
   End
   Begin VB.CommandButton Delete
      Caption         =   "Delete"
      Height          =   615
      Left            =   1200
      TabIndex        =   21
      Top             =   4440
      Width           =   1095
   End
   Begin VB.CommandButton Add
      Caption         =   "Add"
      Height          =   615
      Left            =   120
      TabIndex        =   20
      Top             =   4440
      Width           =   1095
   End
   Begin VB.TextBox AddressCtl
      Height          =   975
      Index           =   10
      Left            =   960
      TabIndex        =   19
      Top             =   2640
      Width           =   6735
   End
   Begin VB.TextBox AddressCtl
      Height          =   375
      Index           =   9
      Left            =   6120
      TabIndex        =   18
      Top             =   2160
      Width           =   1935
   End
   Begin VB.TextBox AddressCtl
      Height          =   375
      Index           =   8
      Left            =   3840
      TabIndex        =   17
      Top             =   2160
      Width           =   1455
   End
   Begin VB.TextBox AddressCtl
      Height          =   375
      Index           =   7
      Left            =   960
      TabIndex        =   16
      Top             =   2160
      Width           =   1575
   End
   Begin VB.TextBox AddressCtl
      Height          =   375
      Index           =   6
      Left            =   4920
      TabIndex        =   15
      Top             =   1560
      Width           =   1935
   End
   Begin VB.TextBox AddressCtl
      Height          =   375
      Index           =   5
      Left            =   3120
      TabIndex        =   14
      Top             =   1560
      Width           =   615
   End
   Begin VB.TextBox AddressCtl
      Height          =   375
      Index           =   4
      Left            =   840
      TabIndex        =   13
      Top             =   1560
      Width           =   1575
   End
   Begin VB.TextBox AddressCtl
      Height          =   375
      Index           =   3
      Left            =   1320
      TabIndex        =   12
      Top             =   1080
      Width           =   3375
   End
   Begin VB.TextBox AddressCtl
      Height          =   375
      Index           =   2
      Left            =   1320
      TabIndex        =   11
      Top             =   600
      Width           =   3375
   End
   Begin VB.Label Label11
      Caption         =   "Notes:"
      Height          =   255
      Left            =   240
      TabIndex        =   10
      Top             =   2760
      Width           =   615
   End
   Begin VB.Label Label10
      Caption         =   "Work Phone:"
      Height          =   255
      Left            =   2640
      TabIndex        =   9
      Top             =   2280
      Width           =   1215
   End
   Begin VB.Label Label9
      Caption         =   "Fax:"
      Height          =   255
      Left            =   5400
      TabIndex        =   8
      Top             =   2280
      Width           =   495
   End
   Begin VB.Label Label8
      Caption         =   "Phone:"
      Height          =   255
      Left            =   240
      TabIndex        =   7
      Top             =   2280
      Width           =   735
   End
   Begin VB.Label Label7
      Caption         =   "Zip Code:"
      Height          =   255
      Left            =   3840
      TabIndex        =   6
      Top             =   1680
      Width           =   975
   End
   Begin VB.Label Label6
      Caption         =   "State:"
      Height          =   255
      Left            =   2520
      TabIndex        =   5
      Top             =   1680
      Width           =   615
   End
   Begin VB.Label Label5
      Caption         =   "City:"
      Height          =   255
      Left            =   240
      TabIndex        =   4
      Top             =   1680
      Width           =   495
   End
   Begin VB.Label Label4
      Caption         =   "Street 2:"
      Height          =   255
      Left            =   240
      TabIndex        =   3
      Top             =   1200
      Width           =   975
   End
   Begin VB.Label Label3
      Caption         =   "Street:"
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   720
      Width           =   975
   End
   Begin VB.Label Label1
      Caption         =   "Name:"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   975
   End
End
Attribute VB_Name = "Address"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
    ' Since all fields are in a control array
' I will setup defines for accessing them
Const NAME_FLD = 1
Const STREET_FLD = 2
Const STREET2_FLD = 3
Const CITY_FLD = 4
Const STATE_FLD = 5
Const ZIP_FLD = 6
Const PHONE_FLD = 7
Const WORK_FLD = 8
Const FAX_FLD = 9
Const NOTES_FLD = 10
Const FIRST_FLD = NAME_FLD
Const LAST_FLD = NOTES_FLD

' Objects and variables global to the application
Dim Ws As Workspace
Dim Db As Database
Dim Tbl As Recordset
Dim SearchSet As Recordset
Dim MemoSet As Recordset
Dim AddInfoAdd As Recordset
Dim SrchValue As String

Private Sub Add_Click()
    If Not AddressCtl(NAME_FLD) = "" Then
        Tbl.AddNew
        Tbl.Fields("Name").Value = AddressCtl(NAME_FLD)
        Tbl.Fields("Street").Value = AddressCtl(STREET_FLD)
        Tbl.Fields("Street2").Value = AddressCtl(STREET2_FLD)
        Tbl.Fields("City").Value = AddressCtl(CITY_FLD)
        Tbl.Fields("State").Value = AddressCtl(STATE_FLD)
        Tbl.Fields("ZipCode").Value = AddressCtl(ZIP_FLD)
        Tbl.Fields("Phone").Value = AddressCtl(PHONE_FLD)
        Tbl.Fields("WorkPhone").Value = AddressCtl(WORK_FLD)
        Tbl.Fields("Fax").Value = AddressCtl(FAX_FLD)
        Tbl.Update
        'Tbl.Fields("Notes").Value = AddressCtl(NOTES_FLD)
        'Tbl.Update

        AddInfoAdd.AddNew
        AddInfoAdd.Fields("Name").Value = AddressCtl(NAME_FLD)
        AddInfoAdd.Fields("Notes").Value = AddressCtl(NOTES_FLD)
        AddInfoAdd.Update
    End If
End Sub

Private Sub Command1_Click()
    Dim i As Integer
    For i = FIRST_FLD To LAST_FLD Step 1
        AddressCtl(i) = ""
    Next i
End Sub

Private Sub Delete_Click()
    If Not SearchSet.NoMatch Then
       SearchSet.Delete
       If Not MemoSet.NoMatch Then
        MemoSet.Delete
       End If
       Command1_Click
       FindFirst_Click
    End If
End Sub

Private Sub FillFormfromImport()
    If Not SearchSet.NoMatch Then
        AddressCtl(NAME_FLD) = ValidateRecordField("Name")
        AddressCtl(STREET_FLD) = ValidateRecordField("Street")
        AddressCtl(STREET2_FLD) = ValidateRecordField("Street2")
        AddressCtl(CITY_FLD) = ValidateRecordField("City")
        AddressCtl(STATE_FLD) = ValidateRecordField("State")
        AddressCtl(ZIP_FLD) = ValidateRecordField("ZipCode")
        AddressCtl(PHONE_FLD) = ValidateRecordField("Phone")
        AddressCtl(WORK_FLD) = ValidateRecordField("WorkPhone")
        AddressCtl(FAX_FLD) = ValidateRecordField("Fax")
        AddressCtl(NOTES_FLD) = ValidateRecordField("Notes")
    End If

End Sub

Private Sub FillFormfromRecord()
    If Not SearchSet.NoMatch Then
        AddressCtl(NAME_FLD) = ValidateRecordField("Name")
        AddressCtl(STREET_FLD) = ValidateRecordField("Street")
        AddressCtl(STREET2_FLD) = ValidateRecordField("Street2")
        AddressCtl(CITY_FLD) = ValidateRecordField("City")
        AddressCtl(STATE_FLD) = ValidateRecordField("State")
        AddressCtl(ZIP_FLD) = ValidateRecordField("ZipCode")
        AddressCtl(PHONE_FLD) = ValidateRecordField("Phone")
        AddressCtl(WORK_FLD) = ValidateRecordField("WorkPhone")
        AddressCtl(FAX_FLD) = ValidateRecordField("Fax")

        Dim AttachStatement As String
        AttachStatement = "SELECT * FROM AddInfo WHERE Name = '" + AddressCtl(NAME_FLD) + "'"
        Set MemoSet = Db.OpenRecordSet(AttachStatement, dbOpenDynaset)
        If MemoSet.BOF = False Then
            If MemoSet.Fields("Notes").Value > "" Then
                AddressCtl(NOTES_FLD) = MemoSet.Fields("Notes").Value
            Else
                AddressCtl(NOTES_FLD) = ""
            End If
        End If
    End If
End Sub

Private Sub FindFirst_Click()
    Dim Statement As String
    Statement = "SELECT * FROM Address WHERE Name >= '" + AddressCtl(NAME_FLD) + "'"
    Set SearchSet = Db.OpenRecordSet(Statement, dbOpenDynaset)
    FillFormfromRecord
End Sub

Private Sub FindNext_Click()
    SearchSet.FindNext "Name > ' '"
    FillFormfromRecord
End Sub

Private Sub FindPrevious_Click()
    SearchSet.FindPrevious "Name > ' '"
    FillFormfromRecord
End Sub

Private Sub Form_Load()
    Dim TblDef As New TableDef

    ' The first step is to create a default workspace to use for the app
    Set Ws = DBEngine.Workspaces(0)
    ' second open the access database
    Set Db = Ws.OpenDatabase("\vb4\address\address.mdb")

    ' now attach the dbase IV table to the open db
    TblDef.Connect = "dBASE IV;DATABASE=\VB4\ADDress"
    TblDef.SourceTableName = "ADDINFO"   ' The name of the file.
    TblDef.Name = "AddInfo"    ' The name in your database.
    Db.TableDefs.Append TblDef  ' Create the link.

    ' now open a table info the main database
    Set Tbl = Db.OpenRecordSet("Address", dbOpenTable)

    ' now we need to create a dynaset from the attached table
    Statement = "SELECT * FROM Address WHERE Name >= '" + AddressCtl(NAME_FLD) + "'"
    Set AddInfoAdd = Db.OpenRecordSet("SELECT * FROM AddInfo", dbOpenDynaset)
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Tbl.Close
    AddInfoAdd.Close
    Db.TableDefs.Delete "AddInfo"
End Sub




Private Sub ImportDbase_Click()
    Dim dbdb As Database
    Dim DTable As Recordset
    Dim Statement As String

    Set dbdb = Ws.OpenDatabase("\vb4\address", False, False, "dBase IV")
    Set DTable = dbdb.OpenRecordSet("Address", dbOpenTable)

    Statement = "SELECT * FROM Address"
    Set SearchSet = dbdb.OpenRecordSet(Statement, dbOpenDynaset)
    While Not SearchSet.EOF
        FillFormfromImport
        Add_Click
        Command1_Click
        SearchSet.MoveNext
    Wend
    dbdb.Close
    DTable.Close
End Sub

Private Function ValidateRecordField(Field As String) As String
    If SearchSet.BOF = False Then
        If SearchSet.Fields(Field).Value > "" Then
            ValidateRecordField = SearchSet.Fields(Field).Value
        Else
            ValidateRecordField = ""
        End If
    End If
End Function