Post by rnbw on Mar 18, 2022 15:37:34 GMT -5
I use LB code adapted from a CardFile Program written by jabas in Just Basic (Cardfile). I decided to adapt it for LB5
'=========================
' My Address Book
' Converted to Liberty Basic 5 from Just Basic
' by RNBW 18 March 2022 (but all credit to jabas)
' Adapted from JABAS Address Cardfile
' by jaba 16 Aug 2009
' All content free to use (jaba permission).
'=========================
' MyAddressBook.bas
' 18 March 2022
'=========================
'
'GLOBAL VARIABLES
global path$, noRec, DBFname$
' Assign file and path info to variables
path$ = DefaultDir$
DBFname$ = "contact.txt"
nomainwin
WindowWidth = 830
WindowHeight = 610
UpperLeftX = 20
UpperLeftY = 20
' Controls
statictext #main, " Name/Company:", 20, 25, 110, 20
statictext #main, " (Surname First)", 20, 40, 110, 15
textbox #main.textName, 150, 20, 300, 25
statictext #main, "Tel:", 20, 55, 45, 20
textbox #main.textPhone, 150, 50, 110, 25
statictext #main, "Mob:", 300, 55, 35, 20
textbox #main.textCell, 340, 50, 110, 25
statictext #main, "Address:", 20, 85, 100, 20
textbox #main.textAddress, 150, 80, 300, 25
statictext #main, "City:", 20, 115, 45, 20
textbox #main.textCity, 150, 110, 300, 25
statictext #main, "County:", 20, 145, 100, 20
textbox #main.textSt, 150, 140, 130, 25
statictext #main, "Zip:", 300, 145, 20, 20
textbox #main.textZip, 340, 140, 110, 25
statictext #main, " E-Mail 1:", 20, 175, 60, 20
textbox #main.textEmail, 150, 170, 300, 25
statictext #main, " E-Mail 2:", 20, 200, 60, 20
textbox #main.textEmail2, 150, 200, 300, 25
statictext #main, " Notes: No commas or Return key", 500, 25, 300, 20
textbox #main.textNotes, 500, 50, 300, 480
statictext #main, " Contacts:", 20, 235, 100, 15
statictext #main.totRecs, " ", 30, 265, 30, 20
' buttons
button #main.btnSave, "Save", [btnSaveClicked], UL, 375, 480, 75, 25
button #main.btnExit, "Exit", [btnExitClicked], UL, 375, 510, 75, 25
button #main.btnClear,"Clear",[btnClearClicked], UL, 375, 450, 75, 25
button #main.btnEdit, "Edit Help", [btnEditHelpClicked], UL, 210, 540, 80, 22
button #main.btnHelp, "?", [btnHelpClicked], UR, 15, 4, 18, 18
button #main.btnSaveEdit, "Save Edit",[btnSaveEdit] ,UL, 295, 540, 60, 22
button #main.btnDelete,"Delete",[btnDeleteClicked], UL, 150, 540, 55, 22
listbox #main.lbx, address$(, [displayContactInfo], 150, 230, 205, 300
statictext #main.helpme, "", 350, 2, 40, 15
'see if data file exists?
'thanks to Noble Bell
dim Info$(11, 11)
If fileExists(path$, DBFname$) = 0 then
confirm "The Address file does not exist." + chr$(13) +_
"Do you want to create the file?"; answer$
If answer$ = "no" then
notice "The program must end until you create a new Address file."
close #main
end
end if
'no database, so create one
open DBFname$ for output as #new
close #new
notice "The Address file has been created."
end if
'open database and fill arrays - rs$, recA$
gosub [fillContactsArray]
'Fill listbox array - address$()
gosub [fillListbox]
'set GUI colors
BackgroundColor$="buttonface"
ForegroundColor$="black"
[openMainWindow]
open "Address Cardfile" for window_nf as #main
print #main, "trapclose [btnExitClicked]"
print #main, "font ms_sans_serif 11"
print #main.textName, "!font arial 11 "
print #main.textPhone, "!font arial 11"
print #main.textCell, "!font arial 11 "
print #main.textAddress, "!font arial 11 "
print #main.textCity, "!font arial 11 "
print #main.textSt, "!font arial 11 "
print #main.textZip, "!font arial 11 "
print #main.textEmail, "!font arial 11 "
print #main.textEmail2, "!font arial 11 "
print #main.textNotes, "!font arial 11"
print #main.btnClear, "!font arial 9 "
print #main.btnSave, "!font arial 9 "
print #main.btnExit, "!font arial 9 "
print #main.btnEdit, "!font arial 9 "
print #main.btnDelete, "!font arial 9 "
print #main.btnSaveEdit, "!font arial 9 "
print #main.totRecs, "!font arial 11 bold"
print #main.helpme, "!font arial 10 "
print #main.lbx, "singleclickselect [displayContactInfo]"
') *Note: When user selects contact from listbox, edit buttons
') are enabled so user can edit or delete a contact AND
') Save button is disabled to avoid user re-saving the contact
') that is currently displayed.
gosub [helpmeLoop]
[getUserInput]
gosub [hide] 'hide edit buttons
print #main.totRecs, noRec
print #main.btnSave, "!enable"
print #main.textName, "!setfocus"
WAIT
[btnSaveClicked]
'get new record info
gosub [readDataFields]
'valid info so continue - record string is saved as rs$
addFlag=1
'add record to file
open DBFname$ for append as #f
print #f, rs$
close #f
'update total records
noRec=noRec+1
'update arrays and listbox
gosub [fillContactsArray]
gosub [fillListbox]
'refresh listbox names - address$()
print #main.lbx, "reload"
'clear fields and prevent user from saving record twice
'save button is disabled while addFlag set
gosub [btnClearClicked]
notice "Record has been saved."
'done adding record
addFlag=0
'we could wait, but lets go back and let user enter another contact
GOTO [getUserInput]
[readDataFields]
'trap accidental save button click if name field is empty
print #main.textName, "!contents? name$"
if name$="" then
notice "Please provide a name for your contact."
addFlag=0 'didn't work - reset flag
goto [getUserInput]
end if
'ok to cont.
print #main.textPhone, "!contents? phone$"
print #main.textCell, "!contents? cell$"
print #main.textAddress, "!contents? address$"
print #main.textCity, "!contents? city$"
print #main.textSt, "!contents? state$"
print #main.textZip, "!contents? zip$"
print #main.textEmail, "!contents? email$"
print #main.textEmail2, "!contents? email2$"
'its all good to here because probably no commas used in first fields
'but a comma in notes field will cause problems with CSV records
'so best to catch it and remove it before attempting to save record...
print #main.textNotes, "!contents? notes$"
iscom=instr(notes$,",")
if iscom>0 then
temp$=left$(notes$,iscom-1)+mid$(notes$,iscom+1)
notes$=temp$
notice "Commas not allowed..."+chr$(13)+_
"Commas are not allowed in notes field and have "+chr$(13)+_
"been removed. (A comma could cause loss of your data)."+chr$(13)+_
chr$(13)+"Use another character, if needed, and re-save."
end if
'Create a record string - used for editing and deleting records
rs$=""
rs$=rs$+name$;",";phone$;",";cell$;",";address$;",";_
city$;",";state$;",";zip$;",";email$;",";email2$; ","; notes$
RETURN
[fieldHeadingDisplayString]
'to be used if helper windows are added
fd$="Name: "+"Phone: "+"Cell: "+"Address: "+"City: "+_
"State: "+"Zip: "+"E-Mail 1: " + "E-Mail 2:" +"Notes: "
[btnClearClicked]
'following is used to allow user to cancel editing a record
'NOTE TO ME: I COULD USE THE EDIT CONTACT BUTTON AS A CANCEL BUTTON????
if editFlag=1 then
confirm "Cancel editing the contact?";ans$
if ans$="yes" then
editFlag=0
print #main.btnSaveEdit, "!disable"
goto [getUserInput]
end if
end if
print #main.btnSave, "!enable"
'good to go, so clear the fields
print #main.textName, ""
print #main.textPhone, ""
print #main.textCell, ""
print #main.textAddress, ""
print #main.textCity, ""
print #main.textSt, ""
print #main.textZip, ""
print #main.textEmail, ""
print #main.textEmail2, ""
print #main.textNotes, ""
'if here from btnSaveClicked (add a record) then go back there
if addFlag=1 then RETURN
'otherwise...
GOTO [getUserInput]
[btnExitClicked]
Confirm "Close Address Cardfile?"; ans$
if ans$= "no" then WAIT
'backup routine (from JB help files)
open DBFname$ for input as #original
open "contactme.bak" for output as #copy
print #copy, input$(#original, lof(#original));
close #original
close #copy
print #main.textNotes, "Backing up database..."
timer 500, [null]
wait
[null]
timer 0
'shut down
close #main
END
'***************************************************
'* EDIT AND DELETE RECORD ROUTINES *
'***************************************************
[btnEditHelpClicked]
'instruct user how to edit records
print #main.btnSaveEdit, "!enable"
notice "Edit contact"+chr$(13)+"Select a contact to modify..."_
+chr$(13)+"Press SAVE EDIT when done."+chr$(13)+chr$(13)+_
"Press CLEAR button to cancel editing."+chr$(13)+_
"Press DELETE to remove selected contact."
editFlag=1
WAIT
[btnSaveEdit]
print #main.lbx, "selectionindex? index" 'number of edited record
gosub [readDataFields] 'read fields will catch changes
rs$(index)=rs$ 'edited record string
'write all records back to file to update database
open DBFname$ for output as #fout
for i=1 to noRec
print #fout, rs$(i)
next i
close #fout
'update arrays and listbox
gosub [fillContactsArray]
gosub [fillListbox]
print #main.lbx, "reload"
'notify user record edit successful
notice "Modifications have been saved."
'trap accidental save attempt
print #main.btnSaveEdit, "!disable"
editFlag=0
WAIT
[btnDeleteClicked]
confirm "Delete this record?"; ans$
if ans$="no" then
gosub [hide]
WAIT
end if
'ok to delete so go ahead
print #main.lbx, "selectionindex? index" 'record number to delete
rs$(index)="" 'tell program this record is empty string
open DBFname$ for output as #fout
'the following test goes through each record; if its not an empty
'string its written to the database
for i=1 to noRec
if rs$(i)<>rs$(index) then
print #fout, rs$(i)
end if
next i
close #fout
'at this point, the new database does not include the deleted record
' so we need to refresh everything
gosub [fillContactsArray]
gosub [fillListbox]
print #main.lbx, "reload"
GOTO [btnClearClicked]
[hide]
print #main.btnEdit, "!disable"
print #main.btnDelete, "!disable"
print #main.btnSaveEdit, "!disable"
RETURN
'**********************************************************
'* COUNT THE RECORDS, FILL THE ARRAYS, SORT THE RECORDS *
'* AND FILL THE LISTBOX *
'**********************************************************
[fillContactsArray]
'open the database to count the records
noRec=0
open DBFname$ for input as #f
while eof(#f)=0
line input #f, dummy$
noRec=noRec+1
wend
close #f
'open the database to read each record into an array - rs$()
dim rs$(noRec)
open DBFname$ for input as #f
for i=1 to noRec
line input #f, rs$(i)
next i
close #f
'Sort rs$() array
FOR i=1 TO noRec
FOR k=1 TO noRec-1
IF rs$(k) > rs$(k+1) THEN
temp$=rs$(k)
rs$(k)=rs$(k+1)
rs$(k+1)=temp$
END IF
NEXT k
NEXT i
're-write the database as sorted list
open DBFname$ for output as #fout
for i=1 to noRec
print #fout, rs$(i)
next i
close #fout
'create two-dimensional array for elements of each record - recA$()
dim recA$(noRec,10) '<== change this number if number of fields chg
open DBFname$ for input as #fin
for i=1 to noRec
input #fin, recA$(i,1),recA$(i,2),recA$(i,3),recA$(i,4),_
recA$(i,5),recA$(i,6),recA$(i,7),recA$(i,8),recA$(i,9), recA$(i,10)
next i
close #fin
RETURN
[fillListbox]
'show name and phone for each contact in listbox - address$()
dim address$(noRec)
for j=1 to noRec
'address$(j)=recA$(j,1)+" "+recA$(j,2)+" "+recA$(j,3)
address$(j)=recA$(j,1)
next j
RETURN
[displayContactInfo]
'when user selects name from listbox,display all info fields
'enable edit buttons
print #main.btnEdit, "!enable"
print #main.btnDelete, "!enable"
print #main.btnSaveEdit, "!enable"
'disable save button to prevent duplicate records if
' user accidentally presses save button instead of save edit button
print #main.btnSave, "!disable"
print #main.lbx, "selectionindex? index" 'record to display
print #main.textName, recA$(index,1)
print #main.textPhone, recA$(index,2)
print #main.textCell, recA$(index,3)
print #main.textAddress, recA$(index,4)
print #main.textCity, recA$(index,5)
print #main.textSt, recA$(index,6)
print #main.textZip, recA$(index,7)
print #main.textEmail, recA$(index,8)
print #main.textEmail2, recA$(index,9)
print #main.textNotes, recA$(index,10)
WAIT
[btnHelpClicked]
notice "CONTROLS"+chr$(13)+_
" Clear: clears display to receive new contact info"+chr$(13)+_
" Save: saves new contact info to database file"+chr$(13)+_
" Exit: close program"+chr$(13)+_
" Edit Help: help for modifying contact"+chr$(13)+_
" Delete: delete a contact and refresh the database "+chr$(13)+_
" Save Edit: saves any editing done to contact"+chr$(13)+_
" and refreshes database"
WAIT
'*********************************
'* FUNCTIONS AND SUBS *
'*********************************
'see if file exists
function fileExists(path1$, filename$)
files path1$, filename$, Info$()
fileExists = val(Info$(0, 0)) 'non zero is true
end function
[helpmeLoop]
for i=1 to 3
print #main.helpme, "help==>"
timer 500, [oop]
wait
[oop]
timer 0
print #main.helpme, " "
timer 100, [oops]
wait
[oops]
timer 0
next i
RETURN
[hehe]
notice "It's not really a button. It's a line!"
goto [getUserInput]
endinsert code hereWithout Stylebits (or similar) the textboxes don't look too good, but other than that it seems to work OK. The exception is the notes column. In LB this is a multiline textbox. LB5 doesn't appear to currently support a multi-line textbox and all that appears is a single line textbox at the bottom of where the textbox would be. This was the reason for my query at Textbox Query. I presume that a multi-line textbox or similar is in the pipeline.
