ADDRESS MANAGER

RNBW · 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 · 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.

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

RNBW wrote: ↑Sun Jul 26, 2020 6:47 pmcan 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.

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

guest wrote: ↑Sun Jul 26, 2020 7:31 pmAttempting 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.

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

guest wrote: ↑Sun Jul 26, 2020 8:53 pmexpecting 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 · 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

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

RNBW wrote: ↑Mon Jul 27, 2020 9:27 amthe 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 · 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.

RNBW · Post by **RNBW** » Tue Aug 18, 2020 7:00 pm

I don't know if anyone is interested, but I have made one or two changes to MyAddressBook. They are mainly cosmetic, but suit my requirements better.

The Notes section has been relocated and increased in size. This has enabled the Contacts Listbox to be increased in depth.

The result is to be able to show far more of the Contacts in the Contacts Listbox and more information in the Notes Textbox.

What I'm not sure about is how much information you can enter into a Textbox, but unless someone can tell me, I'll wait until a problem arises and deal with it then.

I've also moved the Stylebits section to after the Controls to show that this works.

The revised code is:

Code: Select all

'=========================
'  My Address Book
'  by RNBW 18 August 2020 (but all credit to jabas)
'
'  Adapted from JABAS Address Cardfile
'  by jaba 16 Aug 2009
' All content free to use.
'=========================
' MyAddressBookV2C.bas
' 18 August 2020
'=========================
'
'  Difference between this file and MyAddressBookV2B.bas
'  is that the block of stylebits has been moved after the
'  controls instead of before them.  Also the Notes section
'  has been relocated and increased in size.
'  This has enabled the Contacts Listbox to be increased 
'  in depth.
'
'=======================================

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

    nomainwin

    WindowWidth = 830
    WindowHeight = 610
    UpperLeftX = 20
    UpperLeftY = 20

    ' Controls
    statictext  #main, " Name/Company:",       20, 25, 110, 20
    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

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

    ' stylebits formatting
    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

'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"
    '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




filePath$=DefaultDir$

'hidden buttons used by toolbar code:
Button #1.hide0, "", [new], UL, -400, -400, 0, 0
Button #1.hide1, "", [open], UL, -400, -400, 0, 0
Button #1.hide2, "", [save], UL, -400, -400, 0, 0
Button #1.hide3, "", [print], UL, -400, -400, 0, 0
Button #1.hide4, "", [cut], UL, -400, -400, 0, 0
Button #1.hide5, "", [copy], UL, -400, -400, 0, 0
Button #1.hide6, "", [paste], UL, -400, -400, 0, 0
Button #1.hide7, "", [undo], UL, -400, -400, 0, 0
Button #1.hide8, "", [help], UL, -400, -400, 0, 0

Menu #1, "&File", "&New",[new],"&Open",[open],_
    "Open &Last",[openLast],"&Save", [save],|,_
    "&Print",[print],|,"E&xit", [quit]
Menu #1, "&Edit", "&Cut", [cut],_
    "C&opy", [copy], "&Paste", [paste],_
    "&Undo", [undo],"&Select All",[selectAll]
Menu #1, "&Font", "&Arial Small", [arial14],_
    "Arial Medi&um", [arial16],_
    "A&rial Large", [arial18],_
    "&Courier New Small", [courier14],_
    "Courier New &Medium", [courier16],_
    "Courier &New Large",[courier18],_
    "&Default Font",[defaultFont]
Menu #1, "&Help","&Info",[help]

open "Liberty BASIC TextPad" for window as #1
    print #1, "trapclose [quit]"
    print #1, "resizehandler [resizeIt]"

    hParent=hwnd(#1)
    GoSub [MakeToolbar]
    hTextEd=CreateTextEdit(hParent, 1, 25, 300, 400)

    if hFont<>0 then call DeleteObject hFont
    hFont=CreateFont("courier new",16)
    ret = SendMessageLong(hTextEd,_WM_SETFONT,hFont,1)

    calldll #comctl32, "InitCommonControls",re as void
    hStatus=StatusBar(hParent, "  Untitled.txt")
    call SetParts hStatus
    call SetFocus hTextEd

    timer 1000, [changeTime]

    wait

[quit]
    timer 0
    CallDLL #gdi32, "DeleteObject",_
        hbmpTools As long, ret As boolean
    if hFont<>0 then call DeleteObject hFont
    calldll #user32, "SendMessageA",_
    hStatus as word,_WM_DESTROY as word,_
    0 as word,0 as long,re as long
    close #1:end


[resizeIt]
    ww=WindowWidth:wh=WindowHeight
    call MoveWindow hTextEd, 1, 25, ww-2, wh-46
    call ResizeStatus, hStatus, ww
    wait

[new]
    call SetWindowText hTextEd, ""
    call SetText hStatus,0,"  Untitled.txt"
    wait

[open]
    timer 0
    filedialog "Open",filePath$+"\*.txt",file$
    if file$="" then wait
      open DefaultDir$+"\textpad.ini" for output as #ini
        print #ini, file$
      close #ini
    gosub [loadFile]
    timer 1000, [changeTime]
    wait

[openLast]
    timer 0
    if FileExist(DefaultDir$,"textpad.ini")<1 then
        notice "Error"+chr$(13)+"No record of last file."
        wait
    end if
      open DefaultDir$+"\textpad.ini" for input as #ini
        line input #ini, file$
      close #ini
    gosub [loadFile]
    timer 1000, [changeTime]
    wait

[loadFile]
    shortFile$=SeparateFile$(file$)
    filePath$=SeparatePath$(file$)
    if FileExist(filePath$,shortFile$)<0 then wait
    open file$ for input as #f
    txt$=input$(#f, lof(#f))
    close #f
    call SetWindowText hTextEd, txt$
    call SetText hStatus,0,"  "+shortFile$
    return

[save]
    timer 0
    filedialog "Save",filePath$+"\*.txt",savefile$
    if savefile$="" then wait
    if instr(savefile$,".")=0 then savefile$=savefile$+".txt"
      open DefaultDir$+"\textpad.ini" for output as #ini
        print #ini, savefile$
      close #ini
    open savefile$ for output as #f
    txt$=GetWindowText$(hTextEd)
    print #f, txt$
    close #f
    timer 1000, [changeTime]
    wait

[print]
    timer 0
    txt$=GetWindowText$(hTextEd)
    lprint txt$
    dump
    timer 1000, [changeTime]
    wait

[cut]
    ret = SendMessageLong(hTextEd,_WM_CUT,0,0)
    wait

[copy]
    ret = SendMessageLong(hTextEd,_WM_COPY,0,0)
    wait

[paste]
    ret = SendMessageLong(hTextEd,_WM_PASTE,0,0)
    wait

[undo]
    ret = SendMessageLong(hTextEd,_WM_UNDO,0,0)
    wait

[selectAll]
    call SetFocus hTextEd
    ret = SendMessageLong(hTextEd,_EM_SETSEL,0,-1)
    wait


[arial14]
    if hFont<>0 then call DeleteObject hFont
    hFont=CreateFont("arial",14)
    ret = SendMessageLong(hTextEd,_WM_SETFONT,hFont,1)
    wait

[arial16]
    if hFont<>0 then call DeleteObject hFont
    hFont=CreateFont("arial",16)
    ret = SendMessageLong(hTextEd,_WM_SETFONT,hFont,1)
    wait

[arial18]
    if hFont<>0 then call DeleteObject hFont
    hFont=CreateFont("arial",18)
    ret = SendMessageLong(hTextEd,_WM_SETFONT,hFont,1)
    wait

[courier14]
    if hFont<>0 then call DeleteObject hFont
    hFont=CreateFont("courier new",14)
    ret = SendMessageLong(hTextEd,_WM_SETFONT,hFont,1)
    wait

[courier16]
    if hFont<>0 then call DeleteObject hFont
    hFont=CreateFont("courier new",16)
    ret = SendMessageLong(hTextEd,_WM_SETFONT,hFont,1)
    wait

[courier18]
    if hFont<>0 then call DeleteObject hFont
    hFont=CreateFont("courier new",18)
    ret = SendMessageLong(hTextEd,_WM_SETFONT,hFont,1)
    wait

[defaultFont]
    hFontDefault=GetDefaultFont
    ret = SendMessageLong(hTextEd,_WM_SETFONT,hFontDefault,1)
    wait

[help]
    file$=chr$(34)+DefaultDir$+"\textpad.txt"
    run "notepad.exe " + file$
    wait

[changeTime]
    timer 0
    Call SetText hStatus,4,amPmTime$(time$())

    capsLock=GetKeyState(_VK_CAPITAL)
    if capsLock=0 then s$="CAPS OFF" else s$="CAPS ON"
    call SetText hStatus, 1, s$

    numLock=GetKeyState(_VK_NUMLOCK)
    if numLock=0 then s$="NUM OFF" else s$="NUM ON"
    call SetText hStatus, 2, s$

    insLock=GetKeyState(_VK_INSERT)
    if insLock=0 then s$="INS OFF" else s$="INS ON"
    call SetText hStatus, 3, s$

    timer 1000, [changeTime]
    wait


Function SendMessagePtr(hWnd,msg,w,p$)
    calldll #user32, "SendMessageA", hWnd as long, _
    msg as long, w as long, p$ as ptr,_
     SendMessagePtr as long
    end function

function SendMessageLong(hWnd,msg,w,l)
    calldll #user32, "SendMessageA", hWnd as long, _
    msg as long, w as long, l as long,_
    SendMessageLong as long
    end function

sub SetFocus hWnd
    calldll #user32, "SetFocus", hWnd as long,_
    result as long
    end sub

sub SetWindowText hWnd, txt$
    calldll #user32, "SetWindowTextA", hWnd as long,_
    txt$ as ptr, result as void
    end sub

function GetWindowText$(hWnd)
    total = GetWindowTextLength(hWnd)
    Title$=space$(total)+Chr$(0):l= Len(Title$)
    calldll #user32, "GetWindowTextA", hWnd as long,_
    Title$ as ptr, l as long, result as long
    GetWindowText$=trim$(Title$)
    end function

function GetWindowTextLength(hW)
    calldll #user32, "GetWindowTextLengthA",_
    hW as long,_
    GetWindowTextLength as long
    end function

Function CreateTextEdit(hW, x, y, w, h)
    style = _WS_CHILDWINDOW OR _WS_BORDER _
    OR _WS_VISIBLE or _ES_MULTILINE or _WS_VSCROLL
    hInst=GetWindowLong(hW, _GWL_HINSTANCE)

    calldll #user32, "CreateWindowExA",_
        0 as long,"EDIT" as ptr,_
        "" as ptr, style as long,_
        x as long,y as long,w as long,h as long,_
        hW as long, 0 as long, hInst as long,_
        0 as long, CreateTextEdit as long
    end function

Function GetWindowLong(hW, type)
    calldll #user32, "GetWindowLongA", _
    hW as long, type as long,_
    GetWindowLong as long
    End Function

Function CreateFont(fontname$, fontheight)
    fontname$ = fontname$ + chr$(0)
    Calldll #gdi32, "CreateFontA",_
         fontheight as long,_
         0 as long,0 as long,0 as long,_
         0 as long,0 as long,0 as long,_
         0 as long,0 as long,0 as long,_
         0 as long,0 as long,0 as long,_
         fontname$ as PTR,_
         CreateFont as long
    end function

Function GetDefaultFont()
    calldll #gdi32, "GetStockObject",_
        _DEFAULT_GUI_FONT as long,_
        GetDefaultFont as long
    End Function

sub DeleteObject hObject
    calldll #gdi32,"DeleteObject",_
    hObject as long,_
    r as boolean
    end sub

sub MoveWindow hW, x, y, w, h
    calldll #user32, "MoveWindow",_
    hW as long, x as long, y as long,_
    w as long, h as long,_
    1 as boolean, result as boolean
    end sub

function FileExist(fPath$,fFile$)
    dim info$(10,10)
    files fPath$,fFile$,info$(
    FileExist=val(info$(0,0))
    end function

Function StatusBar(hWnd, txt$)
    'statusbar parts:
    '0=changing text
    '1=Capslock On/Off
    '2=Numberlock On/Off
    '3=Ins On/Off
    '4=time
    style = _WS_VISIBLE or _WS_CHILD
    calldll #comctl32, "CreateStatusWindow",_
    style as long,_   'window style
    txt$ as ptr,_     'desired caption
    hWnd as long,_    'handle of parent window
    10 as word,_      'ID, not used by LB
    StatusBar as long 'returns handle of status bar
    End Function

Sub SetParts hWnd
    SB.SETPARTS = 1028
    struct prt,end0 as long, end1 as long,_
        end2 as long,end3 as long,end4 as long
    prt.end0.struct=320
    prt.end1.struct=380
    prt.end2.struct=440
    prt.end3.struct=500
    prt.end4.struct=-1
    numParts=5
    calldll #user32,  "SendMessageA",_
    hWnd as long, SB.SETPARTS as long,_
    numParts as long,prt as struct,r as long
    End Sub

Sub ResizeStatus hWnd,width
    calldll #user32, "SendMessageA",_
    hWnd as long,_WM_SIZE as long,_
    0 as long, width as long,_
    re as long

    SB.SETPARTS = 1028
    struct prt,end0 as long, end1 as long,_
        end2 as long,end3 as long,end4 as long
    prt.end0.struct=width-280
    prt.end1.struct=width-220
    prt.end2.struct=width-160
    prt.end3.struct=width-100
    prt.end4.struct=-1
    numParts=5
    calldll #user32,  "SendMessageA",_
    hWnd as long, SB.SETPARTS as long,_
    numParts as long,prt as struct,r as long
    End Sub

Sub SetText hWnd,segID,txt$
    SB.SETTEXT  = 1025
    calldll #user32,  "SendMessageA",_
    hWnd as long,SB.SETTEXT as long,_
    segID as long,txt$ as ptr,r as long
    End Sub

Function GetKeyState(key)
    CallDLL #user32, "GetKeyState",key As long,_
    GetKeyState As long
    End Function

function amPmTime$(time$)
    colonIndex = instr(time$, ":")
    hours = val(left$(time$, colonIndex - 1))
    amOrPm$ = " AM"
   if hours > 12 then
        hours = hours - 12
        amOrPm$ = " PM"
    else
        if hours = 0 then hours = 12
    end if
    amPmTime$ = str$(hours) + mid$(time$, colonIndex,3) + amOrPm$
    end function

function SeparateFile$(f$)
    fileindex=len(f$)
    filelength=len(f$)
      while mid$(f$, fileindex,1)<>"\"
        fileindex=fileindex-1
      wend
    SeparateFile$=right$(f$,filelength-fileindex)
    end function


function SeparatePath$(f$)
    fileindex=len(f$)
    filelength=len(f$)
      while mid$(f$, fileindex,1)<>"\"
        fileindex=fileindex-1
      wend
    SeparatePath$=left$(f$,fileindex)
    end function

Sub GetClientRect hW
    CallDLL #user32, "GetClientRect",hW As long,_
    Rect As struct,r As long
    End Sub

'All code after this point is needed
'to create the toolbar.  Do not modify
'or remove anything below.
[MakeToolbar]
    hMain = hWnd(#1)    'get window handle

    struct TBBUTTON,_
    bmpID As long,_ 'index of bitmap
    cID As long,_   'command ID
    State As long,_ 'button state
    Style As long,_ 'button style
    dwData As long,_'not used
    Str As long     'not used

    TB.ADDBUTTONS    = 1044
    TB.SETTOOLTIPS   = 1060
    TBSTYLE.BUTN     = 0
    TBSTYLE.FLAT     = 2048
    TBSTYLE.TOOLTIPS = 256

    CallDLL #comctl32, "InitCommonControls", r As void

    hbmpTools=LoadBitmapSystemColors("edittool.bmp")

    If hbmpTools=0 Then
        Notice "Error loading bitmap!"
        Return
    End If

    hID0 = GetWindowLong(hWnd(#1.hide0),_GWL_ID)
    hID1 = GetWindowLong(hWnd(#1.hide1),_GWL_ID)
    hID2 = GetWindowLong(hWnd(#1.hide2),_GWL_ID)
    hID3 = GetWindowLong(hWnd(#1.hide3),_GWL_ID)
    hID4 = GetWindowLong(hWnd(#1.hide4),_GWL_ID)
    hID5 = GetWindowLong(hWnd(#1.hide5),_GWL_ID)
    hID6 = GetWindowLong(hWnd(#1.hide6),_GWL_ID)
    hID7 = GetWindowLong(hWnd(#1.hide7),_GWL_ID)
    hID8 = GetWindowLong(hWnd(#1.hide8),_GWL_ID)

    'fill toobar button struct for first button
    TBBUTTON.bmpID.struct = 0              'index of first bitmap
    TBBUTTON.cID.struct = hID0             'ID of first button
    TBBUTTON.State.struct = 4              'enabled
    TBBUTTON.Style.struct = TBSTYLE.BUTN   'style
    TBBUTTON.dwData.struct = 0             'not used
    TBBUTTON.Str.struct = 0                'not used

    style=_WS_CHILD Or _WS_VISIBLE Or TBSTYLE.TOOLTIPS _
         Or TBSTYLE.FLAT
    uStructSize = Len(TBBUTTON.struct)
    CallDLL #comctl32, "CreateToolbarEx",_
        hMain As long,_     'parent handle
        style As long,_     'window style flags
        0 As long,_         'ID
        9 As long,_         'number of Bitmaps
        0 As long,_         'hBMInst-not used
        hbmpTools As long,_ 'bitmap handle
        TBBUTTON As struct,_'toolbar button struct
        1 As long,_         'number of buttons to start
        16 As long,_        'width buttons
        16 As long,_        'height buttons
        16 As long,_        'width bitmaps for buttons
        16 As long,_        'height bitmaps for buttons
        uStructSize As long,_
        hTB As long         'handle to toolbar

    GoSub [AddTooltips]

    'must add tooltip control before adding buttons to toolbar
    r = SendMessage(hTB, TB.SETTOOLTIPS, hwndTT, 0)

    'fill toolbar button struct with new info to add buttons:
    TBBUTTON.bmpID.struct = 1  'bitmap image index
    TBBUTTON.cID.struct = hID1 'ID of button
    Call AddButton hTB, TB.ADDBUTTONS

    TBBUTTON.bmpID.struct = 2  'bitmap image index
    TBBUTTON.cID.struct = hID2 'ID of button
    Call AddButton hTB, TB.ADDBUTTONS

    TBBUTTON.bmpID.struct = 3  'bitmap image index
    TBBUTTON.cID.struct = hID3 'ID of button
    Call AddButton hTB, TB.ADDBUTTONS

    TBBUTTON.bmpID.struct = 4  'bitmap image index
    TBBUTTON.cID.struct = hID4 'ID of button
    Call AddButton hTB, TB.ADDBUTTONS

    TBBUTTON.bmpID.struct = 5  'bitmap image index
    TBBUTTON.cID.struct = hID5 'ID of button
    Call AddButton hTB, TB.ADDBUTTONS

    TBBUTTON.bmpID.struct = 6  'bitmap image index
    TBBUTTON.cID.struct = hID6 'ID of button
    Call AddButton hTB, TB.ADDBUTTONS

    TBBUTTON.bmpID.struct = 7  'bitmap image index
    TBBUTTON.cID.struct = hID7 'ID of button
    Call AddButton hTB, TB.ADDBUTTONS

    TBBUTTON.bmpID.struct = 8  'bitmap image index
    TBBUTTON.cID.struct = hID8 'ID of button
    Call AddButton hTB, TB.ADDBUTTONS

    'tell toolbar to resize with window
    ret = SendMessage(hTB, TB.AUTOSIZE, 0, 0)
    Return


[AddTooltips]
    TTS.ALWAYSTIP = 1
    TTS.NOPREFIX  = 2
    TTF.SUBCLASS  = 16
    TTM.ADDTOOL   = 1028

    style = _WS_POPUP or TTS.NOPREFIX _
         or TTS.ALWAYSTIP

    hInstance = GetWindowLong(hMain,_GWL_HINSTANCE)

    CallDLL #user32, "CreateWindowExA",_
    _WS_EX_TOPMOST As long,_
    "TOOLTIPS_CLASS32" As ptr,_
    "" As ptr, style As long,_
    _CW_USEDEFAULT As long,_CW_USEDEFAULT As long,_
    _CW_USEDEFAULT As long,_CW_USEDEFAULT As long,_
    hMain As long, 0 As long, hInstance As long,_
    0 As long,hwndTT As long

    flags=_SWP_NOMOVE or _SWP_NOSIZE or _SWP_NOACTIVATE
    CallDLL #user32, "SetWindowPos", hwndTT As long,_
    _HWND_TOPMOST As long, _
    0 As long, 0 As long,_
    0 As long, 0 As long,_
    flags As long, r As long

    struct toolinfo, cbSize As long, uFlags As long,_
    hwin As long, uId As long, left As long, top As long,_
    right As long, bottom As long, _
    hInst As long, lpstrText$ As ptr

    'THESE STRUCT MEMBERS ONLY NEED TO BE FILLED ONCE:
    toolinfo.cbSize.struct = Len(toolinfo.struct)
    toolinfo.uFlags.struct = TTF.SUBCLASS
    toolinfo.hwin.struct = hTB
    toolinfo.top.struct = 0     'top location on toolbar
    toolinfo.bottom.struct = 22 'bottom location on toolbar

    'THESE STRUCT MEMBERS NEED TO BE FILLED ANEW
    'FOR EACH TOOTLIP ADDED:
    toolinfo.lpstrText$.struct = "New"
    toolinfo.left.struct = 0    'initial left location
    toolinfo.right.struct = 22  'add 22 to left for right
    CallDLL #user32, "SendMessageA", hwndTT As long,_
    TTM.ADDTOOL As long, 0 As long,_
    toolinfo As struct, re As long

    toolinfo.lpstrText$.struct = "Open"
    toolinfo.left.struct = 23  'add 23 to previous left location
    toolinfo.right.struct = 45 'add 22 to left for right
    CallDLL #user32,"SendMessageA", hwndTT As long,_
    TTM.ADDTOOL As long, 0 As long,_
    toolinfo As struct, re As long

    toolinfo.lpstrText$.struct = "Save"
    toolinfo.left.struct = 46  'add 23 to previous left location
    toolinfo.right.struct = 68 'add 22 to left for right
    CallDLL #user32,"SendMessageA", hwndTT As long,_
    TTM.ADDTOOL As long, 0 As long,_
    toolinfo As struct, re As long

    toolinfo.lpstrText$.struct = "Print"
    toolinfo.left.struct = 69  'add 23 to previous left location
    toolinfo.right.struct = 91 'add 22 to left for right
    CallDLL #user32,"SendMessageA", hwndTT As long,_
    TTM.ADDTOOL As long, 0 As long,_
    toolinfo As struct, re As long

    toolinfo.lpstrText$.struct = "Cut"
    toolinfo.left.struct = 92  'add 23 to previous left location
    toolinfo.right.struct = 114 'add 22 to left for right
    CallDLL #user32,"SendMessageA", hwndTT As long,_
    TTM.ADDTOOL As long, 0 As long,_
    toolinfo As struct, re As long

    toolinfo.lpstrText$.struct = "Copy"
    toolinfo.left.struct = 115  'add 23 to previous left location
    toolinfo.right.struct = 137 'add 22 to left for right
    CallDLL #user32,"SendMessageA", hwndTT As long,_
    TTM.ADDTOOL As long, 0 As long,_
    toolinfo As struct, re As long

    toolinfo.lpstrText$.struct = "Paste"
    toolinfo.left.struct = 138  'add 23 to previous left location
    toolinfo.right.struct = 160 'add 22 to left for right
    CallDLL #user32,"SendMessageA", hwndTT As long,_
    TTM.ADDTOOL As long, 0 As long,_
    toolinfo As struct, re As long

    toolinfo.lpstrText$.struct = "Undo"
    toolinfo.left.struct = 161  'add 23 to previous left location
    toolinfo.right.struct = 183 'add 22 to left for right
    CallDLL #user32,"SendMessageA", hwndTT As long,_
    TTM.ADDTOOL As long, 0 As long,_
    toolinfo As struct, re As long

    toolinfo.lpstrText$.struct = "Help"
    toolinfo.left.struct = 184  'add 23 to previous left location
    toolinfo.right.struct = 206 'add 22 to left for right
    CallDLL #user32,"SendMessageA", hwndTT As long,_
    TTM.ADDTOOL As long, 0 As long,_
    toolinfo As struct, re As long

    Return

Sub AddButton hndl, msg
    CallDLL #user32, "SendMessageA", hndl As long,_
    msg As long, 1 As long,_
    TBBUTTON As struct, r As long
    End Sub

Function SendMessage(hWin, msg, wParam, lParam)
    CallDLL #user32, "SendMessageA", hWin As long, msg As long, _
    wParam As long, lParam As long, SendMessage As long
    End Function

Function LoadBitmapSystemColors(bmp$)
    flags=_LR_LOADFROMFILE or _LR_LOADMAP3DCOLORS _
        or _LR_LOADTRANSPARENT
    CallDLL #user32, "LoadImageA",_
    0 As long, bmp$ As ptr, _IMAGE_BITMAP As ulong,_
    0 As long, 0 As long, flags As long,_
    LoadBitmapSystemColors As ulong
    End Function

'****** End Toolbar Code ******
'******************************


[hehe]
    notice "It's not really a button. It's a line!"
    goto [getUserInput]
end

Post by **guest** » Tue Aug 18, 2020 9:19 pm

RNBW wrote: ↑Tue Aug 18, 2020 7:00 pm What I'm not sure about is how much information you can enter into a Textbox

I think it depends on the version of Windows (and maybe also on the manifest, if any). In the old days I think an edit control was limited to 64 Kbytes of text, but I suspect that limit has now been lifted.

LB Booster forum

ADDRESS MANAGER

ADDRESS MANAGER

Re: ADDRESS MANAGER

Re: ADDRESS MANAGER

Re: ADDRESS MANAGER

Re: ADDRESS MANAGER

Re: ADDRESS MANAGER

Re: ADDRESS MANAGER

Re: ADDRESS MANAGER

Re: ADDRESS MANAGER

Re: ADDRESS MANAGER