Older Version
Newer Version
StPendl
Oct 29, 2010
[[#TOP]] 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, > [[SimpleDatabaseFrameworkRAF#WithSUB|Using SUB's]] >> Sub's are an easy way to create reusable code. >> The variable names inside of the sub's are different from the ones used outside. >> You can use a sub in different projects. > [[SimpleDatabaseFrameworkRAF#WithGOSUB|Using GOSUB's]] >> This is for people who started to program in BASIC long ago. >> Variable names must be the same for the whole program, which makes following their use difficult in bigger projects. [[user:StPendl|1288348952]] [[#WithSUB]] ===Using SUB's=== [[code format="lb"]] [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 [[code]] [[SimpleDatabaseFrameworkRAF#TOP|Back to Top]] [[#WithGOSUB]] ===Using GOSUB's=== [[code format="lb"]] [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 [[code]] [[SimpleDatabaseFrameworkRAF#TOP|Back to Top]]