home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_code1
/
address
/
address.frm
next >
Wrap
Text File
|
1993-07-05
|
51KB
|
1,794 lines
VERSION 2.00
Begin Form Address
BackColor = &H00C0C0C0&
Caption = "Mike's Address"
ClientHeight = 5355
ClientLeft = 2115
ClientTop = 1410
ClientWidth = 5175
Height = 6045
Icon = ADDRESS.FRX:0000
Left = 2055
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 5355
ScaleWidth = 5175
Top = 780
Width = 5295
Begin Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 4560
Top = 2520
End
Begin SSCommand Command3D3
BevelWidth = 4
Caption = "&Voice"
Font3D = 3 'Inset w/light shading
Height = 375
Left = 120
TabIndex = 34
Top = 4920
Width = 855
End
Begin ListBox List2
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 450
Left = 1080
TabIndex = 11
Top = 4725
Width = 3975
End
Begin ListBox List1
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 3180
Left = 5280
TabIndex = 27
TabStop = 0 'False
Top = 480
Visible = 0 'False
Width = 1215
End
Begin CommandButton Command1
Caption = "|>"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 275
Index = 3
Left = 4875
TabIndex = 26
TabStop = 0 'False
Top = 4440
Visible = 0 'False
Width = 300
End
Begin CommandButton Command1
Caption = ">"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 275
Index = 2
Left = 4580
TabIndex = 25
TabStop = 0 'False
Top = 4440
Visible = 0 'False
Width = 300
End
Begin CommandButton Command1
Caption = "<"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 275
Index = 1
Left = 285
TabIndex = 24
TabStop = 0 'False
Top = 4440
Visible = 0 'False
Width = 300
End
Begin CommandButton Command1
Caption = "|<"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 275
Index = 0
Left = 0
TabIndex = 23
TabStop = 0 'False
Top = 4440
Visible = 0 'False
Width = 300
End
Begin Data Data1
Caption = "Data1"
Connect = ""
DatabaseName = ""
Exclusive = 0 'False
Height = 270
Left = 0
Options = 0
ReadOnly = 0 'False
RecordSource = ""
Top = 4440
Width = 5175
End
Begin SSPanel Panel3D1
Alignment = 6 'Center - TOP
BackColor = &H00C0C0C0&
BevelInner = 2 'Raised
BorderWidth = 1
Font3D = 3 'Inset w/light shading
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 4455
Left = 0
TabIndex = 12
Top = 0
Width = 5175
Begin SSCommand Command3D2
Caption = "&Update"
Font3D = 3 'Inset w/light shading
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 3360
TabIndex = 30
Top = 0
Width = 855
End
Begin SSCommand Command3D1
Caption = "&Cancel"
Font3D = 3 'Inset w/light shading
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 4200
TabIndex = 31
Top = 0
Width = 855
End
Begin TextBox Text11
DataField = "tAlpha"
DataSource = "Data1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Courier"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 4200
MaxLength = 5
TabIndex = 5
Text = "tAlph"
Top = 1680
Width = 855
End
Begin TextBox Text10
DataField = "tRegion"
DataSource = "Data1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Courier"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 1800
MaxLength = 15
TabIndex = 7
Text = "tRegion"
Top = 2280
Width = 2175
End
Begin TextBox Text9
DataField = "tPhone"
DataSource = "Data1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Courier"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 120
MaxLength = 35
TabIndex = 10
Text = "tPhone"
Top = 4080
Width = 4935
End
Begin TextBox Text8
DataField = "tInfo"
DataSource = "Data1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Courier"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 120
MaxLength = 35
TabIndex = 9
Text = "tInfo"
Top = 3480
Width = 4935
End
Begin TextBox Text7
DataField = "tMessage"
DataSource = "Data1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Courier"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 120
MaxLength = 35
TabIndex = 8
Text = "tMessage"
Top = 2880
Width = 4935
End
Begin TextBox Text6
DataField = "tZip"
DataSource = "Data1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Courier"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 120
MaxLength = 10
TabIndex = 6
Text = "tZip"
Top = 2280
Width = 1575
End
Begin TextBox Text5
DataField = "tState"
DataSource = "Data1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Courier"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 3120
MaxLength = 6
TabIndex = 4
Text = "tState"
Top = 1680
Width = 975
End
Begin TextBox Text4
DataField = "tCity"
DataSource = "Data1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Courier"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 120
MaxLength = 20
TabIndex = 3
Text = "tCity"
Top = 1680
Width = 2895
End
Begin TextBox Text3
DataField = "tStreet2"
DataSource = "Data1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Courier"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 120
MaxLength = 35
TabIndex = 2
Text = "tStreet2"
Top = 1090
Width = 4935
End
Begin TextBox Text2
DataField = "tStreet1"
DataSource = "Data1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Courier"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 120
MaxLength = 35
TabIndex = 1
Text = "tStreet1"
Top = 840
Width = 4935
End
Begin TextBox Text1
DataField = "tName"
DataSource = "Data1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Courier"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 120
MaxLength = 35
TabIndex = 0
Text = "tName"
Top = 240
Width = 4935
End
Begin Label Label12
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Last Update:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00800000&
Height = 210
Left = 4080
TabIndex = 29
Top = 2040
Width = 1020
End
Begin Label Label11
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "00-00-0000"
DataField = "tDate"
DataSource = "Data1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00800000&
Height = 210
Left = 4080
TabIndex = 28
Top = 2280
Width = 840
End
Begin Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Order:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 210
Left = 4200
TabIndex = 22
Top = 1440
Width = 525
End
Begin Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Country:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 210
Left = 1800
TabIndex = 21
Top = 2040
Width = 705
End
Begin Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Phone:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 210
Left = 120
TabIndex = 20
Top = 3840
Width = 570
End
Begin Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Information:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 210
Left = 120
TabIndex = 19
Top = 3240
Width = 1005
End
Begin Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Message:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 210
Left = 120
TabIndex = 18
Top = 2640
Width = 810
End
Begin Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Zip Code:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 210
Left = 120
TabIndex = 17
Top = 2040
Width = 780
End
Begin Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "State:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 210
Left = 3120
TabIndex = 16
Top = 1440
Width = 465
End
Begin Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "City:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 210
Left = 120
TabIndex = 15
Top = 1440
Width = 360
End
Begin Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Street Address:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 210
Left = 120
TabIndex = 14
Top = 600
Width = 1320
End
Begin Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Name:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 210
Left = 120
TabIndex = 13
Top = 0
Width = 510
End
End
Begin Label Label14
DataField = "tVoice"
DataSource = "Data1"
Height = 255
Left = 120
TabIndex = 33
Top = 5040
Visible = 0 'False
Width = 855
End
Begin Label Label13
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Name List:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 210
Left = 120
TabIndex = 32
Top = 4725
Width = 870
End
Begin Menu MenuFile
Caption = "&File"
Begin Menu MenuAddRecord
Caption = "&Add Record"
End
Begin Menu MenuDeleteRecord
Caption = "&Delete Record"
End
Begin Menu MenuBrowseRecords
Caption = "&Browse Records"
End
Begin Menu MenuSearchRecords
Caption = "&Search Records"
End
Begin Menu Hash1
Caption = "-"
End
Begin Menu MenuExit
Caption = "E&xit"
End
End
Begin Menu MenuEdit
Caption = "&Edit"
Begin Menu MenuCut
Caption = "&Cut"
End
Begin Menu MenuCopy
Caption = "C&opy"
End
Begin Menu MenuPaste
Caption = "&Paste"
End
Begin Menu MenuClear
Caption = "C&lear"
End
Begin Menu Hash2
Caption = "-"
End
Begin Menu MenuCopyAddress
Caption = "Copy &Address"
End
End
Begin Menu MenuPrint
Caption = "&Print"
Begin Menu MenuNameList
Caption = "&Name List"
End
Begin Menu MenuNamePhoneList
Caption = "Name && &Phone List"
Begin Menu MenuOneList
Caption = "&One Line"
End
Begin Menu MenuTwoList
Caption = "&Two Lines"
End
End
End
Begin Menu MenuVoice
Caption = "V&oice"
Begin Menu MenuRecordVoice
Caption = "&Record"
End
Begin Menu MenuDeleteVoice
Caption = "&Delete"
End
End
Begin Menu MenuPhone
Caption = "P&hone"
Begin Menu MenuDial
Caption = "&Dial"
End
Begin Menu MenuSetup
Caption = "&SetUp"
End
End
Begin Menu MenuDatabase
Caption = "&DataBase"
Begin Menu MenuCompact
Caption = "&Compact"
End
End
End
Dim CurrRec As Long
Dim DBName As String
Dim SkipIt As Integer
Dim CancelFlag As Integer
Dim ABM As String
Dim MyRec As Long
Dim TotRec As Long
Dim AlreadySet As Integer
Dim SearchFlag As Integer
Dim CallString As String
Dim OkSize As Integer
Sub Command1_Click (Index As Integer)
'Our Buttons try to simulate the data control buttons
'This helps to keep the recordset in order
UpdateTheRecord
Select Case Index
Case 0
If MyRec <> 1 Then Data1.Recordset.MoveFirst
Case 1
If MyRec <> 1 Then Data1.Recordset.MovePrevious
Case 2
If MyRec <> TotRec Then Data1.Recordset.MoveNext
Case 3
If MyRec <> TotRec Then Data1.Recordset.MoveLast
End Select
End Sub
Sub Command3D1_Click ()
CancelFlag = True 'cancelflag set to stop update
If Label14.Caption <> "" Then 'make sure delete any wav file saved
xx$ = Label14.Caption
On Error Resume Next
Kill xx$
End If
If ABM <> "" Then 'this tells us if recordset has any records
Data1.Recordset.Bookmark = ABM
Command3D1.Visible = False
Command3D2.Visible = False
MenuAddRecord.Enabled = True
MenuDeleteRecord.Enabled = True
If SearchFlag Then
MenuSearchRecords.Enabled = False
MenuBrowseRecords.Enabled = True
Else
MenuSearchRecords.Enabled = True
MenuBrowseRecords.Enabled = False
End If
If Label14.Caption <> "" Then
Command3D3.Enabled = True
Else
Command3D3.Enabled = False
End If
List2.Visible = True
Data1.Enabled = True
ABM = "" 'must turn off bookmark after cancel
Else
MenuAddRecord_Click
End If
End Sub
Sub Command3D2_Click ()
'Update the added record and the name list and display
'new record in browse mode
If Data1.EditMode = 2 Then
Label11.Caption = Date$
Data1.Recordset.Update
If Data1.EditMode = 0 Then 'record written ?
Data1.Recordset.MoveLast
CurrRec = Data1.Recordset!ID
Data1.Refresh
UpdateMyList
List2.Visible = True
Data1.Recordset.FindFirst "ID = " & CStr(CurrRec)
Else
On Local Error GoTo NoNo
Data1.Recordset.FindFirst "ID = " & CStr(CurrRec)
End If
ABM = "" 'must turn off bookmark when add finished
End If
Data1.Enabled = True
MenuAddRecord.Enabled = True
MenuDeleteRecord.Enabled = True
MenuSearchRecords.Enabled = True
Command3D2.Visible = False
Command3D1.Visible = False
Exit Sub
NoNo:
If Err = 3021 Then
Resume Next
Else
Resume Next
End If
End Sub
Sub Command3D3_Click ()
'play the voice file. It error then just exit. Don't
'cause the user alot of hassle
If Label14.Caption = "" Then Exit Sub
Command3D3.Enabled = False
MenuVoice.Enabled = False
PlayFile$ = Trim$(Label14.Caption)
OpenStr$ = "open " & PlayFile$ & " alias talk"
If Not MMSend%(OpenStr$) Then
Command3D3.Enabled = True 'may need to recheck label14
MenuVoice.Enabled = True
Exit Sub
End If
If Not MMSend%("play talk from 0") Then
X% = MMSend%("close talk")
Command3D3.Enabled = True
MenuVoice.Enabled = True
Exit Sub
Else
Timer1.Enabled = True 'start timer to check when to close
End If
End Sub
Sub CommandOff ()
For i% = 0 To 3
Command1(i%).Visible = False
Next i%
AlreadySet = False
End Sub
Sub Data1_Error (DataErr As Integer, Response As Integer)
'Display an error if database file can't be found and exit
Select Case DataErr
Case 3004
Response = 0
Msg$ = "Couldn't Find DataBase " & DBName
Beep
MsgBox Msg$, 16, ErrorMsg
End
Case 3024
Response = 0
Msg$ = "Couldn't Find File " & DBName
Beep
MsgBox Msg$, 16, ErrorMsg
End
End Select
End Sub
Sub Data1_Reposition ()
If SkipIt Then Exit Sub 'don't do anything
Dim ds As dynaset
Dim bm As String
'update MyRec and TotRec to try and make sure we are on
'top of things. Change caption in data1 to reflect where
'we are at...hopefully
If Data1.Recordset.EOF = 0 Then
Set ds = Data1.Recordset.Clone()
bm = Data1.Recordset.Bookmark
ds.MoveFirst
MyRec = 1
While ds.Bookmark <> bm
MyRec = MyRec + 1
ds.MoveNext
Wend
ds.MoveLast
TotRec = ds.RecordCount
ds.Close
Data1.Caption = "Record " & CStr(MyRec) & " of " & CStr(TotRec)
End If
'keep the listbox index up to date if possible
If List1.ListCount <> 0 And Data1.Recordset.EOF = 0 And Data1.EditMode <> 2 Then
For i% = 0 To List1.ListCount - 1
If List1.List(i%) = CStr(Data1.Recordset!ID) Then
List1.ListIndex = i%
List2.ListIndex = i%
Exit For
End If
Next i%
End If
'keep Comman3d3 up to date as far as enabled property
If Not Timer1.Enabled Then
If Label14.Caption = "" Then
Command3D3.Enabled = False
Else
Command3D3.Enabled = True
End If
End If
End Sub
Sub Data1_Validate (Action As Integer, Save As Integer)
'skip update if this flag set. used by cancel button in
'add mode
If CancelFlag = True Then
CancelFlag = False
Save = False
Exit Sub
End If
Select Case Action
Case 6
Case 11 'form unload
If Save = True Then
Beep
If MsgBox("Commit Changes before Closing?", 36, "Mike's Address") <> 6 Then
Save = False
Else
Label11.Caption = Date$ 'make sure save new date
End If
End If
End Select
End Sub
Sub FilterString (ts$)
'Make sure that we don't goof up SQLQ special characters
'and get them confused with our search string. The [ and
'] characters are not allowed in search string.
cString$ = ""
If InStr(ts$, "#") Or InStr(ts$, "*") Or InStr(ts$, "?") Then
For i% = 1 To Len(ts$)
a$ = Mid$(ts$, i%, 1)
If a$ = "#" Or a$ = "*" Or a$ = "?" Then
cString$ = cString$ & "[" & a$ & "]"
Else
cString$ = cString$ & a$
End If
Next i%
ts$ = cString$
End If
End Sub
Sub Form_Load ()
Dim ds As dynaset
ErrorMsg = "Mike's Address Error"
If App.PrevInstance Then 'load only one
Beep
MsgBox "Mike's Address Already Running.", 16, ErrorMsg
End
End If
ThePath = App.Path 'ThePath is Global Variable
If Right$(ThePath, 1) <> "\" Then
ThePath = ThePath & "\"
End If
X$ = ThePath & "Address.ini"
If Not INISetup%(X$) Then 'we need an ini file
Beep
MsgBox "Unable to SetUp Initialization File.", 16, ErrorMsg
End
End If
'check to see if we have wave playing device. if not then
'we just turn off a button and caption so they are not
'available to the user.
If Not IsWavePlay%() Then
MenuVoice.Visible = False
Command3D3.Visible = False
End If
'set the window position
Default$ = "NOTOP"
INIFile$ = ThePath & "Address.ini"
TheTop$ = GetPPKeyString$("Position", "aTop", Default$, INIFile$)
TheLeft$ = GetPPKeyString$("Position", "aLeft", Default$, INIFile$)
If TheTop$ = "NOTOP" Or TheLeft$ = "NOTOP" Then
Address.Top = (Screen.Height - Address.Height) \ 2
Address.Left = (Screen.Width - Address.Width) \ 2
Else
Address.Top = CDbl(TheTop$)
Address.Left = CDbl(TheLeft$)
End If
'open up that database
DBName = ThePath & "ADDRESS.MDB"
Data1.DatabaseName = DBName
Data1.RecordSource = "Select * From Addresses Order by tAlpha"
SkipIt = True
Command3D2.Visible = False
Command3D1.Visible = False
Data1.Refresh
Address.Show
'if database empty then go to add mode
If Data1.Recordset.BOF And Data1.Recordset.EOF Then
MenuAddRecord_Click
Else 'else update list box and show first record
UpdateMyList
List1.ListIndex = 0
List2.ListIndex = 0
Set ds = Data1.Recordset.Clone()
ds.MoveLast
TotRec = ds.RecordCount
ds.Close
MyRec = 1
Data1.Caption = "Record " & CStr(MyRec) & " of " & CStr(TotRec)
MenuBrowseRecords.Enabled = False
If Label14.Caption = "" Then
Command3D3.Enabled = False
End If
End If
SkipIt = False
End Sub
Sub Form_Resize ()
'I like a border around my application and need the minimize
'button. This procedure lets me have the border and prevents
'the user from resizing the form. Note there is a flag
'to allow me to resize the form from code.
If Address.Height <> 6045 Or Address.Width <> 5295 Then
If Address.WindowState <> 1 Then
If OkSize = False Then
Address.Height = 6045
Address.Width = 5295
End If
End If
End If
End Sub
Sub Form_Unload (Cancel As Integer)
'make sure we close out the player if still running
Y% = MMSend("close talk") 'make sure we are closed
'save form position to ini file for next start up
INIFile$ = ThePath & "Address.ini"
SetName$ = CStr(Address.Top)
Y% = WritePPKeyString%("Position", "aTop", SetName$, INIFile$)
SetName$ = CStr(Address.Left)
Y% = WritePPKeyString%("Position", "aLeft", SetName$, INIFile$)
End
End Sub
Sub Label14_Click ()
'this label receives the path to the voice file
End Sub
Sub List2_DblClick ()
If List2.ListCount = 0 Then Exit Sub
TheID$ = List1.List(List2.ListIndex)
If Command1(0).Visible = True Then
UpdateTheRecord
End If
Data1.Recordset.FindFirst "ID= " & TheID$
End Sub
Sub List2_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
List2_DblClick
End If
End Sub
Sub MenuAddRecord_Click ()
On Local Error GoTo cNewErr
If Command1(0).Visible Then
UpdateTheRecord
End If
ABM = ""
'save the following values for future use
CurrRec = Data1.Recordset!ID
ABM = Data1.Recordset.Bookmark
Data1.Recordset.AddNew
Data1.Caption = "New Record"
List2.Visible = False
Data1.Enabled = False
MenuAddRecord.Enabled = False
MenuDeleteRecord.Enabled = False
MenuBrowseRecords.Enabled = False
MenuSearchRecords.Enabled = False
Command3D2.Visible = True
Command3D1.Visible = True
Command3D3.Enabled = False
Text1.SetFocus
Exit Sub
cNewErr:
'If Err = 3021 Then
' CurrRec = -1
Resume Next
'Else
'Resume cnewEnd
'End If
cnewEnd:
End Sub
Sub MenuBrowseRecords_Click ()
Dim ds As dynaset
'save records if something has changed only if command1
'is visible
If Command1(0).Visible Then
UpdateTheRecord
End If
SkipIt = True
SearchFlag = False
MenuSearchRecords.Enabled = True
MenuBrowseRecords.Enabled = False
'reset the recordsource and refresh to original recordset
Data1.RecordSource = "Select * From Addresses Order by tAlpha"
Data1.Refresh
'if empty then go to add mode
If Data1.Recordset.BOF And Data1.Recordset.EOF Then
Beep
MsgBox "No Records to Browse. Going to Add Mode.", 16, ErrorMsg
MenuAddRecord_Click
Else
UpdateMyList
List1.ListIndex = 0
List2.ListIndex = 0
Set ds = Data1.Recordset.Clone()
ds.MoveLast
TotRec = ds.RecordCount
ds.Close
MyRec = 1
Data1.Caption = "Record " & CStr(MyRec) & " of " & CStr(TotRec)
If Label14.Caption <> "" Then
Command3D3.Enabled = True
Else
Command3D3.Enabled = False
End If
End If
SkipIt = False
End Sub
Sub MenuClear_Click ()
'delete some text and set for update
Screen.ActiveControl.SelText = ""
SetUpdate
End Sub
Sub MenuCompact_Click ()
Dim ds As dynaset
'we can change the form size by setting the oksize flag
'we do this so someone doesn't start click controls on
'the main form while we are compacting
OkSize = True
Address.Height = 200
Standby.Show
Standby.Refresh
Data1.Database.Close 'VERY IMPORTANT
cSource$ = ThePath & "Address.mdb"
cDest$ = ThePath & "NAddress.mdb"
On Error Resume Next
CompactDatabase cSource$, cDest$
If Err Then
Beep
MsgBox "Unable to Compact DataBase.", 16, ErrorMsg
On Error GoTo 0
GoTo cReload
End If
On Error GoTo 0
Kill cSource$
Name cDest$ As cSource$
cReload:
'reload the database
Data1.DatabaseName = DBName
Data1.RecordSource = "Select * From Addresses Order by tAlpha"
SkipIt = True
Command3D2.Visible = False
Command3D1.Visible = False
Data1.Refresh
If Data1.Recordset.BOF And Data1.Recordset.EOF Then
MenuAddRecord_Click
Else
UpdateMyList
List1.ListIndex = 0
List2.ListIndex = 0
Set ds = Data1.Recordset.Clone()
ds.MoveLast
TotRec = ds.RecordCount
ds.Close
MyRec = 1
Data1.Caption = "Record " & CStr(MyRec) & " of " & CStr(TotRec)
MenuBrowseRecords.Enabled = False
If Label14.Caption = "" Then
Command3D3.Enabled = False
End If
End If
SkipIt = False
'resize form back and keep the user out of it
OkSize = False
Address.Height = 6045
Unload Standby
End Sub
Sub MenuCopy_Click ()
Clipboard.Clear
Clipboard.SetText Screen.ActiveControl.SelText
End Sub
Sub MenuCopyAddress_Click ()
TheString$ = ""
TheString$ = Trim$(Text1.Text) & Chr$(13) & Chr$(10)
If Trim$(Text2.Text) <> "" Then
TheString$ = TheString$ & Trim$(Text2.Text) & Chr$(13) & Chr$(10)
End If
If Trim$(Text3.Text) <> "" Then
TheString$ = TheString$ & Trim$(Text3.Text) & Chr$(13) & Chr$(10)
End If
If Trim$(Text4.Text) <> "" Then
TheString$ = TheString$ & Trim$(Text4.Text) & ", " & Trim$(Text5.Text)
TheString$ = TheString$ & " " & Trim$(Text6.Text) & " " & Trim$(Text10.Text) & Chr$(13) & Chr$(10)
End If
If Trim$(Text7.Text) <> "" Then
TheString$ = TheString$ & Trim$(Text7.Text) & Chr$(13) & Chr$(10)
End If
Clipboard.Clear
Clipboard.SetText TheString$
End Sub
Sub MenuCut_Click ()
MenuCopy_Click
Screen.ActiveControl.SelText = ""
SetUpdate
End Sub
Sub MenuDeleteRecord_Click ()
CommandOff
For i% = 0 To List1.ListCount - 1 'Make sure index set right
If List1.List(i%) = CStr(Data1.Recordset!ID) Then
List1.ListIndex = i%
List2.ListIndex = i%
Exit For
End If
Next i%
List1.RemoveItem List1.ListIndex
List2.RemoveItem List2.ListIndex
xx$ = Label14.Caption
On Error Resume Next
Kill xx$
Data1.Recordset.Delete
Data1.Recordset.MoveNext
If Data1.Recordset.EOF Then
On Local Error GoTo cDelErr 'this required if last record deleted
Data1.Recordset.MovePrevious
End If
Exit Sub
cDelErr:
If Err = 3021 Then
If SearchFlag = False Then
Beep
MsgBox "Last Recorded in Database Deleted.", 16, ErrorMsg
MenuAddRecord_Click
Resume cDelEnd
Else
Beep
MsgBox "Last Record in Search Deleted. Returning to Browse Mode.", 16, ErrorMsg
MenuBrowseRecords_Click
Resume cDelEnd
End If
Else
Resume cDelEnd
End If
cDelEnd:
End Sub
Sub MenuDeleteVoice_Click ()
'obvious
X$ = Label14.Caption
Label14.Caption = ""
Command3D3.Enabled = False
On Error Resume Next
Kill X$
On Error GoTo 0
End Sub
Sub MenuDial_Click ()
'check the port form ini file. note if user has not used
'setup at least once he or she will be told to
Default$ = "NOPORT"
INIFile$ = ThePath & "ADDRESS.INI"
TC$ = GetPPKeyString$("Phone", "Port", Default$, INIFile$)
If TC$ = "NOPORT" Then
Beep
MsgBox "You Must SetUp a Comm Port.", 16, ErrorMsg
Exit Sub
End If
TheComm = CInt(TC$) 'thecomm is a global variable
'check callstring for bad characters
CheckString$ = "1234567890()-,"
BadNum% = False
For i% = 1 To Len(CallString)
a$ = Mid$(CallString, i%, 1)
If InStr(CheckString$, a$) = 0 Then
Beep
MsgBox "Selected Number is Incorrect.", 16, ErrorMsg
BadNum% = True
Exit For
End If
Next i%
If BadNum% Then Exit Sub
Dial.Text1.Text = CallString
Dial.Show 1
End Sub
Sub MenuEdit_Click ()
'make sure only the right menu items are enabled
MenuCut.Enabled = True
MenuCopy.Enabled = True
MenuPaste.Enabled = False
MenuClear.Enabled = True
MenuCopyAddress.Enabled = True
If TypeOf Screen.ActiveControl Is TextBox Then
If Clipboard.GetFormat(1) Then MenuPaste.Enabled = True
If Screen.ActiveControl.SelText = "" Then
MenuCut.Enabled = False
MenuCopy.Enabled = False
MenuClear.Enabled = False
End If
Else
MenuCut.Enabled = False
MenuCopy.Enabled = False
MenuClear.Enabled = False
End If
End Sub
Sub MenuExit_Click ()
Unload Address
End Sub
Sub MenuNameList_Click ()
Dim ds As dynaset
PrintX.Show
Set ds = Data1.Recordset.Clone()
MaxRows% = Int(Printer.Height / Printer.TextHeight("T"))
MaxRows% = MaxRows% - 5
Printer.Print "Mike's Address Name List"
Printer.Print String$(35, "=")
PrintedRows% = 0
Do While Not ds.EOF
If IsNull(ds("tName")) Then 'watch out for
Printer.Print "XXXXXX" 'and substitute
Else
Printer.Print ds("tName")
End If
DoEvents
If PrintCancel Then Exit Do
PrintedRows% = PrintedRows% + 1
If PrintedRows% = MaxRows% Then
Printer.NewPage
Printer.Print "Mike's Address Name List"
Printer.Print String$(35, "=")
PrintedRows% = 0
End If
ds.MoveNext
Loop
Printer.EndDoc
ds.Close
Unload PrintX
End Sub
Sub MenuOneList_Click ()
Dim ds As dynaset
PrintX.Show
Set ds = Data1.Recordset.Clone()
MaxRows% = Int(Printer.Height / Printer.TextHeight("T"))
MaxRows% = MaxRows% - 5
Printer.Print "Mike's Address Name & Phone List"
Printer.Print String$(75, "=")
PrintedRows% = 0
Do While Not ds.EOF
If IsNull(ds("tName")) Then
Printer.Print "XXXXXX"; String$(40 - 6, ".");
Else
Printer.Print ds("tName"); String$(40 - Len(ds("tName")), ".");
End If
If IsNull(ds("tPhone")) Then
Printer.Print " "
Else
Printer.Print (ds("tPhone"))
End If
DoEvents
If PrintCancel Then Exit Do
PrintedRows% = PrintedRows% + 1
If PrintedRows% = MaxRows% Then
Printer.NewPage
Printer.Print "Mike's Address Name & Phone List"
Printer.Print String$(75, "=")
PrintedRows% = 0
End If
ds.MoveNext
Loop
Printer.EndDoc
ds.Close
Unload PrintX
End Sub
Sub MenuPaste_Click ()
Screen.ActiveControl.SelText = Clipboard.GetText()
SetUpdate
End Sub
Sub MenuPhone_Click ()
MenuDial.Enabled = False
'make sure we have a good callstring selected before we
'allow a call to be dialed
If TypeOf Screen.ActiveControl Is TextBox Then
If Trim$(Screen.ActiveControl.SelText) <> "" Then
CallString = Screen.ActiveControl.SelText
CallString = Trim$(CallString)
MenuDial.Enabled = True
End If
End If
End Sub
Sub MenuRecordVoice_Click ()
RecordIt.Show 1
If RecordIt.Tag = "NO" Then
Beep
MsgBox "Unable to Complete Recording.", 16, ErrorMsg
End If
If Label14.Caption <> "" Then
Command3D3.Enabled = True
Else
Command3D3.Enabled = False
End If
Unload RecordIt
End Sub
Sub MenuSearchRecords_Click ()
Dim ds As dynaset
If Command1(0).Visible Then
UpdateTheRecord
End If
CommandOff
CurrRec = Data1.Recordset!ID
Search.Show 1
'this is one heck of a way to do things
If Search.Tag = "YES" Then
ThePattern$ = Trim$(Search.Text1.Text)
FilterString ThePattern$
ThePattern$ = " '*" & ThePattern$ & "*' OR "
SQLQ$ = "SELECT * FROM Addresses WHERE "
cFilter$ = ""
If Search.Check3D1.Value Then
cFilter$ = cFilter$ & "tName LIKE" & ThePattern$
End If
If Search.Check3D2.Value Then
cFilter$ = cFilter$ & "tStreet1 LIKE" & ThePattern$ & "tStreet2 LIKE" & ThePattern$
End If
If Search.Check3D3.Value Then
cFilter$ = cFilter$ & "tCity LIKE" & ThePattern$
End If
If Search.Check3D4.Value Then
cFilter$ = cFilter$ & "tState LIKE" & ThePattern$
End If
If Search.Check3D5.Value Then
cFilter$ = cFilter$ & "tZip LIKE" & ThePattern$
End If
If Search.Check3D6.Value Then
cFilter$ = cFilter$ & "tRegion LIKE" & ThePattern$
End If
If Search.Check3D7.Value Then
cFilter$ = cFilter$ & "tMessage LIKE" & ThePattern$
End If
If Search.Check3D8.Value Then
cFilter$ = cFilter$ & "tInfo LIKE" & ThePattern$
End If
If Search.Check3D9.Value Then
cFilter$ = cFilter$ & "tPhone LIKE" & ThePattern$
End If
cFilter$ = Left$(cFilter$, Len(cFilter$) - 3)
SQLQ$ = SQLQ$ & cFilter$ & " ORDER BY tAlpha"
Data1.RecordSource = SQLQ$
SkipIt = True
Data1.Refresh
If Data1.Recordset.BOF And Data1.Recordset.EOF Then
Beep
Msg$ = "Search String " & Search.Text1.Text & " Not Found."
MsgBox Msg$, 16, ErrorMsg
Data1.RecordSource = "Select * From Addresses Order by tAlpha"
Data1.Refresh
UpdateMyList
SkipIt = False
Data1.Recordset.FindFirst "ID = " & CStr(CurrRec)
If Label14.Caption <> "" Then
Command3D3.Enabled = True
Else
Command3D3.Enabled = False
End If
Else
SearchFlag = True
MenuSearchRecords.Enabled = False
MenuBrowseRecords.Enabled = True
UpdateMyList
List1.ListIndex = 0
List2.ListIndex = 0
Set ds = Data1.Recordset.Clone()
ds.MoveLast
TotRec = ds.RecordCount
ds.Close
MyRec = 1
Data1.Caption = "Record " & CStr(MyRec) & " of " & CStr(TotRec)
If Label14.Caption <> "" Then
Command3D3.Enabled = True
Else
Command3D3.Enabled = False
End If
SkipIt = False
End If
Else
If Search.Tag = "NO" Then
Beep
MsgBox "Illegal Search Criteria !!!", 16, ErrorMsg
End If
End If
Unload Search
End Sub
Sub MenuSetup_Click ()
Setup.Show 1
End Sub
Sub MenuTwoList_Click ()
Dim ds As dynaset
PrintX.Show
Set ds = Data1.Recordset.Clone()
MaxRows% = Int(Printer.Height / Printer.TextHeight("T"))
MaxRows% = (MaxRows% - 5) \ 3
Printer.Print "Mike's Address Name & Phone List"
Printer.Print String$(35, "=")
PrintedRows% = 0
Do While Not ds.EOF
If IsNull(ds("tName")) Then
Printer.Print "XXXXXX"
Else
Printer.Print ds("tName")
End If
If IsNull(ds("tPhone")) Then
Printer.Print " "
Else
Printer.Print ds("tPhone")
End If
Printer.Print String$(35, "_")
DoEvents
If PrintCancel Then Exit Do
PrintedRows% = PrintedRows% + 1
If PrintedRows% = MaxRows% Then
Printer.NewPage
Printer.Print "Mike's Address Name & Phone List"
Printer.Print String$(35, "=")
PrintedRows% = 0
End If
ds.MoveNext
Loop
Printer.EndDoc
ds.Close
Unload PrintX
End Sub
Sub MenuVoice_Click ()
'delete only available if label14 has caption
If Label14.Caption = "" Then
MenuDeleteVoice.Enabled = False
Else
MenuDeleteVoice.Enabled = True
End If
End Sub
Sub SetUpdate ()
'If someone has changed something then use our buttons
'and not the data control's. This assures that we keep
'the database in correct order.
If Data1.EditMode = 2 Then Exit Sub
If AlreadySet Then Exit Sub
For i% = 0 To 3
Command1(i%).Visible = True
Next i%
Data1.Enabled = False
AlreadySet = True
End Sub
Sub Text1_KeyDown (KeyCode As Integer, Shift As Integer)
'need to set update if char deleted
If KeyCode = 46 Then 'delete key hit
SetUpdate
End If
End Sub
Sub Text1_KeyPress (KeyAscii As Integer)
'cr=tab
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
Exit Sub
End If
'set for update something has changed
SetUpdate
End Sub
Sub Text10_KeyDown (KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Then 'delete key hit
SetUpdate
End If
End Sub
Sub Text10_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
Exit Sub
End If
SetUpdate
End Sub
Sub Text11_KeyDown (KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Then 'delete key hit
SetUpdate
End If
End Sub
Sub Text11_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
Exit Sub
End If
SetUpdate
End Sub
Sub Text2_KeyDown (KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Then 'delete key hit
SetUpdate
End If
End Sub
Sub Text2_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
Exit Sub
End If
SetUpdate
End Sub
Sub Text3_KeyDown (KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Then 'delete key hit
SetUpdate
End If
End Sub
Sub Text3_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
Exit Sub
End If
SetUpdate
End Sub
Sub Text4_KeyDown (KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Then 'delete key hit
SetUpdate
End If
End Sub
Sub Text4_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
Exit Sub
End If
SetUpdate
End Sub
Sub Text5_KeyDown (KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Then 'delete key hit
SetUpdate
End If
End Sub
Sub Text5_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
Exit Sub
End If
SetUpdate
End Sub
Sub Text6_KeyDown (KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Then 'delete key hit
SetUpdate
End If
End Sub
Sub Text6_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
Exit Sub
End If
SetUpdate
End Sub
Sub Text7_KeyDown (KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Then 'delete key hit
SetUpdate
End If
End Sub
Sub Text7_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
Exit Sub
End If
SetUpdate
End Sub
Sub Text8_KeyDown (KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Then 'delete key hit
SetUpdate
End If
End Sub
Sub Text8_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
Exit Sub
End If
SetUpdate
End Sub
Sub Text9_KeyDown (KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Then 'delete key hit
SetUpdate
End If
End Sub
Sub Text9_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
Exit Sub
End If
SetUpdate
End Sub
Sub Timer1_Timer ()
'if voice file is playing then keep checking. when done
'then close things out and turn the timer off
Stat$ = "status talk mode"
Mlen% = 255
Msg$ = String$(255, 0)
Ret& = mciSendString(Stat$, Msg$, Mlen%, Address.hWnd)
If InStr(Msg$, "playing") = 0 Then
X% = MMSend%("close talk")
If Label14.Caption <> "" Then
Command3D3.Enabled = True
End If
MenuVoice.Enabled = True
Timer1.Enabled = False
End If
End Sub
Sub UpdateMyList ()
'Lets refresh the list box. Note we must watch out for
'records with NUL tName field and substitute xxxxxx.
Dim ds As dynaset
List1.Clear
List2.Clear
Set ds = Data1.Recordset.Clone()
'ds.MoveFirst 'not needed problem with one record left
Do While Not ds.EOF
List1.AddItem CStr(ds("ID"))
If IsNull(ds("tName")) Then
List2.AddItem "XXXXXX"
Else
List2.AddItem ds("tName")
End If
ds.MoveNext
Loop
ds.Close
End Sub
Sub UpdateTheRecord ()
'We update the record and refresh data1 to bring back
'the order we want. Note that we try to come back to the
'record we had before refresh. Also we update the date
'for the record here.
Label11.Caption = Date$
Data1.Recordset.Update
If Data1.EditMode = 0 Then
CurrRec = Data1.Recordset!ID
Data1.Refresh
UpdateMyList
Data1.Recordset.FindFirst "ID =" & CStr(CurrRec)
Else
Data1.UpdateControls
End If
CommandOff
Data1.Enabled = True
End Sub