On Hand/On_Hand_From_Softbank_1994_Release_2_Disc_2_1994.iso/00202/s/disk3/phone.fr_/phone.bin

Text File | 1993-04-28 | 22KB | 823 lines

VERSION 2.00
Begin Form Phone
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Phone List"
   ClientHeight    =   4410
   ClientLeft      =   675
   ClientTop       =   1005
   ClientWidth     =   8205
   Height          =   4815
   Left            =   615
   LinkTopic       =   "Phone"
   MaxButton       =   0   'False
   ScaleHeight     =   4410
   ScaleWidth      =   8205
   Top             =   660
   Width           =   8325
   Begin CommandButton cUpdate
      Caption         =   "&Update"
      Height          =   465
      Left            =   3075
      TabIndex        =   10
      Top             =   3900
      Width           =   2190
   End
   Begin CommandButton cDelete
      Caption         =   "&Delete"
      Height          =   465
      Left            =   5925
      TabIndex        =   11
      Top             =   3900
      Width           =   1965
   End
   Begin CommandButton cNew
      Caption         =   "&New"
      Height          =   465
      Left            =   375
      TabIndex        =   9
      Top             =   3900
      Width           =   2040
   End
   Begin PictureBox Picture1
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   2790
      Left            =   2250
      ScaleHeight     =   2790
      ScaleWidth      =   5715
      TabIndex        =   17
      Top             =   600
      Width           =   5715
      Begin TextBox tPost
         BackColor       =   &H00C0C0C0&
         DataSource      =   "Data1"
         Height          =   285
         Index           =   0
         Left            =   4425
         TabIndex        =   7
         Text            =   "tPost"
         Top             =   1800
         Width           =   1140
      End
      Begin TextBox tCountry
         BackColor       =   &H00C0C0C0&
         DataSource      =   "Data1"
         Height          =   315
         Index           =   0
         Left            =   1125
         TabIndex        =   6
         Text            =   "tCountry"
         Top             =   1800
         Width           =   1965
      End
      Begin TextBox tCity
         BackColor       =   &H00C0C0C0&
         DataSource      =   "Data1"
         Height          =   285
         Index           =   0
         Left            =   1125
         TabIndex        =   4
         Text            =   "tCity"
         Top             =   1350
         Width           =   1515
      End
      Begin TextBox tFName
         BackColor       =   &H00C0C0C0&
         DataField       =   "FirstName"
         DataSource      =   "Data1"
         Height          =   285
         Left            =   4050
         TabIndex        =   2
         Text            =   "tFName"
         Top             =   75
         Width           =   1515
      End
      Begin TextBox tRegion
         BackColor       =   &H00C0C0C0&
         DataSource      =   "Data1"
         Height          =   285
         Index           =   0
         Left            =   4425
         TabIndex        =   5
         Text            =   "tRegion"
         Top             =   1335
         Width           =   1140
      End
      Begin TextBox tAddress
         BackColor       =   &H00C0C0C0&
         DataSource      =   "Data1"
         Height          =   585
         Index           =   0
         Left            =   1110
         MultiLine       =   -1  'True
         TabIndex        =   3
         Text            =   "tAddress"
         Top             =   555
         Width           =   4455
      End
      Begin TextBox tPhone
         BackColor       =   &H00C0C0C0&
         DataSource      =   "Data1"
         Height          =   285
         Index           =   0
         Left            =   1125
         TabIndex        =   8
         Text            =   "tPhone"
         Top             =   2400
         Width           =   1665
      End
      Begin TextBox tLName
         BackColor       =   &H00C0C0C0&
         DataField       =   "LastName"
         DataSource      =   "Data1"
         Height          =   285
         Left            =   1125
         TabIndex        =   1
         Text            =   "tLName"
         Top             =   75
         Width           =   1605
      End
      Begin Label Label11
         BackColor       =   &H00C0C0C0&
         Caption         =   "Postal Code:"
         Height          =   240
         Left            =   3225
         TabIndex        =   25
         Top             =   1800
         Width           =   1140
      End
      Begin Label Label10
         BackColor       =   &H00C0C0C0&
         Caption         =   "Country:"
         Height          =   240
         Left            =   225
         TabIndex        =   24
         Top             =   1800
         Width           =   690
      End
      Begin Label Label9
         BackColor       =   &H00C0C0C0&
         Caption         =   "City:"
         Height          =   240
         Left            =   525
         TabIndex        =   23
         Top             =   1350
         Width           =   390
      End
      Begin Label Label8
         BackColor       =   &H00C0C0C0&
         Caption         =   "First Name:"
         Height          =   255
         Left            =   3000
         TabIndex        =   22
         Top             =   75
         Width           =   975
      End
      Begin Label Label7
         BackColor       =   &H00C0C0C0&
         Caption         =   "Region:"
         Height          =   255
         Left            =   3600
         TabIndex        =   21
         Top             =   1335
         Width           =   660
      End
      Begin Label Label6
         BackColor       =   &H00C0C0C0&
         Caption         =   "Address:"
         Height          =   255
         Left            =   225
         TabIndex        =   20
         Top             =   555
         Width           =   735
      End
      Begin Label Label5
         BackColor       =   &H00C0C0C0&
         Caption         =   "Phone:"
         Height          =   255
         Left            =   375
         TabIndex        =   19
         Top             =   2400
         Width           =   615
      End
      Begin Label Label4
         BackColor       =   &H00C0C0C0&
         Caption         =   "Last Name:"
         Height          =   255
         Left            =   0
         TabIndex        =   18
         Top             =   120
         Width           =   975
      End
   End
   Begin PictureBox Picture2
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   465
      Left            =   2175
      Picture         =   PHONE.FRX:0000
      ScaleHeight     =   465
      ScaleWidth      =   4740
      TabIndex        =   13
      Top             =   75
      Width           =   4740
      Begin Label Label1
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         Caption         =   "Work"
         Height          =   240
         Left            =   75
         TabIndex        =   16
         Top             =   150
         Width           =   840
      End
      Begin Label Label2
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         Caption         =   "Home"
         Height          =   240
         Left            =   1050
         TabIndex        =   15
         Top             =   150
         Width           =   765
      End
      Begin Label Label3
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         Caption         =   "Notes"
         Height          =   240
         Left            =   1950
         TabIndex        =   14
         Top             =   150
         Width           =   840
      End
   End
   Begin Outline Outline1
      BackColor       =   &H00C0C0C0&
      Height          =   3765
      Left            =   75
      PictureClosed   =   PHONE.FRX:2C3C
      PictureLeaf     =   PHONE.FRX:2EB6
      PictureMinus    =   PHONE.FRX:3130
      PictureOpen     =   PHONE.FRX:33AA
      PicturePlus     =   PHONE.FRX:3624
      Style           =   2  'Plus/Minus and Text
      TabIndex        =   0
      Top             =   75
      Width           =   2040
   End
   Begin TextBox tNotes
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      DataField       =   "Notes"
      DataSource      =   "Data1"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   2865
      Left            =   2250
      MultiLine       =   -1  'True
      TabIndex        =   12
      Text            =   "tNotes"
      Top             =   600
      Width           =   5715
   End
   Begin Data Data1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Data1"
      Connect         =   ""
      DatabaseName    =   ""
      Exclusive       =   0   'False
      Height          =   315
      Left            =   2175
      Options         =   0
      ReadOnly        =   0   'False
      RecordSource    =   ""
      Top             =   3525
      Width           =   5940
   End
   Begin Image pTab1
      Height          =   480
      Left            =   300
      Picture         =   PHONE.FRX:389E
      Top             =   5175
      Width           =   4800
   End
   Begin Image pTab3
      Height          =   480
      Left            =   300
      Picture         =   PHONE.FRX:64DA
      Top             =   6375
      Width           =   4800
   End
   Begin Image pTab2
      Height          =   480
      Left            =   300
      Picture         =   PHONE.FRX:9116
      Top             =   5775
      Width           =   4800
   End
   Begin Line Line3
      X1              =   8100
      X2              =   8100
      Y1              =   3525
      Y2              =   525
   End
   Begin Line Line2
      X1              =   8100
      X2              =   6900
      Y1              =   525
      Y2              =   525
   End
   Begin Line Line1
      X1              =   2175
      X2              =   2175
      Y1              =   3525
      Y2              =   525
   End
End
Dim DBName As String
Dim gLIBDB As Database
Dim gDS As DynaSet
Dim gCode As String
Dim iCurrentRecord As Integer
Dim fAll As Integer
Dim CurrRec As Integer
Dim fStartUp As Integer
Dim iEditMode As Integer

Const EM_NOTHING = 0
Const EM_EDIT = 1
Const EM_ADDNEW = 2

Const YES = 6
Const MSGBOX_TYPE = 4 + 48

Sub cDelete_Click ()
  If Outline1.Indent(Outline1.ListIndex) = 2 Then   'Expanded name.
    Outline1.RemoveItem Outline1.ListIndex
  Else
    Outline1.Expand(Outline1.ListIndex) = True
    For i = Outline1.ListIndex To Outline1.ListCount - 1
      If Outline1.List(i) = Data1.Recordset!LastName + ", " + Data1.Recordset!FirstName Then
        Outline1.RemoveItem i
        Exit For
      End If
    Next i
  End If

  Data1.Recordset.Delete
  Data1.Recordset.MoveNext
  If Data1.Recordset.EOF Then Data1.Recordset.MovePrevious
  Outline1.SetFocus

End Sub

Sub closedb ()
  On Error Resume Next
  gLIBDB.Close
End Sub

Sub cNew_Click ()
  On Error GoTo cNewErr

  CurrRec = Data1.Recordset!ID
  Data1.Recordset.AddNew
  Data1.Caption = "New Record"
  Data1.Enabled = False
  cNew.Enabled = False
  cDelete.Enabled = False
  cUpdate.Enabled = True

  tLName.SetFocus

  GoTo cNewEnd

cNewErr:
  If Err = 3021 Then Resume Next
  MsgBox Error$
  Resume cNewEnd

cNewEnd:


End Sub

Sub cUpdate_Click ()
  If tLName <> "" And tFName <> "" Then
    If Data1.EditMode = EM_ADDNEW Then
      Data1.Recordset.Update
      If Data1.EditMode = 0 Then    'Did record get written?
        Data1.Recordset.MoveLast
        CurrRec = Data1.Recordset!ID
        Data1.Refresh
        FillList
        ProcessOutline
        Data1.Recordset.FindFirst "ID = " + CStr(CurrRec)
      Else
        Data1.Recordset.FindFirst "ID = " + CStr(CurrRec)
      End If
    Else
      Data1.Recordset.Update
      If Data1.EditMode = 0 Then
        CurrRec = Data1.Recordset!ID
        Data1.Refresh
        FillList
        ProcessOutline
        Data1.Recordset.FindFirst "ID = " + CStr(CurrRec)
      Else
        Data1.UpdateControls
      End If
    End If
    Data1.Enabled = True
    cNew.Enabled = True
    cDelete.Enabled = True
    cUpdate.Enabled = False
    Outline1.SetFocus

  Else
    MsgBox "First and last name must have a value"
  End If
End Sub

Sub Data1_RePosition ()
  gCode = tNotes.Text

  If Not Data1.Recordset.EOF Then
    'Set the Data Control's caption:
    If Not IsNull(Data1.Recordset!LastName) And Not IsNull(Data1.Recordset!FirstName) Then
      Data1.Caption = Data1.Recordset!LastName + ", " + Data1.Recordset!FirstName
    Else
      Data1.Caption = ""
    End If

    'Set Outline Control's selection to match current record:
    For i% = 0 To Outline1.ListCount - 1
      If Outline1.List(i%) = Data1.Recordset!LastName + ", " + Data1.Recordset!FirstName Then
        Outline1.ListIndex = i%
        If Not Outline1.IsItemVisible(Outline1.ListIndex) Then
          'Set focus to first level item:
          stChar = Left(Outline1.FullPath(Outline1.ListIndex), 1)
          Do While stChar <> Outline1.List(Outline1.ListIndex)
            Outline1.ListIndex = Outline1.ListIndex - 1
          Loop
        End If
        Exit For
      End If
    Next i%
  Else
    Data1.Caption = "No records found!"
  End If
End Sub

Sub Data1_Validate (Action As Integer, Save As Integer)

  Select Case Action
    Case 1          'First

    Case 2          'Previous

    Case 3          'Next

    Case 4          'Last

    Case 5          'AddNew

    Case 6          'Update
      If Save = True Then
        If MsgBox("Commit Changes?", MSGBOX_TYPE) <> YES Then Action = 0: Save = False
      End If

    Case 7          'Delete

    Case 8
      Save = False

    Case 9          'BookMark

    Case 10          'Close
      If Save = True Then
        If MsgBox("Commit Changes before Closing?", MSGBOX_TYPE) <> YES Then Save = False
      End If

  End Select

End Sub

Sub FillList ()
  On Error GoTo FillPhoneErr

  Set gDS = Data1.Recordset.Clone()

  Outline1.Clear
  'Fill top level A-Z
  For i = 0 To 25
      Outline1.AddItem Chr$(65 + i)
      Outline1.Indent(Outline1.ListCount - 1) = 1

      'Add Names
      Do While Not gDS.EOF
            If UCase(Left(gDS!LastName, 1)) = Chr$(65 + i) Then
              Outline1.AddItem gDS!LastName + ", " + gDS!FirstName
              Outline1.Indent(Outline1.ListCount - 1) = 2
              gDS.MoveNext
            Else
              Exit Do
            End If
      Loop
  Next i

EndOfData:
  Exit Sub

FillPhoneErr:
  MsgBox Error(Err)
  Resume Next
  Exit Sub


End Sub

Sub Form_Load ()
  DBName = App.Path + "\phone.mdb"
  fStartUp = True
  Data1.DatabaseName = DBName
  X% = OpenDB(DBName)

  Load tPhone(1)
  Load tAddress(1)
  Load tCity(1)
  Load tRegion(1)
  Load tCountry(1)
  Load tPost(1)

  cUpdate.Enabled = False
  RefreshForm

End Sub

Sub Label1_Click ()
  Picture2.Picture = pTab1.Picture
  Picture1.Visible = True

  tPhone(0).Visible = True
  tAddress(0).Visible = True
  tCity(0).Visible = True
  tRegion(0).Visible = True
  tCountry(0).Visible = True
  tPost(0).Visible = True

  tPhone(1).Visible = False
  tAddress(1).Visible = False
  tCity(1).Visible = False
  tRegion(1).Visible = False
  tCountry(1).Visible = False
  tPost(1).Visible = False

  tNotes.Visible = False
End Sub

Sub Label2_Click ()
  Picture2.Picture = pTab2.Picture
  Picture1.Visible = True

  tPhone(1).Visible = True
  tAddress(1).Visible = True
  tCity(1).Visible = True
  tRegion(1).Visible = True
  tCountry(1).Visible = True
  tPost(1).Visible = True

  tPhone(0).Visible = False
  tAddress(0).Visible = False
  tCity(0).Visible = False
  tRegion(0).Visible = False
  tCountry(0).Visible = False
  tPost(0).Visible = False

  tNotes.Visible = False
End Sub

Sub Label3_Click ()
  Picture2.Picture = pTab3.Picture

  Picture1.Visible = False
  tNotes.Visible = True

End Sub

Function OpenDB (DBName As String) As Integer
  Dim Connect As String

  On Error GoTo OpenDBErr

  Set gLIBDB = OpenDatabase(DBName)

  'success
  OpenDB = True
  GoTo OpenDBEnd

OpenDBErr:
  OpenDB = False
  Resume OpenDBEnd

OpenDBEnd:

End Function

Sub Outline1_Click ()
  Dim stLName As String
  Dim stFName As String

  If Outline1.Indent(Outline1.ListIndex) = 2 Then
    stTmp$ = Outline1.List(Outline1.ListIndex)
    stLName = stGetToken$(stTmp$, ",")
    stFName = Right(stTmp$, Len(stTmp$) - 1)

    Data1.Recordset.FindFirst "LastName='" + stLName + "' and FirstNAME='" + stFName + "'"
  End If

End Sub

Sub Outline1_Collapse (i As Integer)
  Outline1.ListIndex = i
End Sub

Sub Outline1_DblClick ()
  If Outline1.Expand(Outline1.ListIndex) Then
    Outline1.Expand(Outline1.ListIndex) = False
  Else
    Outline1.Expand(Outline1.ListIndex) = True
  End If
End Sub

Sub Outline1_Expand (i As Integer)
  Outline1.ListIndex = i
End Sub

Sub Outline1_KeyPress (KeyAscii As Integer)
  If KeyAscii = 13 Then
    Outline1_DblClick
  End If
End Sub

Sub ProcessOutline ()
  For i% = 0 To Outline1.ListCount - 1
    If Outline1.HasSubItems(i%) Then
      Outline1.Expand(i%) = False
    End If
  Next i%
End Sub

Sub RefreshForm ()
  Data1.RecordSource = "select * from PhoneList order by LastName,FirstName"
  Data1.Refresh

  'Set DataField properties for control array
  tPhone(0).DataField = "WorkPhone"
  tAddress(0).DataField = "WorkAddress"
  tCity(0).DataField = "WorkCity"
  tRegion(0).DataField = "WorkRegion"
  tCountry(0).DataField = "WorkCountry"
  tPost(0).DataField = "WorkPostalCode"

  tPhone(1).DataField = "HomePhone"
  tAddress(1).DataField = "HomeAddress"
  tCity(1).DataField = "HomeCity"
  tRegion(1).DataField = "HomeRegion"
  tCountry(1).DataField = "HomeCountry"
  tPost(1).DataField = "HomePostalCode"

  FillList
  ProcessOutline

  If fStartUp Then
    Label1_Click
    SendKeys "{Home}"   'Move selection to top of Outline.
    fStartUp = False
  End If

End Sub

Function stGetID (ctrl As Control)
  stTxt$ = ctrl.Text
  i% = InStr(stTxt$, " ")
  stTmp$ = stTxt$
  Do While i% <> 0
    stTmp$ = Right$(stTmp$, Len(stTmp$) - i%)
    i% = InStr(stTmp$, " ")
  Loop
  stGetID = stTmp$
End Function

Function stGetToken (stLn$, stDelim$) As String
    On Error GoTo GetTokenError

    iOpenQuote% = InStr(1, stLn$, """")
    iDelim% = InStr(1, stLn$, stDelim$)

    If (iOpenQuote% > 0) And (iOpenQuote% < iDelim%) Then
         iCloseQuote% = InStr(iOpenQuote% + 1, stLn$, """")
         iDelim% = InStr(iCloseQuote% + 1, stLn$, stDelim$)
    End If

    If (iDelim% <> 0) Then
         stToken$ = LTrim$(RTrim$(Mid$(stLn$, 1, iDelim% - 1)))
         stLn$ = Mid$(stLn$, iDelim% + 1)
    Else
         stToken$ = LTrim$(RTrim$(Mid$(stLn$, 1)))
         stLn$ = ""
    End If

    If (Len(stToken$) > 0) Then
         If (Mid$(stToken$, 1, 1) = """") Then
              stToken$ = Mid$(stToken$, 2)
         End If
         If (Mid$(stToken$, Len(stToken$), 1) = """") Then
              stToken$ = Mid$(stToken$, 1, Len(stToken$) - 1)
         End If
    End If
    stGetToken = stToken$

GetTokenExit:
    Exit Function

GetTokenError:
    Resume GetTokenExit
End Function

Sub tAddress_KeyPress (Index As Integer, KeyAscii As Integer)
  Data1.Enabled = False
  cNew.Enabled = False
  cDelete.Enabled = False
  cUpdate.Enabled = True

End Sub

Sub tCity_KeyPress (Index As Integer, KeyAscii As Integer)
  Data1.Enabled = False
  cNew.Enabled = False
  cDelete.Enabled = False
  cUpdate.Enabled = True

End Sub

Sub tCountry_KeyPress (Index As Integer, KeyAscii As Integer)
  Data1.Enabled = False
  cNew.Enabled = False
  cDelete.Enabled = False
  cUpdate.Enabled = True

End Sub

Sub tFName_KeyPress (KeyAscii As Integer)
  Data1.Enabled = False
  cNew.Enabled = False
  cDelete.Enabled = False
  cUpdate.Enabled = True
End Sub

Sub tLName_KeyPress (KeyAscii As Integer)
  Data1.Enabled = False
  cNew.Enabled = False
  cDelete.Enabled = False
  cUpdate.Enabled = True
End Sub

Sub tNotes_KeyPress (KeyAscii As Integer)
  Data1.Enabled = False
  cNew.Enabled = False
  cDelete.Enabled = False
  cUpdate.Enabled = True

End Sub

Sub tPhone_KeyPress (Index As Integer, KeyAscii As Integer)
  Data1.Enabled = False
  cNew.Enabled = False
  cDelete.Enabled = False
  cUpdate.Enabled = True

End Sub

Sub tPost_KeyPress (Index As Integer, KeyAscii As Integer)
  Data1.Enabled = False
  cNew.Enabled = False
  cDelete.Enabled = False
  cUpdate.Enabled = True

End Sub

Sub tRegion_KeyPress (Index As Integer, KeyAscii As Integer)
  Data1.Enabled = False
  cNew.Enabled = False
  cDelete.Enabled = False
  cUpdate.Enabled = True

End Sub