Option Explicit
Dim RecordLenght As Integer
Dim RecordCount As Integer
Dim RecordSaved As Integer
Dim NewRecord As Integer
Dim Search As Integer
Dim Found As Integer
Dim TypeNo As Integer
Dim AsciiType As Integer
Dim RecordNo As Integer
Dim CodeChanged As Integer
Dim AbcFirstRecord As Integer
Dim AbcLastRecord As Integer
Dim ErrorType As Integer
Dim AddressCode As String * 20
Private Sub AlphabeticMovement(MovementType As Integer)
Dim PrevPointer As Integer
Dim NextPointer As Integer
Dim RndPointer As Integer
IndexRecordNo = Asc(Left$(LTrim$(Address.Code), 1)) + 1
MousePointer = 0
ErrorType = 0
If MovementType = 1 Then
If AbcFirstRecord < 1 Then
FindAbcFirstLast (1)
End If
If ErrorType > 0 Then GoTo Error
RecordNo = AbcFirstRecord
cmdPrevious.Enabled = False
If AbcFirstRecord <> AbcLastRecord Then
cmdNext.Enabled = True
End If
Repeat_1:
If RecordNo > LastRecord Or RecordNo < 1 Then
ErrorType = 3
GoTo Error
End If
Get #FileNo, RecordNo, Address
PrevPointer = Address.Previous
NextPointer = Address.Next
AsciiType = Asc(Address.TypeChr)
TypeNo = AsciiType - 48
If RecordNo = AbcFirstRecord Or RecordNo = PrevPointer Then
cmdPrevious.Enabled = False
Else
cmdPrevious.Enabled = True
If RecordNo = AbcLastRecord Or RecordNo = NextPointer Then
cmdNext.Enabled = False
Else
cmdNext.Enabled = True
End If
End If
If AsciiType < 48 Or AsciiType > 57 Then
If RecordNo = NextPointer Or RecordNo = AbcLastRecord Then
ErrorType = 4
GoTo Error
End If
RecordNo = NextPointer
GoTo Repeat_1
Else
If TypeNo > 3 Then
optPerson.Value = True
Else
optCompany.Value = True
End If
iboxCode.Text = Trim$(Address.Code)
iboxName.Text = Trim$(Address.Name)
iboxAddress1.Text = Trim$(Address.Address1)
iboxAddress2.Text = Trim$(Address.Address2)
iboxWard.Text = Trim$(Address.Ward)
iboxCity.Text = Trim$(Address.City)
iboxCountry.Text = Trim$(Address.Country)
iboxPost.Text = Trim$(Address.Post)
iboxTelephone.Text = Trim$(Address.Telephone)
iboxFax.Text = Trim$(Address.Fax)
iboxTax1.Text = Trim$(Address.Tax1)
iboxTax2.Text = Trim$(Address.Tax2)
iboxProfession.Text = Trim$(Address.Profession)
iboxSpecial.Text = Trim$(Address.Special)
End If
Else
If MovementType = 4 Then
If AbcLastRecord = 0 Or AbcLastRecord > LastRecord Then
FindAbcFirstLast (4)
End If
If ErrorType > 0 Then GoTo Error
RecordNo = AbcLastRecord
cmdNext.Enabled = False
If AbcLastRecord <> AbcFirstRecord Then
cmdPrevious.Enabled = True
End If
Repeat_4:
If RecordNo < 1 Or RecordNo > LastRecord Then
ErrorType = 5
GoTo Error
End If
Get #FileNo, RecordNo, Address
PrevPointer = Address.Previous
NextPointer = Address.Next
AsciiType = Asc(Address.TypeChr)
TypeNo = AsciiType - 48
If RecordNo = AbcLastRecord Or RecordNo = NextPointer Then
cmdNext.Enabled = False
Else
cmdNext.Enabled = True
If RecordNo = AbcFirstRecord Or RecordNo = PrevPointer Then
cmdPrevious.Enabled = False
Else
cmdPrevious.Enabled = True
End If
End If
If AsciiType < 48 Or AsciiType > 57 Then
If RecordNo = PrevPointer Or RecordNo = AbcFirstRecord Then
ErrorType = 6
GoTo Error
End If
RecordNo = PrevPointer
GoTo Repeat_4
Else
If TypeNo > 3 Then
optPerson.Value = True
Else
optCompany.Value = True
End If
iboxCode.Text = Address.Code
iboxName.Text = Address.Name
If MovementType = 2 Or MovementType = 3 Then GoTo ForwardBackward
End If
End If
GoTo Finish
ForwardBackward:
If RecordNo < 1 Then
RecordNo = AbcFirstRecord
Address.Previous = AbcFirstRecord
ErrorType = 7
GoTo Error
Else
If RecordNo > LastRecord Then
RecordNo = AbcLastRecord
Address.Next = AbcLastRecord
ErrorType = 8
GoTo Error
End If
End If
Get #FileNo, RecordNo, Address
If MovementType = 2 Then
RndPointer = Address.Previous
Else
RndPointer = Address.Next
End If
If RndPointer < 1 Or RndPointer > LastRecord Then
ErrorType = 9
GoTo Error
End If
Get #FileNo, RndPointer, Address
AsciiType = Asc(Address.TypeChr)
TypeNo = AsciiType - 48
If AsciiType < 48 Or AsciiType > 57 Then
ErrorType = 10
GoTo Error
End If
If RndPointer = AbcFirstRecord Or Address.Previous = RndPointer Then
If MovementType = 2 Then cmdPrevious.Enabled = False
Else
cmdPrevious.Enabled = True
If RndPointer = AbcLastRecord Or Address.Next = RndPointer Then
If MovementType = 3 Then cmdNext.Enabled = False
Else
cmdNext.Enabled = True
End If
End If
If TypeNo > 3 Then
optPerson.Value = True
Else
optCompany.Value = True
End If
iboxCode.Text = Address.Code
iboxName.Text = Address.Name
iboxAddress1.Text = Address.Address1
iboxAddress2.Text = Address.Address2
iboxWard.Text = Address.Ward
iboxCity.Text = Address.City
iboxCountry.Text = Address.Country
iboxPost.Text = Address.Post
iboxTelephone.Text = Address.Telephone
iboxFax.Text = Address.Fax
iboxTax1.Text = Address.Tax1
iboxTax2.Text = Address.Tax2
iboxProfession.Text = Address.Profession
iboxSpecial.Text = Address.Special
RecordNo = RndPointer
Finish:
If TypeNo = 0 Or TypeNo = 4 Then
OptPrivate.Value = True
Else
If TypeNo = 1 Or TypeNo = 5 Then
OptCustomer.Value = True
Else
OptSupplier.Value = True
End If
End If
PassIt:
If RecordSaved = False Then frmAddress.Caption = " ADDRESS 417 Version 2.3 Record :" + Str$(RecordNo) + " /" + Str$(LastRecord)
If RecordNo > 0 And RecordNo <= LastRecord Then
ActiveRecord = RecordNo
CodeChanged = False
AddressCode = Address.Code
Else
iboxTelephone.Text = ""
iboxFax.Text = ""
iboxTax1.Text = ""
iboxTax2.Text = ""
iboxProfession.Text = ""
iboxSpecial.Text = ""
frmAddress.Caption = " ADDRESS 417 Version 2.3"
End If
Search = False
NewRecord = False
RecordSaved = False
iboxCode.SetFocus
Exit Sub
Error:
If ErrorType > 0 Then
MsgBox ("Error Number :" + Str$(ErrorType)), 48, "! ALPHABETICAL INDEXING ERROR !"
If MovementType < 3 Then
cmdPrevious.Enabled = False
Else
cmdNext.Enabled = False
End If
GoTo PassIt
End If
End Sub
Private Sub iboxAddress1_KeyDown(KeyCode As Integer, Shift As Integer)
iboxAddress1.Text = LTrim(iboxAddress1.Text)
If KeyCode = KEY_DOWN Then
iboxAddress2.SetFocus
Exit Sub
End If
If KeyCode = KEY_UP Then
iboxName.SetFocus
Exit Sub
End If
FunctionKeys (KeyCode)
End Sub
Private Sub iboxAddress1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then iboxAddress2.SetFocus
End Sub
If MovementType < 3 Then
cmdPrevious.Enabled = False
Else
cmdNext.Enabled = False
End If
GoTo PassIt
End If
End Sub
Private Sub chkAlphabetical_Click()
cmdPrevious.Enabled = True
cmdNext.Enabled = True
iboxCode.SetFocus
End Sub
Private Sub iboxCode_Change()
CodeChanged = True
End Sub
Private Sub iboxCode_KeyDown(KeyCode As Integer, Shift As Integer)
iboxCode.Text = LTrim(iboxCode.Text)
If KeyCode = KEY_DOWN Then
iboxName.SetFocus
Exit Sub
End If
FunctionKeys (KeyCode)
End Sub
Private Sub iboxName_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then iboxAddress1.SetFocus
End Sub
Private Sub iboxAddress1_KeyDown(KeyCode As Integer, Shift As Integer)
iboxAddress1.Text = LTrim(iboxAddress1.Text)
If KeyCode = KEY_DOWN Then
iboxAddress2.SetFocus
Exit Sub
End If
If KeyCode = KEY_UP Then
iboxName.SetFocus
Exit Sub
End If
FunctionKeys (KeyCode)
End Sub
Private Sub iboxAddress1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then iboxAddress2.SetFocus
End Sub
Private Sub iboxAddress2_KeyDown(KeyCode As Integer, Shift As Integer)
iboxAddress2.Text = LTrim(iboxAddress2.Text)
If KeyCode = KEY_DOWN Then
iboxWard.SetFocus
Exit Sub
End If
If KeyCode = KEY_UP Then
iboxAddress1.SetFocus
Exit Sub
End If
FunctionKeys (KeyCode)
End Sub
Private Sub iboxAddress2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then iboxWard.SetFocus
End Sub
Private Sub iboxFax_KeyDown(KeyCode As Integer, Shift As Integer)
iboxFax.Text = LTrim(iboxFax.Text)
If KeyCode = KEY_DOWN Then
iboxTax1.SetFocus
Exit Sub
End If
If KeyCode = KEY_UP Then
iboxTelephone.SetFocus
Exit Sub
End If
FunctionKeys (KeyCode)
End Sub
Private Sub iboxFax_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then iboxTax1.SetFocus
End Sub
End If
FunctionKeys (KeyCode)
End Sub
Private Sub iboxCity_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then iboxCountry.SetFocus
End Sub
Private Sub iboxCode_Change()
CodeChanged = True
End Sub
Private Sub iboxCode_KeyDown(KeyCode As Integer, Shift As Integer)
iboxCode.Text = LTrim(iboxCode.Text)
If KeyCode = KEY_DOWN Then
iboxName.SetFocus
Private Sub iboxCode_Change()
CodeChanged = True
End Sub
Private Sub iboxCode_KeyDown(KeyCode As Integer, Shift As Integer)
iboxCode.Text = LTrim(iboxCode.Text)
If KeyCode = KEY_DOWN Then
iboxName.SetFocus
Else
FunctionKeys (KeyCode)
End If
End Sub
Private Sub iboxCode_KeyPress(KeyAscii As Integer)
If KeyAscii <> 13 Then Exit Sub
If Trim(iboxCode.Text) = "" Then Exit Sub
If Search = True Then
iboxProfession.Text = LTrim(iboxProfession.Text)
If KeyCode = KEY_DOWN Then
iboxSpecial.SetFocus
iboxName.SetFocus
End If
End Sub
Private Sub iboxProfession_KeyDown(KeyCode As Integer, Shift As Integer)
FunctionKeys (KeyCode)
End Sub
End If
If KeyCode = KEY_UP Then
iboxTax2.SetFocus
Exit Sub
End If
FunctionKeys (KeyCode)
End Sub
Private Sub iboxProfession_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then iboxSpecial.SetFocus
End Sub
Private Sub iboxSpecial_KeyDown(KeyCode As Integer, Shift As Integer)
iboxSpecial.Text = LTrim(iboxSpecial.Text)
If KeyCode = KEY_UP Then
iboxProfession.SetFocus
Else
FunctionKeys (KeyCode)
End If
End Sub
Private Sub iboxSpecial_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then iboxCode.SetFocus
End Sub
Private Sub iboxPost_KeyDown(KeyCode As Integer, Shift As Integer)
iboxPost.Text = LTrim(iboxPost.Text)
If KeyCode = KEY_DOWN Then
iboxTelephone.SetFocus
Exit Sub
End If
If KeyCode = KEY_UP Then
iboxCountry.SetFocus
Exit Sub
End If
FunctionKeys (KeyCode)
End Sub
Private Sub iboxPost_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then iboxTelephone.SetFocus
End Sub
Private Sub iboxWard_KeyDown(KeyCode As Integer, Shift As Integer)
iboxWard.Text = LTrim(iboxWard.Text)
If KeyCode = KEY_DOWN Then
iboxCity.SetFocus
Exit Sub
End If
If KeyCode = KEY_UP Then
iboxAddress2.SetFocus
End If
FunctionKeys (KeyCode)
End Sub
Private Sub iboxWard_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then iboxCity.SetFocus
End Sub
Private Sub iboxTelephone_KeyDown(KeyCode As Integer, Shift As Integer)
iboxTelephone.Text = LTrim(iboxTelephone.Text)
If KeyCode = KEY_DOWN Then
iboxFax.SetFocus
Exit Sub
End If
If KeyCode = KEY_UP Then
iboxPost.SetFocus
Exit Sub
End If
FunctionKeys (KeyCode)
End Sub
Private Sub iboxTelephone_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then iboxFax.SetFocus
End Sub
Private Sub iboxCountry_KeyDown(KeyCode As Integer, Shift As Integer)
iboxCountry.Text = LTrim(iboxCountry.Text)
If KeyCode = KEY_DOWN Then
iboxPost.SetFocus
Exit Sub
End If
If KeyCode = KEY_UP Then
iboxCity.SetFocus
Exit Sub
End If
FunctionKeys (KeyCode)
End Sub
Private Sub iboxCountry_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then iboxPost.SetFocus
End Sub
Private Sub iboxTax1_KeyDown(KeyCode As Integer, Shift As Integer)
iboxTax1.Text = LTrim(iboxTax1.Text)
If KeyCode = KEY_DOWN Then
iboxTax2.SetFocus
Exit Sub
End If
If KeyCode = KEY_UP Then
iboxFax.SetFocus
Exit Sub
End If
FunctionKeys (KeyCode)
End Sub
Private Sub iboxTax1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then iboxTax2.SetFocus
End Sub
Private Sub iboxTax2_KeyDown(KeyCode As Integer, Shift As Integer)
iboxTax2.Text = LTrim(iboxTax2.Text)
If KeyCode = KEY_DOWN Then
iboxProfession.SetFocus
Exit Sub
End If
If KeyCode = KEY_UP Then
iboxTax1.SetFocus
Exit Sub
End If
FunctionKeys (KeyCode)
End Sub
Private Sub iboxTax2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then iboxProfession.SetFocus
End Sub
Private Sub cmdSearch_Click()
cmdPrevious.Enabled = True
cmdNext.Enabled = True
If Search = False Then
Beep
NewRecord = False
Search = True
iboxCode.Text = ""
iboxName.Text = ""
iboxAddress1.Text = ""
iboxAddress2.Text = ""
iboxWard.Text = ""
iboxCity.Text = ""
iboxCountry.Text = ""
iboxPost.Text = ""
iboxTelephone.Text = ""
iboxFax.Text = ""
iboxTax1.Text = ""
iboxTax2.Text = ""
iboxProfession.Text = ""
iboxSpecial.Text = ""
frmAddress.Caption = " ADDRESS 417 Version 2.3 [ Record Search ] "
Else
If Trim(iboxCode.Text) <> "" Then
SearchFind
Else
Beep
End If
End If
iboxCode.SetFocus
End Sub
Private Sub cmdSearch_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> &HD Then FunctionKeys (KeyCode)
End Sub
Private Sub cmdFirst_Click()
If NewRecord = True Then
If iboxCode.Text <> "" Then
Beep
If MsgBox("The new record is not saved! Do you want to save it?", 36, "ADDRESS 417 Version 2.3") = 6 Then
SaveIt
End If
End If
cmdNext.Enabled = False
ActiveRecord = 1
RecordShow (0)
iboxCode.SetFocus
Exit Sub
End If
If chkAlphabetical.Value = 1 Then
RecordNo = ActiveRecord
AlphabeticMovement (1)
Else
If ActiveRecord = 1 Then
Beep
Else
ActiveRecord = 1
End If
RecordShow (0)
cmdPrevious.Enabled = False
If LastRecord > 1 Then
cmdNext.Enabled = True
Else
cmdNext.Enabled = False
End If
End If
iboxCode.SetFocus
End Sub
Private Sub cmdFirst_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> &HD Then FunctionKeys (KeyCode)
End Sub
Private Sub cmdExit_Click()
If NewRecord = True And iboxCode.Text <> "" Then
Beep
If MsgBox("The new record is not saved! Do you want to save it?", 36, "ADDRESS 417 Version 2.3") = 6 Then
SaveIt
End If
End If
Beep
End
End Sub
Private Sub cmdExit_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> &HD Then FunctionKeys (KeyCode)
End Sub
Private Sub cmdExport_Click()
Beep
MsgBox ("'ADDRESS 417 Version 2.3 ACCESS' program is available for converting ADDRESS 417 random data to Microsoft Access Jet 3.0 database format and vice versa. So, you can use ADDRESS 417 data in Microsoft Access environment. Locate and run 'A417MDB.EXE' program file in working directory of 'ADDRESS 417 Version 2.3' program." + Chr$(13) + Chr$(13) + "All ADDRESS 417 programs are available for downloading at 'http://www.singlix.com/download/adres417.html'."), 0, "ADDRESS 417 Version 2.3 DATA EXPORT"
End Sub
Private Sub cmdExport_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> &HD Then FunctionKeys (KeyCode)
End Sub
Private Sub cmdSave_Click()
Beep
If Trim(iboxCode.Text) = "" Or Search = True Then
iboxCode.SetFocus
Exit Sub
End If
If CodeChanged = False Then
MousePointer = 11
Address.Code = Trim(iboxCode.Text)
Address.Name = Trim(iboxName.Text)
Address.Address1 = Trim(iboxAddress1.Text)
Address.Address2 = Trim(iboxAddress2.Text)
Address.Ward = Trim(iboxWard.Text)
Address.City = Trim(iboxCity.Text)
Address.Country = Trim(iboxCountry.Text)
Address.Post = Trim(iboxPost.Text)
Address.Telephone = Trim(iboxTelephone.Text)
Address.Fax = Trim(iboxFax.Text)
Address.Tax1 = Trim(iboxTax1.Text)
Address.Tax2 = Trim(iboxTax2.Text)
Address.Profession = Trim(iboxProfession.Text)
Address.Special = Trim(iboxSpecial.Text)
If OptCustomer.Value = True Then
If optCompany.Value = True Then
TypeNo = 1
Else
TypeNo = 5
End If
Else
If OptSupplier.Value = True Then
If optCompany.Value = True Then
TypeNo = 2
Else
TypeNo = 6
TypeNo = 4
End If
End If
End If
End If
Address.TypeChr = Chr$(TypeNo + 48)
Put #FileNo, ActiveRecord, Address
MousePointer = 0
frmAddress.Caption = " Saved... Record Number :" + Str$(ActiveRecord)
Else
SearchFind
End If
iboxCode.SetFocus
End Sub
Private Sub cmdSave_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> &HD Then FunctionKeys (KeyCode)
End Sub
Private Sub cmdList_Click()
If NewRecord = True Then
If iboxCode.Text <> "" Then
Beep
If MsgBox("The new record is not saved! Do you want to save it?", 36, "ADDRESS 417 Version 2.3") = 6 Then
SaveIt
End If
End If
End If
Close #FileNo
Close #IndexFileNo
Unload frmAddress
frmLstPrep.Show
End Sub
Private Sub cmdList_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> &HD Then FunctionKeys (KeyCode)
End Sub
Private Sub cmdPrevious_Click()
cmdNext.Enabled = True
If NewRecord = True Then
If iboxCode.Text <> "" Then
Beep
If MsgBox("The new record is not saved! Do you want to save it?", 36, "ADDRESS 417 Version 2.3") = 6 Then
SaveIt
End If
End If
RecordShow (-1)
iboxCode.SetFocus
Exit Sub
End If
If chkAlphabetical.Value = 1 Then
RecordNo = ActiveRecord
AlphabeticMovement (2)
Exit Sub
Else
RecordShow (-1)
iboxCode.SetFocus
End If
End Sub
Private Sub cmdPrevious_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> &HD Then FunctionKeys (KeyCode)
End Sub
Private Sub cmdService_Click()
If NewRecord = True Then
If iboxCode.Text <> "" Then
Beep
If MsgBox("The new record is not saved! Do you want to save it?", 36, "ADDRESS 417 Version 2.3") = 6 Then
SaveIt
End If
End If
End If
Close #FileNo
Close #IndexFileNo
Unload frmAddress
frmService.Show
End Sub
Private Sub cmdService_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> &HD Then FunctionKeys (KeyCode)
End Sub
Private Sub cmdRemove_Click()
Dim PrevPointer As Integer
Dim NextPointer As Integer
Dim Char1 As String * 1
Dim Char2 As String * 1
Beep
If NewRecord = True Then
RecordShow (0)
iboxCode.SetFocus
Exit Sub
Else
RecordShow (0)
End If
If MsgBox("Do you want to remove current record ?", 36, "ADDRESS 417 Version 2.3") <> 6 Then
frmAddress.Caption = " ADDRESS 417 Version 2.3"
NewRecord = False
iboxCode.SetFocus
Exit Sub
End If
If LastRecord < 2 Then
MsgBox ("Single one record can not be removed ! (can be changed !)"), 48, "ADDRESS 417 Version 2.3"
iboxCode.SetFocus
Exit Sub
End If
If ActiveRecord < 1 Then GoTo MsgInvalidRecord
Get #FileNo, ActiveRecord, Address
PrevPointer = Address.Previous
NextPointer = Address.Next
If PrevPointer = 0 Or NextPointer = 0 Then
MsgInvalidRecord:
MsgBox "Current record is an invalid record, can not be removed !", 48, "REMOVING ERROR !"
iboxCode.SetFocus
Exit Sub
End If
iboxCode.Text = ""
iboxName.Text = ""
iboxAddress1.Text = ""
iboxAddress2.Text = ""
iboxWard.Text = ""
iboxCity.Text = ""
iboxCountry.Text = ""
iboxPost.Text = ""
iboxTelephone.Text = ""
iboxFax.Text = ""
iboxTax1.Text = ""
iboxTax2.Text = ""
iboxProfession.Text = ""
Get #FileNo, NextPointer, Address
Char2 = Left$(LTrim$(Address.Code), 1)
If Char1 = Char2 Then
Index.First = NextPointer
Else
Index.First = 0
End If
Index.Last = Index.First
End If
Else
Index.Last = Index.First
End If
Else
Index.Last = Index.First
End If
End If
Put #IndexFileNo, IndexRecordNo, Index
Get #FileNo, ActiveRecord, Address
Address.TypeChr = Chr$(Asc(Address.TypeChr) + 16)
PrevPointer = Address.Previous
NextPointer = Address.Next
Address.Previous = 0
Address.Next = 0
Put #FileNo, ActiveRecord, Address
If PrevPointer < 1 Or NextPointer < 1 Or PrevPointer > LastRecord Or NextPointer > LastRecord Then
MousePointer = 0
Beep
MsgBox ("Index pointer error in record " + Str$(ActiveRecord) + "! Run REBUILD command for rebuilding pointer chain..."), 48, "INDEX POINTER ERROR !"
Exit Sub
End If
If PrevPointer <> ActiveRecord Then
Get #FileNo, PrevPointer, Address
If Address.Next = ActiveRecord Then
If NextPointer = ActiveRecord Then
Address.Next = PrevPointer
Else
Address.Next = NextPointer
End If
Else
If Address.Next < 1 Or Address.Next > LastRecord Then
Address.Next = PrevPointer
End If
End If
Put #FileNo, PrevPointer, Address
End If
If NextPointer <> ActiveRecord Then
Get #FileNo, NextPointer, Address
If Address.Previous = ActiveRecord Then
If PrevPointer = ActiveRecord Then
Address.Previous = NextPointer
Else
Address.Previous = PrevPointer
End If
Else
If Address.Previous < 1 Or Address.Previous > LastRecord Then
Address.Previous = NextPointer
End If
End If
Put #FileNo, NextPointer, Address
End If
MousePointer = 0
LastRecord = LastRecord - 1
If ActiveRecord = LastRecord Then
RecordShow (-1)
Else
RecordShow (1)
End If
iboxCode.SetFocus
End Sub
Private Sub cmdRemove_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> &HD Then FunctionKeys (KeyCode)
End Sub
Private Sub cmdNext_Click()
cmdPrevious.Enabled = True
If NewRecord = True Then
Beep
If iboxCode.Text <> "" Then
If MsgBox("The new record is not saved! Do you want to save it?", 36, "ADDRESS 417 Version 2.3") = 6 Then
SaveIt
End If
End If
RecordShow (1)
iboxCode.SetFocus
Exit Sub
End If
If chkAlphabetical.Value = 1 Then
RecordNo = ActiveRecord
AlphabeticMovement (3)
Else
RecordShow (1)
End If
iboxCode.SetFocus
End Sub
Private Sub cmdNext_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> &HD Then FunctionKeys (KeyCode)
End Sub
Private Sub cmdLast_Click()
If NewRecord = True Then
Beep
If iboxCode.Text <> "" Then
If MsgBox("The new record is not saved! Do you want to save it?", 36, "ADDRESS 417 Version 2.3") = 6 Then
SaveIt
End If
End If
cmdNext.Enabled = False
RecordShow (0)
iboxCode.SetFocus
Exit Sub
End If
If chkAlphabetical.Value = 1 Then
RecordNo = ActiveRecord
AlphabeticMovement (4)
Else
If ActiveRecord = LastRecord Then
Beep
Else
ActiveRecord = LastRecord
End If
RecordShow (0)
cmdNext.Enabled = False
If LastRecord < 2 Then
cmdPrevious.Enabled = False
Else
cmdPrevious.Enabled = True
End If
iboxCode.SetFocus
End If
End Sub
Private Sub cmdLast_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> &HD Then FunctionKeys (KeyCode)
End Sub
Private Sub cmdHelp_Click()
Beep
MsgBox ("F1 = New Record" + Chr$(13) + "F2 = Save" + Chr$(13) + "F3 = Search/Find" + Chr$(13) + "F4 = Remove" + Chr$(13) + "F5 = Company / Person" + Chr$(13) + "F6 = Private / Supplier / Customer" + Chr$(13) + "F7 = Alphabetical / Sequental" + Chr$(13) + "F8 = List" + Chr$(13) + "F9 = Export" + Chr$(13) + "F10 = Help" + Chr$(13) + "F11= SERVICE" + Chr$(13) + "F12= Exit" + Chr$(13) + Chr$(13) + "HOME = First Record" + Chr$(13) + "END = Last Record" + Chr$(13) + "PAGE UP = Previous Record" + Chr$(13) + "PAGE DOWN = Next Record" + Chr$(13) + Chr$(13) + "ESC = 'Exit' in general mode, 'Cancel' in other modes" + Chr$(13) + Chr$(13) + "NOT : If you want to learn this program as detailed, use interactive help program 'A417HELP.EXE'."), 0, " © Erdogan TAN 1996-2001"
End Sub
Private Sub cmdHelp_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> &HD Then FunctionKeys (KeyCode)
End Sub
Private Sub cmdNew_Click()
Beep
Search = Falsvetica, sans-serif; font-size: x-small;">iboxPost.Text = ""
iboxTelephone.Text = ""
iboxFax.Text = ""
iboxTax1.Text = ""
iboxTax2.Text = ""
iboxProfession.Text = ""
iboxSpecial.Text = ""
frmAddress.Caption = " ADDRESS 417 Version 2.3 [ New Record ]"
iboxCode.SetFocus
End Sub
Private Sub cmdNew_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> &HD Then FunctionKeys (KeyCode)
End Sub
Private Sub FunctionKeys(KeyCode As Integer)
If KeyCode = KEY_NEXT Then
If cmdNext.Enabled = True Then cmdNext_Click
Exit Sub
End If
If KeyCode = KEY_PRIOR Then
If cmdPrevious.Enabled = True Then cmdPrevious_Click
Exit Sub
End If
If KeyCode = KEY_HOME Then
cmdFirst_Click
Exit Sub
End If
If KeyCode = KEY_END Then
cmdLast_Click
Exit Sub
End If
If KeyCode = KEY_F1 Then
cmdNew_Click
Exit Sub
End If
If KeyCode = KEY_F2 Then
cmdSave_Click
Exit Sub
End If
If KeyCode = KEY_F3 Then
cmdSearch_Click
Exit Sub
If OptCustomer.Value = True Then
OptPrivate.Value = True
Else
OptSupplier.Value = True
End If
End If
Exit Sub
End If
If KeyCode = KEY_F7 Then
If chkAlphabetical.Value = 1 Then
chkAlphabetical.Value = 0
Else
chkAlphabetical.Value = 1
End If
Exit Sub
End If
If KeyCode = KEY_F8 Then
cmdList_Click
Exit Sub
End If
If KeyCode = KEY_F9 Then
cmdExport_Click
End If
If KeyCode = KEY_F10 Then
cmdHelp_Click
Exit Sub
End If
If KeyCode = KEY_F11 Then
cmdService_Click
Exit Sub
End If
If KeyCode = KEY_ESCAPE Then
frmAddress.Caption = " ADDRESS 417 Version 2.3 BETA"
If NewRecord = True Or Search = True Then
RecordShow (0)
iboxCode.SetFocus
Else
cmdExit_Click
End If
Else
If KeyCode = KEY_F12 Then cmdExit_Click
End If
End Sub
Private Sub Form_Activate()
ActiveRecord = LastRecord
If ActiveRecord < 2 Then
chkAlphabetical.Value = 0
If ActiveRecord = 0 Then
ActiveRecord = 1
Address.TypeChr = Chr$(AsciiType + 49)
Address.Code = ""
Address.Name = ""
Address.Address1 = ""
Address.Address2 = ""
Address.Ward = ""
Address.City = ""
Address.Country = ""
Address.Post = ""
Address.Telephone = ""
Address.Fax = ""
Address.Tax1 = ""
Address.Tax2 = ""
Address.Profession = ""
Address.Special = ""
Address.Previous = 1
Address.Next = 1
Address.Password = "ERDOÐAN"
Address.HiddenInfo = "ADRES 417 Version 2.3e BETA" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "© Erdoðan Tan 1996-2001"
Put #FileNo, ActiveRecord, Address
End If
End If
End Sub
Private Sub Form_DblClick()
If Search = False Then
cmdSave_Click
Else
SearchFind
End If
End Sub
Private Sub Form_Load()
Beep
If Dir("ADRES417.DAT") <> "ADRES417.DAT" Then
If Dir("ADRES417.IND") <> "ADRES417.IND" Then
MsgBox ("You are entering the program from zero..." + Chr$(13) + Chr$(13) + "When you click OK button under this message, ADRES417.DAT & ADRES417.IND files will be created..."), 0, " ADDRESS 417 Version 2.3"
Else
MsgBox ("ADRES417.IND file is found in working directory but ADRES417.DAT file is not existent!..." + Chr$(13) + Chr$(13) + "ADRES417.IND file can not be used without ADRES417.DAT file. Find the lost data file ADRES417.DAT or delete ADRES417.IND file in working directory..."), 0, " ADDRESS 417 Version 2.3"
End
End If
Else
If Dir("ADRES417.IND") <> "ADRES417.IND" Then
MsgBox ("ADRES417.IND is not existent in working directory!..." + Chr$(13) + Chr$(13) + "You have to rebuild ADRES417.IND file..." + Chr$(13) + Chr$(13) + "Go to SERVICE menu (by using SERVICE command) and run REBUILD command there..."), 0, " ADDRESS 417 Version 2.3"
End If
End If
FileNo = FreeFile
RecordLenght = Len(Address)
Open "ADRES417.DAT" For Random As FileNo Len = RecordLenght
LastRecord = FileLen("ADRES417.DAT") / RecordLenght
If Dir("ADRES417.IND") = "ADRES417.IND" Then
RecordCount = FileLen("ADRES417.IND") / Len(Index)
If RecordCount > 256 Then Kill "ADRES417.IND"
End If
IndexFileNo = FreeFile
Open "ADRES417.IND" For Random As IndexFileNo Len = Len(Index)
If RecordCount <> 256 Then
For RecordCount = 1 To 256
Index.First = 0
Index.Last = 0
Put #IndexFileNo, RecordCount, Index
Next RecordCount
End If
Search = True
End Sub
Private Sub FrameAddress_DblClick()
If Search = False Then
cmdSave_Click
Else
SearchFind
End If
End Sub
Private Sub RecordShow(Movement As Integer)
MousePointer = 0
If LastRecord < 1 Then Exit Sub
GetValidRecord:
ActiveRecord = ActiveRecord + Movement
If ActiveRecord < 1 Then
ActiveRecord = 1
cmdPrevious.Enabled = False
Exit Sub
Else
If ActiveRecord > LastRecord Then
ActiveRecord = LastRecord
cmdNext.Enabled = False
Exit Sub
End If
End If
Get #FileNo, ActiveRecord, Address
AsciiType = Asc(Address.TypeChr)
TypeNo = AsciiType - 48
If TypeNo > 6 Or TypeNo < 0 Then
If Movement <> 0 Then
GoTo GetValidRecord
Else
Beep
MsgBox ("Current record is invalid or removed !"), 48, "! ERROR !"
End If
Exit Sub
Else
If TypeNo > 3 Then
optPerson.Value = True
If TypeNo = 4 Then
OptPrivate.Value = True
Else
If TypeNo = 5 Then
OptPrivate.Value = True
Else
If TypeNo = 1 Then
OptCustomer.Value = True
Else
OptSupplier.Value = True
End If
End If
End If
iboxCode.Text = Trim$(Address.Code)
iboxName.Text = Trim$(Address.Name)
iboxAddress1.Text = Trim$(Address.Address1)
iboxAddress2.Text = Trim$(Address.Address2)
iboxWard.Text = Trim$(Address.Ward)
iboxCity.Text = Trim$(Address.City)
iboxCountry.Text = Trim$(Address.Country)
iboxPost.Text = Trim$(Address.Post)
iboxTelephone.Text = Trim$(Address.Telephone)
iboxFax.Text = Trim$(Address.Fax)
iboxTax1.Text = Trim$(Address.Tax1)
iboxTax2.Text = Trim$(Address.Tax2)
iboxProfession.Text = Trim$(Address.Profession)
iboxSpecial.Text = Trim$(Address.Special)
End If
CodeChanged = False
AddressCode = Trim$(Address.Code)
If RecordSaved = False Then frmAddress.Caption = " ADDRESS 417 Version 2.3 Record :" + Str(ActiveRecord) + " /" + Str(LastRecord)
Search = False
NewRecord = False
RecordSaved = False
End Sub
Private Sub SaveIt()
Dim PrevPointer As Integer
Dim NextPointer As Integer
Dim Char1 As String * 1
Dim Char2 As String * 1
MousePointer = 11
If NewRecord = False Then
Char1 = Left$(LTrim$(Address.Code), 1)
IndexRecordNo = Asc(Char1) + 1
Get #IndexFileNo, IndexRecordNo, Index
If Index.First = ActiveRecord Then
If Address.Next <> ActiveRecord Then
NextPointer = Address.Next
If NextPointer > 0 And NextPointer <= LastRecord Then
Get #FileNo, NextPointer, Address
Char2 = Left$(LTrim$(Address.Code), 1)
If Char1 = Char2 Then
Index.First = NextPointer
Else
Index.First = 0
End If
Else
Index.First = 0
End If
Else
Index.First = 0
End If
End If
If Index.Last = ActiveRecord Then
If Address.Previous <> ActiveRecord Then
PrevPointer = Address.Previous
If PrevPointer > 0 And PrevPointer <= LastRecord Then
Get #FileNo, PrevPointer, Address
Index.Last = Index.First
End If
Else
Index.Last = Index.First
End If
End If
Put #IndexFileNo, IndexRecordNo, Index
Get #FileNo, ActiveRecord, Address
PrevPointer = Address.Previous
NextPointer = Address.Next
If PrevPointer < 1 Or NextPointer < 1 Or PrevPointer > LastRecord Or NextPointer > LastRecord Then
MousePointer = 0
Beep
MsgBox ("Index pointer error in record " + Str$(ActiveRecord) + "! Run REBUILD command for rebuilding pointer chain..."), 48, "INDEX POINTER ERROR !"
Exit Sub
End If
If PrevPointer <> ActiveRecord Then
Get #FileNo, PrevPointer, Address
If Address.Next = ActiveRecord Then
If NextPointer = ActiveRecord Then
Address.Next = PrevPointer
Else
Address.Next = NextPointer
End If
Else
If Address.Next < 1 Or Address.Next > LastRecord Then
Address.Next = PrevPointer
End If
End If
Put #FileNo, PrevPointer, Address
End If
If NextPointer <> ActiveRecord Then
Get #FileNo, NextPointer, Address
If Address.Previous = ActiveRecord Then
If PrevPointer = ActiveRecord Then
Address.Previous = NextPointer
Else
Address.Previous = PrevPointer
End If
Else
If Address.Previous < 1 Or Address.Previous > LastRecord Then
Address.Previous = NextPointer
End If
End If
Put #FileNo, NextPointer, Address
End If
Get #FileNo, ActiveRecord, Address
Else
ActiveRecord = LastRecord + 1
Address.Password = "ERDOÐAN"
Address.HiddenInfo = "ADDRESS 417 Version 2.3 BETA" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "© Erdoðan Tan 2001"
LastRecord = ActiveRecord
End If
Address.Code = Trim(iboxCode.Text)
Address.Name = Trim(iboxName.Text)
Address.Address1 = Trim(iboxAddress1.Text)
Address.Address2 = Trim(iboxAddress2.Text)
Address.Ward = Trim(iboxWard.Text)
Address.City = Trim(iboxCity.Text)
Address.Country = Trim(iboxCountry.Text)
Address.Post = Trim(iboxPost.Text)
Address.Telephone = Trim(iboxTelephone.Text)
Address.Fax = Trim(iboxFax.Text)
Address.Tax1 = Trim(iboxTax1.Text)
Address.Tax2 = Trim(iboxTax2.Text)
Address.Profession = Trim(iboxProfession.Text)
Address.Special = Trim(iboxSpecial.Text)
Address.Previous = 0
Address.Next = 0
If Address.Code <> "" Then
If OptCustomer.Value = True Then
If optCompany.Value = True Then
TypeNo = 1
Else
TypeNo = 5
End If
Else
If OptSupplier.Value = True Then
If optCompany.Value = True Then
TypeNo = 2
Else
TypeNo = 6
End If
Else
If OptPrivate.Value = True Then
TypeNo = 0
If optCompany.Value = True Then
TypeNo = 0
Else
TypeNo = 4
End If
End If
End If
End If
Address.TypeChr = Chr$(TypeNo + 48)
Else
Address.TypeChr = "S"
End If
Put #FileNo, ActiveRecord, Address
MousePointer = 0
frmAddress.Caption = " Saved... Record Number :" + Str$(ActiveRecord)
If NewRecord = False Then
If CodeChanged = True And (Trim$(AddressCode) <> Trim$(iboxCode.Text)) Then Indexer
Else
Indexer
NewRecord = False
End If
FindAbcFirstLast (0)
End Sub
Private Sub OptSupplier_Click()
iboxCode.SetFocus
End Sub
Private Sub optCompany_Click()
lblCode.Caption = "Company Code :"
iboxCode.SetFocus
End Sub
Private Sub optPerson_Click()
lblCode.Caption = "Name :"
iboxCode.SetFocus
End Sub
Private Sub OptPrivate_Click()
iboxCode.SetFocus
End Sub
Private Sub OptCustomer_Click()
iboxCode.SetFocus
End Sub
Sub SearchFind()
Dim RecordNo As Integer
Dim FoundRecord As Integer
Dim Char1 As String * 1
Dim TableChar As Integer
Dim SearchStart As Integer
Dim SearchFinish As Integer
Dim Char2 As String * 1
Dim ScanStart As Integer
Dim ScanFinish As Integer
Dim CharCount As Integer
Dim SearchCode As String
Dim SearchedRecord As String
Found = False
If NewRecord = False And Search = False Then
SearchedRecord = Trim$(iboxCode.Text)
Else
SearchedRecord = UCase(Trim$(iboxCode.Text))
End If
Char1 = Left$(Trim$(SearchedRecord), 1)
IndexRecordNo = Asc(Char1) + 1
MousePointer = 11
Get #IndexFileNo, IndexRecordNo, Index
SearchStart = Index.First
SearchFinish = Index.Last
If NewRecord = True Or Search = True Then
Char2 = LCase(Char1)
If Char1 <> Char2 Then
IndexRecordNo = Asc(Char2) + 1
Get #IndexFileNo, IndexRecordNo, Index
ScanStart = Index.First
ScanFinish = Index.Last
Else
ScanStart = 0
End If
End If
If Search = False Then
RecordNo = SearchStart
SearchIt:
If RecordNo = 0 Or RecordNo > LastRecord Then GoTo LowerCSearchIt
If SearchedRecord = SearchCode Then
AsciiType = Asc(Address.TypeChr)
If AsciiType >= 48 And AsciiType <= 57 Then
Found = True
GoTo Result
End If
End If
Else
If SearchedRecord = SearchCode Then
AsciiType = Asc(Address.TypeChr)
If AsciiType >= 48 And AsciiType <= 57 Then
Found = True
GoTo Result
End If
End If
If RecordNo <> Address.Next Then
RecordNo = Address.Next
GoTo SearchIt
End If
End If
LowerCSearchIt:
RecordNo = ScanStart
If Search = False And NewRecord = False Then GoTo Result
RepeatLowerCSearchIt:
If RecordNo = 0 Or RecordNo > LastRecord Then GoTo Result
FoundRecord = RecordNo
Get #FileNo, RecordNo, Address
SearchCode = UCase(Trim$(Address.Code))
If RecordNo = ScanFinish Then
If SearchedRecord = SearchCode Then
AsciiType = Asc(Address.TypeChr)
If AsciiType >= 48 And AsciiType <= 57 Then Found = True
End If
Else
If SearchedRecord = SearchCode Then
AsciiType = Asc(Address.TypeChr)
If AsciiType >= 48 And AsciiType <= 57 Then
Found = True
GoTo Result
End If
End If
If RecordNo <> Address.Next Then
RecordNo = Address.Next
GoTo RepeatLowerCSearchIt
End If
End If
Else
CharCount = Len(SearchedRecord)
RecordNo = SearchStart
SearchOne:
If RecordNo = 0 Or RecordNo > LastRecord Then GoTo SearchTwo
FoundRecord = RecordNo
Get #FileNo, RecordNo, Address
If RecordNo = SearchFinish Then
If SearchedRecord = Left$(UCase(Trim(Address.Code)), CharCount) Then
AsciiType = Asc(Address.TypeChr)
If AsciiType >= 48 And AsciiType <= 57 Then
Found = True
GoTo EndOfSearch
End If
AsciiType = Asc(Address.TypeChr)
If AsciiType >= 48 Or AsciiType <= 57 Then
Found = True
GoTo EndOfSearch
End If
End If
Else
If SearchedRecord = Left$(UCase(Trim(Address.Code)), CharCount) Then
AsciiType = Asc(Address.TypeChr)
If AsciiType >= 48 Or AsciiType <= 57 Then
Found = True
GoTo EndOfSearch
End If
End If
If RecordNo <> Address.im$(SearchedRecord) + Chr$(34) + " is not existent.", 0, "ADDRESS 417 Version 2.3"
RecordShow (0)
Else
ActiveRecord = FoundRecord
RecordShow (0)
If ActiveRecord = 1 And chkAlphabetical.Value = 0 Then
cmdPrevious.Enabled = False
Else
If chkAlphabetical.Value = 0 Then cmdPrevious.Enabled = True
End If
If ActiveRecord = LastRecord And chkAlphabetical.Value = True Then
cmdNext.Enabled = False
Else
If chkAlphabetical.Value = 0 Then cmdNext.Enabled = True
End If
MsgBox "The code or name which you have entered is already recorded! Key field modification could not be saved!...", 48, "! MODIFICATION ERROR !"
RecordShow (0)
Else
If ActiveRecord > 0 And ActiveRecord <= LastRecord Then
If Trim(iboxCode.Text) <> "" Then
If CodeChanged = True And (Trim$(AddressCode) <> Trim$(iboxCode.Text)) Then
If MsgBox("Are you sure for changing the code or name?...", 36, "ADDRESS 417 Version 2.3") = 6 Then
SaveIt
RecordSaved = True
End If
Else
SaveIt
RecordSaved = True
End If
RecordShow (0)
Else
Beep
MsgBox "Key field can not be left empty! Modification will not be performed!...", 48, "! MODIFICATION ERROR !"
RecordShow (0)
End If
Else
Beep
MsgBox ("Modification could not be saved due to invalid record!..."), 48, "! MODIFICATION ERROR !"
End If
End If
Else
If NewRecord = True Then
If Found = True Then
Beep
MsgBox "The code or name which you have entered is already recorded!...", 48, "! NEW RECORD ERROR !"
Else
cmdNext.Enabled = False
SaveIt
RecordSaved = True
End If
If RecordNo = SearchFinish Then
If SearchedRecord = Left$(UCase(Trim(Address.Code)), CharCount) Then
AsciiType = Asc(Address.TypeChr)
If AsciiType >= 48 And AsciiType <= 57 Then
Found = True
GoTo EndOfSearch
End If
End If
Else
If SearchedRecord = Left$(UCase(Trim(Address.Code)), CharCount) Then
AsciiType = Asc(Address.TypeChr)
If AsciiType >= 48 And AsciiType <= 57 Then
Found = True
GoTo EndOfSearch
End If
End If
If RecordNo <> Address.Next Then
RecordNo = Address.Next
GoTo SearchOne
End If
End If
SearchTwo:
RecordNo = ScanStart
RepeatSearchTwo:
If RecordNo = 0 Or RecordNo > LastRecord Then GoTo EndOfSearch
FoundRecord = RecordNo
Get #FileNo, RecordNo, Address
If RecordNo = ScanFinish Then
If SearchedRecord = Left$(UCase(Trim(Address.Code)), CharCount) Then
AsciiType = Asc(Address.TypeChr)
If AsciiType >= 48 Or AsciiType <= 57 Then
Found = True
GoTo EndOfSearch
End If
End If
Else
If SearchedRecord = LefNext Then
RecordNo = Address.Next
GoTo RepeatSearchTwo
End If
End If
EndOfSearch:
If Found = False Then
Beep
MsgBox Chr$(34) + Trim$(SearchedRecord) + Chr$(34) + " is not existent.", 0, "ADDRESS 417 Version 2.3"
RecordShow (0)
Else
ActiveRecord = FoundRecord
RecordShow (0)
If ActiveRecord = 1 And chkAlphabetical.Value = 0 Then
cmdPrevious.Enabled = False
Else
If chkAlphabetical.Value = 0 Then cmdPrevious.Enabled = True
End If
If ActiveRecord = LastRecord And chkAlphabetical.Value = True Then
cmdNext.Enabled = False
Else
If chkAlphabetical.Value = 0 Then cmdNext.Enabled = True
End If
End If
Exit Sub
End If
Result:
MousePointer = 0
If NewRecord = False And Search = False Then
If Found = True And (ActiveRecord <> FoundRecord) Then
Beep
MsgBox "The code or name which you have entered is already recorded! Key field modification could not be saved!...", 48, "! MODIFICATION ERROR !"
RecordShow (0)
Else
If ActiveRecord > 0 And ActiveRecord <= LastRecord Then
If Trim(iboxCode.Text) <> "" Then
If CodeChanged = True And (Trim$(AddressCode) <> Trim$(iboxCode.Text)) Then
If MsgBox("Are you sure for changing the code or name?...", 36, "ADDRESS 417 Version 2.3") = 6 Then
SaveIt
RecordSaved = True
End If
Else
SaveIt
RecordSaved = True
End If
RecordShow (0)
Else
Beep
MsgBox "Key field can not be left empty! Modification will not be performed!...", 48, "! MODIFICATION ERROR !"
RecordShow (0)
End If
RecordShow (0)
NewRecord = False
End If
End If
End Sub
Private Sub FindAbcFirstLast(MovementType As Integer)
If Moveme-family: Arial, Helvetica, sans-serif; font-size: x-small;"> End If
Else
Beep
MsgBox ("Modification could not be saved due to invalid record!..."), 48, "! MODIFICATION ERROR !"
End If
End If
Else
If NewRecord = True Then
If Found = True Then
Beep
MsgBox "The code or name which you have entered is already recorded!...", 48, "! NEW RECORD ERROR !"
Else
cmdNext.Enabled = False
SaveIt
RecordSaved = True
End If
RecordShow (0)
NewRecord = False
End If
End If
End Sub
Private Sub FindAbcFirstLast(MovementType As Integer)
If MovementType = 4 Then GoTo FindLastRecordPointer
IndexRecordNo = 1
NextIndexFirstRecord:
Get #IndexFileNo, IndexRecordNo, Index
If Index.First > 0 And Index.First <= LastRecord Then
AbcFirstRecord = Index.First
Else
If IndexRecordNo < 256 Then
IndexRecordNo = IndexRecordNo + 1
End If
End If
If RecordNo <> Address.Next Then
RecordNo = Address.Next
GoTo SearchOne
End If
End If
SearchTwo:
RecordNo = ScanStart
RepeatSearchTwo:
If RecordNo = 0 Or RecordNo > LastRecord Then GoTo EndOfSearch
FoundRecord = RecordNo
Get #FileNo, RecordNo, Address
If RecordNo = ScanFinish Then
If SearchedRecord = Left$(UCase(Trim(Address.Code)), CharCount) Then
Else
AbcLastRecord = 0
ErrorType = 2
End If
End If
End Sub
Tidak ada komentar:
Posting Komentar