|
|
Post by Rod on Jan 12, 2020 15:11:09 GMT -5
We have recently had a welter of code discussions about contact4.bas which in actual fact is a relatively complex code demo. It ships with Liberty. I decided to embark on the creation of a simpler alternative. One that uses all native code, no API. One that demonstrates the concept of indexing and selection (find). The index allows the main data to be listed and sorted without disturbing the actual record set. I will also add relational data, in this instance contact history. This will be held in linked list format. The linked list allows discussions to be appended to a chain. We follow the chain to display all discussions for a contact. Each discussion has a previous record pointer and a next record pointer.
Here is where I am, at the very beginning. I hope you can see that it already has features that improve on contact4.bas. It builds its own garbage database to allow testing.
Contact history next.
'build a fresh garbage .dbf to play with
'remove this code block to keep contact.dat intact
'##################################################################################################
open "contact.dat" for output as #1
close #1
Open "contact.dat" For Random As #1 Len = 269
Field #1, 35 As company$, 35 As contact$, 35 As addr1$, 35 As addr2$, 35 As addr3$,_
10 As zip$, 12 As phone1$,12 As phone2$, 50 As email$,10 as memo
n$="Robert John Paul Lisa Janette Peter Gordon Manuel Harry William Jane Joan Debra"
s$="Houston Wilson Raydon Malcom McDonald House Morrow Menzies Buxton Souness Keen Goran Allan"
b$="Ace Acme Arrow Big Best Custom Fast Cheap Hungry"
d$="Carriers Hauliers Chemicals Cleaners Builders Plumbers Decorators Electricians Insurance"
open "memo.dat" for output as #2
close #2
open "memo.dat" for random as #2 len = 130
field #2, 10 as prev, 100 as memo$, 10 as nexx, 10 as cont
mn=1
for n= 1 to 100
company$=word$(b$,int(rnd(0)*9+1))+" "+word$(d$,int(rnd(0)*9+1))
contact$=word$(n$,int(rnd(0)*13+1))+" "+word$(s$,int(rnd(0)*13+1))
addr1$=str$(n)+" First line of address"
addr2$="Second line of address"
addr3$="Third line of address"
zip$="9999"
phone1$="0123456789"
phone2$="0987654321"
email$=contact$+"@hotmail.com"
memo=mn
put #1,n
prev=0
memo$=date$("yyyy/mm/dd")+" at "+left$(time$(),5)+chr$(13)+"Account opened"
nexx=0
cont=n
put #2,mn
mn=mn+1
next
close #1
close #2
'##################################################################################################
Global searchTxt$,searchIn,currentContact, foundContacts, maxContacts,maxMemos
'Nomainwin
dim findby$(7)
dim index$(10)
dim term$(4)
dim letter$(4)
findby$(1)="Contact"
findby$(2)="Company"
findby$(3)="Address"
findby$(4)="Zip"
findby$(5)="Phone"
findby$(6)="Email"
findby$(7)="Any Field"
term$(1)="Today"
term$(2)="Week"
term$(3)="Month"
term$(4)="Year"
letter$(1)="Welcome letter"
letter$(2)="Confirmation letter"
letter$(3)="Appology letter"
letter$(4)="Closure letter"
WindowWidth = 1000
WindowHeight = 460
UpperLeftX=Int((DisplayWidth-WindowWidth)/2)
UpperLeftY=Int((DisplayHeight-WindowHeight)/2)
'open the main window
groupbox #main.gb1 "Search",5,5,175,335
statictext #main "Text",15,25,30,20
textbox #main.findtxt ,50,20,120,20
statictext #main, "Field", 15, 55, 30, 20
combobox #main.findby, findby$(, findwhat, 50, 50, 120, 20
button #main.search, "Search for text in field", find, UL, 15, 80,155,20
statictext #main, "Click contact to review and edit", 15, 110, 160, 20
listbox #main.index, index$(, getContact, 15, 130, 150, 110
groupbox #main.gb2 "Contact" ,190, 5, 240, 335
Textbox #main.contact, 200, 20, 225, 20
Textbox #main.company, 200, 50, 225, 20
Textbox #main.addr1, 200, 70, 225, 20
Textbox #main.addr2, 200, 90, 225, 20
Textbox #main.addr3, 200, 110, 225, 20
Textbox #main.zip, 200, 130, 125, 20
Statictext #main, "Phone Mobile eMail", 200, 160, 225, 20
Textbox #main.phone1, 200, 180, 225, 20
Textbox #main.phone2, 200, 200, 225, 20
Textbox #main.email, 200, 220, 225, 20
groupbox #main.gb3 "History",440,5,240,335
Texteditor #main.hist, 450, 20, 225, 300
groupbox #main.gb4 "Memo / Action",690,5,240,335
Texteditor #main.memo, 700,20,225,70
button #main.due,"Todays reminders",findReminders,UL,15,250,155,20
button #main.pre,"Last week's reminder",findReminders,UL,15,275,155,20
button #main.nex,"Coming week's reminders",findReminders,UL,15,300,155,20
button #main.new, "New Contact", newContact, UL, 200, 250,100,20
button #main.del, "Delete Contact", eraseContact, UL, 325, 250,100,20
button #main.upd, "Save Updates", saveContact, UL, 200, 275,225,45
button #main.anm, "Save as memo",memo, UL, 700,100,225,20
button #main.sae, "Send as email",memo, UL, 700,120,225,20
button #main.sms, "Send as sms",memo, UL, 700,140,225,20
combobox #main.ltr, letter$(,selectletter,700,170,225,20
button #main.sal, "Send letter",letter, UL, 700,195,225,20
button #main.lbl, "Print a label",letter, UL, 700,215,225,20
combobox #main.trm, term$(,term, 700,250,225,20
button #main.rem, "Set reminder",reminder, UL, 700,275,225,20
Open "Mini Contact Manager" For Window_nf As #main
#main "Trapclose endProgram"
#main.index "singleclickselect"
#main.trm "select Today"
#main.ltr "select Confirmation letter"
'remove the edit menu item that texteditors create
hMain=hWnd(#main)
hMainMenu=GetMenu(hMain)
hMainEdit=GetSubMenu(hMainMenu,0)
result=RemoveMenu(hMainMenu,hMainEdit)
Call DrawMenuBar hWnd(#main)
call openContacts
searchTxt$=lower$("John")
searchIn=1
#main.findtxt "John"
#main.findby "select Contact"
call buildIndex
wait
sub findwhat h$
end sub
sub find h$
#main.findtxt "!contents? txt$"
#main.findby "selectionindex? in"
searchTxt$=lower$(txt$)
searchIn=in
if searchTxt$<>"" and searchIn>0 then
currentContact=0
call buildIndex
else
notice "Search text and field required"
end if
end sub
sub findReminders h$
dim c(maxMemos)
'set the day range depending on what button was pressed
t=date$("days")
p=t-7
n=t+7
select case h$
case "#main.due"
s=t
e=t
case "#main.pre"
s=p
e=t-1
case "#main.nex"
s=t+1
e=n
end select
'now get a list of all reminder memos in the date range
m=1
for i= 1 to maxMemos
gettrim #memo ,i
if mid$(memo$,21,8)="reminder" then
d$=right$(memo$,10)
y$=left$(d$,4)
md$=mid$(d$,6,5)
d=date$(md$+"/"+y$)
if d>=s and d<=e then
c(m)=cont
m=m+1
end if
end if
next
m=m-1
'now use that list to create a new index
redim index$(maxContacts)
found=1
for i=1 to m
gettrim #contacts, c(i)
index$(found)=contact$+chr$(0)+str$(c(i)) : found=found+1
next
found=found-1
foundContacts=found
if foundContacts=0 then
#main.index "reload"
currentContact=0
call clearDisplay
else
sort index$(,1,foundContacts
#main.index "reload"
'show the first record in the new index list
currentContact=val(word$(index$(1),2,chr$(0)))
call fillDisplay
end if
end sub
sub buildIndex
'now find all matching records seeking the txt$ fragment in wherever we are supposed to be looking
'use lower$() to match records and store found records in a new index
'we ignore records with contact$="999999" these are blank records awaiting reuse
found=1
redim index$(maxContacts)
for i=1 to maxContacts
gettrim #contacts, i
if contact$<>"999999" then
select case searchIn
case 1
if instr(lower$(contact$),searchTxt$,1)then index$(found)=contact$+chr$(0)+str$(i) : found=found+1
case 2
if instr(lower$(company$),searchTxt$,1)then index$(found)=contact$+chr$(0)+str$(i) : found=found+1
case 3
if instr(lower$(addr1$+addr2$+addr3$+zip$),searchTxt$,1)then index$(found)=contact$+chr$(0)+str$(i) : found=found+1
case 4
if instr(lower$(zip$),searchTxt$,1)then index$(found)=contact$+chr$(0)+str$(i) : found=found+1
case 5
if instr(lower$(phone1$+" "+phone2$),txt$,1)then index$(found)=contact$+chr$(0)+str$(i) : found=found+1
case 6
if instr(lower$(email$),searchTxt$,1)then index$(found)=contact$+chr$(0)+str$(i) : found=found+1
case 7
s$=company$+contact$+addr1$+addr2$+addr3$+zip$+phone1$+" "+phone2$+email$
if instr(lower$(s$),searchTxt$,1)then index$(found)=contact$+chr$(0)+str$(i) : found=found+1
end select
end if
next
found=found-1
foundContacts=found
if foundContacts=0 then
#main.index "reload"
currentContact=0
call clearDisplay
else
sort index$(,1,foundContacts
#main.index "reload"
if currentContact=0 then
'show the first record in the new index list
currentContact=val(word$(index$(1),2,chr$(0)))
end if
call fillDisplay
end if
end sub
sub memo h$
#main.memo "!contents? m$"
m$=trim$(m$)
if m$<>"" then
d$=date$("yyyy/mm/dd")+" at "+left$(time$(),5)
select case h$
case "#main.anm"
r$="memo"
case "#main.sae"
r$="email"
case "#main.sms"
r$="sms"
end select
m$=d$+" "+r$+chr$(13)+m$
call newMemo m$
call fillDisplay
else
notice "Memo text required"
end if
end sub
sub newMemo m$
'get the last memo number recorded in the contact RAF
gettrim #contacts,currentContact
'search the memo RAF for a free slot or increase the RAF
new=1
gettrim #memo,new
while memo$<>"FREE" and new<maxMemos
new=new+1
gettrim #memo,new
wend
if new=maxMemos then new=new+1 : maxMemos=new
'record new as nexx in memo if there is a previous memo
if memo>0 then
gettrim #memo,memo
nexx=new
put #memo,memo
end if
'record memo as prev in new
'record 0 as nexx in new (terminator)
prev=memo
nexx=0
memo$=m$
cont=currentContact
put #memo,new
'finaly store the new starting point in contact.dat
memo=new
put #contacts,currentContact
end sub
sub selectletter h$
end sub
sub letter h$
d$=date$("yyyy/mm/dd")+" at "+left$(time$(),5)
select case h$
case "#main.sal"
#main.ltr "selectionindex? lt"
m$="letter sent"
select case lt
case 1
r$="welcome"
case 2
r$="confirmation"
case 3
r$="appology"
case 4
r$="closure"
end select
case "#main.lbl"
r$="label"
m$="Label printed"
end select
m$=d$+" "+r$+chr$(13)+m$
call newMemo m$
call fillDisplay
end sub
sub term h$
end sub
sub reminder h$
#main.memo "!contents? m$"
mm$=trim$(m$)
r$="reminder"
if m$<>"" then
#main.trm "selectionindex? tr"
d$=date$("yyyy/mm/dd")+" at "+left$(time$(),5)
select case tr
case 1
dd$=date$("yyyy/mm/dd")
m$="Set for today: "+dd$
case 2
r=date$("days")+7
dd$=right$(date$(r),4)+"/"+left$(date$(r),5)
m$="Set for next week: "+dd$
case 3
r=date$("days")+30
dd$=right$(date$(r),4)+"/"+left$(date$(r),5)
m$="Set for next month: "+dd$
case 4
r=date$("days")+365
dd$=right$(date$(r),4)+"/"+left$(date$(r),5)
m$="Set for next year: "+dd$
end select
m$=d$+" "+r$+chr$(13)+mm$+chr$(13)+m$
call newMemo m$
call fillDisplay
else
notice "Memo text required"
end if
end sub
sub getContact h$
#main.index "selectionindex? i"
'#main.index "selectindex 0"
if i>0 then
'extract the record number from the index$ array
currentContact=val(word$(index$(i),2,chr$(0)))
call fillDisplay
end if
end sub
sub newContact h$
'search the RAF for a free record
currentContact=1
gettrim #contacts,currentContact
while contact$<>"999999" and currentContact<maxContacts
currentContact=currentContact+1
gettrim #contacts,currentContact
wend
if currentContact=maxContacts then currentContact=currentContact+1 : maxContacts=currentContact
contact$="Enter new details"
company$="Click on Save Updates when done"
addr1$=""
addr2$=""
addr3$=""
zip$=""
phone1$=""
phone2$=""
email$=""
memo=0
put #contacts, currentContact
call newMemo date$("yyyy/mm/dd")+" at "+left$(time$(),5)+chr$(13)+"Account opened"
call fillDisplay
end sub
sub saveContact h$
if currentContact>0 then
gettrim #contacts,currentContact
#main.contact "!contents? contact$"
#main.company "!contents? company$"
#main.addr1, "!contents? addr1$"
#main.addr2, "!contents? addr2$"
#main.addr3, "!contents? addr3$"
#main.zip, "!contents? zip$"
#main.phone1, "!contents? phone1$"
#main.phone2, "!contents? phone2$"
#main.email, "!contents? email$"
put #contacts, currentContact
call buildIndex
end if
end sub
sub eraseContact h$
if currentContact>0 then
'fill the record with blanks and "999999"
contact$="999999"
company$=""
addr1$=""
addr2$=""
addr3$=""
zip$=""
phone1$=""
phone2$=""
email$=""
'set all memo records free
if memo>0 then
gettrim #memo, memo
p=prev
prev=0
memo$="FREE"
nexx=0
cont=0
put #memo,memo
while p>0
gettrim #memo, p
p=prev
prev=0
memo$="FREE"
nexx=0
cont=0
put #memo,p
wend
end if
memo=0
put #contacts,currentContact
currentContact=0
call buildIndex
end if
end sub
sub clearDisplay
'clear the display
#main.contact ""
#main.company ""
#main.addr1 ""
#main.addr2 ""
#main.addr3 ""
#main.zip ""
#main.phone1 ""
#main.phone2 ""
#main.email ""
#main.hist "!cls"
#main.memo "!cls"
end sub
sub fillDisplay
'clear the display
call clearDisplay
'fill the display
if currentContact>0 then
gettrim #contacts, currentContact
#main.contact, contact$
#main.company, company$
#main.addr1, addr1$
#main.addr2, addr2$
#main.addr3, addr3$
#main.zip, zip$
#main.phone1, phone1$
#main.phone2, phone2$
#main.email, email$
if memo>0 then
gettrim #memo, memo
while prev>0
#main.hist memo$
#main.hist ""
gettrim #memo, prev
wend
#main.hist memo$
else
#main.hist "!cls"
#main.memo "!cls"
end if
'push all the text down
#main.hist "!origin 0 0"
end if
end sub
Sub openContacts
Open "contact.dat" For Random As #contacts Len = 269
Field #contacts, 35 As company$, 35 As contact$, 35 As addr1$, 35 As addr2$, 35 As addr3$, _
10 As zip$, 12 As phone1$,12 As phone2$, 50 As email$,10 as memo
if lof(#contacts)>0 then maxContacts=lof(#contacts)/269 else maxContacts=0
open "memo.dat" for random as #memo len = 130
field #memo, 10 as prev, 100 as memo$, 10 as nexx, 10 as cont
if lof(#memo)>0 then maxMemos=lof(#memo)/130 else maxMemos=0
End Sub
Sub endProgram h$
close #main
close #contacts
close #memo
end
End Sub
'functions:
Sub DrawMenuBar hWnd
CallDLL #user32, "DrawMenuBar",_
hWnd As ulong, r As boolean
End Sub
Function GetSubMenu(hMenuBar,nPos)
CallDLL #user32, "GetSubMenu",_
hMenuBar As ulong, nPos As long,_
GetSubMenu As ulong
End Function
Function GetMenu(hWnd)
CallDLL #user32, "GetMenu",hWnd As ulong,_
GetMenu As ulong
End Function
Function RemoveMenu(hMenu,hSubMenu)
CallDLL #user32, "RemoveMenu", hMenu As ulong,_
hSubMenu As ulong, _MF_BYCOMMAND As ulong,_
RemoveMenu As boolean
End Function
|
|
|
|
Post by sarossell on Jan 12, 2020 21:57:36 GMT -5
Looks like a promising start. I particularly appreciate the native code approach.  |
|
|
|
Post by meerkat on Jan 13, 2020 13:34:33 GMT -5
I decided to also have a go at it.
I used the ionSQL program to design and generate the code.
Development process using ionSQL.
1. create a database called contact.
2. create 3 tables;
The contact table to hold the contact
and 2 tables for referential integredy used for dropdowns and joins for list
state.. to hold state id and name
stage.. to hold stage codes and name
3. I entered the stage codes as defined, and a few states and their names.
4. I exported the database and data
5. I told ionSQL I wanted the satat and stage tables to be used and dropdowns and joins.
6. I clicked 'Gen Prog' and it generated the program.
The program
1.list the contacts.
2.do Add, Change, or Delete
3.sort any field
4.drill down with searches on multiple fields. Each field can be a wild card field search as;
x* begins with x
*xy ends with xy
*xyz* contains xyz
do equal, greater than, less than, less than or equal, greater than or equal
5. export to csv
6. inport csv
As soon as I generated the code I added and changed a contact and sorted and drilled down on it.
I did not try the Delete. So not sure it is 100% functional..
Have a great day..
Dan
The tables that you can copy to ionSQL and use ths'SQL' button
# --------------------------------------------------------
# SQLite Dump
# Generation Time:Jan 13, 2020 02:38:39
# Database:contact.db
# --------------------------------------------------------
# --------------------------------------------------------
# Table structure for: contact 13 fields
# --------------------------------------------------------
CREATE TABLE contact (
contNum INTEGER(2),
business VARCHAR(32),
contact VARCHAR(22),
addr VARCHAR(22),
city VARCHAR(12),
state CHAR(2),
zip VARCHAR(10),
phone1 VARCHAR(17),
phone2 VARCHAR(17),
cell VARCHAR(17),
eMail VARCHAR(32),
stage CHAR(2),
memo TEXT
);
# --------------------------------------------------------
# Table structure for: stage 2 fields
# --------------------------------------------------------
CREATE TABLE stage (
stage CHAR(2),
name VARCHAR(12)
);
# --------------------------------------------------------
# Dumping 9 records for table: stage
# --------------------------------------------------------
INSERT INTO stage VALUES ('IP','Initial Phone Call');
INSERT INTO stage VALUES ('OM','Open Mailer');
INSERT INTO stage VALUES ('FM','Follow Up Call');
INSERT INTO stage VALUES ('MT','Meeting');
INSERT INTO stage VALUES ('NP','Next Phone Call');
INSERT INTO stage VALUES ('JQ','Job Quoted');
INSERT INTO stage VALUES ('JC','Job Current');
INSERT INTO stage VALUES ('JF','Job Finished');
INSERT INTO stage VALUES ('AL','All');
# --------------------------------------------------------
# Table structure for: state 2 fields
# --------------------------------------------------------
CREATE TABLE state (
state CHAR(2),
name VARCHAR(12)
);
# --------------------------------------------------------
# Dumping 4 records for table: state
# --------------------------------------------------------
INSERT INTO state VALUES ('WA','Washington');
INSERT INTO state VALUES ('OR','Oregon');
INSERT INTO state VALUES ('CA','California');
INSERT INTO state VALUES ('NV','Navada');
The program..
' ---------------------------------------------------------------------------------
' Program :contact.bas
' Date :Jan 13, 2020
'----------------------------------------------------------------------------------
Struct RS,_
BOF as long,_ ' is True when CurrPos = 1
EOF as long,_ ' is True when CurrPos = Rows
Handle as long,_ ' address of recordset data returned by sqlite3.dll (dont't use)
Rows as long,_ ' number of rows in recordset
Cols as long,_ ' number of columns in recordset
CurrPos as long,_ ' current row in recordset
StrAdr as long ' address of data item (pointer to a string)
Open "SQ3_4_LB.dll" for DLL As #sq3 ' open SQ3_4_LB.dll
calldll #sq3, "SQ3_4_LB_GetLastMessage", result as long ' was sqlite3.dll loaded by SQ3_4_LB.dll
msg$ = Winstring(result) ' LastMessage would be -General Error - Couldn't open 'sqlite3.dll-
if instr(msg$,"Error") then ' If we have an error
print msg$ : close #sq3 ' close sqlite and end program
end
end if
' --------------------------------------
' Connect to Database
' --------------------------------------
DB$ = "e:\lb4\contact\contact.db"
calldll #sq3, "SQ3_4_LB_OpenDB",DB$ as ptr, overwrite as long, DBhnd as long ' see if it exist
If DBhnd = 0 then
calldll #sq3, "SQ3_4_LB_GetLastMessage", result as long
notice Winstring(result)
close #sq3
end
end if
' -------------------------------------------------------------
' Possible Sorts Array
' Make changes to the sorts you want to allow here
' sortDescr - is the description displayed to the user
' sortSel - is the fields to sort
' you can sort on multiple fields seperted by comma (,)
' and any field can be descending by following it with desc
' example - person.personNum, person.lName desc
' -------------------------------------------------------------
numSorts = 13
dim sortDescr$(numSorts)
dim sortSel$(numSorts)
sortDescr$(1) = "contNum" : sortSel$(1) = "contact.contNum"
sortDescr$(2) = "business" : sortSel$(2) = "contact.business"
sortDescr$(3) = "contact" : sortSel$(3) = "contact.contact"
sortDescr$(4) = "addr" : sortSel$(4) = "contact.addr"
sortDescr$(5) = "city" : sortSel$(5) = "contact.city"
sortDescr$(6) = "state" : sortSel$(6) = "contact.state"
sortDescr$(7) = "zip" : sortSel$(7) = "contact.zip"
sortDescr$(8) = "phone1" : sortSel$(8) = "contact.phone1"
sortDescr$(9) = "phone2" : sortSel$(9) = "contact.phone2"
sortDescr$(10) = "cell" : sortSel$(10) = "contact.cell"
sortDescr$(11) = "eMail" : sortSel$(11) = "contact.eMail"
sortDescr$(12) = "stage" : sortSel$(12) = "contact.stage"
sortDescr$(13) = "memo" : sortSel$(13) = "contact.memo"
orderBy$ = " ORDER BY ";sortSel$(1)
sortBy$ = sortDescr$(1)
' -------------------------------------------------------------
' Possible Search Array
' Make changes to the searches you want to allow here
' srchDescr - is the description displayed to the user
' srchSel - is the fields to Search
' -------------------------------------------------------------
numSrch = 13
dim srchDescr$(numSrch)
dim srchSel$(numSrch)
srchDescr$(1) = "contNum" : srchSel$(1) = "contact.contNum"
srchDescr$(2) = "business" : srchSel$(2) = "contact.business"
srchDescr$(3) = "contact" : srchSel$(3) = "contact.contact"
srchDescr$(4) = "addr" : srchSel$(4) = "contact.addr"
srchDescr$(5) = "city" : srchSel$(5) = "contact.city"
srchDescr$(6) = "state" : srchSel$(6) = "contact.state"
srchDescr$(7) = "zip" : srchSel$(7) = "contact.zip"
srchDescr$(8) = "phone1" : srchSel$(8) = "contact.phone1"
srchDescr$(9) = "phone2" : srchSel$(9) = "contact.phone2"
srchDescr$(10) = "cell" : srchSel$(10) = "contact.cell"
srchDescr$(11) = "eMail" : srchSel$(11) = "contact.eMail"
srchDescr$(12) = "stage" : srchSel$(12) = "contact.stage"
srchDescr$(13) = "memo" : srchSel$(13) = "contact.memo"
' -------------------------------------------------------------
' Make Drop Downs
' -------------------------------------------------------------
SQL$ = "SELECT state,name FROM state ORDER BY name"
gosub [sqlExec]
dim Dstatestate$(rows)
dim Dstatename$(rows)
for i = 1 to rows
Dstatestate$(i) = fldData$("state")
Dstatename$(i) = fldData$("name")
calldll #sq3, "SQ3_4_LB_RecordsetMoveNext", result as void ' Next Row
next i
SQL$ = "SELECT stage,name FROM stage ORDER BY name"
gosub [sqlExec]
dim Dstagestage$(rows)
dim Dstagename$(rows)
for i = 1 to rows
Dstagestage$(i) = fldData$("stage")
Dstagename$(i) = fldData$("name")
calldll #sq3, "SQ3_4_LB_RecordsetMoveNext", result as void ' Next Row
next i
join$ = " LEFT JOIN state ON contact.state = state.state LEFT JOIN stage ON contact.stage = stage.stage"
numRows = 30
pageNum = 1
dim recID$(numRows)
gridW = 2742
cellH = 22 'cell height in pixels
gridH = numRows * cellH 'total pixel height needed
gridX = 50 'start location of data display
gridY = 70
cellClr$ = "black"
cellBkClr$ = "lightgray"
cellBkClr$ = "white"
' ------------------------------
' Window Sizeing
' ------------------------------
WindowWidth = min(gridW,1400)
WindowHeight = 800
UpperLeftX = (DisplayWidth - WindowWidth)/2
UpperLeftY = (DisplayHeight - WindowHeight)/2
Margin = 3
BackgroundColor$="darkcyan"
nomainwin
graphicbox #gen.g,gridX,gridY,gridW+Margin,gridH+Margin+cellH ' Big box around info display
button #gen.add, "Add", [add], UL, 050,010,070,030
button #gen.exp, "Export", [exp], UL, 130,010,100,030
statictext #gen.hdr, "-- contact --", 400,010,150,030
button #gen.pre, "Prev", [prePage], UL, 600,010,070,030
textbox #gen.pge, 680,010,055,030
button #gen.nxt, "Next", [nxtPage], UL, 740,010,070,030
button #gen.ext, "Exit", [exit], UL, 840,010
COMBOBOX #gen.srt, sortDescr$(), [sort], 030,40,300,030
button #gen.sch, "Search", [search], UL, 340,040,100,030
statictext #gen.sct, "- None -", 510,40,100,030
statictext #gen.rcs, "Records:", 620,40,100,030
statictext #gen.pgs, "Pages:", 740,40,100,030
OPEN ";genTableName$;" for window_nf as #gen
#gen "trapclose [exit]"
#gen "font Courier New 10 bold"
#gen.srt "!--Select Sort Field---"
#gen.hdr "!font arial 12 bold"
#gen.sct "!font arial 10 bold"
#gen.rcs "!font arial 10 bold"
#gen.pgs "!font arial 10 bold"
gosub [getNumRecords]
[list]
#gen.g "segment list"
#gen.g "font Courier New 12 bold"
#gen.g "down;fill buttonface;flush"
#gen.g "when leftButtonUp [acdClicked]"
SQL$ = "SELECT contact.rowid,*,state.name as stateShoname,stage.name as stageShoname FROM contact " + join$ + where$ + groupBy$ + orderBy$ + " LIMIT ";(pageNum - 1) * numRows;",";numRows
gosub [sqlExec]
if sqlErr$ <> "" then
print "SQL execute error: ";sqlErr$
end
end if
if rows < 1 then
wait
end if
[heading]
i = 0
colTot = 0
#gen.g "color white ;backcolor black"
siz = 03
a$ = align$("Add",3,"l") : gosub [dispGrid]
a$ = align$("Chg",3,"l") : gosub [dispGrid]
a$ = align$("Del",3,"l") : gosub [dispGrid]
a$ = align$("See",3,"l") : gosub [dispGrid]
siz = 2 :a$ = align$("contNum",siz,"c") : gosub [dispGrid]
siz = 20 :a$ = align$("business",siz,"c") : gosub [dispGrid]
siz = 20 :a$ = align$("contact",siz,"c") : gosub [dispGrid]
siz = 20 :a$ = align$("addr",siz,"c") : gosub [dispGrid]
siz = 12 :a$ = align$("city",siz,"c") : gosub [dispGrid]
siz = 2 :a$ = align$("state",siz,"c") : gosub [dispGrid]
siz = 12 :a$ = align$("name",siz,"c") : gosub [dispGrid]
siz = 10 :a$ = align$("zip",siz,"c") : gosub [dispGrid]
siz = 17 :a$ = align$("phone1",siz,"c") : gosub [dispGrid]
siz = 17 :a$ = align$("phone2",siz,"c") : gosub [dispGrid]
siz = 17 :a$ = align$("cell",siz,"c") : gosub [dispGrid]
siz = 20 :a$ = align$("eMail",siz,"c") : gosub [dispGrid]
siz = 2 :a$ = align$("stage",siz,"c") : gosub [dispGrid]
siz = 12 :a$ = align$("name",siz,"c") : gosub [dispGrid]
siz = 0 :a$ = align$("memo",siz,"c") : gosub [dispGrid]
colTot = 0
for i = 1 to rows
gosub [getRecData]
#gen.g "color white ;backcolor darkgray"
siz = 03
a$ = align$("A",3,"c") : gosub [dispGrid]
a$ = align$("C",3,"c") : gosub [dispGrid]
a$ = align$("D",3,"c") : gosub [dispGrid]
a$ = align$("S",3,"c") : gosub [dispGrid]
#gen.g "color ";cellClr$;";backcolor ";cellBkClr$
siz = 2 :a$ = align$(contNum$,siz,"r") : gosub [dispGrid]
siz = 20 :a$ = align$(business$,siz,"l") : gosub [dispGrid]
siz = 20 :a$ = align$(contact$,siz,"l") : gosub [dispGrid]
siz = 20 :a$ = align$(addr$,siz,"l") : gosub [dispGrid]
siz = 12 :a$ = align$(city$,siz,"l") : gosub [dispGrid]
siz = 2 :a$ = align$(state$,siz,"l") : gosub [dispGrid]
siz = 12 :a$ = align$(stateShoname$,siz,"l") : gosub [dispGrid]
siz = 10 :a$ = align$(zip$,siz,"l") : gosub [dispGrid]
siz = 17 :a$ = align$(phone1$,siz,"l") : gosub [dispGrid]
siz = 17 :a$ = align$(phone2$,siz,"l") : gosub [dispGrid]
siz = 17 :a$ = align$(cell$,siz,"l") : gosub [dispGrid]
siz = 20 :a$ = align$(eMail$,siz,"l") : gosub [dispGrid]
siz = 2 :a$ = align$(stage$,siz,"l") : gosub [dispGrid]
siz = 12 :a$ = align$(stageShoname$,siz,"l") : gosub [dispGrid]
siz = 0 :a$ = align$(memo$,siz,"l") : gosub [dispGrid]
colTot = 0
calldll #sq3, "SQ3_4_LB_RecordsetMoveNext", result as void ' Next Row
next i
#gen.g "flush"
wait
' ----------------------------------
' That's all folks
' ----------------------------------
[exit]
close #gen
close #sq3
end
[dispGrid]
#gen.g "place ";colTot+8;" ";((i)*cellH)+17;";|";a$
colTot = colTot + (siz * 10)+5
RETURN
' ------------------------------------
' Get Record Data
' ------------------------------------
[getRecData]
recID$(i) = fldData$("rowid")
[getRecData1]
contNum$ = fldData$("contNum")
contNum = val(contNum$)
business$ = fldData$("business")
contact$ = fldData$("contact")
addr$ = fldData$("addr")
city$ = fldData$("city")
state$ = fldData$("state")
zip$ = fldData$("zip")
phone1$ = fldData$("phone1")
phone2$ = fldData$("phone2")
cell$ = fldData$("cell")
eMail$ = fldData$("eMail")
stage$ = fldData$("stage")
memo$ = fldData$("memo")
stateShoname$ = fldData$("stateShoname")
stageShoname$ = fldData$("stageShoname")
RETURN
' ---------------------------------------
' Next or Previous page request
' ---------------------------------------
[prePage]
asp = -1
[nxtPage]
#gen.pge "!contents? pge$"
pge = val(pge$)
if pge = 0 then goto [addPage]
if pge <> pageNum then
pageNum = pge
goto [chkPage]
end if
[addPage]
if asp = -1 then
pageNum = pageNum - 1
else
pageNum = pageNum + 1
end if
[chkPage]
asp = 1
if pageNum < 1 then pageNum = numPages
if pageNum > numPages then pageNum = 1
#gen.g "delsegment list"
#gen.pge str$(pageNum)
goto [list]
' -----------------------------------------
' Sort Selection
' -----------------------------------------
[sort]
#gen.srt "selection? sortFld$"
#gen.srt "selectionindex? sortIdx"
#gen.srt "select ";sortFld$
orderBy$ = " ORDER BY " + sortSel$(sortIdx)
goto [list]
' -----------------------------------------
' Search Dialog
' -----------------------------------------
[search]
WindowWidth = 500
WindowHeight = 400
UpperLeftX = (DisplayWidth - WindowWidth)/2
UpperLeftY = (DisplayHeight - WindowHeight)/2
Margin = 3
statictext #srch.sct, "Search:", 010,010,055,020
COMBOBOX #srch.src, srchDescr$(),[srchFld], 066,010,150,020
statictext #srch.for, "For", 220,010,040,020
textbox #srch.cmp, 250,010,200,020
button #srch.ext, "Add", [srchAdd], UL, 450,010,030,020
statictext #srch.whr, "Wild Cards(*) XX*=begins *XX=ends *XX*=contains",010,040,400,150
button #srch.ext, "Go", [srchGo], UL, 100,300
button #srch.ext, "Clear", [srchClr], UL, 200,300
button #srch.ext, "Exit", [srchExt], UL, 300,300
open "Drill Down Search" for dialog as #srch
#srch "trapclose [srchExt]"
#srch "font Courier New 10 bold"
wait
[srchAdd]
#srch.cmp,"!contents? srchCmp$"
srchCmp$ = trim$(srchCmp$)
if srchCmp$ = "" then
notice "Compare field is blank"
wait
end if
if srchIdx = 0 then
notice "No Field is selected"
wait
end if
comp$ = " = "
if left$(srchCmp$,1) = "*" then ' check for wild card (*)
comp$ = " like "
srchCmp$ = "%" + mid$(srchCmp$,2)
end if
if right$(srchCmp$,1) = "*" then
comp$ = " like "
srchCmp$ = left$(srchCmp$,len(srchCmp$)-1) + "%"
end if
wa$ = " WHERE "
if where$ <> "" then wa$ = " AND "
where$ = where$ + wa$ + srchSel$(srchIdx) + comp$;"'";srchCmp$;"'"
#srch.whr, where$
wait
[srchFld]
#srch.src "selection? srchFld$"
#srch.src "selectionindex? srchIdx"
#srch.src "select ";srchFld$
wait
[srchClr]
where$ = ""
#srch.whr, ""
wait
[srchGo]
#gen.g "delsegment list"
close #srch
gosub [getNumRecords]
goto [list]
[srchExt]
where$ = ""
close #srch
goto [list]
' ------------------------------------------------
' how many records
' This can change depending on the where clause
' ------------------------------------------------
[getNumRecords]
SQL$ = "SELECT count(*) as numRecords FROM contact " + join$ + where$
gosub [sqlExec]
numRecords = val(fldData$("numRecords"))
numPages = int((numRecords + 29)/ numRows)
limit = min(numRows,numRecords)
pageNum = min(pageNum,numPages)
if pageNum < 1 then pageNum = 1
#gen.rcs "Records:";str$(numRecords)
#gen.pgs "Pages:";str$(numPages)
#gen.pge str$(pageNum)
RETURN
' ----------------------------------------
' get field values from table
' ----------------------------------------
FUNCTION fldData$(field$)
calldll #sq3, "SQ3_4_LB_GetRecordsetValueByName",field$ as ptr, result as long
if result = 1 then
fldData$ = Winstring(RS.StrAdr.struct)
else
calldll #sq3, "SQ3_4_LB_GetLastMessage", result as long
fldData$ = Winstring(result)
end If
END FUNCTION
' --------------------------------------
' Execute SQL command
' --------------------------------------
[sqlExec]
calldll #sq3, "SQ3_4_LB_GetRecordset", SQL$ as ptr,DBhnd as long,RS as struct, ret as long
if ret = 0 then
calldll #sq3, "SQ3_4_LB_GetLastMessage", result as long
sqlExec$ = Winstring(result)
cols = 0
rows = 0
else
cols = RS.Cols.struct
rows = RS.Rows.struct
sqlExec$ = ""
end if
RETURN
' -------------------------------------
' Align fld$ to left right or center
' of a given width
' -------------------------------------
FUNCTION align$(fld$,width,lrc$)
s = width - len(fld$)
fld$ = left$(fld$,width)
if s < 1 then
align$ = fld$
else
b$ = space$(width)
if lrc$ = "l" then align$ = fld$;left$(b$,s)
if lrc$ = "r" then align$ = left$(b$,s);fld$
if lrc$ = "c" then align$ = left$(b$,int(s / 2));fld$;left$(b$,int(s / 2) + (s and 1))
end if
END FUNCTION
' --------------------------------
' Add Change or Delete Record
' --------------------------------
[add] ' add a new record
acd$ = "Add New"
goto [acdNew]
[acdClicked]
'set an editing flag and capture cell coordinates
thisRow = int(MouseY/cellH)
if thisRow < 1 then wait
acd = int(MouseX / 30) + 1
if acd < 1 or acd > 6 then wait
setCom$ = ""
setComCr$ = ""
if acd > 0 then acd$ = "Add"
if acd > 2 then acd$ = "Chg"
if acd > 3 then acd$ = "Del"
if acd > 5 then acd$ = "See"
' -------------------------------------------------------
' Add Change Delete See Add New
' If adding then auto assign a number not used in the table
' -------------------------------------------------------
[acdNew]
if acd$ <> "Add New" then
SQL$ = "SELECT *,state.name as stateShoname,stage.name as stageShoname FROM contact LEFT JOIN state ON contact.state = state.state LEFT JOIN stage ON contact.stage = stage.stage WHERE contact.rowid = ";recID$(thisRow)
gosub [sqlExec]
if sqlErr$ <> "" then
notice "SQL execute error: ";sqlErr$
end if
gosub [getRecData1]
else
contNum$ = ""
contNum = 0
business$ = ""
contact$ = ""
addr$ = ""
city$ = ""
state$ = ""
zip$ = ""
phone1$ = ""
phone2$ = ""
cell$ = ""
eMail$ = ""
stage$ = ""
memo$ = ""
end if
if left$(acd$,3) = "Add" then
ffile$ = "contact"
ffield$ = "contNum"
gosub [useNum]
contNum = useNum
contNum$ = str$(contNum)
end if
statictext #acd "---";acd$;" contact ---" ,250,020,180,30
statictext #acd align$("contNum",20,"r") ,10,40,200,30
textbox #acd.contNum,160,40,40,30
statictext #acd align$("business",20,"r") ,10,70,200,30
textbox #acd.business,160,70,400,30
statictext #acd align$("contact",20,"r") ,10,100,200,30
textbox #acd.contact,160,100,280,30
statictext #acd align$("addr",20,"r") ,10,130,200,30
textbox #acd.addr,160,130,280,30
statictext #acd align$("city",20,"r") ,10,160,200,30
textbox #acd.city,160,160,150,30
statictext #acd align$("state",20,"r") ,10,190,200,30
COMBOBOX #acd.state, Dstatename$(), [Dstate],160,190,120,30
statictext #acd align$("zip",20,"r") ,10,220,200,30
textbox #acd.zip,160,220,130,30
statictext #acd align$("phone1",20,"r") ,10,250,200,30
textbox #acd.phone1,160,250,220,30
statictext #acd align$("phone2",20,"r") ,10,280,200,30
textbox #acd.phone2,160,280,220,30
statictext #acd align$("cell",20,"r") ,10,310,200,30
textbox #acd.cell,160,310,220,30
statictext #acd align$("eMail",20,"r") ,10,340,200,30
textbox #acd.eMail,160,340,400,30
statictext #acd align$("stage",20,"r") ,10,370,200,30
COMBOBOX #acd.stage, Dstagename$(), [Dstage],160,370,120,30
statictext #acd align$("memo",20,"r") ,10,400,200,30
TEXTEDITOR #acd.memo,160,400,400,90
statictext #acd.errMsg "" ,10,490,200,100
button #acd.go,"Go", [acdGo], UL, 200,510
button #acd.ext,"Exit",[acdExt], UL, 260,510
WindowWidth = 600
WindowHeight = 590
UpperLeftX = (DisplayWidth - WindowWidth)/2
UpperLeftY = (DisplayHeight - WindowHeight)/2
Margin = 3
BackgroundColor$=""
open acd$; "contact Maintenance" for dialog_modal as #acd
'#acd "resizehandler resized"
#acd "trapclose [acdExt]"
#acd "font curier 11 bold"
#acd.errMsg, ""
#acd.contNum, contNum$
#acd.business, business$
#acd.contact, contact$
#acd.addr, addr$
#acd.city, city$
#acd.state "!";stateShoname$
#acd.zip, zip$
#acd.phone1, phone1$
#acd.phone2, phone2$
#acd.cell, cell$
#acd.eMail, eMail$
#acd.stage "!";stageShoname$
#acd.memo, memo$
wait
[acdGo]
if acd$ = "Del" then
SQL$ = "DELETE FROM contact WHERE rowid = '";recID$(thisRow);"'"
gosub [sqlExec]
goto [acdExDel]
end if
if acd$ = "See" then goto [acdExt]
errMsg$ = ""
#acd.contNum, "!contents? contNum$"
if isNumeric(contNum$) = 0 then errMsg$ = errMsg$ + "* contNum";contNum$;" not numeric ";chr$(13)
contNum = val(contNum$)
#acd.business, "!contents? business$"
#acd.contact, "!contents? contact$"
#acd.addr, "!contents? addr$"
#acd.city, "!contents? city$"
#acd.zip, "!contents? zip$"
#acd.phone1, "!contents? phone1$"
#acd.phone2, "!contents? phone2$"
#acd.cell, "!contents? cell$"
#acd.eMail, "!contents? eMail$"
#acd.memo, "!contents? memo$"
if errMsg$ <> "" then
#acd.errMsg, errMsg$
wait
end if
dbFields$ = "contNum,business,contact,addr,city,state,zip,phone1,phone2,cell,eMail,stage,memo"
dbVals$ = "'";contNum$;"','";dblQuote$(business$);"','";dblQuote$(contact$);"','";dblQuote$(addr$);"','";dblQuote$(city$);"','";dblQuote$(state$);"','";dblQuote$(zip$);"','";dblQuote$(phone1$);"','";dblQuote$(phone2$);"','";dblQuote$(cell$);"','";dblQuote$(eMail$);"','";dblQuote$(stage$);"','";dblQuote$(memo$);"'"
if acd$ = "Chg" then
dbf$ = ",rowid"
dbv$ = ","+recID$(thisRow)
else
dbf$ = ""
dbv$ = ""
END IF
SQL$ = "INSERT or REPLACE into contact("; dbFields$;dbf$; ") VALUES ("; dbVals$;dbv$ ; ")"
gosub [sqlExec]
[acdExDel]
close #acd
gosub [getNumRecords]
goto [list]
[acdExt]
close #acd
wait
[Dstate] '----- Drop Down for state ----
#acd.state "selectionindex? idx"
state$ = Dstatestate$(idx)
wait
[Dstage] '----- Drop Down for stage ----
#acd.stage "selectionindex? idx"
stage$ = Dstagestage$(idx)
wait
' ---------------------------------------------------
' Export CSV file
' ---------------------------------------------------
[exp]
WindowWidth = 620
WindowHeight = 220
groupbox #exp.sep, "Seperate Fields With:", 10, 20, 150, 100
radiobutton #exp.sep.cm, "Comma", [sepCma], [nil], 20, 45, 130, 20
radiobutton #exp.sep.bl, "Blank", [sepBlank], [nil], 20, 70, 130, 20
radiobutton #exp.sep.br, "Bar", [sepBar], [nil], 20, 95, 130, 20
groupbox #exp.enc, "Enclose Fields With", 150, 20, 150, 100
radiobutton #exp.enc.sq, "Single Quote", [encSngQt], [nil], 160, 45, 130, 20
radiobutton #exp.enc.dq, "Double Quote", [encDblQt], [nil], 160, 70, 130, 20
radiobutton #exp.enc.sp, "Blank", [encBlank], [nil], 160, 95, 130, 20
groupbox #exp.trm, "Terminate line With", 300, 20, 150, 100
radiobutton #exp.trm.sc, "Semi Colon", [trmSc], [nil], 310, 45, 130, 20
radiobutton #exp.trm.cl, "Colon", [trmCl], [nil], 310, 70, 130, 20
radiobutton #exp.trm.bl, "Blank", [trmBlank],[nil], 310, 95, 130, 20
groupbox #exp.inc, "Include", 450, 20, 300, 100
radiobutton #exp.inc.tp, "This Page", [incTp], [nil], 460, 45, 130, 20
radiobutton #exp.inc.ap, "All Pages", [incAp], [nil], 460, 70, 130, 20
button #exp, "Go", [expGo], UL, 230,140
button #exp, "Exit", [expExt], UL, 280,140
sep$ = ","
enc$ = "'"
trm$ = ";"
inc$ = "A"
open "Export Spread Sheet" for dialog as #exp
#exp, "trapclose [expExt]"
#exp "font curier 12 bold"
#exp.enc.sq, "set"
#exp.sep.cm, "set"
#exp.trm.sc, "set"
#exp.inc.tp, "set"
wait
[sepCma] sep$ = "," :wait
[sepBlank] sep$ = "" :wait
[sepBar] sep$ = "|" :wait
[encSngQt] enc$ = "'" :wait
[encDblQt] enc$ = chr$(34) :wait
[encBlank] enc$ = "" :wait
[trmSc] trm$ = ";" :wait
[trmCl] trm$ = ":" :wait
[trmBlank] trm$ = "" :wait
[incTp] inc$ = "T" :wait
[incAp] inc$ = "A" :wait
[expExt]
close #exp
wait
[expGo]
if inc$ = "A" then SQL$ = word$(SQL$,1,"LIMIT") ' get rid of the limit
gosub [sqlExec]
if sqlErr$ <> "" then
notice"SQL execute error: ";sqlErr$
wait
end if
if rows < 1 then goto [expExt]
close #exp
notice "Output C:\Users\egnek\AppData\Roaming\Liberty BASIC v4.5.1\contact.csv"
open "C:\Users\egnek\AppData\Roaming\Liberty BASIC v4.5.1\contact.csv" for output as #1
for i = 1 to rows
gosub [getRecData1]
expData$ = ""_
+ enc$;contNum$;enc$;sep$ _
+ enc$;business$;enc$;sep$ _
+ enc$;contact$;enc$;sep$ _
+ enc$;addr$;enc$;sep$ _
+ enc$;city$;enc$;sep$ _
+ enc$;state$;enc$;sep$ _
+ enc$;zip$;enc$;sep$ _
+ enc$;phone1$;enc$;sep$ _
+ enc$;phone2$;enc$;sep$ _
+ enc$;cell$;enc$;sep$ _
+ enc$;eMail$;enc$;sep$ _
+ enc$;stage$;enc$;sep$ _
+ enc$;memo$;enc$;trm$
print #1,expData$
calldll #sq3, "SQ3_4_LB_RecordsetMoveNext", result as void ' Next Row
next i
close #1
wait
[nil]
wait
' ------------------------------------------------------------------------------------
' Find available record number
' This does not always find the next number but finds holes in the numbers and uses it
' Therefore, you never run out of numbers and you never need to reorganize the files
' supply file in ffile$ and field in ffield$
' ------------------------------------------------------------------------------------
[useNum]
useNum = 1
SQL$ = "SELECT a.";ffield$;" AS aa, c.";ffield$;" AS cc,a.";ffield$;" - 1 AS useNum "_
+ "FROM ";ffile$;" AS a "_
+ "LEFT JOIN ";ffile$;" as c "_
+ "ON c.";ffield$;" = a.";ffield$;" - 1 "_
+ "WHERE c.";ffield$;" is null "_
+ "AND a.";ffield$;" > 1 "_
+ "ORDER BY a.";ffield$;" LIMIT 1"
gosub [sqlExec]
if rows > 0 then
aa = val(fldData$("aa"))
cc = val(fldData$("cc"))
useNum = val(fldData$("useNum"))
else
SQL$ = "SELECT max(";ffield$;") as useNum FROM ";ffile$
gosub [sqlExec]
if rows > 0 then
useNum = val(fldData$("useNum")) + 1
end if
end if
RETURN
' ------------------------
' Numeric Check
' 0 = bad
' 1 = good
' ------------------------
FUNCTION isNumeric(f$)
isNumeric = 1
f$ = trim$(f$)
if left$(f$,1) = "-" or left$(f$,1) = "+" then
f$ = mid$(f$,2)
end if
for i = 1 to len(f$)
if mid$(f$,i,1) = "." then
if dot$ = "." then isNumeric = 0
dot$ = "."
goto [nxtDigit]
end if
if mid$(f$,i,1) = "," then goto [nxtDigit]
if mid$(f$,i,1) < "0" then isNumeric = 0
if mid$(f$,i,1) > "9" then isNumeric = 0
[nxtDigit]
next i
END FUNCTION
' -----------------------------------------
' Convert single quotes to double quotes
' -----------------------------------------
FUNCTION dblQuote$(str$)
i = 1
qq$ = ""
while (word$(str$,i,"'")) <> ""
dblQuote$ = dblQuote$;qq$;word$(str$,i,"'")
qq$ = "''"
i = i + 1
WEND
END FUNCTION
[quit]
close #gen
end
|
|
|
|
Post by Rod on Jan 15, 2020 11:09:51 GMT -5
Ok, some progress. I am liking where it is going. Some general points about the project. Its all native code that a beginner may follow. No stylebits, no API, it is pure BASIC and as little of that as I can manage. For example restricting the size of the display is as simple as window_nf.
It does not use big arrays, if you have the data in a RAF use the RAF. It uses the minimum size of array to service each query. Liberty is fast enough to do all of this on the fly so no need to have a huge burden of file handling. The RAF gets opened once at the start and closed at the end. Duplicates are allowed at this point, defining a duplicate can be tricky, two contacts one company?
The index is rebuilt for each search so it is mostly very small and built very quickly You can search for anything in any field or a specific field. I will add stage$ once I get memos sorted.
I have used one trick, listboxes can only use single dimensioned arrays. This is a bother because an index needs two items of data, the search text and record pointer. So I have used Stefan Pendle's trick of using chr$(0) to hide the record pointer in the single dimensioned listbox array. Works great. Because the listbox is Windows based it sees the chr$(0) as an end of string$ marker. But Liberty can see the rest and return the pointer.
This now has find, edit save, delete, add new. deleted records are recycled to new, or, the RAF is increased in size. Memo chain next.
snipped
|
|
|
|
Post by Rod on Jan 16, 2020 14:39:41 GMT -5
Ok more progress. Memos now work. Add a new memo in the memo box and it will be appended to the history when you click Save Updates. To play, key a search fragment in the Search box and click on the Field combobox to search a specific field or all fields. An index list will be built and presented. This index hangs about till you search out a new one. Select the actual record you want by clicking on the contact. If there are several Joe Smiths search the Company name or incoming telephone number to get the correct Joe Smith. The record you select and worked on will stay in view. You can amend any aspect of the record, including the index field it will all be saved and resorted when you click on Save Updates. Delete frees the record space for reuse, Add New reuses free record spaces. By using an Index the main record set remains largely undisturbed, only delete and add new reuse record space. The file is not constantly rewritten. Backup would involve reading and saving to a new file. Associated memos are displayed latest to last. Next step is to enhance the memos to include "actions" outstanding and complete. So say a call back within 24hr has been agreed. Memos will record that and allow outstanding call backs to be listed. So a callback can be set and reset, so too any other task like quote, letter,review etc etc. So some thinking time needed but its looking good to me (self praise is no praise  No obligation to play but if anything confuses you or you find something buggy feedback is welcome. snipped
|
|
|
|
Post by wexhammer on Jan 17, 2020 10:34:16 GMT -5
It's looking good Rod! I will for sure start studying this in depth, when i have a little more time, i like the feature of the linked memo as this file can get big pretty quick causing longer loadtimes.
|
|
|
|
Post by Rod on Jan 22, 2020 8:03:34 GMT -5
I have added more to this than I should have. It is a demonstration of how I think a RAF should be managed. It has its origins in contact4.bas but it is now more an "office in a box". Or potentially. I have not programmed the actions, they are all feasible, email, texts, letters. PrintForm.bas that ships with Liberty will show you how to print high quality letters and labels even with photo realistic logos and headers. LBPE discusses emails. I am pretty sure SMS is possible as well though it would require a.dll and a service provider.
So what is the demo about. Well its about how you manage a large RAF. I do it by leaving the RAF almost completely alone and fronting it with a small index that lists only what we are interested in. The RAF is never sorted or compacted. Records never change position and we don't care what order they are in. In other words there is virtually no management of the RAF. It just sits there, mostly we overwrite old records and occasionally expand its size.
So the index is the key, it is a small selection of the records ordered by contact name. The search is surprisingly powerful as you can search for anything in any field.
There are also memos, these are short notes, emails, reminders actions you have taken. They are displayed in chronological order. They are held as a "linked list" This is another technique for minimising the management of a RAF. There is a link to the last know memo recorded in the contacts database. Using that we follow a chain of links in the memo database. We don't care what order the memo RAF is in. Each record has a link to the previous record and the next record or a 0 terminator. I just keep extending the chain in this demo but it is easy to break chains insert into chains and erase chains. Old records can be reused. The "chain" is a concept, the records are widely dispersed in the database.
I have added "reminders" that can be searched for just another part of office life!
With any database you only get a feel for it when it is full of data. So at the head of the program I create a dummy dataset. This will happen each time you run the program. If you are interested in checking out what it can do you would be better to take the header code and copy it to its own.bas file. Remove it from the head of the main code. That way contact.dat will remain intact. You can start again by running the header or have a completely fresh start with some blank files.
I have not included backup code, usually that would be a completely separate program. The backup is easy just copy the file or the records to a new file. The challenge is usually when and what to restore. I would normally keep yyyymmddackup.dat files so there are several iterations to look back on before deciding the restore point.
'build a fresh garbage .dbf to play with
'remove this code block to keep contact.dat intact
'##################################################################################################
open "contact.dat" for output as #1
close #1
Open "contact.dat" For Random As #1 Len = 269
Field #1, 35 As company$, 35 As contact$, 35 As addr1$, 35 As addr2$, 35 As addr3$,_
10 As zip$, 12 As phone1$,12 As phone2$, 50 As email$,10 as memo
n$="Robert John Paul Lisa Janette Peter Gordon Manuel Harry William Jane Joan Debra"
s$="Houston Wilson Raydon Malcom McDonald House Morrow Menzies Buxton Souness Keen Goran Allan"
b$="Ace Acme Arrow Big Best Custom Fast Cheap Hungry"
d$="Carriers Hauliers Chemicals Cleaners Builders Plumbers Decorators Electricians Insurance"
open "memo.dat" for output as #2
close #2
open "memo.dat" for random as #2 len = 130
field #2, 10 as prev, 100 as memo$, 10 as nexx, 10 as cont
mn=1
for n= 1 to 100
company$=word$(b$,int(rnd(0)*9+1))+" "+word$(d$,int(rnd(0)*9+1))
contact$=word$(n$,int(rnd(0)*13+1))+" "+word$(s$,int(rnd(0)*13+1))
addr1$=str$(n)+" First line of address"
addr2$="Second line of address"
addr3$="Third line of address"
zip$="9999"
phone1$="0123456789"
phone2$="0987654321"
email$=contact$+"@hotmail.com"
memo=mn
put #1,n
prev=0
memo$=date$("yyyy/mm/dd")+" at "+left$(time$(),5)+chr$(13)+"Account opened"
nexx=0
cont=n
put #2,mn
mn=mn+1
next
close #1
close #2
'##################################################################################################
Global searchTxt$,searchIn,currentContact, foundContacts, maxContacts,maxMemos
'Nomainwin
dim findby$(7)
dim index$(10)
dim term$(4)
dim letter$(4)
findby$(1)="Contact"
findby$(2)="Company"
findby$(3)="Address"
findby$(4)="Zip"
findby$(5)="Phone"
findby$(6)="Email"
findby$(7)="Any Field"
term$(1)="Today"
term$(2)="Week"
term$(3)="Month"
term$(4)="Year"
letter$(1)="Welcome letter"
letter$(2)="Confirmation letter"
letter$(3)="Appology letter"
letter$(4)="Closure letter"
WindowWidth = 1000
WindowHeight = 460
UpperLeftX=Int((DisplayWidth-WindowWidth)/2)
UpperLeftY=Int((DisplayHeight-WindowHeight)/2)
'open the main window
groupbox #main.gb1 "Search",5,5,175,335
statictext #main "Text",15,25,30,20
textbox #main.findtxt ,50,20,120,20
statictext #main, "Field", 15, 55, 30, 20
combobox #main.findby, findby$(, findwhat, 50, 50, 120, 20
button #main.search, "Search for text in field", find, UL, 15, 80,155,20
statictext #main, "Click contact to review and edit", 15, 110, 160, 20
listbox #main.index, index$(, getContact, 15, 130, 150, 110
groupbox #main.gb2 "Contact" ,190, 5, 240, 335
Textbox #main.contact, 200, 20, 225, 20
Textbox #main.company, 200, 50, 225, 20
Textbox #main.addr1, 200, 70, 225, 20
Textbox #main.addr2, 200, 90, 225, 20
Textbox #main.addr3, 200, 110, 225, 20
Textbox #main.zip, 200, 130, 125, 20
Statictext #main, "Phone Mobile eMail", 200, 160, 225, 20
Textbox #main.phone1, 200, 180, 225, 20
Textbox #main.phone2, 200, 200, 225, 20
Textbox #main.email, 200, 220, 225, 20
groupbox #main.gb3 "History",440,5,240,335
Texteditor #main.hist, 450, 20, 225, 300
groupbox #main.gb4 "Memo / Action",690,5,240,335
Texteditor #main.memo, 700,20,225,70
button #main.due,"Todays reminders",findReminders,UL,15,250,155,20
button #main.pre,"Last week's reminder",findReminders,UL,15,275,155,20
button #main.nex,"Coming week's reminders",findReminders,UL,15,300,155,20
button #main.new, "New Contact", newContact, UL, 200, 250,100,20
button #main.del, "Delete Contact", eraseContact, UL, 325, 250,100,20
button #main.upd, "Save Updates", saveContact, UL, 200, 275,225,45
button #main.anm, "Save as memo",memo, UL, 700,100,225,20
button #main.sae, "Send as email",memo, UL, 700,120,225,20
button #main.sms, "Send as sms",memo, UL, 700,140,225,20
combobox #main.ltr, letter$(,selectletter,700,170,225,20
button #main.sal, "Send letter",letter, UL, 700,195,225,20
button #main.lbl, "Print a label",letter, UL, 700,215,225,20
combobox #main.trm, term$(,term, 700,250,225,20
button #main.rem, "Set reminder",reminder, UL, 700,275,225,20
Open "Mini Contact Manager" For Window_nf As #main
#main "Trapclose endProgram"
#main.index "singleclickselect"
#main.trm "select Today"
#main.ltr "select Confirmation letter"
'remove the edit menu item that texteditors create
hMain=hWnd(#main)
hMainMenu=GetMenu(hMain)
hMainEdit=GetSubMenu(hMainMenu,0)
result=RemoveMenu(hMainMenu,hMainEdit)
Call DrawMenuBar hWnd(#main)
call openContacts
searchTxt$=lower$("John")
searchIn=1
#main.findtxt "John"
#main.findby "select Contact"
call buildIndex
wait
sub findwhat h$
end sub
sub find h$
#main.findtxt "!contents? txt$"
#main.findby "selectionindex? in"
searchTxt$=lower$(txt$)
searchIn=in
if searchTxt$<>"" and searchIn>0 then
currentContact=0
call buildIndex
else
notice "Search text and field required"
end if
end sub
sub findReminders h$
dim c(maxMemos)
'set the day range depending on what button was pressed
t=date$("days")
p=t-7
n=t+7
select case h$
case "#main.due"
s=t
e=t
case "#main.pre"
s=p
e=t-1
case "#main.nex"
s=t+1
e=n
end select
'now get a list of all reminder memos in the date range
m=1
for i= 1 to maxMemos
gettrim #memo ,i
if mid$(memo$,21,8)="reminder" then
d$=right$(memo$,10)
y$=left$(d$,4)
md$=mid$(d$,6,5)
d=date$(md$+"/"+y$)
if d>=s and d<=e then
c(m)=cont
m=m+1
end if
end if
next
m=m-1
'now use that list to create a new index
redim index$(maxContacts)
found=1
for i=1 to m
gettrim #contacts, c(i)
index$(found)=contact$+chr$(0)+str$(c(i)) : found=found+1
next
found=found-1
foundContacts=found
if foundContacts=0 then
#main.index "reload"
currentContact=0
call clearDisplay
else
sort index$(,1,foundContacts
#main.index "reload"
'show the first record in the new index list
currentContact=val(word$(index$(1),2,chr$(0)))
call fillDisplay
end if
end sub
sub buildIndex
'now find all matching records seeking the txt$ fragment in wherever we are supposed to be looking
'use lower$() to match records and store found records in a new index
'we ignore records with contact$="999999" these are blank records awaiting reuse
found=1
redim index$(maxContacts)
for i=1 to maxContacts
gettrim #contacts, i
if contact$<>"999999" then
select case searchIn
case 1
if instr(lower$(contact$),searchTxt$,1)then index$(found)=contact$+chr$(0)+str$(i) : found=found+1
case 2
if instr(lower$(company$),searchTxt$,1)then index$(found)=contact$+chr$(0)+str$(i) : found=found+1
case 3
if instr(lower$(addr1$+addr2$+addr3$+zip$),searchTxt$,1)then index$(found)=contact$+chr$(0)+str$(i) : found=found+1
case 4
if instr(lower$(zip$),searchTxt$,1)then index$(found)=contact$+chr$(0)+str$(i) : found=found+1
case 5
if instr(lower$(phone1$+" "+phone2$),txt$,1)then index$(found)=contact$+chr$(0)+str$(i) : found=found+1
case 6
if instr(lower$(email$),searchTxt$,1)then index$(found)=contact$+chr$(0)+str$(i) : found=found+1
case 7
s$=company$+contact$+addr1$+addr2$+addr3$+zip$+phone1$+" "+phone2$+email$
if instr(lower$(s$),searchTxt$,1)then index$(found)=contact$+chr$(0)+str$(i) : found=found+1
end select
end if
next
found=found-1
foundContacts=found
if foundContacts=0 then
#main.index "reload"
currentContact=0
call clearDisplay
else
sort index$(,1,foundContacts
#main.index "reload"
if currentContact=0 then
'show the first record in the new index list
currentContact=val(word$(index$(1),2,chr$(0)))
end if
call fillDisplay
end if
end sub
sub memo h$
#main.memo "!contents? m$"
m$=trim$(m$)
if m$<>"" then
d$=date$("yyyy/mm/dd")+" at "+left$(time$(),5)
select case h$
case "#main.anm"
r$="memo"
case "#main.sae"
r$="email"
case "#main.sms"
r$="sms"
end select
m$=d$+" "+r$+chr$(13)+m$
call newMemo m$
call fillDisplay
else
notice "Memo text required"
end if
end sub
sub newMemo m$
'get the last memo number recorded in the contact RAF
gettrim #contacts,currentContact
'search the memo RAF for a free slot or increase the RAF
new=1
gettrim #memo,new
while memo$<>"FREE" and new<maxMemos
new=new+1
gettrim #memo,new
wend
if new=maxMemos then new=new+1 : maxMemos=new
'record new as nexx in memo if there is a previous memo
if memo>0 then
gettrim #memo,memo
nexx=new
put #memo,memo
end if
'record memo as prev in new
'record 0 as nexx in new (terminator)
prev=memo
nexx=0
memo$=m$
cont=currentContact
put #memo,new
'finaly store the new starting point in contact.dat
memo=new
put #contacts,currentContact
end sub
sub selectletter h$
end sub
sub letter h$
d$=date$("yyyy/mm/dd")+" at "+left$(time$(),5)
select case h$
case "#main.sal"
#main.ltr "selectionindex? lt"
m$="letter sent"
select case lt
case 1
r$="welcome"
case 2
r$="confirmation"
case 3
r$="appology"
case 4
r$="closure"
end select
case "#main.lbl"
r$="label"
m$="Label printed"
end select
m$=d$+" "+r$+chr$(13)+m$
call newMemo m$
call fillDisplay
end sub
sub term h$
end sub
sub reminder h$
#main.memo "!contents? m$"
mm$=trim$(m$)
r$="reminder"
if m$<>"" then
#main.trm "selectionindex? tr"
d$=date$("yyyy/mm/dd")+" at "+left$(time$(),5)
select case tr
case 1
dd$=date$("yyyy/mm/dd")
m$="Set for today: "+dd$
case 2
r=date$("days")+7
dd$=right$(date$(r),4)+"/"+left$(date$(r),5)
m$="Set for next week: "+dd$
case 3
r=date$("days")+30
dd$=right$(date$(r),4)+"/"+left$(date$(r),5)
m$="Set for next month: "+dd$
case 4
r=date$("days")+365
dd$=right$(date$(r),4)+"/"+left$(date$(r),5)
m$="Set for next year: "+dd$
end select
m$=d$+" "+r$+chr$(13)+mm$+chr$(13)+m$
call newMemo m$
call fillDisplay
else
notice "Memo text required"
end if
end sub
sub getContact h$
#main.index "selectionindex? i"
'#main.index "selectindex 0"
if i>0 then
'extract the record number from the index$ array
currentContact=val(word$(index$(i),2,chr$(0)))
call fillDisplay
end if
end sub
sub newContact h$
'search the RAF for a free record
currentContact=1
gettrim #contacts,currentContact
while contact$<>"999999" and currentContact<maxContacts
currentContact=currentContact+1
gettrim #contacts,currentContact
wend
if currentContact=maxContacts then currentContact=currentContact+1 : maxContacts=currentContact
contact$="Enter new details"
company$="Click on Save Updates when done"
addr1$=""
addr2$=""
addr3$=""
zip$=""
phone1$=""
phone2$=""
email$=""
memo=0
put #contacts, currentContact
call newMemo date$("yyyy/mm/dd")+" at "+left$(time$(),5)+chr$(13)+"Account opened"
call fillDisplay
end sub
sub saveContact h$
if currentContact>0 then
gettrim #contacts,currentContact
#main.contact "!contents? contact$"
#main.company "!contents? company$"
#main.addr1, "!contents? addr1$"
#main.addr2, "!contents? addr2$"
#main.addr3, "!contents? addr3$"
#main.zip, "!contents? zip$"
#main.phone1, "!contents? phone1$"
#main.phone2, "!contents? phone2$"
#main.email, "!contents? email$"
put #contacts, currentContact
call buildIndex
end if
end sub
sub eraseContact h$
if currentContact>0 then
'fill the record with blanks and "999999"
contact$="999999"
company$=""
addr1$=""
addr2$=""
addr3$=""
zip$=""
phone1$=""
phone2$=""
email$=""
'set all memo records free
if memo>0 then
gettrim #memo, memo
p=prev
prev=0
memo$="FREE"
nexx=0
cont=0
put #memo,memo
while p>0
gettrim #memo, p
p=prev
prev=0
memo$="FREE"
nexx=0
cont=0
put #memo,p
wend
end if
memo=0
put #contacts,currentContact
currentContact=0
call buildIndex
end if
end sub
sub clearDisplay
'clear the display
#main.contact ""
#main.company ""
#main.addr1 ""
#main.addr2 ""
#main.addr3 ""
#main.zip ""
#main.phone1 ""
#main.phone2 ""
#main.email ""
#main.hist "!cls"
#main.memo "!cls"
end sub
sub fillDisplay
'clear the display
call clearDisplay
'fill the display
if currentContact>0 then
gettrim #contacts, currentContact
#main.contact, contact$
#main.company, company$
#main.addr1, addr1$
#main.addr2, addr2$
#main.addr3, addr3$
#main.zip, zip$
#main.phone1, phone1$
#main.phone2, phone2$
#main.email, email$
if memo>0 then
gettrim #memo, memo
while prev>0
#main.hist memo$
#main.hist ""
gettrim #memo, prev
wend
#main.hist memo$
else
#main.hist "!cls"
#main.memo "!cls"
end if
'push all the text down
#main.hist "!origin 0 0"
end if
end sub
Sub openContacts
Open "contact.dat" For Random As #contacts Len = 269
Field #contacts, 35 As company$, 35 As contact$, 35 As addr1$, 35 As addr2$, 35 As addr3$, _
10 As zip$, 12 As phone1$,12 As phone2$, 50 As email$,10 as memo
if lof(#contacts)>0 then maxContacts=lof(#contacts)/269 else maxContacts=0
open "memo.dat" for random as #memo len = 130
field #memo, 10 as prev, 100 as memo$, 10 as nexx, 10 as cont
if lof(#memo)>0 then maxMemos=lof(#memo)/130 else maxMemos=0
End Sub
Sub endProgram h$
close #main
close #contacts
close #memo
end
End Sub
'functions:
Sub DrawMenuBar hWnd
CallDLL #user32, "DrawMenuBar",_
hWnd As ulong, r As boolean
End Sub
Function GetSubMenu(hMenuBar,nPos)
CallDLL #user32, "GetSubMenu",_
hMenuBar As ulong, nPos As long,_
GetSubMenu As ulong
End Function
Function GetMenu(hWnd)
CallDLL #user32, "GetMenu",hWnd As ulong,_
GetMenu As ulong
End Function
Function RemoveMenu(hMenu,hSubMenu)
CallDLL #user32, "RemoveMenu", hMenu As ulong,_
hSubMenu As ulong, _MF_BYCOMMAND As ulong,_
RemoveMenu As boolean
End Function
|
|
|
|
Post by metro on Jan 23, 2020 3:49:00 GMT -5
Rod, Just a tip of the hat to say your efforts have not gone unnoticed.
I've got a couple of tips from your code that I can use for a trading journal.
Thanks
|
|
|
|
Post by Rod on Jan 23, 2020 10:23:35 GMT -5
Thanks, I shouldn't call it simple now. I get carried away. I was contemplating an appointments calendar add on but enough for now.....
|
|
|
|
Post by Rod on Jan 24, 2022 4:00:59 GMT -5
A bug spotted by Pierre
|
|
rnbw
New Member
Posts: 48
|
Post by rnbw on Jan 24, 2022 9:50:16 GMT -5
Rod's not so simple Contacts Database is very good. However, I am long retired and only need a simple address book. I found a very simple address book here ( Address Cardfile) and adjusted it to meet my own requirements: '=========================
' My Address Book
' by RNBW 24 January 2022 (but all credit to jabas)
'
' Adapted from JABAS Address Cardfile
' by jaba 16 Aug 2009
' All content free to use.
'=========================
' MyAddressBook.bas
' 24 January 2022
'=========================
'
'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
statictext #main, " (Surname First)", 20, 40, 110, 15
textbox #main.textName, 150, 20, 300, 25
statictext #main, "Tel:", 20, 55, 45, 20
textbox #main.textPhone, 150, 50, 110, 25
statictext #main, "Mob:", 300, 55, 35, 20
textbox #main.textCell, 340, 50, 110, 25
statictext #main, "Address:", 20, 85, 100, 20
textbox #main.textAddress, 150, 80, 300, 25
statictext #main, "City:", 20, 115, 45, 20
textbox #main.textCity, 150, 110, 300, 25
statictext #main, "County:", 20, 145, 100, 20
textbox #main.textSt, 150, 140, 130, 25
statictext #main, "Zip:", 300, 145, 20, 20
textbox #main.textZip, 340, 140, 110, 25
statictext #main, " E-Mail 1:", 20, 175, 60, 20
textbox #main.textEmail, 150, 170, 300, 25
statictext #main, " E-Mail 2:", 20, 200, 60, 20
textbox #main.textEmail2, 150, 200, 300, 25
statictext #main, " Notes: No commas or Return key", 500, 25, 300, 20
textbox #main.textNotes, 500, 50, 300, 480
statictext #main, " Contacts:", 20, 235, 100, 15
statictext #main.totRecs, " ", 30, 265, 30, 20
' buttons
button #main.btnSave, "Save", [btnSaveClicked], UL, 375, 480, 75, 25
button #main.btnExit, "Exit", [btnExitClicked], UL, 375, 510, 75, 25
button #main.btnClear,"Clear",[btnClearClicked], UL, 375, 450, 75, 25
button #main.btnEdit, "Edit Help", [btnEditHelpClicked], UL, 210, 540, 80, 22
button #main.btnHelp, "?", [btnHelpClicked], UR, 15, 4, 18, 18
button #main.btnSaveEdit, "Save Edit",[btnSaveEdit] ,UL, 295, 540, 60, 22
button #main.btnDelete,"Delete",[btnDeleteClicked], UL, 150, 540, 55, 22
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 "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
The code is basically the same as Jabas, but I have changed the number of controls and introduced Stylebits to smarten them up. I hope it may prove useful to someone. |
|
