Rem * Title : Christmas Card Records Rem * Author : Robert the Robot Rem * Date : 18/12/07 rem **************************** rem Christmas Card Record Keeper rem **************************** rem Please note - This program was coded in DB V1.20, and may not work in V1.13. rem Sorry... rem ****************** rem Glossary of arrays rem ****************** remstart - ARRAYS Name$(CardLimit, 2) : First and last names of individuals Address$(CardLimit, 4) : Address line 1, address line 2 (Opptional), City/State, Postcode CardType$(Cardlimit) : A text description of the type of card Sent RecievedCard$(Cardlimit) : Did you recieve a card from them last year? remend rem **************** rem Startup commands rem **************** rem 1024x 768 display mode - still givers a max. of 62fps, just one or two less than rem with 800 x 600. It also makes the font look better... Check And Set The Display Mode Hide Mouse Disable EscapeKey Sync On Sync rate zero Sync rem ********************** rem The All-Important Logo rem ********************** rem Draw the logo on a blank bitmap, then copy to screen Create Bitmap 1, 1024, 768 Ink RGB(0,255,255), 0 Set Text Size 30 Set Text Font "Arial Bold", 1 Center text 512, 231, "Christmas Card Record Keeper" Set Text To Italic Center text 512, 262, "by" Center text 512, 293, "Robert the Robot" Copy bitmap 1, 0 Delete Bitmap 1 rem Fade In/Fade out For T = 1 to 255 Set Gamma T, T, T Sync Next T Timer = timer() Repeat until (Spacekey() = 1) or (Timer+1000<Timer() ) rem Total Reset Set Gamma 255, 255, 255 Ink RGB(255, 255, 255), 0 Set Text to Normal rem ************* rem Create arrays rem ************* rem Max Number of Christmas cards you want to send CardLimit = 1000 : rem This should be more than enough for your needs... :) Dim Name$(CardLimit, 2) Dim Address$(CardLimit, 4) Dim CardType$(Cardlimit) Dim RecievedCard$(Cardlimit) NamePointer = 1 If File Exist("Christmas Card Database.txt") Open to Read 1, "Christmas Card Database.txt" rem read ion the Number of Records Read String 1, Temp$ NumberOfCards = Val(Temp$) rem Read in the data For T = 1 to NumberOfCards Read string 1, Name$(T, 1) Read string 1, Name$(T, 2) Read string 1, Address$(T, 1) Read string 1, Address$(T, 2) Read string 1, Address$(T, 3) Read string 1, Address$(T, 4) Read string 1, CardType$(T) Read string 1, RecievedCard$(T) Next T Close file 1 endif rem clear the screen Cls rem ********************* rem The Main Program Loop rem ********************* Set Text font "Arial", 1 Set Text Size 17 Show Mouse Cardpointer = 1 GoSub GenerateScreen MainProgram: Do rem Handle exiting If EscapeKey() = 1 then GoSub SavingArrayData rem Scroll through records If Scancode() = 0 and Mouseclick() = 0 then Held = 0 If (Held = 0) or (Timer+100<Timer()) If (Upkey() = 1) or (MouseX()>=981 and MouseX()<=1000 and mouseY()>=31 and MouseY()<=46 and MouseClick()=1) CardPointer = CardPointer-1 If (CardPointer<1) then CardPointer = CardPointer+1 Timer = Timer() Held = 1 GoSub GenerateScreen endif If (Downkey() = 1) or (MouseX()>=981 and MouseX()<=1000 and mouseY()>=651 and MouseY()<667 and MouseClick()=1) CardPointer = CardPointer+1 If CardPointer > Numberofcards then Cardpointer = NumberOfCards Timer = Timer() Held = 1 GoSub GenerateScreen endif endif If Held = 0 rem Clicking Compact data If MouseX()>438 and MouseX()<585 and mouseY()>715 and MouseY()<733 and MouseClick()=1 Cls Center text 512, 50, "You are about to delete the entries on all" Center text 512, 70, "the people who did not send you a christmas" Center text 512, 90, "card last year. Do you wish to continue?" Make Button(312, 150, "Yes") Make Button(712, 150, "No") Do rem Clicking No If MouseX()>668 and MouseX()<755 and mouseY()>165 and MouseY()<183 and MouseClick()=1 Repeat : Until Mouseclick() = 0 GoSub GenerateScreen endif rem Clicking Yes - Delete all entries who sent no cards to you last year If MouseX()>268 and MouseX()<355 and mouseY()>165 and MouseY()<183 and MouseClick()=1 Repeat : Until Mouseclick() = 0 OriginalCardNumber = NumberofCards rem This looks horrendous, doesn't it? rem That's probably because it is... For T = 1 to OriginalCardNumber If RecievedCard$(T) = "No" For U = T to (OriginalCardNumber-1) Name$(U, 1) = Name$(U+1, 1) Name$(U, 2) = Name$(U+1, 2) Address$(U, 1) = Address$(U+1, 1) Address$(U, 2) = Address$(U+1, 2) Address$(U, 3) = Address$(U+1, 3) Address$(U, 4) = Address$(U+1, 4) CardType$(U) = CardType$(U+1) RecievedCard$(U) = RecievedCard$(U+1) Next U Dec NumberOfCards endif Next T For T = NumberOfCards+1 to OriginalCardNumber Name$(T, 1) = "" Name$(T, 2) = "" Address$(T, 1) = "" Address$(T, 2) = "" Address$(T, 3) = "" Address$(T, 4) = "" CardType$(T) = "" RecievedCard$(T) = "" Next T rem Return to data screen CLS GoSub GenerateScreen endif Sync Loop endif If MouseClick()=1 If MouseY()>715 and MouseY()<733 rem Clicking add new record If MouseX()>56 and MouseX()<143 GoSub GenerateNewRecordScreen endif rem Clicking Sort by Surname If MouseX()>182 and MouseX()<329 Repeat : Until Mouseclick() = 0 GoSub SortArraysBySurname endif rem Clicking Sort by Forename If MouseX()>694 and MouseX()<841 Repeat : Until Mouseclick() = 0 GoSub SortArraysByForename endif rem Clicking Help If MouseX()>880 and MouseX()<967 Repeat : Until Mouseclick() = 0 GoSub Help endif endif rem Check if a record has been clicked Gosub GenerateEditRecordScreen endif endif sync Loop rem ************************** rem Create Main Screen Display rem ************************** GenerateScreen: Create Bitmap 1, 1024, 768 Set Current bitmap 1 rem Display headings Text 10, 2, "Name" Text 213, 2, "Address" Text 463, 2, "Card Type sent" Text 713, 2, "Did they send a card last year?" Text 0, 5, "_______________________________________________________________________________________________________________________________" rem Display the data Counter = 1 For T = CardPointer to Cardpointer+6 rem Record numbers If T<Numberofcards+1 Text 5, ((Counter-1)*90)+38, Str$(T) endif rem Names Text 30, ((Counter-1)*90)+38, Name$(T, 1) + " " + Name$(T, 2) rem Addresses If Address$(T, 2) <> "" Text 213, ((Counter-1)*90)+38, Address$(T, 1) Text 213, ((Counter-1)*90)+56, Address$(T, 2) Text 213, ((Counter-1)*90)+74, Address$(T, 3) Text 213, ((Counter-1)*90)+92, Address$(T, 4) else Text 213, ((Counter-1)*90)+38, Address$(T, 1) Text 213, ((Counter-1)*90)+56, Address$(T, 3) Text 213, ((Counter-1)*90)+74, Address$(T, 4) endif rem Other information Text 463, ((Counter-1)*90)+38, CardType$(T) Text 713, ((Counter-1)*90)+38, RecievedCard$(T) Inc Counter Next T rem Make Scroll Buttons Text 980, 30, "| / |" Text 980, 28, "|" : Text 999, 28, "|" Text 981, 15, "__" : Text 985, 15, "__" Text 981, 30, "__" : Text 985, 30, "__" Text 980, 650, "| / |" Text 980, 648, "|" : Text 999, 648, "|" Text 981, 635, "__" : Text 985, 635, "__" Text 981, 650, "__" : Text 985, 650, "__" rem Create the Buttons Make Button(100, 700, "Add Data") Make Large Button(256, 700, "Sort by Surname") Make Large Button(512, 700, "Compact Data") Make Large Button(768, 700, "Sort by Forename") Make Button(924, 700, "Help") Copy Bitmap 1, 0 Delete Bitmap 1 GoTo MainProgram return rem **************************** rem Creat New/Edit Record Screen rem **************************** GenerateNewRecordScreen: Create Bitmap 1, 1024, 768 Set Current bitmap 1 Set Text To Normal rem Display Headings Text 10, 2, "Add a New Record to the database" Text 0, 5, "_______________________________________________________________________________________________________________________________" rem Display Criteria Text 10, 25, "First Name:" Text 10, 45, "Surname:" Text 10, 70, "Address Line 1:" Text 10, 90, "Address Line 2:" Text 10, 110, "City/State:" Text 10, 130, "Postcode:" Text 10, 155, "Card Type sent:" Text 10, 190, "Did they send a card last year? (Y/N):" Make Large Button(512, 670, "Apply This Data") Make Large Button(512, 700, "Cancel") Copy Bitmap 1, 0 Delete Bitmap 1 GoTo NewRecord return rem ******************* rem Program Subroutines rem ******************* NewRecord: Do rem Set the Cursor If Timer+500<Timer() If cursor$ = "|" then Cursor$="" else cursor$ = "|" Timer = Timer() endif rem Clicking the Record Slot If Mouseclick() = 1 If MouseY()>22 and MouseY()<41 Line$ = Forename$ Mode = 1 endif If MouseY()>42 and MouseY()<61 Line$ = Surname$ Mode = 2 endif If MouseY()>69 and MouseY()<86 Line$ = AddressOne$ Mode = 3 endif If MouseY()>89 and MouseY()<106 Line$ = AddressTwo$ Mode = 4 endif If MouseY()>112 and MouseY()<129 Line$ = CityState$ Mode = 5 endif If MouseY()>131 and MouseY()<148 Line$ = Postcode$ Mode = 6 endif If MouseY()>155 and MouseY()<172 Line$ = CardTypeSent$ Mode = 7 endif If MouseY()>190 and MouseY()<207 Mode = 8 endif rem Clicking Cancel - Return to the Main program If MouseY()>715 and MouseY()<733 and MouseX()>438 and MouseX()<585 For T = 100 to 107 If Sprite Exist(T) then Delete Sprite T If Image Exist(T) then Delete image T Next T rem Reset Variables Forename$ = "" : Surname$ = "" : AddressOne$ = "" : AddressTwo$ = "" : CityState$ = "" Postcode$ = "" : CardTypeSent$ = "" : RecievedCards$ = "" : Line$ = "" Held = 1 GoSub GenerateScreen endif rem Clicking Apply Data If MouseY()>685 and MouseY()<703 and MouseX()>438 and MouseX()<585 If Forename$<>"" and Surname$<>"" and AddressOne$<>"" and CityState$<>"" and Postcode$<>"" and CardTypeSent$<>"" and RecievedCards$<>"" Line$ = "" Inc NumberOfCards Name$(NumberOfCards, 1) = Forename$ Name$(NumberOfCards, 2) = Surname$ Address$(NumberOfCards, 1) = AddressOne$ Address$(NumberOfCards, 2) = AddressTwo$ Address$(NumberOfCards, 3) = CityState$ Address$(NumberOfCards, 4) = Postcode$ CardType$(NumberOfCards) = CardTypeSent$ RecievedCard$(NumberOfCards) = RecievedCards$ rem Reset Variables Forename$ = "" : Surname$ = "" : AddressOne$ = "" : AddressTwo$ = "" CityState$ = "" : Postcode$ = "" : CardTypeSent$ = "" : RecievedCards$ = "" rem Delete the Sprites For T = 100 to 107 If Sprite Exist(T) then Delete Sprite T If Image Exist(T) then Delete image T Next T Held = 1 GoSub GenerateScreen endif endif endif Select Mode Case 1 GoSub EnterString Line$ = Left$(Line$, 12) Forename$ = Line$ rem Put the new text on a temp bitmap, get an image and sprite it Create Bitmap 1, 200, 30 Text 0, 5, ForeName$+Cursor$ Get image 100, 0, 0, 200, 30 Sprite 100, 120, 20, 100 Delete bitmap 1 EndCase Case 2 GoSub EnterString Line$ = Left$(Line$, 12) Surname$ = Line$ rem Put the new text on a temp bitmap, get an image and sprite it Create Bitmap 1, 200, 30 Text 0, 5, Surname$+Cursor$ Get image 101, 0, 0, 200, 30 Sprite 101, 120, 40, 101 Delete bitmap 1 EndCase Case 3 GoSub EnterString Line$ = Left$(Line$, 25) AddressOne$ = Line$ rem Put the new text on a temp bitmap, get an image and sprite it Create Bitmap 1, 200, 30 Text 0, 5, AddressOne$+Cursor$ Get image 102, 0, 0, 200, 30 Sprite 102, 120, 65, 102 Delete bitmap 1 EndCase Case 4 GoSub EnterString Line$ = Left$(Line$, 25) AddressTwo$ = Line$ rem Put the new text on a temp bitmap, get an image and sprite it Create Bitmap 1, 200, 30 Text 0, 5, AddressTwo$+Cursor$ Get image 103, 0, 0, 200, 30 Sprite 103, 120, 85, 103 Delete bitmap 1 EndCase Case 5 GoSub EnterString Line$ = Left$(Line$, 25) CityState$ = Line$ rem Put the new text on a temp bitmap, get an image and sprite it Create Bitmap 1, 200, 30 Text 0, 5, CityState$+Cursor$ Get image 104, 0, 0, 200, 30 Sprite 104, 120, 105, 104 Delete bitmap 1 EndCase Case 6 GoSub EnterString Line$ = Left$(Line$, 10) Postcode$ = Line$ rem Put the new text on a temp bitmap, get an image and sprite it Create Bitmap 1, 200, 30 Text 0, 5, Postcode$+Cursor$ Get image 105, 0, 0, 200, 30 Sprite 105, 120, 125, 105 Delete bitmap 1 EndCase Case 7 GoSub EnterString Line$ = Left$(Line$, 25) CardTypeSent$ = Line$ rem Put the new text on a temp bitmap, get an image and sprite it Create Bitmap 1, 200, 30 Text 0, 5, CardTypeSent$+Cursor$ Get image 106, 0, 0, 200, 30 Sprite 106, 120, 150, 106 Delete bitmap 1 EndCase Case 8 If Lower$(Inkey$() ) = "y" rem Put the new text on a temp bitmap, get an image and sprite it RecievedCards$ = "Yes" Create Bitmap 1, 200, 30 Text 0, 5, "Yes" Get image 107, 0, 0, 200, 30 Sprite 107, 260, 185, 107 Delete bitmap 1 endif If Lower$(Inkey$() ) = "n" rem Put the new text on a temp bitmap, get an image and sprite it RecievedCards$ = "No" Create Bitmap 1, 200, 30 Text 0, 5, "No" Get image 107, 0, 0, 200, 30 Sprite 107, 260, 185, 107 Delete bitmap 1 endif rem Remove any data that maight get put into Line$ Clear Entry Buffer EndCase EndSelect sync Loop return rem Editing a record GenerateEditRecordScreen: Found = 0 Y = MouseY() If Y>21 and Y<111 then Cardselected = Cardpointer : Found = 1 If Y>111 and Y<201 then Cardselected = Cardpointer+1 : Found = 1 If Y>201 and Y<291 then Cardselected = Cardpointer+2 : Found = 1 If Y>291 and Y<381 then Cardselected = Cardpointer+3 : Found = 1 If Y>381 and Y<471 then Cardselected = Cardpointer+4 : Found = 1 If Y>471 and Y<561 then Cardselected = Cardpointer+5 : Found = 1 If Y>561 and Y<651 then Cardselected = Cardpointer+6 : Found = 1 If Found = 1 rem Set the Variables Forename$ = Name$(Cardselected, 1) Surname$ = Name$(Cardselected, 2) AddressOne$ = Address$(Cardselected, 1) AddressTwo$ = Address$(Cardselected, 2) CityState$ = Address$(Cardselected, 3) Postcode$ = Address$(Cardselected, 4) CardTypeSent$ = CardType$(Cardselected) RecievedCards$ = RecievedCard$(Cardselected) rem Generate Backdrop Create Bitmap 1, 1024, 768 Set Current bitmap 1 Set Text To Normal rem Display Headings Text 10, 2, "Edit a database record" Text 0, 5, "_______________________________________________________________________________________________________________________________" rem Display Criteria Text 10, 25, "First Name: " Text 10, 45, "Surname: " Text 10, 70, "Address Line 1: " Text 10, 90, "Address Line 2: " Text 10, 110, "City/State: " Text 10, 130, "Postcode: " Text 10, 155, "Card Type sent: " Text 10, 190, "Did they send a card last year? (Y/N): " Make Large Button(512, 670, "Apply This Data") Make Large Button(512, 700, "Cancel") Copy Bitmap 1, 0 Delete Bitmap 1 rem Now generate Sprites rem Forename Create Bitmap 1, 200, 30 Text 0, 5, ForeName$ Get image 100, 0, 0, 200, 30 Delete bitmap 1 rem Surname Create Bitmap 1, 200, 30 Text 0, 5, Surname$ Get image 101, 0, 0, 200, 30 Delete bitmap 1 rem Address one Create Bitmap 1, 200, 30 Text 0, 5, AddressOne$ Get image 102, 0, 0, 200, 30 Delete bitmap 1 rem Address two Create Bitmap 1, 200, 30 Text 0, 5, AddressTwo$ Get image 103, 0, 0, 200, 30 Delete bitmap 1 rem City/State Create Bitmap 1, 200, 30 Text 0, 5, CityState$ Get image 104, 0, 0, 200, 30 Delete bitmap 1 rem Postcode Create Bitmap 1, 200, 30 Text 0, 5, Postcode$ Get image 105, 0, 0, 200, 30 Delete bitmap 1 rem Card Type sent Create Bitmap 1, 200, 30 Text 0, 5, CardTypeSent$ Get image 106, 0, 0, 200, 30 Delete bitmap 1 rem Whether a card was recieved or not If RecievedCards$ = "Yes" Create Bitmap 1, 200, 30 Text 0, 5, "Yes" Get image 107, 0, 0, 200, 30 Delete bitmap 1 else Create Bitmap 1, 200, 30 Text 0, 5, "No" Get image 107, 0, 0, 200, 30 Delete bitmap 1 endif Repeat : Until Mouseclick() = 0 Mode = 0 GoTo EditRecord endif return EditRecord: Do rem Set the Cursor If Timer+500<Timer() If cursor$ = "|" then Cursor$="" else cursor$ = "|" Timer = Timer() endif rem Clicking the Record Slot If Mouseclick() = 1 If MouseY()>22 and MouseY()<41 Line$ = Forename$ Mode = 1 endif If MouseY()>42 and MouseY()<61 Line$ = Surname$ Mode = 2 endif If MouseY()>69 and MouseY()<86 Line$ = AddressOne$ Mode = 3 endif If MouseY()>89 and MouseY()<106 Line$ = AddressTwo$ Mode = 4 endif If MouseY()>112 and MouseY()<129 Line$ = CityState$ Mode = 5 endif If MouseY()>131 and MouseY()<148 Line$ = Postcode$ Mode = 6 endif If MouseY()>155 and MouseY()<172 Line$ = CardTypeSent$ Mode = 7 endif If MouseY()>190 and MouseY()<207 Mode = 8 endif rem Clicking Cancel - Return to the Main program If MouseY()>715 and MouseY()<733 and MouseX()>438 and MouseX()<585 For T = 100 to 107 If Sprite Exist(T) then Delete Sprite T If Image Exist(T) then Delete image T Next T rem Reset Variables Forename$ = "" : Surname$ = "" : AddressOne$ = "" : AddressTwo$ = "" : CityState$ = "" Postcode$ = "" : CardTypeSent$ = "" : RecievedCards$ = "" : Line$ = "" Held = 1 GoSub GenerateScreen endif rem Clicking Apply Data If MouseY()>685 and MouseY()<703 and MouseX()>438 and MouseX()<585 If Forename$<>"" and Surname$<>"" and AddressOne$<>"" and CityState$<>"" and Postcode$<>"" and CardTypeSent$<>"" and RecievedCards$<>"" Line$ = "" Name$(CardSelected, 1) = Forename$ Name$(CardSelected, 2) = Surname$ Address$(CardSelected, 1) = AddressOne$ Address$(CardSelected, 2) = AddressTwo$ Address$(CardSelected, 3) = CityState$ Address$(CardSelected, 4) = Postcode$ CardType$(CardSelected) = CardTypeSent$ RecievedCard$(CardSelected) = RecievedCards$ rem Reset Variables Forename$ = "" : Surname$ = "" : AddressOne$ = "" : AddressTwo$ = "" CityState$ = "" : Postcode$ = "" : CardTypeSent$ = "" : RecievedCards$ = "" rem Delete the Sprites For T = 100 to 107 If Sprite Exist(T) then Delete Sprite T If Image Exist(T) then Delete image T Next T Held = 1 GoTo GenerateScreen endif rem DELETING RECORDS - All fields left blank If Forename$ = "" and Surname$ = "" and AddressOne$ = "" and Addresstwo$ = "" and CityState$ = "" and Postcode$ = "" and CardTypeSent$ = "" and RecievedCards$ = "" rem Move every subsequent record up one place in the array For T = CardSelected to NumberOfCards Name$(T, 1) = Name$(T+1, 1) Name$(T, 2) = Name$(T+1, 2) Address$(T, 1) = Address$(T+1, 1) Address$(T, 2) = Address$(T+1, 2) Address$(T, 3) = Address$(T+1, 3) Address$(T, 4) = Address$(T+1, 4) CardType$(T) = CardType$(T+1) RecievedCard$(T) = RecievedCard$(T+1) Next T Name$(NumberOfCards, 1) = "" Name$(NumberOfCards, 2) = "" Address$(NumberOfCards, 1) = "" Address$(NumberOfCards, 2) = "" Address$(NumberOfCards, 3) = "" Address$(NumberOfCards, 4) = "" CardType$(NumberOfCards) = "" RecievedCard$(NumberOfCards) = "" Dec NumberOfCards rem Reset Variables Forename$ = "" : Surname$ = "" : AddressOne$ = "" : AddressTwo$ = "" CityState$ = "" : Postcode$ = "" : CardTypeSent$ = "" : RecievedCards$ = "" rem Delete the Sprites For T = 100 to 107 If Sprite Exist(T) then Delete Sprite T If Image Exist(T) then Delete image T Next T Held = 1 GoTo GenerateScreen endif endif endif Select Mode Case 1 GoSub EnterString Line$ = Left$(Line$, 12) Forename$ = Line$ rem Put the new text on a temp bitmap, get an image and sprite it Create Bitmap 1, 200, 30 Text 0, 5, ForeName$+Cursor$ Get image 100, 0, 0, 200, 30 Delete bitmap 1 EndCase Case 2 GoSub EnterString Line$ = Left$(Line$, 12) Surname$ = Line$ rem Put the new text on a temp bitmap, get an image and sprite it Create Bitmap 1, 200, 30 Text 0, 5, Surname$+Cursor$ Get image 101, 0, 0, 200, 30 Delete bitmap 1 EndCase Case 3 GoSub EnterString Line$ = Left$(Line$, 25) AddressOne$ = Line$ rem Put the new text on a temp bitmap, get an image and sprite it Create Bitmap 1, 200, 30 Text 0, 5, AddressOne$+Cursor$ Get image 102, 0, 0, 200, 30 Delete bitmap 1 EndCase Case 4 GoSub EnterString Line$ = Left$(Line$, 25) AddressTwo$ = Line$ rem Put the new text on a temp bitmap, get an image and sprite it Create Bitmap 1, 200, 30 Text 0, 5, AddressTwo$+Cursor$ Get image 103, 0, 0, 200, 30 Delete bitmap 1 EndCase Case 5 GoSub EnterString Line$ = Left$(Line$, 25) CityState$ = Line$ rem Put the new text on a temp bitmap, get an image and sprite it Create Bitmap 1, 200, 30 Text 0, 5, CityState$+Cursor$ Get image 104, 0, 0, 200, 30 Delete bitmap 1 EndCase Case 6 GoSub EnterString Line$ = Left$(Line$, 10) Postcode$ = Line$ rem Put the new text on a temp bitmap, get an image and sprite it Create Bitmap 1, 200, 30 Text 0, 5, Postcode$+Cursor$ Get image 105, 0, 0, 200, 30 Delete bitmap 1 EndCase Case 7 GoSub EnterString Line$ = Left$(Line$, 25) CardTypeSent$ = Line$ rem Put the new text on a temp bitmap, get an image and sprite it Create Bitmap 1, 200, 30 Text 0, 5, CardTypeSent$+Cursor$ Get image 106, 0, 0, 200, 30 Delete bitmap 1 EndCase Case 8 If Lower$(Inkey$() ) = "y" rem Put the new text on a temp bitmap, get an image and sprite it RecievedCards$ = "Yes" Create Bitmap 1, 200, 30 Text 0, 5, "Yes" Get image 107, 0, 0, 200, 30 Delete bitmap 1 endif If Lower$(Inkey$() ) = "n" rem Put the new text on a temp bitmap, get an image and sprite it RecievedCards$ = "No" Create Bitmap 1, 200, 30 Text 0, 5, "No" Get image 107, 0, 0, 200, 30 Delete bitmap 1 endif If Lower$(Inkey$() ) = "c" rem Put the new text on a temp bitmap, get an image and sprite it RecievedCards$ = "" Create Bitmap 1, 200, 30 Text 0, 5, "" Get image 107, 0, 0, 200, 30 Delete bitmap 1 endif rem Remove any data that maight get put into Line$ Clear Entry Buffer EndCase EndSelect rem Display the images of the text Sprite 100, 120, 20, 100 Sprite 101, 120, 40, 101 Sprite 102, 120, 65, 102 Sprite 103, 120, 85, 103 Sprite 104, 120, 105, 104 Sprite 105, 120, 125, 105 Sprite 106, 120, 150, 106 Sprite 107, 260, 185, 107 sync Loop return rem ***************** rem Saving Array Data rem ***************** SavingArrayData: If File Exist("Christmas Card Database.txt") Delete file "Christmas Card Database.txt" Open to Write 1, "Christmas Card Database.txt" rem Write the Number of Records Write String 1, Str$(NumberOfCards) rem Read in the data For T = 1 to NumberOfCards Write string 1, Name$(T, 1) Write string 1, Name$(T, 2) Write string 1, Address$(T, 1) Write string 1, Address$(T, 2) Write string 1, Address$(T, 3) Write string 1, Address$(T, 4) Write string 1, CardType$(T) Write string 1, RecievedCard$(T) Next T Close file 1 endif End return rem ********************** rem Miscellaneous Routines rem ********************** EnterString: rem Build line string New$=entry$() For n=1 to len(new$) If asc(mid$(new$,n))=8 line$=left$(line$,len(line$)-1) else If ReturnKey() = 0 line$=line$+mid$(new$,n) endif endif next n Clear Entry Buffer return rem Sort all Arrays by Forename SortArraysByForename: Dim TempName$(1, 2) Dim TempAddress$(1, 4) Dim TempCardType$(1) Dim TempRecievedCard$(1) rem Bubble sort into alphabetical order (First letter only) Sorted = 0 LastRecord = NumberofCards While (Lastrecord>1) and (Sorted = 0) Sorted = 1 For T = 1 to NumberofCards-1 If ASC(Lower$(Name$(T, 1)))>Asc(Lower$(Name$((T+1), 1))) rem Sort names TempName$(1, 1) = Name$(T+1, 1) TempName$(1, 2) = Name$(T+1, 2) Name$(T+1, 1) = Name$(T, 1) Name$(T+1, 2) = Name$(T, 2) Name$(T, 1) = TempName$(1, 1) Name$(T, 2) = TempName$(1, 2) rem Sort addresses TempAddress$(1, 1) = Address$(T+1, 1) TempAddress$(1, 2) = Address$(T+1, 2) TempAddress$(1, 3) = Address$(T+1, 3) TempAddress$(1, 4) = Address$(T+1, 4) Address$(T+1, 1) = Address$(T, 1) Address$(T+1, 2) = Address$(T, 2) Address$(T+1, 3) = Address$(T, 3) Address$(T+1, 4) = Address$(T, 4) Address$(T, 1) = TempAddress$(1, 1) Address$(T, 2) = TempAddress$(1, 2) Address$(T, 3) = TempAddress$(1, 3) Address$(T, 4) = TempAddress$(1, 4) rem Sort Cardtype TempCardType$(1) = CardType$(T+1) TempCardType$(1) = CardType$(T+1) CardType$(T+1) = CardType$(T) CardType$(T+1) = CardType$(T) CardType$(T) = TempCardType$(1) CardType$(T) = TempCardType$(1) rem Sort names TempRecievedCard$(1) = RecievedCard$(T+1) TempRecievedCard$(1) = RecievedCard$(T+1) RecievedCard$(T+1) = RecievedCard$(T) RecievedCard$(T+1) = RecievedCard$(T) RecievedCard$(T) = TempRecievedCard$(1) RecievedCard$(T) = TempRecievedCard$(1) Sorted = 0 endif Next T Dec LastRecord Endwhile Undim TempName$(1, 2) Undim TempAddress$(1, 4) Undim TempCardType$(1) Undim TempRecievedCard$(1) GoSub GenerateScreen return rem Sort All arrays by Surname SortArraysBySurname: Dim TempName$(1, 2) Dim TempAddress$(1, 4) Dim TempCardType$(1) Dim TempRecievedCard$(1) rem Bubble sort into alphabetical order (First letter only) Sorted = 0 LastRecord = NumberofCards While (Lastrecord>1) and (Sorted = 0) Sorted = 1 For T = 1 to NumberofCards-1 If ASC(Lower$(Name$(T, 2)))>Asc(Lower$(Name$((T+1), 2))) rem Sort names TempName$(1, 1) = Name$(T+1, 1) TempName$(1, 2) = Name$(T+1, 2) Name$(T+1, 1) = Name$(T, 1) Name$(T+1, 2) = Name$(T, 2) Name$(T, 1) = TempName$(1, 1) Name$(T, 2) = TempName$(1, 2) rem Sort addresses TempAddress$(1, 1) = Address$(T+1, 1) TempAddress$(1, 2) = Address$(T+1, 2) TempAddress$(1, 3) = Address$(T+1, 3) TempAddress$(1, 4) = Address$(T+1, 4) Address$(T+1, 1) = Address$(T, 1) Address$(T+1, 2) = Address$(T, 2) Address$(T+1, 3) = Address$(T, 3) Address$(T+1, 4) = Address$(T, 4) Address$(T, 1) = TempAddress$(1, 1) Address$(T, 2) = TempAddress$(1, 2) Address$(T, 3) = TempAddress$(1, 3) Address$(T, 4) = TempAddress$(1, 4) rem Sort Cardtype TempCardType$(1) = CardType$(T+1) TempCardType$(1) = CardType$(T+1) CardType$(T+1) = CardType$(T) CardType$(T+1) = CardType$(T) CardType$(T) = TempCardType$(1) CardType$(T) = TempCardType$(1) rem Sort names TempRecievedCard$(1) = RecievedCard$(T+1) TempRecievedCard$(1) = RecievedCard$(T+1) RecievedCard$(T+1) = RecievedCard$(T) RecievedCard$(T+1) = RecievedCard$(T) RecievedCard$(T) = TempRecievedCard$(1) RecievedCard$(T) = TempRecievedCard$(1) Sorted = 0 endif Next T Dec LastRecord Endwhile Undim TempName$(1, 2) Undim TempAddress$(1, 4) Undim TempCardType$(1) Undim TempRecievedCard$(1) GoSub GenerateScreen return Help: Create Bitmap 1, 1024, 768 Set Current bitmap 1 Center text 512, 40, "Welcome to the Christmas Card Record Keeper" Center text 512, 80, "Click 'Add Data' to create a new record. The 'Address Line 2' field is optional, but all other fields are required." Center text 512, 100, "Click anywhere along the rtow of the field you want to edit to select it, and then start typing with your keyboard." Center text 512, 120, "Note that you must use Y or N on your keyboard to select whether you recieved a card from the person last year." Center text 512, 140, "Click 'Cancel' to return to the main menu, or 'Apply this data' add the new record." Center text 512, 170, "To Edit an existing record, simply click on it on the main menu. You can then edit it as you would if you were" Center text 512, 190, "adding a new record. If you wish to permanently remove the record, you must manually clear each field of text," Center text 512, 210, "and then click 'Apply this data'. Note that to clear the 'Recieved Card' field you must select it and then" Center text 512, 230, "press C on your keyboard" Center text 512, 260, "Clicking 'Compact Data' will search your database and delete all records on people who didn't send you a card last year." Center text 512, 290, "Clicking 'Sort by Surname' and 'Sort by Forename' will permanently sort the records in the database as the label states." Center text 512, 330, "IMPORTANT: You may only exit by pressing the Escape Key anfd only when you are viewing the Main Menu. This automatically" Center text 512, 350, "saves all the records to a text file ('Christmas card Database.txt') in the same directory as the program or source code file." Center text 512, 420, "Thank you for reading this." Center text 512, 440, "Click the Mouse to Exit" Center text 512, 460, "Merry Christmas!" Copy Bitmap 1, 0 Delete Bitmap 1 Do rem Return to the main menu If MouseClick()>0 Repeat : Until Mouseclick() = 0 GoSub Generatescreen endif Sync Loop return rem ***************** rem Program Functions rem ***************** Function Check And Set The Display Mode() rem Check for 1024x768x32 If Check Display Mode(1024, 768, 32) Set Display Mode 1024, 768, 32 ExitFunction endif rem Check for 1024x768x24 If Check Display Mode(1024, 768, 24) Set Display Mode 1024, 768, 24 ExitFunction endif rem Check for 1024 x 768 x 16 If Check Display Mode(1024, 768, 16) Set Display Mode 1024, 768, 16 ExitFunction endif rem If no valid display formats are found, end the program Exit Prompt "Christmas card records", "Display Format Not Supported!" End EndFunction Function Make Button(x, y, text$) Center Text x, y, "__________" Center text x, y+15, Text$ Center Text x, y+16, "__________" rem Fill in the gaps Text x-43, y, "_" : Text x+35, y, "_" Text x-43, y+16, "_" : Text x+35, y+16, "_" Text x-44, y+15, "|" : Text x+41, y+15, "|" Text x-44, y+13, "|" : Text x+41, y+13, "|" EndFunction Function Make Large Button(x, y, text$) Center Text x, y, "_________________" Center text x, y+15, Text$ Center Text x, y+16, "_________________" rem Fill in the gaps Text x-73, y, "_" : Text x+65, y, "_" Text x-73, y+16, "_" : Text x+65, y+16, "_" Text x-74, y+15, "|" : Text x+71, y+15, "|" Text x-74, y+13, "|" : Text x+71, y+13, "|" EndFunction