Older Version
Newer Version
StPendl
Oct 29, 2010
Below find a simple framework for a database program.
You can use it in any way in your own projects, there is no usage limitation.
There are two versions available,
-
StPendl Oct 29, 2010 Using SUB's
[init]
'define global variables
global MaxItems
'predefine item array
dim items$(1), search$(1)
'get database contents
call OpenDB
call ReadDB
call CloseDB
[MainGUI]
'Form created with the help of Freeform 3 v01-28-07
'Generated on Jun 19, 2007 at 22:50:13
nomainwin
WindowWidth = 440
WindowHeight = 230
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
listbox #main.itemlist, items$(, [DisplayItem], 5, 5, 175, 185
statictext #main.NumberTxt, "Item Number:", 200, 7, 80, 25
statictext #main.NumberDisp, "", 300, 7, 95, 25
statictext #main.NameTxt, "Item Name:", 200, 32, 80, 25
statictext #main.NameDisp, "", 300, 32, 95, 25
statictext #main.PrizeTxt, "Item Prize:", 200, 57, 80, 25
statictext #main.PrizeDisp, "", 300, 57, 95, 25
button #main.add, "Add Item", CheckButton, UL, 200, 112, 63, 25
button #main.edit, "Edit Item", CheckButton, UL, 275, 112, 63, 25
button #main.delete,"Delete Item",CheckButton, UL, 350, 112, 75, 25
button #main.search,"Search", [search], UL, 200, 162, 63, 25
button #main.exit, "EXIT", [quit.main], UL, 350, 162, 39, 25
open "Simple Database Framework" for window as #main
print #main, "font ms_sans_serif 10"
print #main, "trapclose [quit.main]"
#main.itemlist "singleclickselect"
wait
[DisplayItem]
'get index of selected item
#main.itemlist "selectionindex? index"
#main.NameDisp word$(items$(index), 1, chr$(0))
#main.NumberDisp word$(items$(index), 2, chr$(0))
#main.PrizeDisp word$(items$(index), 3, chr$(0))
wait
[search]
'search in the database
WindowWidth = 430
WindowHeight = 190
'position of dialogs are relative to previous open window
UpperLeftX=1
UpperLeftY=1
textbox #search.String, 5, 5, 175, 25
button #search.default, "Search", [doSearch], UL, 200, 5, 75, 25
listbox #search.itemlist, search$(,[doDisplay], 5, 35, 175, 120
statictext #search.NumberTxt, "Item Number:", 200, 35, 80, 25
statictext #search.NumberDisp, "", 300, 35, 95, 25
statictext #search.NameTxt, "Item Name:", 200, 60, 80, 25
statictext #search.NameDisp, "", 300, 60, 95, 25
statictext #search.PrizeTxt, "Item Prize:", 200, 85, 80, 25
statictext #search.PrizeDisp, "", 300, 85, 95, 25
button #search.cancel, "Close",[quit.search], UL, 300, 127, 63, 25
'modal windows block access to the previous window
open "Search Database for Name" for dialog_modal as #search
print #search, "font ms_sans_serif 10"
print #search, "trapclose [quit.search]"
#search.itemlist "singleclickselect"
wait
[doSearch]
redim search$(MaxItems)
foundItem = 0
' search by name = field 1
FieldNumber = 1
#search.String "!contents? SearchString$"
for Count = 1 to MaxItems
'ignore case using LOWER$()
if instr(lower$(word$(items$(Count), FieldNumber, chr$(0))), lower$(SearchString$)) > 0 then
foundItem = foundItem + 1
search$(foundItem) = items$(Count)
end if
next
#search.itemlist "reload"
#search.itemlist "selectindex 0"
wait
[doDisplay]
'get index of selected item
#search.itemlist "selectionindex? index"
#search.NameDisp word$(search$(index), 1, chr$(0))
#search.NumberDisp word$(search$(index), 2, chr$(0))
#search.PrizeDisp word$(search$(index), 3, chr$(0))
wait
[quit.search]
close #search
wait
[quit.main]
close #main
END
sub CheckButton handle$
'get extension of button
extension$ = word$(handle$, 2, ".")
'get index of selected item
#main.itemlist "selectionindex? index"
'select action based on pushed button
select case extension$
case "add"
call DisplayDialog "Add Item", MaxItems
case "edit"
if index > 0 then call DisplayDialog "Edit Item", index
case "delete"
if index > 0 then call DeleteItem index
end select
'refresh listbox contents
#main.itemlist "reload"
'cancel selection to allow reselection of currently selected item
#main.itemlist "selectindex 0"
end sub
sub DisplayDialog Caption$, ItemNumber
'Form created with the help of Freeform 3 v01-28-07
'Generated on Jun 19, 2007 at 22:59:56
WindowWidth = 275
WindowHeight = 195
'position of dialogs are relative to previous open window
UpperLeftX=1
UpperLeftY=1
statictext #item.NumberTxt, "Item Number:", 10, 7, 80, 25
statictext #item.NameTxt, "Item Name:", 10, 42, 80, 25
statictext #item.PrizeTxt, "Item Prize:", 10, 77, 80, 25
textbox #item.Number, 105, 7, 150, 25
textbox #item.Name, 105, 42, 150, 25
textbox #item.Prize, 105, 77, 150, 25
button #item.cancel, "Close",[quit.item], UL, 95, 127, 63, 25
button #item.default, "Apply",[apply], UL, 180, 127, 75, 25
'modal windows block access to the previous window
open Caption$; " - "; ItemNumber for dialog_modal as #item
print #item, "font ms_sans_serif 10"
print #item, "trapclose [quit.item]"
if ItemNumber <> MaxItems then
#item.Name word$(items$(ItemNumber), 1, chr$(0))
#item.Number word$(items$(ItemNumber), 2, chr$(0))
#item.Prize word$(items$(ItemNumber), 3, chr$(0))
end if
#item.Number "!setfocus"
wait
[apply]
' apply changes
#item.Number "!contents? Temp1$"
#item.Name "!contents? Name$"
#item.Prize "!contents? Temp2$"
' Make sure info in boxes is the proper type of data (number/string)
if Temp1$ = str$(val(Temp1$)) then
Number = val(Temp1$)
else
' Item entered in the Number box is not a number !
notice "Item Number must be numeric only."
wait
end if
if Temp2$ = str$(val(Temp2$)) then
Prize = val(Temp2$)
else
' Item entered in the Prize box is not a number !
notice "Item Prize must be numeric only."
wait
end if
'fill the array element with the data
'separate fields by CHR$(0) to display only the first field in the listbox
items$(ItemNumber) = trim$(Name$); chr$(0); Number; chr$(0); Prize
call ApplyItemData
wait
[quit.item]
'exit dialog
close #item
end sub
sub ApplyItemData
call BackupDB
call OpenDB
call WriteDB
call ReadDB
call CloseDB
end sub
sub DeleteItem ItemIndex
confirm "Delete Item ... "+str$(ItemIndex)+chr$(13)+_
"Name ..... "+word$(items$(ItemIndex), 1, chr$(0))+chr$(13)+_
"Number ... "+word$(items$(ItemIndex), 2, chr$(0))+chr$(13)+_
"Prize .... "+word$(items$(ItemIndex), 3, chr$(0)); answer
if answer then
items$(ItemIndex) = ""
call BackupDB
call OpenDB
call WriteDB
call ReadDB
call CloseDB
end if
end sub
sub OpenDB
'open database and define record length
open "database.dat" for random as #db len=150
'set the fields, include some extra space for future use
field #db,_
40 as ItemName$,_
10 as ItemNumber,_
10 as ItemPrize,_
90 as Reserve$
end sub
sub CloseDB
close #db
end sub
sub ReadDB
'get the number of records in the database
'= length of database file divided by the record length
TotalRecords = lof(#db)/150
'check if the database is corrupted
if TotalRecords <> int(TotalRecords) then
notice "Database corrupted"; chr$(13); "Please check its contents!"
TotalRecords = int(TotalRecords + .5)
end if
'dimension array to enable adding one record
MaxItems = TotalRecords + 1
redim items$(MaxItems)
for Record = 1 to TotalRecords
get #db, Record
'fill the array with the data
'separate fields by CHR$(0) to display only the first field in the listbox
items$(Record) = trim$(ItemName$); chr$(0); ItemNumber; chr$(0); ItemPrize
next
end sub
sub WriteDB
Record = 1
for Count = 1 to MaxItems
if items$(Count) <> "" then
ItemName$ = word$(items$(Count), 1, chr$(0))
ItemNumber = val(word$(items$(Count), 2, chr$(0)))
ItemPrize = val(word$(items$(Count), 3, chr$(0)))
put #db, Record
Record = Record + 1
end if
next
end sub
sub BackupDB
if FileExists("database.bak") then kill "database.bak"
name "database.dat" as "database.bak"
end sub
function FileExists(FilePath$)
' returns zero if file does not exist
' returns one if file exists
dim FileExistsInfo$(1,1)
files "", FilePath$, FileExistsInfo$(
FileExists = val(FileExistsInfo$(0,0))
end function
Back to Top
Using GOSUB's
[init]
'predefine item array
dim items$(1)
'get database contents
gosub [OpenDB]
gosub [ReadDB]
gosub [CloseDB]
[MainGUI]
'Form created with the help of Freeform 3 v01-28-07
'Generated on Jun 19, 2007 at 22:50:13
nomainwin
WindowWidth = 440
WindowHeight = 230
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
listbox #main.itemlist, items$(, [DisplayItem], 5, 5, 175, 185
statictext #main.NumberTxt, "Item Number:", 200, 7, 80, 25
statictext #main.NumberDisp, "", 300, 7, 95, 25
statictext #main.NameTxt, "Item Name:", 200, 32, 80, 25
statictext #main.NameDisp, "", 300, 32, 95, 25
statictext #main.PrizeTxt, "Item Prize:", 200, 57, 80, 25
statictext #main.PrizeDisp, "", 300, 57, 95, 25
button #main.add, "Add Item", [add], UL, 200, 112, 63, 25
button #main.edit, "Edit Item", [edit], UL, 275, 112, 63, 25
button #main.delete,"Delete Item",[delete], UL, 350, 112, 75, 25
button #main.search,"Search", [search], UL, 200, 162, 63, 25
button #main.exit, "EXIT", [quit.main], UL, 350, 162, 39, 25
open "Simple Database Framework" for window as #main
print #main, "font ms_sans_serif 10"
print #main, "trapclose [quit.main]"
#main.itemlist "singleclickselect"
wait
[add]
extension$ = "add"
gosub [CheckButton]
wait
[edit]
extension$ = "edit"
gosub [CheckButton]
wait
[delete]
extension$ = "delete"
gosub [CheckButton]
wait
[DisplayItem]
'get index of selected item
#main.itemlist "selectionindex? SelectedItem"
#main.NameDisp word$(items$(SelectedItem), 1, chr$(0))
#main.NumberDisp word$(items$(SelectedItem), 2, chr$(0))
#main.PrizeDisp word$(items$(SelectedItem), 3, chr$(0))
wait
[search]
'search in the database
WindowWidth = 430
WindowHeight = 190
'position of dialogs are relative to previous open window
UpperLeftX=1
UpperLeftY=1
textbox #search.String, 5, 5, 175, 25
button #search.default, "Search", [doSearch], UL, 200, 5, 75, 25
listbox #search.itemlist, search$(,[doDisplay], 5, 35, 175, 120
statictext #search.NumberTxt, "Item Number:", 200, 35, 80, 25
statictext #search.NumberDisp, "", 300, 35, 95, 25
statictext #search.NameTxt, "Item Name:", 200, 60, 80, 25
statictext #search.NameDisp, "", 300, 60, 95, 25
statictext #search.PrizeTxt, "Item Prize:", 200, 85, 80, 25
statictext #search.PrizeDisp, "", 300, 85, 95, 25
button #search.cancel, "Close",[quit.search], UL, 300, 127, 63, 25
'modal windows block access to the previous window
open "Search Database for Name" for dialog_modal as #search
print #search, "font ms_sans_serif 10"
print #search, "trapclose [quit.search]"
#search.itemlist "singleclickselect"
wait
[doSearch]
redim search$(MaxItems)
foundItem = 0
' search by name = field 1
FieldNumber = 1
#search.String "!contents? SearchString$"
for Count = 1 to MaxItems
'ignore case using LOWER$()
if instr(lower$(word$(items$(Count), FieldNumber, chr$(0))), lower$(SearchString$)) > 0 then
foundItem = foundItem + 1
search$(foundItem) = items$(Count)
end if
next
#search.itemlist "reload"
#search.itemlist "selectindex 0"
wait
[doDisplay]
'get index of selected item
#search.itemlist "selectionindex? index"
#search.NameDisp word$(search$(index), 1, chr$(0))
#search.NumberDisp word$(search$(index), 2, chr$(0))
#search.PrizeDisp word$(search$(index), 3, chr$(0))
wait
[quit.search]
close #search
wait
[quit.main]
close #main
END
[CheckButton]
'select action based on pushed button
select case extension$
case "add"
SelectedItem = MaxItems
DialogCaption$ = "Add Item"
gosub [DisplayDialog]
case "edit"
DialogCaption$ = "Edit Item"
if SelectedItem > 0 then gosub [DisplayDialog]
case "delete"
if SelectedItem > 0 then gosub [DeleteItem]
end select
'refresh listbox contents
#main.itemlist "reload"
'cancel selection to allow reselection of currently selected item
#main.itemlist "selectindex 0"
return
[DisplayDialog]
'Form created with the help of Freeform 3 v01-28-07
'Generated on Jun 19, 2007 at 22:59:56
WindowWidth = 275
WindowHeight = 195
'position of dialogs is relative to previous open window
UpperLeftX=1
UpperLeftY=1
statictext #item.NumberTxt, "Item Number:", 10, 7, 80, 25
statictext #item.NameTxt, "Item Name:", 10, 42, 80, 25
statictext #item.PrizeTxt, "Item Prize:", 10, 77, 80, 25
textbox #item.Number, 105, 7, 150, 25
textbox #item.Name, 105, 42, 150, 25
textbox #item.Prize, 105, 77, 150, 25
button #item.cancel, "Close",[quit.item], UL, 95, 127, 63, 25
button #item.default, "Apply",[apply], UL, 180, 127, 75, 25
'modal windows block access to the previous window
open DialogCaption$; " - "; SelectedItem for dialog_modal as #item
print #item, "font ms_sans_serif 10"
print #item, "trapclose [quit.item]"
if SelectedItem <> MaxItems then
#item.Name word$(items$(SelectedItem), 1, chr$(0))
#item.Number word$(items$(SelectedItem), 2, chr$(0))
#item.Prize word$(items$(SelectedItem), 3, chr$(0))
end if
#item.Number "!setfocus"
wait
[apply]
' apply changes
#item.Number "!contents? Temp1$"
#item.Name "!contents? Name$"
#item.Prize "!contents? Temp2$"
' Make sure info in boxes is the proper type of data (number/string)
if Temp1$ = str$(val(Temp1$)) then
Number = val(Temp1$)
else
' Item entered in the Number box is not a number !
notice "Item Number must be numeric only."
wait
end if
if Temp2$ = str$(val(Temp2$)) then
Prize = val(Temp2$)
else
' Item entered in the Prize box is not a number !
notice "Item Prize must be numeric only."
wait
end if
'fill the array element with the data
'separate fields by CHR$(0) to display only the first field in the listbox
items$(SelectedItem) = trim$(Name$); chr$(0); Number; chr$(0); Prize
gosub [ApplyItemData]
wait
[quit.item]
'exit dialog
close #item
return
[ApplyItemData]
gosub [BackupDB]
gosub [OpenDB]
gosub [WriteDB]
gosub [ReadDB]
gosub [CloseDB]
return
[DeleteItem]
confirm "Delete Item ... "+str$(SelectedItem)+chr$(13)+_
"Name ..... "+word$(items$(SelectedItem), 1, chr$(0))+chr$(13)+_
"Number ... "+word$(items$(SelectedItem), 2, chr$(0))+chr$(13)+_
"Prize .... "+word$(items$(SelectedItem), 3, chr$(0)); answer
if answer then
items$(SelectedItem) = ""
gosub [BackupDB]
gosub [OpenDB]
gosub [WriteDB]
gosub [ReadDB]
gosub [CloseDB]
end if
return
[OpenDB]
'open database and define record length
open "database.dat" for random as #db len=150
'set the fields, include some extra space for future use
field #db,_
40 as ItemName$,_
10 as ItemNumber,_
10 as ItemPrize,_
90 as Reserve$
return
[CloseDB]
close #db
return
[ReadDB]
'get the number of records in the database
'= length of database file divided by the record length
TotalRecords = lof(#db)/150
'check if the database is corrupted
if TotalRecords <> int(TotalRecords) then
notice "Database corrupted"; chr$(13); "Please check its contents!"
TotalRecords = int(TotalRecords + .5)
end if
'dimension array to enable adding one record
MaxItems = TotalRecords + 1
redim items$(MaxItems)
for Record = 1 to TotalRecords
get #db, Record
'fill the array with the data
'separate fields by CHR$(0) to display only the first field in the listbox
items$(Record) = trim$(ItemName$); chr$(0); ItemNumber; chr$(0); ItemPrize
next
return
[WriteDB]
Record = 1
for Count = 1 to MaxItems
if items$(Count) <> "" then
ItemName$ = word$(items$(Count), 1, chr$(0))
ItemNumber = val(word$(items$(Count), 2, chr$(0)))
ItemPrize = val(word$(items$(Count), 3, chr$(0)))
put #db, Record
Record = Record + 1
end if
next
return
[BackupDB]
if FileExists("database.bak") then kill "database.bak"
name "database.dat" as "database.bak"
return
function FileExists(FilePath$)
' returns zero if file does not exist
' returns one if file exists
dim FileExistsInfo$(1,1)
files "", FilePath$, FileExistsInfo$(
FileExists = val(FileExistsInfo$(0,0))
end function
Back to Top