I think you are correct in thinking an array would be best here. This code just shows how a file would be deleted. By delete, the deleted record is filled with empty data. There are also a few other comments.
That background trick is very good. I sure can't see any difference -- and I even put my glasses on! LOL
Code: Select all
dim info$(10, 10)
maxrecno = 0
recno = 1
editrec = 0
addrec = 0
delrec = 0
Status = 0
' *** You have some places where you GOSUB [Opendb]
' *** and others where you GOTO [Opendb] You need to
' *** choose one or the other. Sooner or later the program
' *** will become confused with its RETURN pointers.
' *** I changed all instances of GOSUB [Opendb] to
' *** GOTO [Opendb]]
nomainwin
loadbmp "bar1", "bar1.bmp"
loadbmp "bar2", "bar2.bmp"
loadbmp "bar3", "bar3.bmp"
loadbmp "larrow", "larrow.bmp"
loadbmp "larrow2", "larrow2.bmp"
loadbmp "rarrow", "rarrow.bmp"
loadbmp "rarrow2", "rarrow2.bmp"
loadbmp "backward", "backward.bmp"
loadbmp "forward", "forward.bmp"
loadbmp "webshots1", "webshots1.bmp"
loadbmp "addbck2", "addbck2.bmp"
loadbmp "editbck2", "editbck2.bmp"
WindowWidth = 803
'*** Added another 5 pixels to accomodate XP users
' *** I know, I know, you think they should suffer! <smile>
WindowHeight = 630
UpperLeftX = Int((DisplayWidth - WindowWidth)/2)
UpperLeftY = Int((DisplayHeight - WindowHeight)/20)
graphicbox #main.graph1, 0, 0, 800, 29
graphicbox #main.graph5, 20,32,27,26
graphicbox #main.graph6, 110,32,27,26
graphicbox #main.graph2, 0, 28, 800, 33
graphicbox #main.graph3, 0, 60, 800, 29
'*** XP users were getting status text squished at bottom
graphicbox #main.graph4, 0, 574, 800, 34
graphicbox #main.graph8, 0, 88, 800, 488
TextboxColor$ = "cyan"
textbox #main.textbox2, 240, 181, 40, 25
textbox #main.textbox3, 284, 181, 85, 25
textbox #main.textbox4, 373, 181, 33, 25
textbox #main.textbox5, 410, 181, 100, 25
textbox #main.textbox6, 240, 241, 270, 25
textbox #main.textbox7, 240, 301, 125, 25
textbox #main.textbox8, 240, 361, 145, 25
textbox #main.textbox9, 389, 361, 80, 25
textbox #main.textbox10, 240, 421, 90, 25
textbox #main.textbox11, 335, 421, 90, 25
textbox #main.textbox12, 429, 421, 90, 25
textbox #main.textbox14, 240, 481, 100, 25
ForegroundColor$ = "black"
checkbox #main.checkbox15, "YN", [cbSet], [cbReset], 348, 486, 13, 12
'*** Make all buttons uniform width
'*** Sequence button in Tab order
BUTTON #main.btn1, "Cancel", [Cancel], UL, 140, 5, 78, 20
'*** Add a Delete Record Button
BUTTON #main.btn2, "Delete Record", [Delrec], UL, 220, 5, 78, 20
BUTTON #main.btn3, "Goto Record", [Gotorec], UL, 140, 35, 78, 20
BUTTON #main.btn4, "Edit Record", [Editrec], UL, 220, 35, 78, 20
BUTTON #main.btn5, "Add Record", [Addrec], UL, 300, 35, 78, 20
BUTTON #main.btn6, "Close Dbf", [quit], UL, 380, 35, 78, 20
BUTTON #main.btn7, "Save to Dbf", [Save], UL, 460, 35, 78, 20
open "Friends DBF Entry Form v1.00" for window_nf as #main
print #main.graph1, "fill white"
print #main.graph1, "drawbmp bar1 0 0"
print #main.graph1, "flush"
print #main.graph2, "fill white"
print #main.graph2, "drawbmp bar2 0 0"
print #main.graph5, "down;drawbmp larrow 1 0;flush"
print #main.graph5,"when mouseMove [dbback1]"
print #main.graph5,"when leftButtonDown [backdown]"
print #main.graph6, "down;drawbmp rarrow 0 0;flush"
print #main.graph6,"when mouseMove [dbback2]"
print #main.graph6,"when leftButtonDown [forwarddown]"
print #main.graph3, "fill white"
print #main.graph3, "drawbmp bar3 0 0"
print #main.graph3, "flush"
print #main.graph4, "fill white"
print #main.graph4, "drawbmp bar1 0 0"
print #main.graph4, "flush"
print #main, "font ms_sans_serif 0 18"
'*** Assign font to buttons so all labels can be seen
For i = 1 to 7
handle$ = "#main.btn";i
print #handle$, "!font verdana 6 bold"
Next i
#main "Trapclose [quit]"
'[main.inputLoop] 'wait here for input event
' wait
[iffexists]
if fileExists(DefaultDir$, "Friends.dbf") then
maxrecno = determineLOF()
end if
goto [Opendb]
wait
[Gotorec]
if addrec = 1 then wait
prompt "Type in a record #"; recno
maxrecno = determineLOF()
if recno > maxrecno then
notice "There is no # "; recno; " record in the database, the maximum records in the database is ";maxrecno
recno = maxrecno
end if
if recno < 1 then recno = 1
print #main.graph2, "place 555 22"
print #main.graph2, "| Record # ";recno;" of Friends.dbf"
print #main.graph2, "flush"
goto [Opendb]
wait
[Editrec]
TextboxColor$ = "darkred"
textbox #main.textbox2, 240, 141, 40, 25
editrec = 1
Status = 2
if addrec = 1 then wait
print #main.graph8, "Down; fill black; flush"
print #main.graph8, "drawbmp editbck2 -65 0"
print #main.graph8, "flush"
print #main.graph4, "font ms_sans_serif 0 14"
print #main.graph4, "place 15 18"
print #main.graph4, "backcolor 170 192 196"
print #main.graph4, "| Status = Editing record ";recno;" of Friends.dbf"
print #main.graph4, "flush"
wait
[Addrec]
Status = 3
if addrec = 1 then wait
addrec = 1
previousrecno = recno
maxrecno = determineLOF()
maxrecno = maxrecno + 1
recno = maxrecno
print #main.graph8, "Down; fill white; flush"
print #main.graph8, "drawbmp addbck2 -5 -78"
print #main.graph8, "flush"
print #main.graph2, "place 555 22"
print #main.graph2, "| Record # ";recno;" of Friends.dbf"
print #main.graph2, "flush"
print #main.graph4, "font ms_sans_serif 0 14"
print #main.graph4, "place 24 18"
print #main.graph4, "backcolor 170 192 196"
print #main.graph4, "| Status = Adding record to Friends.dbf"
print #main.graph4, "flush"
#main.textbox2, ""
#main.textbox3, ""
#main.textbox4, ""
#main.textbox5, ""
#main.textbox6, ""
#main.textbox7, ""
#main.textbox8, ""
#main.textbox9, ""
#main.textbox10, ""
#main.textbox11, ""
#main.textbox12, ""
#main.textbox14, ""
wait
[Delrec]
Status = 4
' *** Unsure what this flag does, but put it here to
' go along with the [Addrec] code
if delrec = 1 then wait
delrec = 1
' *** Read the information in case user changes mind
#main.textbox2, "!contents? Title$";
#main.textbox3, "!contents? FName$";
#main.textbox4, "!contents? Initial$";
#main.textbox5, "!contents? LName$";
#main.textbox6, "!contents? Address$";
#main.textbox7, "!contents? City$";
#main.textbox8, "!contents? PROVSTATE$";
#main.textbox9, "!contents? PZC$";
#main.textbox10, "!contents? HTelnumber$";
#main.textbox11, "!contents? WTelnumber$";
#main.textbox12, "!contents? Cellnumber$";
#main.textbox14, "!contents? Bdate$";
' *** Empty the textboxes
#main.textbox2, ""
#main.textbox3, ""
#main.textbox4, ""
#main.textbox5, ""
#main.textbox6, ""
#main.textbox7, ""
#main.textbox8, ""
#main.textbox9, ""
#main.textbox10, ""
#main.textbox11, ""
#main.textbox12, ""
#main.textbox14, ""
' *** Just flush your image at the end of the draw
print #main.graph8, "Down; fill 170 192 196"
' print #main.graph8, "drawbmp addbck2 -5 -78"
' print #main.graph8, "flush"
print #main.graph2, "place 555 22"
print #main.graph2, "| Record # ";recno;" of Friends.dbf"
' print #main.graph2, "flush"
'*** Do you need to keep reissuing this font?
'*** Does it ever change during the program?"
print #main.graph4, "font ms_sans_serif 0 14"
print #main.graph4, "place 24 18"
print #main.graph4, "backcolor 170 192 196"
'*** Confirm Delete
msg$ = "This will delete Record Number " + Str$(recno) + Chr$(13) + "Continue?"
Confirm msg$;yn$
if yn$ = "no" then
'*** If user changes mind, restore saved information
#main.textbox2, Title$
#main.textbox3, FName$
#main.textbox4, Initial$
#main.textbox5, LName$
#main.textbox6, Address$
#main.textbox7, City$
#main.textbox8, PROVSTATE$
#main.textbox9, PZC$
#main.textbox10, HTelnumber$
#main.textbox11, WTelnumber$
#main.textbox12, Cellnumber$
#main.textbox14, Bdate$
' *** Reset delrec flag although I'm not sure it's necesssary
delrec = 0
' *** Wait for next move
wait
else
'*** but if user says yes, go ahead and delete then
'*** update status bar
print #main.graph4, "| Status = Deleting record ";recno;" of Friends.dbf"
print #main.graph4, "flush"
end if
'*** keep code here so you can drop right down into [SAVE]
[Save]
if Status = 1 then wait
addrec = 0
editrec = 0
' *** Add delrec flag
delrec = 0
print #main.graph4, "font ms_sans_serif 0 14"
print #main.graph4, "place 15 18"
print #main.graph4, "backcolor 170 192 196"
print #main.graph4, "| Status = Saving record to Friends.dbf"
print #main.graph4, "flush"
OPEN "Friends.dbf" FOR RANDOM AS #Friends LEN=260
field #Friends, 4 AS Title$, 20 AS FName$, 4 AS Initial$, 20 AS LName$, 110 AS Address$, 30 AS City$, 15 AS PROVSTATE$, 10 AS PZC$, 10 AS Bdate$, 12 AS HTelnumber$, 12 AS Cellnumber$, 12 AS WTelnumber$, 1 AS YN
#main.textbox2, "!contents? Title$";
#main.textbox3, "!contents? FName$";
#main.textbox4, "!contents? Initial$";
#main.textbox5, "!contents? LName$";
#main.textbox6, "!contents? Address$";
#main.textbox7, "!contents? City$";
#main.textbox8, "!contents? PROVSTATE$";
#main.textbox9, "!contents? PZC$";
#main.textbox10, "!contents? HTelnumber$";
#main.textbox11, "!contents? WTelnumber$";
#main.textbox12, "!contents? Cellnumber$";
#main.textbox14, "!contents? Bdate$";
PUT #Friends, recno
close #Friends
wait
[Cancel]
if Status = 1 then wait
if Status = 2 then
maxrecno = determineLOF()
maxrecno = maxrecno
recno = maxrecno
Status = 0
addrec = 0
editrec = 0
goto [Opendb]
end if
if Status = 3 then
maxrecno = determineLOF()
maxrecno = maxrecno
recno = maxrecno
Status = 0
addrec = 0
editrec = 0
goto [Opendb]
end if
wait
[cbSet]
YN = 1
wait
[cbReset]
YN = 0
wait
[Opendb]
OPEN "Friends.dbf" FOR RANDOM AS #Friends LEN=260
field #Friends, 4 AS Title$, 20 AS FName$, 4 AS Initial$, 20 AS LName$, _
110 AS Address$, 30 AS City$, 15 AS PROVSTATE$, 10 AS PZC$, _
10 AS Bdate$, 12 AS HTelnumber$, 12 AS Cellnumber$, _
12 AS WTelnumber$, 1 AS YN
GET #Friends,recno
print #main.graph8, "drawbmp webshots1 -110 -90"
print #main.graph8, "flush"
#main.textbox2, trim$(Title$)
#main.textbox3, trim$(FName$)
#main.textbox4, trim$(Initial$)
#main.textbox5, trim$(LName$)
#main.textbox6, trim$(Address$)
#main.textbox7, trim$(City$)
#main.textbox8, trim$(PROVSTATE$)
#main.textbox9, trim$(PZC$)
#main.textbox10, trim$(HTelnumber$)
#main.textbox11, trim$(WTelnumber$)
#main.textbox12, trim$(Cellnumber$)
#main.textbox14, trim$(Bdate$)
Close #Friends
print #main.graph2, "font ms_sans_serif 0 14"
print #main.graph2, "place 555 22"
print #main.graph2, "| Record # ";recno;" of Friends.dbf"
print #main.graph2, "flush"
print #main.graph4, "font ms_sans_serif 0 14"
print #main.graph4, "place 19 18"
print #main.graph4, "backcolor 170 192 196"
print #main.graph4, "| Status = Browsing Friends.dbf "
print #main.graph4, "flush"
Status = 1
wait
[dbback1]
print #main.graph3, "discard"
print #main.graph3, "down;drawbmp backward 20 6"
print #main.graph3, "flush"
print #main.graph2,"when mouseMove [dbUnSelected]"
print #main.graph3,"when mouseMove [dbUnSelected]"
wait
[dbback2]
print #main.graph3, "discard"
print #main.graph3, "down;drawbmp forward 110 6"
print #main.graph3, "flush"
print #main.graph2,"when mouseMove [dbUnSelected]"
print #main.graph3,"when mouseMove [dbUnSelected]"
wait
[backdown]
if addrec = 1 then wait
print #main.graph5, "flush"
print #main.graph5, "down;drawbmp larrow2 -3 0"
for x = 1 to 20000:next x
print #main.graph5, "discard"
print #main.graph5, "down;drawbmp larrow 1 0;flush"
recno = recno - 1
maxrecno = determineLOF()
if recno < 1 then recno = 1
print #main.graph2, "place 555 22"
print #main.graph2, "| Record # ";recno;" of Friends.dbf"
print #main.graph2, "flush"
if editrec = 1 then
wait
else
goto [Opendb]
end if
wait
wait
[forwarddown]
if addrec = 1 then wait
print #main.graph6, "flush"
print #main.graph6, "down;drawbmp rarrow2 3 0"
for x = 1 to 20000:next x
print #main.graph6, "discard"
print #main.graph6, "down;drawbmp rarrow 0 0;flush"
recno = recno + 1
maxrecno = determineLOF()
if recno > maxrecno then recno = maxrecno
print #main.graph2, "place 555 22"
print #main.graph2, "| Record # ";recno;" of Friends.dbf"
print #main.graph2, "flush"
if editrec = 1 then
wait
else
goto [Opendb]
end if
wait
[dbUnSelected]
print #main.graph3, "drawbmp bar3 0 0;flush"
wait
function determineLOF() ' Thanks to uncleBen & John Davidson at JB forum
' for this function and determining how many records
OPEN "Friends.dbf" FOR RANDOM AS #Friends LEN=260
qtyBytes = lof(#Friends)
determineLOF = qtyBytes/260
CLOSE #Friends
End function
function fileExists(path$, filename$)
'dimension the array info$( at the beginning of your program
files path$, filename$, info$()
fileExists = val(info$(0, 0)) 'non zero is true
end function
[quit]
unloadbmp("bar1")
unloadbmp("bar2")
unloadbmp("bar3")
unloadbmp("larrow")
unloadbmp("rarrow")
unloadbmp("backward")
unloadbmp("forward")
unloadbmp("larrow2")
unloadbmp("rarrow2")
unloadbmp("webshots1")
unloadbmp("addbck2")
close #main
End