ADDRESS MANAGER

You can talk about anything related to LB Booster here, not covered in another category
Post Reply
RNBW
Posts: 42
Joined: Thu Apr 05, 2018 9:21 pm

ADDRESS MANAGER

Post by RNBW » Tue Jul 21, 2020 6:56 pm

I needed an Address Manager for my PC and I decided to obtain or produce one written in Liberty Basic. After searching LB, LBB and JB, I finally found one in the JB Archives written by jabas http://jbfilesarchive.com/phpBB3/viewto ... f=3&t=1501. It is not as complicated as some that I looked at and was an Address Manager, rather than a Contact Manager (I’m way past needing a Contact Manager). The layout needed adjustment to meet my needs and I also changed the size of fonts and smartened up the controls.

The code below is the result. I am most grateful to jabas for his code (which makes up almost all of it), so any credit is due to him. I’m just a modifier. Although I am loath to say it, the code also runs on both LB and JB, but I shan’t post it on their web sites because I was banned. If someone wishes to do so, I have no objection. The code came from JB anyway.

I have found the program to be most useful. I hope others may also find it so.

Code: Select all

'=========================
'  My Address Book
'  by RNBW 20 July 2020 (but all credit to jabas)
'
'  Adapted from JABAS Address Cardfile
'  by jaba 16 Aug 2009
' All content free to use.
'=========================
' MyAddressBookV1.bas
' 20 July 2020
'=========================

'GLOBAL VARIABLES
    global path$, noRec, DBFname$
' Assign file and path info to variables
    path$ = DefaultDir$
    DBFname$ = "contactme.txt"

    nomainwin

    WindowWidth = 480    
    WindowHeight = 610
    UpperLeftX = 20
    UpperLeftY = 20
    
    statictext  #main, " Name/Company:",       20, 25, 110, 20
    stylebits #main.textName,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textName,        150, 20, 300, 25
    
    statictext  #main, "Tel:",       20, 55, 45, 20
    stylebits #main.textPhone,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textPhone,       150, 50, 110, 25
    
    statictext  #main, "Mob:",        300, 55, 35, 20
    stylebits #main.textCell,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textCell,        340, 50, 110, 25
    
    statictext  #main, "Address:",    20, 85, 100, 20
    stylebits #main.textAddress,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textAddress,     150, 80, 300, 25
    
    statictext  #main, "City:",    20, 115, 45, 20
    stylebits #main.textCity,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textCity,        150, 110, 300, 25
    
    statictext  #main, "County:",          20, 145, 100, 20
    stylebits #main.textSt,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textSt,          150, 140, 130, 25
    
    statictext  #main, "Zip:",         300, 145, 20, 20
    stylebits #main.textZip,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textZip,         340, 140, 110, 25
    
    statictext  #main, " E-Mail:",     20, 175, 45, 20
    stylebits #main.textEmail,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textEmail,       150, 170, 300, 25
    
    statictext  #main, " Notes:",      20, 235, 45, 20
    stylebits #main.textNotes, _ES_LEFT OR _WS_VSCROLL OR _ES_MULTILINE, _WS_BORDER OR _ES_AUTOHSCROLL, 0, 0
    textbox     #main.textNotes,       150, 230, 300, 100
    
    statictext  #main, " Contacts:",   20, 335, 100, 15
    statictext  #main.totRecs, " ",    30, 365, 30, 20

    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

    stylebits #main.lbx,  _ES_LEFT,  _WS_BORDER, 0, 0
    listbox #main.lbx, address$(, [displayContactInfo],  150, 335, 205, 200
    statictext #main.helpme, "", 350, 2, 40, 15

'see if data file exists?
'thanks to Noble Bell
    dim Info$(10, 10)
    If fileExists(path$, DBFname$) = 0 then
        confirm "The contacts 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 contacts file."
            close #main
            end
        end if
        'no database, so create one
        open DBFname$ for output as #new
        close #new
            notice "The contacts 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
        #main, "trapclose [btnExitClicked]"
        #main, "font ms_sans_serif 11"

    #main.textName,    "!font arial 11 "
    #main.textPhone,   "!font arial 11"
    #main.textCell,    "!font arial 11 "
    #main.textAddress, "!font arial 11 "
    #main.textCity,    "!font arial 11 "
    #main.textSt,      "!font arial 11 "
    #main.textZip,     "!font arial 11 "
    #main.textEmail,   "!font arial 11 "
    #main.textNotes, "!font arial 11"
    #main.btnClear,    "!font arial 9 "
    #main.btnSave,     "!font arial 9 "
    #main.btnExit,     "!font arial 9 "
    #main.btnEdit,     "!font arial 9 "
    #main.btnDelete,   "!font arial 9 "
    #main.btnSaveEdit, "!font arial 9 "
    #main.totRecs,     "!font arial 11 bold"
    #main.helpme,      "!font arial 10 "

    #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
    #main.totRecs, noRec
    #main.btnSave, "!enable"
    #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
    #f, rs$
    close #f
'update total records
    noRec=noRec+1
'update arrays and listbox
    gosub [fillContactsArray]
    gosub [fillListbox]
'refresh listbox names - address$()
    #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
    #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.
    #main.textPhone, "!contents? phone$"
    #main.textCell, "!contents? cell$"
    #main.textAddress, "!contents? address$"
    #main.textCity, "!contents? city$"
    #main.textSt, "!contents? state$"
    #main.textZip, "!contents? zip$"
    #main.textEmail, "!contents? email$"
'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...
    #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$;",";notes$
RETURN

[fieldHeadingDisplayString]
'to be used if helper windows are added
    fd$="Name: "+"Phone: "+"Cell: "+"Address: "+"City: "+_
    "State: "+"Zip: "+"E-Mail: "+"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
                #main.btnSaveEdit, "!disable"
                goto [getUserInput]
            end if
    end if
    #main.btnSave, "!enable"
'good to go, so clear the fields
    #main.textName, ""
    #main.textPhone, ""
    #main.textCell, ""
    #main.textAddress, ""
    #main.textCity, ""
    #main.textSt, ""
    #main.textZip, ""
    #main.textEmail, ""
    #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
    #copy, input$(#original, lof(#original));
    close #original
    close #copy
    #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
    #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]
    #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
        #fout, rs$(i)
    next i
    close #fout
'update arrays and listbox
    gosub [fillContactsArray]
    gosub [fillListbox]
    #main.lbx, "reload"
'notify user record edit successful
    notice "Modifications have been saved."
'trap accidental save attempt
    #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
    #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
        #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]
    #main.btnEdit, "!disable"
    #main.btnDelete, "!disable"
    #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
        #fout, rs$(i)
    next i
    close #fout

'create two-dimensional array for elements of each record - recA$()
    dim recA$(noRec,9)  '<== 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)
    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
    #main.btnEdit, "!enable"
    #main.btnDelete, "!enable"
    #main.btnSaveEdit, "!enable"
'disable save button to prevent duplicate records if
' user accidentally presses save button instead of save edit button
    #main.btnSave, "!disable"
    #main.lbx, "selectionindex? index"  'record to display
    #main.textName, recA$(index,1)
    #main.textPhone, recA$(index,2)
    #main.textCell, recA$(index,3)
    #main.textAddress, recA$(index,4)
    #main.textCity, recA$(index,5)
    #main.textSt, recA$(index,6)
    #main.textZip, recA$(index,7)
    #main.textEmail, recA$(index,8)
    #main.textNotes, recA$(index,9)
WAIT

[btnHelpClicked]
    notice "Address Cardfile v1.0" +chr$(13)+_
            "Freeware by jaba - 8/16/2009"+chr$(13)+_
            "Made for my wife because she likes "+chr$(13)+_
            "MS Cardfile and it hiccups on Vista."+chr$(13)+_
            chr$(13)+_
            "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(path$, filename$)
    files path$, filename$, Info$()
    fileExists = val(Info$(0, 0))   'non zero is true
end function

[helpmeLoop]
    for i=1 to 3
    #main.helpme, "help==>"
    timer 500, [oop]
    wait
    [oop]
    timer 0
   #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]
end                                                                                                                                                                                                                      

RNBW
Posts: 42
Joined: Thu Apr 05, 2018 9:21 pm

Re: ADDRESS MANAGER

Post by RNBW » Sun Jul 26, 2020 6:47 pm

I appreciate that a simple address book is not everybody's requirement and some may want a Contacts Manager.

I had another look at the Just basic Archives and came up with the following Contacts Manager. It was originally written for Liberty Basic by Sean Fennell and modified by C.W. Rodriguez. It's not complete. It doesn't have a print function, but I thought I would smarten it up with stylebits. Here is the code:

Code: Select all

'  =================================
'  Contact Manager_01
'  Originally by Sean Fennell and modified by
'  C.W. Rodriguez 26 November 2004
'  
'  Latest modification by RNBW

'Features: Add, Edit and Delete contacts. 
' Does not include a PRINT function.
' ==================================


NOMAINWIN
GOSUB [ContactListBuild]

[MainWindowSetup]

    '-----Begin code for #cmain

    WindowWidth = 626
    WindowHeight = 428
    UpperLeftX=int((DisplayWidth-WindowWidth)/2)
    UpperLeftY=int((DisplayHeight-WindowHeight)/2)

    'Contact types
    'Contact types can be easily changed just by
    'adding your own to the list
    ContactType$(1) = "Gallery Owner"
    ContactType$(2) = "Friend/Family"
    ContactType$(3) = "Educator/Instructor"
    ContactType$(4) = "Artist"
    ContactType$(5) = "Museum"
    ContactType$(6) = "Publisher"
    ContactType$(7) = "Workshop Participant"
    ContactType$(8) = "Artshow Director"
    ContactType$(9) = "Agent"
    ContactType$(10) = "Other Contact"

    '-----Begin GUI objects code

    statictext #cmain.name, "Name", 270,  10,  65,  20
    statictext #cmain.company, "Company", 270, 139,  58,  20
    statictext #cmain.address, "Address", 270,  50,  57,  20
    statictext #cmain.email, "e-mail", 270, 206,  37,  20
    statictext #cmain.phone, "Phone", 270, 106,  39,  20
    statictext #cmain.webpage, "Web Page", 270, 233,  65,  20
    statictext #cmain.contacttype, "Contact Type", 270, 173,  80,  20
    statictext #cmain.status, "", 200, 287, 240,  50

    TextboxColor$ = "white"
    stylebits #cmain.name, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.name, 340,   8, 260,  25
    stylebits #cmain.address1, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.address1, 340,  47, 260,  25
    stylebits #cmain.address2, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.address2, 340,  72, 260,  25
    stylebits #cmain.phone, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.phone, 340, 105, 197,  25
    stylebits #cmain.company, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.company, 340, 136, 260,  25
    stylebits #cmain.contacttype, _ES_LEFT, _WS_BORDER, 0,0
    ComboboxColor$ = "white"
    combobox #cmain.contacttype, ContactType$(, [ContactType],  358, 173, 170,  98
    stylebits #cmain.email, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.email, 340, 202, 260,  25
    stylebits #cmain.webpage, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.webpage, 340, 228, 260,  25


    ListboxColor$ = "white"
    stylebits #cmain.contacts, _ES_LEFT, _WS_BORDER, 0,0
    listbox #cmain.contacts, contacts$(, [ContactSelect],    8,   9, 234, 196

    button #cmain.addcontact,"Add Contact",[AddContact], UL,   8, 249, 150,  25
    button #cmain.viewcontact,"View Contact",[ViewContact], UL,   8, 218, 150,  25
    button #cmain.editcontact,"Edit Contact",[EditContact], UL,   8, 282, 150,  25
    button #cmain.savecontact,"Save",[SaveContact], UL, 448, 270, 150,  25
    button #cmain.printcontact,"Print Contacts",[PrintContacts], UL,   7, 348, 150,  25
    button #cmain.closemanager,"Close",[Quit], UL, 448, 306, 150,  25
    button #cmain.help,"Help",[ContactHelp], UL, 448, 340, 150,  25
    button #cmain.contactdelete,"Delete Contact",[DeleteContact], UL,   8, 315, 150,  25
    '-----End GUI objects code

    OPEN "Contact Manager v 1.0" FOR window_nf AS #cmain
    PRINT #cmain, "font ms_sans_serif 10"
    PRINT #cmain, "trapclose [Quit]"
    PRINT #cmain.contacts, "singleclickselect"
    PRINT #cmain.status, "Please select a contact or"; chr$(10); "press Add New Contact"
    WAIT

[MainState]'Main state of the Contact Manager before the user chooses an option
    PRINT #cmain.name, ""
    PRINT #cmain.company, ""
    PRINT #cmain.address1, ""
    PRINT #cmain.address2, ""
    PRINT #cmain.phone, ""
    PRINT #cmain.webpage, ""
    PRINT #cmain.email, ""
    PRINT #cmain.status, "Please select a contact or"; chr$(10); "press Add New Contact"
    PRINT #cmain.contacttype, "! "
    PRINT #cmain.savecontact, "!disable"
    RETURN

[ContactListBuild]'Build list of contacts to appear in the listbox

    'Open Directory File
    OPEN "directory.dat" FOR random AS #dir LEN = 230
    FIELD #dir, 30 AS name$, 35 AS address1$, 30 AS address2$, 15 AS phone$, 20 AS company$,_
         20 AS type$, 45 AS webpage$, 35 AS email$
    numberrecords = lof(#dir)/230

    DIM contacts$(100)

    [BuildLoop]'Loads list of names
    FOR i = 1 TO numberrecords
        GET #dir, i
        contacts$(i) = trim$(name$)
    NEXT i
    RETURN

[ContactSelect]'Returns the selected contact name and displays it in the textbox
    GOSUB [MainState]
    PRINT #cmain.contacts, "selection? contactsel$"
    PRINT #cmain.name, contactsel$
    PRINT #cmain.status, "Please press View Contact or"; chr$(10); "Edit Contact"
    PRINT #cmain.savecontact, "!disable"
    WAIT

[ContactType]'Returns the Contact Category selected by the user
    PRINT #cmain.contacttype, "selection? type$"
    WAIT


'******************************
'*****View Contact routine*****
'******************************
[ViewContact]
    PRINT #cmain.savecontact, "!disable"
    GOSUB [SearchContact]
    PRINT #cmain.name, name$
    PRINT #cmain.address1, address1$
    PRINT #cmain.address2, address2$
    PRINT #cmain.phone, phone$
    PRINT #cmain.company, company$
    PRINT #cmain.email, email$
    PRINT #cmain.webpage, webpage$
    PRINT #cmain.contacttype, "!"; type$
    PRINT #cmain.status, "Viewing Contact"
    WAIT


'**************************************
'*****Add & Edit Contacts Routines*****
'**************************************
[AddContact]' Add contact routine

    SaveAdd = 1 : SaveEdit = 0
    GOSUB [MainState]
    PRINT #cmain.status, "Add Contact"
    PRINT #cmain.name, "!setfocus"
    PRINT #cmain.savecontact, "!enable"
    WAIT

[EditContact]'Edit contact routine
    PRINT #cmain.savecontact, "!enable"
    IF contactsel$ = "" THEN WAIT
    SaveAdd = 0 : SaveEdit = 1
    GOSUB [SearchContact]
    PRINT #cmain.name, name$
    PRINT #cmain.address1, address1$
    PRINT #cmain.address2, address2$
    PRINT #cmain.phone, phone$
    PRINT #cmain.company, company$
    PRINT #cmain.email, email$
    PRINT #cmain.webpage, webpage$
    PRINT #cmain.contacttype, "!"; type$
    PRINT #cmain.status, "Edit Contact"
    WAIT

'************************************
'*****Delete an unwanted contact*****
'************************************
[DeleteContact]' Contact Delete Routine
    IF contactsel$ = "" THEN WAIT

    CONFIRM "Are you sure you want to delete this contact?"; answer$
    IF answer$ = "no" THEN WAIT

    GOSUB [SearchContact]

    name$ = "deleted" : address1$ = "" : address2$ = "" : phone$ = ""
    company$ = "" : type$ = "" : webpage$ = "" : email$ = ""

    PUT #dir, index
    CLOSE #dir

    GOSUB [ContactListBuild]
    PRINT #cmain.contacts, "reload"
    GOSUB [MainState]
    WAIT

'************************
'*****Search Routine*****
'************************
[SearchContact]'Searches FOR the contact name selected
    IF contactsel$ = "" THEN WAIT

    index = 1
    [Loop]
        GET #dir, index
        IF trim$(name$) = contactsel$ THEN RETURN

        index = index + 1
        GOTO [Loop]

'***********************************************
'*****Save New & Edited contact inFORmation*****
'***********************************************
[SaveContact]'Save initiation
    IF SaveAdd = 1 THEN [SaveAdd]

    IF SaveEdit = 1 THEN [SaveEdit]
    WAIT

[SaveAdd]'Save New Contacts
    CONFIRM "Save New Contact?"; answer$
    IF answer$ = "no" THEN WAIT
    PRINT #cmain.name, "!contents? name$"
    PRINT #cmain.address1, "!contents? address1$"
    PRINT #cmain.address2, "!contents? address2$"
    PRINT #cmain.phone, "!contents? phone$"
    PRINT #cmain.company, "!contents? company$"
    PRINT #cmain.email, "!contents? email$"
    PRINT #cmain.webpage, "!contents? webpage$"

    numberrecords = numberrecords + 1
    PUT #dir, numberrecords
    CLOSE #dir
    GOSUB [ContactListBuild]
    PRINT #cmain.contacts, "reload"
    SaveAdd = 0
    GOSUB [MainState]
    WAIT

[SaveEdit]' Save Edited Contact inFORmation
    CONFIRM "Save Changes?"; answer$
        IF answer$ = "no" THEN WAIT
    PRINT #cmain.name, "!contents? name$"
    PRINT #cmain.address1, "!contents? address1$"
    PRINT #cmain.address2, "!contents? address2$"
    PRINT #cmain.phone, "!contents? phone$"
    PRINT #cmain.company, "!contents? company$"
    PRINT #cmain.email, "!contents? email$"
    PRINT #cmain.webpage, "!contents? webpage$"

    PUT #dir, index
    SaveEdit = 0
    GOSUB [MainState]
    WAIT

[PrintContacts]'PRINTs a list of all contacts
    wait

[ContactHelp]
    WAIT

[Quit]'The End
    CONFIRM "Are you sure you want to quit?"; quit$
        IF quit$ = "no" THEN WAIT
    CLOSE #dir
    CALL CleanDirectory
    CLOSE #cmain
    END

SUB CleanDirectory
    OPEN "directory.dat" FOR RANDOM AS #del LEN = 230
    FIELD #del, 30 AS name$, 200 AS a$
    numberrecords = lof(#del)/230

    DIM temporary$(numberrecords, 2)

    counter = 0
    for x=1 to numberrecords
        get #del, x
        if trim$(name$) <> "deleted" then 'get names that aren't deleted into array

            counter=counter+1
            temporary$(counter,1)= name$
            temporary$(counter,2)= a$
            print temporary$(counter, 1)
        end if
    next x
    close #del

    KILL "directory.dat"

    OPEN "directory.dat" FOR RANDOM AS #temp LEN = 230
    FIELD #temp, 30 AS name$, 200 AS a$

    FOR t = 1 TO counter
        name$ = temporary$(t, 1)
        a$ = temporary$(t, 2)
        PUT #temp, t
    NEXT t
    CLOSE #temp
END SUB                       
Now I get something peculiar happening when I run it in LBB. The stylebits I entered were to left justify all text and for the textboxes to have a thin border. The Address boxes do have a thin border, but not the others.

I tried the code in Liberty Basic and it worked fine.

Can someone else run the code to see if the problem is replicated on their machine and if so, can someone see why it is happening. I have never had this problem before.

guest
Site Admin
Posts: 114
Joined: Tue Apr 03, 2018 1:34 pm

Re: ADDRESS MANAGER

Post by guest » Sun Jul 26, 2020 7:31 pm

RNBW wrote:
Sun Jul 26, 2020 6:47 pm
can someone see why it is happening.
Move the stylebits commands so they follow, rather than precede the definitions of the controls to which they apply. Attempting to change the style of a control that hasn't yet been defined is a bit odd.

guest
Site Admin
Posts: 114
Joined: Tue Apr 03, 2018 1:34 pm

Re: ADDRESS MANAGER

Post by guest » Sun Jul 26, 2020 8:53 pm

guest wrote:
Sun Jul 26, 2020 7:31 pm
Attempting to change the style of a control that hasn't yet been defined is a bit odd.
The original code would actually have worked, even in LBB (for compatibility with LB4), if it wasn't for the way some of the controls are initially defined as STATICTEXT and their handles later reused as TEXTBOX controls (here with some lines deleted for clarity):

Code: Select all

    statictext #cmain.name, "Name", 270,  10,  65,  20
    statictext #cmain.company, "Company", 270, 139,  58,  20
    statictext #cmain.email, "e-mail", 270, 206,  37,  20
    statictext #cmain.phone, "Phone", 270, 106,  39,  20
    statictext #cmain.webpage, "Web Page", 270, 233,  65,  20

    stylebits #cmain.name, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.name, 340,   8, 260,  25 ' was previously defined as STATICTEXT
    stylebits #cmain.phone, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.phone, 340, 105, 197,  25 ' was previously defined as STATICTEXT
    stylebits #cmain.company, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.company, 340, 136, 260,  25 ' was previously defined as STATICTEXT
    stylebits #cmain.email, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.email, 340, 202, 260,  25 ' was previously defined as STATICTEXT
    stylebits #cmain.webpage, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.webpage, 340, 228, 260,  25 ' was previously defined as STATICTEXT
In my opinion this code is illegal: #cmain.name can be a STATICTEXT or a TEXTBOX, but not both! It seems that neither LB4 nor LBB notices that this has happened, and in LBB it confuses the stylebits command (not in the least surprisingly, I would suggest).

If the 'reused' STATICTEXT controls are, as it seems, purely labels then they don't need a child 'extension' at all. If those unnecessary extensions are deleted the code works as it should in LBB:

Code: Select all

    statictext #cmain, "Name", 270,  10,  65,  20
    statictext #cmain, "Company", 270, 139,  58,  20
    statictext #cmain.address, "Address", 270,  50,  57,  20
    statictext #cmain, "e-mail", 270, 206,  37,  20
    statictext #cmain, "Phone", 270, 106,  39,  20
    statictext #cmain, "Web Page", 270, 233,  65,  20
    statictext #cmain.contacttype, "Contact Type", 270, 173,  80,  20
    statictext #cmain.status, "", 200, 287, 240,  50
It's one thing (and quite hard enough!) attempting to make LBB behave the same as LB4 when presented with legal BASIC code, but expecting it to behave the same with illegal BASIC code is unreasonable! Ensure that child control handles are unique; if they are simply static labels you can omit the extension entirely.

guest
Site Admin
Posts: 114
Joined: Tue Apr 03, 2018 1:34 pm

Re: ADDRESS MANAGER

Post by guest » Sun Jul 26, 2020 10:22 pm

guest wrote:
Sun Jul 26, 2020 8:53 pm
expecting it to behave the same with illegal BASIC code is unreasonable!
Not for the first time, I don't understand how it manages to work in LB4. Stripping it down to its bare essentials, we have this code:

Code: Select all

    statictext #cmain.name, "Name", 270,  10,  65,  20
    stylebits #cmain.name, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.name, 340,   8, 260,  25
So when the stylebits command is seen by the interpreter the STATICTEXT control with the same handle (#cmain.name) has already been defined, so naturally that's the control to which the stylebits is applied. Next a TEXTBOX is defined with the same child handle as the earlier STATICTEXT (which I think is illegal), but although that successfully creates a new control there is no reason for LBB to think it should apply the stylebits to it! Perhaps in LB4 the stylebits gets applied to both controls (the STATICTEXT and the TEXTBOX) but there's no easy way I could modify LBB to do that.

RNBW
Posts: 42
Joined: Thu Apr 05, 2018 9:21 pm

Re: ADDRESS MANAGER

Post by RNBW » Mon Jul 27, 2020 9:27 am

Richard
Thanks for your response.

It shows that you should look at someone else's code carefully before committing yourself to its use. I copied the code into LBB and ran it successfully, but decided it needed tidying up. I didn't notice the duplication of handles between statictext and textboxes. I simply did a find and replace on the original #contactmain.XXX handles to #cmain.XXX and then inserted the stylebits, which didn't tidy it up as I had expected.

I have corrected the statictext handles to #cmain.sXXX and now everything works as it should. I have also included _LBS_SORT in the stylebits for the listbox to sort the list alphabetically.

By the way, the LB Helpfile shows stylebits ahead of the controls and I have always followed this. However, I did try one of the textbox controls with stylebits following it and this also worked. So it seems stylebits can be before or after the controls to be acted upon. Useful to know!

The corrected code is shown below:

Code: Select all

''  =================================
'  Contact Manager_02
'  Originally by Sean Fennell and modified by
'  C.W. Rodriguez 26 November 2004
'  
'  Latest modification by RNBW

'Features: Add, Edit and Delete contacts. 
' Does not include a PRINT function.
' ==================================


NOMAINWIN
GOSUB [ContactListBuild]

[MainWindowSetup]

    '-----Begin code for #cmain

    WindowWidth = 626
    WindowHeight = 428
    UpperLeftX=int((DisplayWidth-WindowWidth)/2)
    UpperLeftY=int((DisplayHeight-WindowHeight)/2)

    'Contact types
    'Contact types can be easily changed just by
    'adding your own to the list
    ContactType$(1) = "Gallery Owner"
    ContactType$(2) = "Friend/Family"
    ContactType$(3) = "Educator/Instructor"
    ContactType$(4) = "Artist"
    ContactType$(5) = "Museum"
    ContactType$(6) = "Publisher"
    ContactType$(7) = "Workshop Participant"
    ContactType$(8) = "Artshow Director"
    ContactType$(9) = "Agent"
    ContactType$(10) = "Other Contact"

    '-----Begin GUI objects code

    statictext #cmain.sname, "Name", 270,  10,  65,  20
    statictext #cmain.scompany, "Company", 270, 139,  58,  20
    statictext #cmain.saddress, "Address", 270,  50,  57,  20
    statictext #cmain.semail, "e-mail", 270, 206,  37,  20
    statictext #cmain.sphone, "Phone", 270, 106,  39,  20
    statictext #cmain.swebpage, "Web Page", 270, 233,  65,  20
    statictext #cmain.scontacttype, "Contact Type", 270, 173,  80,  20
    statictext #cmain.sstatus, "", 200, 287, 240,  50

    TextboxColor$ = "white"
    stylebits #cmain.name, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.name, 340,   8, 260,  25
    stylebits #cmain.address1, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.address1, 340,  47, 260,  26
    stylebits #cmain.address2, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.address2, 340,  72, 260,  25
    stylebits #cmain.phone, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.phone, 340, 105, 197,  25
    stylebits #cmain.company, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.company, 340, 136, 260,  25
    stylebits #cmain.contacttype, _ES_LEFT, _WS_BORDER, 0,0
    ComboboxColor$ = "white"
    combobox #cmain.contacttype, ContactType$(, [ContactType],  358, 173, 170,  98
    stylebits #cmain.email, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.email, 340, 202, 260,  25
    stylebits #cmain.webpage, _ES_LEFT, _WS_BORDER, 0,0
    textbox #cmain.webpage, 340, 228, 260,  25


    ListboxColor$ = "white"
    stylebits #cmain.contacts, _ES_LEFT or _LBS_SORT, _WS_BORDER, 0,0
    listbox #cmain.contacts, contacts$(, [ContactSelect],    8,   9, 234, 196

    button #cmain.addcontact,"Add Contact",[AddContact], UL,   8, 249, 150,  25
    button #cmain.viewcontact,"View Contact",[ViewContact], UL,   8, 218, 150,  25
    button #cmain.editcontact,"Edit Contact",[EditContact], UL,   8, 282, 150,  25
    button #cmain.savecontact,"Save",[SaveContact], UL, 448, 270, 150,  25
    button #cmain.printcontact,"Print Contacts",[PrintContacts], UL,   7, 348, 150,  25
    button #cmain.closemanager,"Close",[Quit], UL, 448, 306, 150,  25
    button #cmain.help,"Help",[ContactHelp], UL, 448, 340, 150,  25
    button #cmain.contactdelete,"Delete Contact",[DeleteContact], UL,   8, 315, 150,  25
    '-----End GUI objects code

    OPEN "Contact Manager v 1.0" FOR window_nf AS #cmain
    PRINT #cmain, "font ms_sans_serif 10"
    PRINT #cmain, "trapclose [Quit]"
    PRINT #cmain.contacts, "singleclickselect"
    PRINT #cmain.sstatus, "Please select a contact or"; chr$(10); "press Add New Contact"
    WAIT

[MainState]'Main state of the Contact Manager before the user chooses an option
    PRINT #cmain.name, ""
    PRINT #cmain.company, ""
    PRINT #cmain.address1, ""
    PRINT #cmain.address2, ""
    PRINT #cmain.phone, ""
    PRINT #cmain.webpage, ""
    PRINT #cmain.email, ""
    PRINT #cmain.sstatus, "Please select a contact or"; chr$(10); "press Add New Contact"
    PRINT #cmain.contacttype, "! "
    PRINT #cmain.savecontact, "!disable"
    RETURN

[ContactListBuild]'Build list of contacts to appear in the listbox

    'Open Directory File
    OPEN "directory.dat" FOR random AS #dir LEN = 230
    FIELD #dir, 30 AS name$, 35 AS address1$, 30 AS address2$, 15 AS phone$, 20 AS company$,_
         20 AS type$, 45 AS webpage$, 35 AS email$
    numberrecords = lof(#dir)/230

    DIM contacts$(100)

    [BuildLoop]'Loads list of names
    FOR i = 1 TO numberrecords
        GET #dir, i
        contacts$(i) = trim$(name$)
    NEXT i
    RETURN

[ContactSelect]'Returns the selected contact name and displays it in the textbox
    GOSUB [MainState]
    PRINT #cmain.contacts, "selection? contactsel$"
    PRINT #cmain.name, contactsel$
    PRINT #cmain.sstatus, "Please press View Contact or"; chr$(10); "Edit Contact"
    PRINT #cmain.savecontact, "!disable"
    WAIT

[ContactType]'Returns the Contact Category selected by the user
    PRINT #cmain.contacttype, "selection? type$"
    WAIT


'******************************
'*****View Contact routine*****
'******************************
[ViewContact]
    PRINT #cmain.savecontact, "!disable"
    GOSUB [SearchContact]
    PRINT #cmain.name, name$
    PRINT #cmain.address1, address1$
    PRINT #cmain.address2, address2$
    PRINT #cmain.phone, phone$
    PRINT #cmain.company, company$
    PRINT #cmain.email, email$
    PRINT #cmain.webpage, webpage$
    PRINT #cmain.contacttype, "!"; type$
    PRINT #cmain.status, "Viewing Contact"
    WAIT


'**************************************
'*****Add & Edit Contacts Routines*****
'**************************************
[AddContact]' Add contact routine

    SaveAdd = 1 : SaveEdit = 0
    GOSUB [MainState]
    PRINT #cmain.sstatus, "Add Contact"
    PRINT #cmain.name, "!setfocus"
    PRINT #cmain.savecontact, "!enable"
    WAIT

[EditContact]'Edit contact routine
    PRINT #cmain.savecontact, "!enable"
    IF contactsel$ = "" THEN WAIT
    SaveAdd = 0 : SaveEdit = 1
    GOSUB [SearchContact]
    PRINT #cmain.name, name$
    PRINT #cmain.address1, address1$
    PRINT #cmain.address2, address2$
    PRINT #cmain.phone, phone$
    PRINT #cmain.company, company$
    PRINT #cmain.email, email$
    PRINT #cmain.webpage, webpage$
    PRINT #cmain.contacttype, "!"; type$
    PRINT #cmain.sstatus, "Edit Contact"
    WAIT

'************************************
'*****Delete an unwanted contact*****
'************************************
[DeleteContact]' Contact Delete Routine
    IF contactsel$ = "" THEN WAIT

    CONFIRM "Are you sure you want to delete this contact?"; answer$
    IF answer$ = "no" THEN WAIT

    GOSUB [SearchContact]

    name$ = "deleted" : address1$ = "" : address2$ = "" : phone$ = ""
    company$ = "" : type$ = "" : webpage$ = "" : email$ = ""

    PUT #dir, index
    CLOSE #dir

    GOSUB [ContactListBuild]
    PRINT #cmain.contacts, "reload"
    GOSUB [MainState]
    WAIT

'************************
'*****Search Routine*****
'************************
[SearchContact]'Searches FOR the contact name selected
    IF contactsel$ = "" THEN WAIT

    index = 1
    [Loop]
        GET #dir, index
        IF trim$(name$) = contactsel$ THEN RETURN

        index = index + 1
        GOTO [Loop]

'***********************************************
'*****Save New & Edited contact inFORmation*****
'***********************************************
[SaveContact]'Save initiation
    IF SaveAdd = 1 THEN [SaveAdd]

    IF SaveEdit = 1 THEN [SaveEdit]
    WAIT

[SaveAdd]'Save New Contacts
    CONFIRM "Save New Contact?"; answer$
    IF answer$ = "no" THEN WAIT
    PRINT #cmain.name, "!contents? name$"
    PRINT #cmain.address1, "!contents? address1$"
    PRINT #cmain.address2, "!contents? address2$"
    PRINT #cmain.phone, "!contents? phone$"
    PRINT #cmain.company, "!contents? company$"
    PRINT #cmain.email, "!contents? email$"
    PRINT #cmain.webpage, "!contents? webpage$"

    numberrecords = numberrecords + 1
    PUT #dir, numberrecords
    CLOSE #dir
    GOSUB [ContactListBuild]
    PRINT #cmain.contacts, "reload"
    SaveAdd = 0
    GOSUB [MainState]
    WAIT

[SaveEdit]' Save Edited Contact inFORmation
    CONFIRM "Save Changes?"; answer$
        IF answer$ = "no" THEN WAIT
    PRINT #cmain.name, "!contents? name$"
    PRINT #cmain.address1, "!contents? address1$"
    PRINT #cmain.address2, "!contents? address2$"
    PRINT #cmain.phone, "!contents? phone$"
    PRINT #cmain.company, "!contents? company$"
    PRINT #cmain.email, "!contents? email$"
    PRINT #cmain.webpage, "!contents? webpage$"

    PUT #dir, index
    SaveEdit = 0
    GOSUB [MainState]
    WAIT

[PrintContacts]'PRINTs a list of all contacts
    wait

[ContactHelp]
    WAIT

[Quit]'The End
    CONFIRM "Are you sure you want to quit?"; quit$
        IF quit$ = "no" THEN WAIT
    CLOSE #dir
    CALL CleanDirectory
    CLOSE #cmain
    END

SUB CleanDirectory
    OPEN "directory.dat" FOR RANDOM AS #del LEN = 230
    FIELD #del, 30 AS name$, 200 AS a$
    numberrecords = lof(#del)/230

    DIM temporary$(numberrecords, 2)

    counter = 0
    for x=1 to numberrecords
        get #del, x
        if trim$(name$) <> "deleted" then 'get names that aren't deleted into array

            counter=counter+1
            temporary$(counter,1)= name$
            temporary$(counter,2)= a$
            print temporary$(counter, 1)
        end if
    next x
    close #del

    KILL "directory.dat"

    OPEN "directory.dat" FOR RANDOM AS #temp LEN = 230
    FIELD #temp, 30 AS name$, 200 AS a$

    FOR t = 1 TO counter
        name$ = temporary$(t, 1)
        a$ = temporary$(t, 2)
        PUT #temp, t
    NEXT t
    CLOSE #temp
END SUB                                               

guest
Site Admin
Posts: 114
Joined: Tue Apr 03, 2018 1:34 pm

Re: ADDRESS MANAGER

Post by guest » Tue Jul 28, 2020 2:48 pm

RNBW wrote:
Mon Jul 27, 2020 9:27 am
the LB Helpfile shows stylebits ahead of the controls
I wonder what the use case for this was intended to be. Specifying the style after the control has been defined seems more natural to me and would have significantly simplified the code of LBB (you can imagine the poor interpreter's confusion when told the style of a control it's not yet encountered!). Maybe it's something that 'fell out' of the SmallTalk implementation.

RNBW
Posts: 42
Joined: Thu Apr 05, 2018 9:21 pm

Re: ADDRESS MANAGER

Post by RNBW » Thu Jul 30, 2020 2:49 pm

Richard
It doesn't seem natural. When you look at other implementations of Basic (Purebasic, Powerbasic, BBC Basic, etc) these all have styles implemented at the end or near the end of the control code. In other words the code is read from left to right and it is set up before the style is added to it.

I have played around with it a little and the stylebits commands do not actually need to be close to the control. I tried listing all the stylebits statements together before the controls were set up and it worked. All I can assume is that somewhere in the code for the control (invisible to the user) it looks for a stylebits statement associated with its handle to set the style.

I've adapted the code for the Address Book code to reflect this:

Code: Select all

'=========================
'  My Address Book
'  by RNBW 20 July 2020 (but all credit to jabas)
'
'  Adapted from JABAS Address Cardfile
'  by jaba 16 Aug 2009
' All content free to use.
'=========================
' MyAddressBookV2A.bas
' 30 July 2020
'=========================

'GLOBAL VARIABLES
    global path$, noRec, DBFname$
' Assign file and path info to variables
    path$ = DefaultDir$
    DBFname$ = "contactme_2.txt"

    nomainwin

    WindowWidth = 480    
    WindowHeight = 610
    UpperLeftX = 20
    UpperLeftY = 20
    
    stylebits #main.textName,  _ES_LEFT,  _WS_BORDER, 0, 0
    stylebits #main.textPhone,  _ES_LEFT,  _WS_BORDER, 0, 0
    stylebits #main.textCell,  _ES_LEFT,  _WS_BORDER, 0, 0
    stylebits #main.textAddress,  _ES_LEFT,  _WS_BORDER, 0, 0
    stylebits #main.textCity,  _ES_LEFT,  _WS_BORDER, 0, 0
    stylebits #main.textSt,  _ES_LEFT,  _WS_BORDER, 0, 0
    stylebits #main.textZip,  _ES_LEFT,  _WS_BORDER, 0, 0
    stylebits #main.textEmail,  _ES_LEFT,  _WS_BORDER, 0, 0
    stylebits #main.textEmail2,  _ES_LEFT,  _WS_BORDER, 0, 0
    stylebits #main.textNotes, _ES_LEFT OR _WS_VSCROLL OR _ES_MULTILINE, _WS_BORDER OR _ES_AUTOHSCROLL, 0, 0
    stylebits #main.lbx,  _ES_LEFT,  _WS_BORDER, 0, 0
    
    
    statictext  #main, " Name/Company:",       20, 25, 110, 20
    'stylebits #main.textName,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textName,        150, 20, 300, 25
    
    statictext  #main, "Tel:",       20, 55, 45, 20
    'stylebits #main.textPhone,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textPhone,       150, 50, 110, 25
    
    statictext  #main, "Mob:",        300, 55, 35, 20
    'stylebits #main.textCell,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textCell,        340, 50, 110, 25
    
    statictext  #main, "Address:",    20, 85, 100, 20
    'stylebits #main.textAddress,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textAddress,     150, 80, 300, 25
    
    statictext  #main, "City:",    20, 115, 45, 20
    'stylebits #main.textCity,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textCity,        150, 110, 300, 25
    
    statictext  #main, "County:",          20, 145, 100, 20
    'stylebits #main.textSt,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textSt,          150, 140, 130, 25
    
    statictext  #main, "Zip:",         300, 145, 20, 20
    'stylebits #main.textZip,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textZip,         340, 140, 110, 25
    
    statictext  #main, " E-Mail 1:",     20, 175, 60, 20
    'stylebits #main.textEmail,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox     #main.textEmail,       150, 170, 300, 25
    
    statictext  #main, " E-Mail 2:",     20, 200, 60, 20
    'stylebits #main.textEmail2,  _ES_LEFT,  _WS_BORDER, 0, 0
    textbox  #main.textEmail2,   150, 200, 300, 25   
    
    statictext  #main, " Notes:",      20, 235, 45, 20
    'stylebits #main.textNotes, _ES_LEFT OR _WS_VSCROLL OR _ES_MULTILINE, _WS_BORDER OR _ES_AUTOHSCROLL, 0, 0
    textbox     #main.textNotes,       150, 230, 300, 100
    
    statictext  #main, " Contacts:",   20, 335, 100, 15
    statictext  #main.totRecs, " ",    30, 365, 30, 20

    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

    stylebits #main.lbx,  _ES_LEFT,  _WS_BORDER, 0, 0
    listbox #main.lbx, address$(, [displayContactInfo],  150, 335, 205, 200
    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 contacts 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 contacts file."
            close #main
            end
        end if
        'no database, so create one
        open DBFname$ for output as #new
        close #new
            notice "The contacts 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"
    'BackgroundColor$="215, 195, 200"
    ForegroundColor$="black"

[openMainWindow]
    open "Address Cardfile" for window_nf as #main
        #main, "trapclose [btnExitClicked]"
        #main, "font ms_sans_serif 11"

    #main.textName,    "!font arial 11 "
    #main.textPhone,   "!font arial 11"
    #main.textCell,    "!font arial 11 "
    #main.textAddress, "!font arial 11 "
    #main.textCity,    "!font arial 11 "
    #main.textSt,      "!font arial 11 "
    #main.textZip,     "!font arial 11 "
    #main.textEmail,   "!font arial 11 "
    #main.textEmail2,   "!font arial 11 " 
    #main.textNotes, "!font arial 11"
    #main.btnClear,    "!font arial 9 "
    #main.btnSave,     "!font arial 9 "
    #main.btnExit,     "!font arial 9 "
    #main.btnEdit,     "!font arial 9 "
    #main.btnDelete,   "!font arial 9 "
    #main.btnSaveEdit, "!font arial 9 "
    #main.totRecs,     "!font arial 11 bold"
    #main.helpme,      "!font arial 10 "

    #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
    #main.totRecs, noRec
    #main.btnSave, "!enable"
    #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
    #f, rs$
    close #f
'update total records
    noRec=noRec+1
'update arrays and listbox
    gosub [fillContactsArray]
    gosub [fillListbox]
'refresh listbox names - address$()
    #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
    #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.
    #main.textPhone, "!contents? phone$"
    #main.textCell, "!contents? cell$"
    #main.textAddress, "!contents? address$"
    #main.textCity, "!contents? city$"
    #main.textSt, "!contents? state$"
    #main.textZip, "!contents? zip$"
    #main.textEmail, "!contents? email$"
    #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...
    #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
                #main.btnSaveEdit, "!disable"
                goto [getUserInput]
            end if
    end if
    #main.btnSave, "!enable"
'good to go, so clear the fields
    #main.textName, ""
    #main.textPhone, ""
    #main.textCell, ""
    #main.textAddress, ""
    #main.textCity, ""
    #main.textSt, ""
    #main.textZip, ""
    #main.textEmail, ""
    #main.textEmail2, ""    
    #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
    #copy, input$(#original, lof(#original));
    close #original
    close #copy
    #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
    #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]
    #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
        #fout, rs$(i)
    next i
    close #fout
'update arrays and listbox
    gosub [fillContactsArray]
    gosub [fillListbox]
    #main.lbx, "reload"
'notify user record edit successful
    notice "Modifications have been saved."
'trap accidental save attempt
    #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
    #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
        #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]
    #main.btnEdit, "!disable"
    #main.btnDelete, "!disable"
    #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
        #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
    #main.btnEdit, "!enable"
    #main.btnDelete, "!enable"
    #main.btnSaveEdit, "!enable"
'disable save button to prevent duplicate records if
' user accidentally presses save button instead of save edit button
    #main.btnSave, "!disable"
    #main.lbx, "selectionindex? index"  'record to display
    #main.textName, recA$(index,1)
    #main.textPhone, recA$(index,2)
    #main.textCell, recA$(index,3)
    #main.textAddress, recA$(index,4)
    #main.textCity, recA$(index,5)
    #main.textSt, recA$(index,6)
    #main.textZip, recA$(index,7)
    #main.textEmail, recA$(index,8)
    #main.textEmail2, recA$(index,9)    
    #main.textNotes, recA$(index,10)
WAIT

[btnHelpClicked]
    notice "Address Cardfile v1.0" +chr$(13)+_
            "Freeware by jaba - 8/16/2009"+chr$(13)+_
            "Made for my wife because she likes "+chr$(13)+_
            "MS Cardfile and it hiccups on Vista."+chr$(13)+_
            chr$(13)+_
            "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(path$, filename$)
    files path$, filename$, Info$()
    fileExists = val(Info$(0, 0))   'non zero is true
end function

[helpmeLoop]
    for i=1 to 3
    #main.helpme, "help==>"
    timer 500, [oop]
    wait
    [oop]
    timer 0
   #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]
end                                                                                                                                                                                                                                                                                                    
I even moved the block of stylebit statements to immediately before the window was opened and it still worked.

What LB lacks is some sort of Enumeration that could be used to set up to put the control handles in a loop. LBB gets round this with Maphandle, which we used successfully in constructing grids of textboxes.

Maybe Carl Gundel will sort something out with the final version of LB5.

Post Reply