Sorry your browser is not supported!

`# Setup
hide mouse
sync on : sync rate 60

`dim menu options
DIM menu$(3)
menu$(0)="Quit"
menu$(1)="New Game"
menu$(2)="Load Game"
menu$(3)="Options"
`dim menu option positions
DIM menupos(2)
menupos(0)= 100
menupos(1)= 240
menupos(2)= 380

set text font "algerian",1

`skip to menu
menu(0,3,1,1)

`# Main Program
print "The game would now begin."
END

`# Functions
FUNCTION menu(min,max,sel,exitsel)
   Repeat
      `input
      old=u+d
      u=upkey() : d=downkey()
      `adjust and bind selection
      if u+d>old then inc sel,d-u
      if sel<min then sel=max
      if sel>max then sel=min
      `get currently displayed options
      if sel-1<min then menu1$=menu$(max) else menu1$=menu$(sel-1)
      menu2$=menu$(sel)
      if sel+1>max then menu3$=menu$(min) else menu3$=menu$(sel+1)
      `display
      ink rgb(128,128,128),0
      set text size 12
      center text 320,100,menu1$
      center text 320,380,menu3$
      ink rgb(255,255,255),0
      set text size 20
      center text 320,240,menu2$
      sync:cls
   Until returnkey()=1 and (sel=exitsel or sel=0)

   if sel=0 then end : `Quit
ENDFUNCTION

`# Setup
hide mouse
sync on : sync rate 60

`dim menu options
DIM menu$(15)
menu$(0)="Quit"
menu$(1)="New Game"
menu$(2)="Load Game"
menu$(3)="Options"
menu$(4)="Game 1" :`Load Game
menu$(5)="Game 2" :`Load Game
menu$(6)="Game 3" :`Load Game
menu$(7)="Game 4" :`Load Game
menu$(8)="Exit" :`Load Game/Options
menu$(9)="Audio" :`Options
menu$(10)="Display" :`Options
menu$(11)="Volume" :`Audio
menu$(12)="Exit" :`Audio/Display
menu$(13)="Graphics Detail" :`Display
menu$(14)="Draw Distance" :`Display
menu$(15)="FOV" :`Display
`dim active menu option positions
DIM menupos(2)
menupos(0)= 100
menupos(1)= 240
menupos(2)= 380

set text font "algerian",1

`skip to menu
menu(0,3,1,1)

`# Main Program
print "The game would now begin."
END

`# Functions
FUNCTION menu(min,max,sel,exitsel)
   REPEAT
      Repeat
         `input
         old=u+d
         u=upkey() : d=downkey()
         `adjust and bind selection
         if u+d>old then inc sel,d-u
         if sel<min then sel=max
         if sel>max then sel=min
         `get currently displayed options
         if sel-1<min then menu1$=menu$(max) else menu1$=menu$(sel-1)
         menu2$=menu$(sel)
         if sel+1>max then menu3$=menu$(min) else menu3$=menu$(sel+1)
         `display
         ink rgb(128,128,128),0
         set text size 12
         center text 320,100,menu1$
         center text 320,380,menu3$
         ink rgb(255,255,255),0
         set text size 20
         center text 320,240,menu2$
         sync:cls
      Until returnkey()=1

      rem crappy delay for single key press
      repeat : until returnkey()=0

      `selected options that aren't exit
      select sel
       case 0 : end : endcase :`Quit
       case 2 : menu(4,8,4,8) : endcase :`Load Game
       case 3 : menu(8,10,9,8) : endcase :`Options
       case 9 : menu(11,12,11,12) : endcase :`Audio
       case 10: menu(12,15,15,12) : endcase :`Display
      endselect
   UNTIL sel=exitsel
ENDFUNCTION

Rem DBC Menu Challenge
Rem TDK_Man December 2007
Rem Hopefully something a little different...

Gosub Setup
Rem Main Program Loop
Do
  If LeftKey()=1 Then Gosub Clockwise
  If RightKey()=1 Then Gosub AntiClockwise
  If ReturnKey()=1 Then Gosub DecodeButton
  Sync
  Ink RGB(255,255,255),0: Center Text 400,580,ButtonText$(CurrentButton)
  Center Text 400,0,"TDK_Man's TR-Style 3D Menu.  Left/Right Cursor Keys To Highlight, Enter Key To Select"
Loop
End

Rem ******************************************************************************************
Rem ***                                    PROCEDURES                                      ***
Rem ******************************************************************************************

DecodeButton:
  Select CurrentButton
    Case 1
      Rem Start Game
      A$="Start Game Selected From The Menu"
    EndCase
    Case 2
      Rem Options
      A$="Options Screen Selected From The Menu"
    EndCase
    Case 3
      Rem Help
      A$="Help Screen Selected From The Menu"
    EndCase
    Case 4
      Rem HiScores
      A$="HiScores Screen Selected From The Menu"
    EndCase
    Case 5
      Rem MultiPlay
      A$="Multiplayer Screen Selected From The Menu"
    EndCase
    Case 6
      Rem Exit Game
      A$="Exit Program Selected From The Menu"
    EndCase
  EndSelect
  Set Camera View 0,0,1,1
  CLS
  Print A$
  Print
  End
Return

Clockwise:
  Rem Rotate Front Row Left
  Hide Object 100
  For N=1 To AngleSpacing
    For I=1 To MenuOptions
      X#(I) = WrapValue(X#(I) + 1)
      Z#(I) = WrapValue(Z#(I) + 1)
      Position Object I, NewXValue(0,X#(I),XDist#),0.0,NewZValue(0,Z#(I),ZDist#)
    Next I
    Sync
  Next N
  Show Object 100
  Dec CurrentButton: If CurrentButton < 1 Then CurrentButton = MenuOptions
  Repeat
  Until LeftKey()=0
Return

AntiClockwise:
  Rem Rotate Front Row Right
  Hide Object 100
  For N=1 To AngleSpacing
    For I=1 To MenuOptions
      X#(I) = WrapValue(X#(I) - 1)
      Z#(I) = WrapValue(Z#(I) - 1)
      Position Object I, NewXValue(0,X#(I),XDist#),0.0,NewZValue(0,Z#(I),ZDist#)
    Next I
    Sync
  Next N
  Show Object 100
  Inc CurrentButton: If CurrentButton > MenuOptions Then CurrentButton = 1
  Repeat
  Until RightKey()=0
Return

Setup:
  Set Display Mode 800,600,16
  Sync On
  Sync Rate 0
  Hide Mouse

  MenuOptions = 9: Rem Number of buttons on menu screen
  Dim ButtonText$(MenuOptions)
  Rem Make sure there are the same number of text labels below as there are MenuOptions
  ButtonText$(1) = "Start Game"
  ButtonText$(2) = "Options"
  ButtonText$(3) = "Help"
  ButtonText$(4) = "HiScores"
  ButtonText$(5) = "MultiPlay"
  ButtonText$(6) = "Exit Game"
  ButtonText$(7) = "Unused"
  ButtonText$(8) = "Unused"
  ButtonText$(9) = "Unused"

  Rem Make Menu Option Textures
  Create Bitmap 1,800,600

  Rem Highlight texture
  CLS 0
  Ink RGB(140,10,80),0
  Box 0,10,300,90: Box 30,0,270,100
  Get Image 101,0,0,300,101

  Rem Main Button texture
  CLS 0
  Ink RGB(240,240,255),0
  Box 0,10,300,90: Box 30,0,270,100
  Ink RGB(90,90,150),0
  Box 1,11,300,90: Box 31,1,270,100
  Ink RGB(120,120,255),0
  Box 1,11,298,88: Box 31,1,268,98
  Get Image 100,0,0,300,101

  Rem Set Font
  Set Text Font "Comic Sans MS",1
  Set Text Size 64

  Rem Buttons
  For N=1 To MenuOptions
    Paste Image 100,0,0
    Ink RGB(0,0,10),0: Center Text 150,15,ButtonText$(N)
    Ink RGB(255,255,255),0: Center Text 149,14,ButtonText$(N)
    Get Image N,0,0,301,101
  Next N

  Set Current Bitmap 0
  Delete Bitmap 1

  Backdrop On
  Color Backdrop 0
  AutoCam Off

  AngleSpacing = 360/MenuOptions
  CurrentButton = 1
  XDist#=6.0: XDistInc=0-AngleInc
  ZDist#=4.0: ZDistInc=AngleInc
  Dim ButtonPosition(MenuOptions)
  Dim X#(MenuOptions)
  Dim Z#(MenuOptions)

  For N=0 To MenuOptions-1
    X#(N+1) = WrapValue(N*AngleSpacing+180.0)
    Z#(N+1) = X#(N+1)
    Make Object Box N+1,3,1,1
    XRotate Object N+1,30
    Texture Object N+1,N+1
    Scale Object N+1,100,100,.1
    Set Object N+1,1,0,1
    Position Object N+1,NewXValue(0,X#(N+1),XDist#),0.0,NewZValue(0,Z#(N+1),ZDist#)
  Next N

  Rem Highlight Current Option
  Make Object Box 100,3,1,1
  Set Object 100,1,0,1
  XRotate Object 100,30
  Texture Object 100,101
  Scale Object 100,100,100,.1
  Ghost Object On 100
  Position Object 100,Object Position X(1),Object Position Y(1),Object Position Z(1)-0.01

  Rem Reset Font
  Set Text Font "Arial",1
  Set Text Size 16

  Position Camera 0,5,-10
  Point Camera 0,0,0
Return

Rem DBC Menu Challenge
Rem TDK_Man December 2007
Rem Hopefully something a little different Number 2...

Gosub Setup
Rem Main Program Loop
Do
  If UpKey()=1 Then Gosub Clockwise
  If DownKey()=1 Then Gosub AntiClockwise
  If ReturnKey()=1 Then Gosub DecodeButton
  Sync
  Ink RGB(255,255,255),0: Center Text 400,580,ButtonText$(CurrentButton)
  Center Text 400,0,"TDK_Man's 3D Rotating Menu V2.  Left/Right Cursor Keys To Highlight, Enter Key To Select"
Loop
End

Rem ******************************************************************************************
Rem ***                                    PROCEDURES                                      ***
Rem ******************************************************************************************

DecodeButton:
  Select CurrentButton
    Case 1
      Rem Start Game
      A$="Start Game Selected From The Menu"
    EndCase
    Case 2
      Rem Options
      A$="Options Screen Selected From The Menu"
    EndCase
    Case 3
      Rem Help
      A$="Help Screen Selected From The Menu"
    EndCase
    Case 4
      Rem HiScores
      A$="HiScores Screen Selected From The Menu"
    EndCase
    Case 5
      Rem MultiPlay
      A$="Multiplayer Screen Selected From The Menu"
    EndCase
    Case 6
      Rem Exit Game
      A$="Exit Program Selected From The Menu"
    EndCase
  EndSelect
  Set Camera View 0,0,1,1
  CLS
  Print A$
  Print
  End
Return

Clockwise:
  Rem Rotate Front Row Left
  Hide Object 100
  For N=1 To AngleSpacing
    For I=1 To MenuOptions
      Y#(I) = WrapValue(Y#(I) + 1)
      Z#(I) = WrapValue(Z#(I) + 1)
      rem Position Object I, NewXValue(0,Y#(I),XDist#),0.0,NewZValue(0,Z#(I),ZDist#)
      Position Object I,0.0,NewYValue(0,Y#(I),YDist#),NewZValue(0,Z#(I),ZDist#)
    Next I
    Sync
  Next N
  Show Object 100
  Dec CurrentButton: If CurrentButton < 1 Then CurrentButton = MenuOptions
  Repeat
  Until LeftKey()=0
Return

AntiClockwise:
  Rem Rotate Front Row Right
  Hide Object 100
  For N=1 To AngleSpacing
    For I=1 To MenuOptions
      Y#(I) = WrapValue(Y#(I) - 1)
      Z#(I) = WrapValue(Z#(I) - 1)
      rem Position Object I, NewXValue(0,Y#(I),XDist#),0.0,NewZValue(0,Z#(I),ZDist#)
      Position Object I,0.0,NewYValue(0,Y#(I),YDist#),NewZValue(0,Z#(I),ZDist#)
    Next I
    Sync
  Next N
  Show Object 100
  Inc CurrentButton: If CurrentButton > MenuOptions Then CurrentButton = 1
  Repeat
  Until RightKey()=0
Return

Setup:
  Set Display Mode 800,600,16
  Sync On
  Sync Rate 0
  Hide Mouse

  MenuOptions = 9: Rem Number of buttons on menu screen
  Dim ButtonText$(MenuOptions)
  Rem Make sure there are the same number of text labels below as there are MenuOptions
  ButtonText$(1) = "Start Game"
  ButtonText$(2) = "Options"
  ButtonText$(3) = "Help"
  ButtonText$(4) = "HiScores"
  ButtonText$(5) = "MultiPlay"
  ButtonText$(6) = "Exit Game"
  ButtonText$(7) = "Unused"
  ButtonText$(8) = "Unused"
  ButtonText$(9) = "Unused"

  Rem Make Menu Option Textures
  Create Bitmap 1,800,600

  Rem Highlight texture
  CLS 0
  Ink RGB(0,255,255),0
  Box 0,10,300,90: Box 30,0,270,100
  Get Image 101,0,0,300,101

  Rem Main Button texture
  CLS 0
  Ink RGB(240,240,255),0
  Box 0,10,300,90: Box 30,0,270,100
  Ink RGB(90,90,150),0
  Box 1,11,300,90: Box 31,1,270,100
  Ink RGB(120,120,255),0
  Box 1,11,298,88: Box 31,1,268,98
  Get Image 100,0,0,300,101

  Rem Set Font
  Set Text Font "Comic Sans MS",1
  Set Text Size 64

  Rem Buttons
  For N=1 To MenuOptions
    Paste Image 100,0,0
    Ink RGB(0,0,10),0: Center Text 150,15,ButtonText$(N)
    Ink RGB(255,255,255),0: Center Text 149,14,ButtonText$(N)
    Get Image N,0,0,301,101
  Next N

  Set Current Bitmap 0
  Delete Bitmap 1

  Backdrop On
  Color Backdrop 0
  AutoCam Off

  AngleSpacing = 360/MenuOptions
  CurrentButton = 1: YDist#=2.0: ZDist#=2.0
  Dim ButtonPosition(MenuOptions)
  Dim Y#(MenuOptions)
  Dim Z#(MenuOptions)

  For N=0 To MenuOptions-1
    Y#(N+1) = WrapValue(N*AngleSpacing+180.0)
    Z#(N+1) = Y#(N+1)
    Make Object Box N+1,3,1,1
    Texture Object N+1,N+1
    Scale Object N+1,100,100,.1
    Set Object N+1,1,0,1
    Position Object N+1,0.0,NewYValue(0,Y#(N+1),YDist#),NewZValue(0,Z#(N+1),ZDist#)
  Next N

  Rem Highlight Current Option
  Make Object Box 100,3,1,1
  Set Object 100,1,0,1
  Texture Object 100,101
  Scale Object 100,100,100,.1
  Ghost Object On 100
  Position Object 100,Object Position X(1),Object Position Y(1),Object Position Z(1)-0.01

  Rem Fading Fog
  Fog On
  Fog Color 0
  Fog Distance 11

  Rem Reset Font
  Set Text Font "Arial",1
  Set Text Size 16

  Position Camera 0,0,-8
  Point Camera 0,0,0
Return

cls
`Menu Array - (menu item,submenu item)
dim MenuOptions$(5,4)
`how many values to read from the menu
dim MenOptCount(5)
gosub setupmendat
sync on

open=0
repeat
cls
if open=0
	for y=1 to 5 : set cursor 10,y*15 : print MenuOptions$(y,0) : next y
	if mouseclick()=1
		if mousex()>10 and mousex()<100
			for y=1 to 5
				if mousey()>(y*15) and mousey()<((y+1)*15) then open=y
			next y
		endif
		repeat : until mouseclick()=0
	endif
else
	for y=1 to open : set cursor 10,y*15 : print MenuOptions$(y,0) : next y
	for y=open+1 to 5 : set cursor 10,(y*15)+(15*MenOptCount(open)) : print MenuOptions$(y,0) : next y
	for y=1 to MenOptCount(open) : set cursor 20,(open+y)*15 : print "- "+MenuOptions$(open,y) : next y
	if mouseclick()=1
		if mousex()>10 and mousex()<100
			for y=1 to open
				if mousey()>(y*15) and mousey()<((y+1)*15) : if open=y : open=0 : else : open=y : endif : endif
			next y
			for y=open+1 to 5
				if mousey()>(15*(y+MenOptCount(open))) and mousey()<(15*(y+MenOptCount(open)+1)) : open=y : endif
			next y
		endif
		repeat : until mouseclick()=0
	endif
endif

if open=2 then contdat#=2
if open=3 then contdat#=3
if open=5 then end

if spacekey()=1 then open=0

sync
until contdat#>0
cls
if contdat#=2 then print "You have selected the Load Game option"
if contdat#=3 then print "You have selected the Help/Instructions option"

suspend for key
end

setupmendat:
`1 - new game:
MenOptCount(1)=4
MenuOptions$(1,0)="New Game"
MenuOptions$(1,1)="Beginner"
MenuOptions$(1,2)="Intermediate"
MenuOptions$(1,3)="Hard"
MenuOptions$(1,4)="Expert"
`2 - load game:
MenOptCount(2)=0
MenuOptions$(2,0)="Load Game"
`3 - help:
MenOptCount(3)=0
MenuOptions$(3,0)="Help/Instructions"
`4 - settings:
MenOptCount(4)=3
MenuOptions$(4,0)="Settings"
MenuOptions$(4,1)="Audio"
MenuOptions$(4,2)="Visual"
MenuOptions$(4,3)="Controls"
`5 - load game:
MenOptCount(5)=0
MenuOptions$(5,0)="Exit"
return

cls
`Menu Array - (menu item,submenu item)
dim MenuOptions$(5,4)
`how many values to read from the menu
dim MenOptCount(5)
gosub setupmendat
sync on

open=0
repeat
  cls
  Center Text 320,0,"Menu Item Selected: "+MenuOptions$(Open,0)
  if open=0
    for y=1 to 5
      set cursor 10,y*15 : print MenuOptions$(y,0)
    next y
    if mouseclick()=1
      if mousex()>10 and mousex()<100
        for y=1 to 5
          if mousey()>(y*15) and mousey()<((y+1)*15) then open=y
        next y
      endif
      repeat
      until mouseclick()=0
    endif
  else
    for y=1 to open
      set cursor 10,y*15 : print MenuOptions$(y,0)
    next y
    for y=open+1 to 5
      set cursor 10,(y*15)+(15*MenOptCount(open)) : print MenuOptions$(y,0)
    next y
    for y=1 to MenOptCount(open)
      set cursor 20,(open+y)*15 : print "- "+MenuOptions$(open,y)
    next y


    if mouseclick()=1
      if mousex()>10 and mousex()<100
        for y=1 to open
          if mousey()>(y*15) and mousey()<((y+1)*15)
            if open=y
              open=0
            else
              open=y
            endif
          endif
        next y
        for y=open+1 to 5
          if mousey()>(15*(y+MenOptCount(open))) and mousey()<(15*(y+MenOptCount(open)+1)) Then open=y
        next y
      endif
      repeat
      until mouseclick()=0
    endif


  endif

  remstart
  if open=2 then contdat#=2
  if open=3 then contdat#=3
  if open=5 then end

  if spacekey()=1 then open=0
  remend
  sync
until contdat#>110
cls
if contdat#=2 then print "You have selected the Load Game option"
if contdat#=3 then print "You have selected the Help/Instructions option"

suspend for key
end

setupmendat:
  `1 - new game:
  MenOptCount(1)=4
  MenuOptions$(1,0)="New Game"
  MenuOptions$(1,1)="Beginner"
  MenuOptions$(1,2)="Intermediate"
  MenuOptions$(1,3)="Hard"
  MenuOptions$(1,4)="Expert"
  `2 - load game:
  MenOptCount(2)=0
  MenuOptions$(2,0)="Load Game"
  `3 - help:
  MenOptCount(3)=0
  MenuOptions$(3,0)="Help/Instructions"
  `4 - settings:
  MenOptCount(4)=3
  MenuOptions$(4,0)="Settings"
  MenuOptions$(4,1)="Audio"
  MenuOptions$(4,2)="Visual"
  MenuOptions$(4,3)="Controls"
  `5 - load game:
  MenOptCount(5)=0
  MenuOptions$(5,0)="Exit"
return

Rem DBC Menu Challenge
Rem TDK_Man December 2007
Rem Sprite Scaling Menu Function

Gosub Setup
Rem Main Program Loop
Do
  Mx=MouseX(): My=MouseY(): Mc=MouseClick()
  Sprite 100,Mx-8,My-8,100
  CurrentButton = Sprite Collision(100,0)
  If CurrentButton > 0
    Gosub ScaleSprite
    If ButtonClicked=1 Then Gosub DecodeButton
  Endif
  Sync
  Center Text 400,0,"TDK_Man's Scaled Sprite Menu."
Loop
End

DecodeButton:
  For N=1 To MenuOptions
    Delete Sprite N
  Next N
  CLS
  Print "Button Selected: ";ButtonText$(CurrentButton)
  Wait Key
  End
Return

ScaleSprite:
 For N=0 To 40 Step 4
   Scale Sprite CurrentButton,100+N
   Sprite CurrentButton,ButtonPosX(CurrentButton)-(N/1.5),ButtonPosY(CurrentButton)-(N/4),CurrentButton
   Sync
 Next N
 ButtonClicked=0
 Repeat
   Mx=MouseX(): My=MouseY(): Mc=MouseClick()
   Sprite 100,Mx-8,My-8,100
   If Mc=1 Then ButtonClicked=1
   Sync
 Until Sprite Collision(100,0)=0 Or ButtonClicked=1
 If ButtonClicked=0
   For N=40 To 0 Step -4
     Scale Sprite CurrentButton,100+N
     Sprite CurrentButton,ButtonPosX(CurrentButton)-(N/1.5),ButtonPosY(CurrentButton)-(N/4),CurrentButton
     Sync
   Next N
 Endif
Return

Setup:
  Set Display Mode 800,600,16
  Sync On
  Sync Rate 0
  MenuOptions = 7: Rem Number of buttons on menu screen
  Dim ButtonPosX(MenuOptions)
  Dim ButtonPosY(MenuOptions)
  Dim ButtonText$(MenuOptions)
  Rem Make sure there are the same number of text labels below as there are MenuOptions
  ButtonText$(0) = "Nothing Selected"
  ButtonText$(1) = "Start Game"
  ButtonText$(2) = "Options"
  ButtonText$(3) = "Help"
  ButtonText$(4) = "HiScores"
  ButtonText$(5) = "MultiPlay"
  ButtonText$(6) = "Exit Game"
  ButtonText$(7) = "Unused"

  Rem Set Font
  Set Text Font "Arial",1
  Set Text Size 32

  Rem Make Menu Option Textures
  Create Bitmap 1,800,600
  CLS RGB(255,255,255)
  Get Image 100,0,0,16,16
  Sprite 100,Mx,My,100
  Hide Sprite 100

  For N=1 To MenuOptions
    CLS 0
    Ink RGB(255,180,180),0: Center Text 74,3,ButtonText$(N)
    Ink RGB(200,0,0),0: Center Text 75,4,ButtonText$(N)
    Get Image N,0,0,151,51
  Next N
  Set Text Opaque

  Set Current Bitmap 0
  Delete Bitmap 1

  VOffset = (600-(MenuOptions*50))/2
  For N=0 To MenuOptions-1
    Sprite N+1,620,N*50+VOffset,N+1
    ButtonPosX(N+1)=620
    ButtonPosY(N+1)=N*50+VOffset
  Next N

  Rem Reset Font
  Set Text Font "Arial",1
  Set Text Size 16
  Ink RGB(255,255,255),0
Return

`ooooooooooooooooooooooooo
` Christmas Card Database
`       By OBese87
`ooooooooooooooooooooooooo

gosub Setup
gosub CreateArrays
gosub MakePersons

SortData(LastName)

`-------------------------
` Main Program
`-------------------------
cls 128
DisplayData()

sync

END

`-------------------------
` Gosubs
`-------------------------
Setup:
hide mouse
sync on
return
`-----
CreateArrays:
   DIM Person$(100,8) :`Don't use Person$(0)!
   `Label Constants
   LastName       = 1
   FirstName      = 2
   AddressLine1   = 3
   AddressLine2   = 4
   AddressTown    = 5
   PostCode       = 6
   SentCard       = 7
   ReceivedCard   = 8
   DIM Sort(100) :`used to sort entries for display
return
`-----
MakePersons:
   Person$(1,LastName)     = "Zidane"
   Person$(1,FirstName)    = "Zinedine"
   Person$(1,AddressLine1) = "5 Legends Place"
   Person$(1,AddressLine2) = "Memory Lane"
   Person$(1,AddressTown)  = "French Town"
   Person$(1,PostCode)     = "ZZ10 8FF"
   Person$(1,SentCard)     = "YES"
   Person$(1,ReceivedCard) = "YES"
   `--
   Person$(2,LastName)     = "Aaronson"
   Person$(2,FirstName)    = "Aaron"
   Person$(2,AddressLine1) = "18 Hill Road"
   Person$(2,AddressLine2) = "~"
   Person$(2,AddressTown)  = "Hill Town"
   Person$(2,PostCode)     = "HL21 9GB"
   Person$(2,SentCard)     = "NO"
   Person$(2,ReceivedCard) = "YES"
   `--
   Person$(3,LastName)     = "Vanner"
   Person$(3,FirstName)    = "Richard"
   Person$(3,AddressLine1) = "3 Creators Park"
   Person$(3,AddressLine2) = "~"
   Person$(3,AddressTown)  = "Gamesville"
   Person$(3,PostCode)     = "BI42 7GC"
   Person$(3,SentCard)     = "YES"
   Person$(3,ReceivedCard) = "NO"
   `--
   Person$(4,LastName)     = "Bamber"
   Person$(4,FirstName)    = "Lee"
   Person$(4,AddressLine1) = "1 Creators Park"
   Person$(4,AddressLine2) = "~"
   Person$(4,AddressTown)  = "Gamesville"
   Person$(4,PostCode)     = "BI23 7GC"
   Person$(4,SentCard)     = "YES"
   Person$(4,ReceivedCard) = "NO"
return

`-------------------------
` Functions
`-------------------------
Function SortData(field)
   DataMax=4

   `Wipe Previous Sort Data
   For clr = 1 to DataMax
      Sort(clr)=0
   Next clr

   `Sort Data
   For entity = 1 to DataMax
      For pos = 1 to DataMax-1
         `Is current position empty?
         If Sort(pos)=0 then Sort(pos)=entity : exit

         `Is selected field less than sorted field?
         If ASC(Person$(entity,field)) < ASC(Person$(Sort(pos),field))
            `shift data to make space for current entity
            For shift = pos to DataMax-1
               Sort(shift+1)=Sort(shift)
            Next shift
            `place current entity in Sort array
            Sort(pos)=entity
            exit
         Endif

         if pos=DataMax-1 then Sort(DataMax)=entity :`If we can't find a place for it then it belongs at the end
      Next pos
   Next ent
EndFunction
`-----
Function DisplayData()
   DataMax=5
   `Label Constants
   LastName       = 1
   FirstName      = 2
   AddressLine1   = 3
   AddressLine2   = 4
   AddressTown    = 5
   PostCode       = 6
   SentCard       = 7
   ReceivedCard   = 8

   For entity = 1 to DataMax
      Print entity ; ".  " ; Person$(Sort(entity),Lastname) ; ", " ; Person$(Sort(entity),FirstName)
   Next entity
EndFunction

`ooooooooooooooooooooooooo
` Christmas Card Database
`       By OBese87
`ooooooooooooooooooooooooo

gosub Setup
gosub CreateArrays
gosub MakePersons

`-------------------------
` Main Program
`-------------------------
SortData(LastName)
cls 128
Print "Sorted by surname."
DisplayData()
sync

wait key

SortData(FirstName)
cls 128
Print "Sorted by first name."
DisplayData()
sync

END

`-------------------------
` Gosubs
`-------------------------
Setup:
hide mouse
sync on
return
`-----
CreateArrays:
   DIM Person$(100,8) :`Don't use Person$(0)!
   `Label Constants
   LastName       = 1
   FirstName      = 2
   AddressLine1   = 3
   AddressLine2   = 4
   AddressTown    = 5
   PostCode       = 6
   SentCard       = 7
   ReceivedCard   = 8
   DIM Sort(100) :`used to sort entries for display
return
`-----
MakePersons:
   Person$(1,LastName)     = "Walker"
   Person$(1,FirstName)    = "Ben"
   Person$(1,AddressLine1) = "5 Regents Park"
   Person$(1,AddressLine2) = "Covent Gardens"
   Person$(1,AddressTown)  = "London"
   Person$(1,PostCode)     = "GU12 5LP"
   Person$(1,SentCard)     = "YES"
   Person$(1,ReceivedCard) = "YES"
   `--
   Person$(2,LastName)     = "Anderson"
   Person$(2,FirstName)    = "Joseph"
   Person$(2,AddressLine1) = "18 Hill Road"
   Person$(2,AddressLine2) = "~"
   Person$(2,AddressTown)  = "Hill Town"
   Person$(2,PostCode)     = "HL21 9GB"
   Person$(2,SentCard)     = "NO"
   Person$(2,ReceivedCard) = "YES"
   `--
   Person$(3,LastName)     = "Vanner"
   Person$(3,FirstName)    = "Richard"
   Person$(3,AddressLine1) = "3 Creators Park"
   Person$(3,AddressLine2) = "~"
   Person$(3,AddressTown)  = "Gamesville"
   Person$(3,PostCode)     = "BI42 7GC"
   Person$(3,SentCard)     = "YES"
   Person$(3,ReceivedCard) = "NO"
   `--
   Person$(4,LastName)     = "Bamber"
   Person$(4,FirstName)    = "Lee"
   Person$(4,AddressLine1) = "1 Creators Park"
   Person$(4,AddressLine2) = "~"
   Person$(4,AddressTown)  = "Gamesville"
   Person$(4,PostCode)     = "BI23 7GC"
   Person$(4,SentCard)     = "YES"
   Person$(4,ReceivedCard) = "NO"
return

`-------------------------
` Functions
`-------------------------
Function SortData(field)
   DataMax=4

   `Wipe Previous Sort Data
   For clr = 1 to DataMax
      Sort(clr)=0
   Next clr

   `Sort Data
   For entity = 1 to DataMax
      For pos = 1 to DataMax-1
         `Is current position empty?
         If Sort(pos)=0 then Sort(pos)=entity : exit

         `Is selected field less than sorted field?
         If ASC(Person$(entity,field)) < ASC(Person$(Sort(pos),field))
            `shift data to make space for current entity
            For shift = DataMax-1 to pos step -1
               Sort(shift+1)=Sort(shift)
            Next shift
            `place current entity in Sort array
            Sort(pos)=entity
            exit
         Endif

         if pos=DataMax-1 then Sort(DataMax)=entity :`If we can't find a place for it then it belongs at the end
      Next pos
      `+++++++BUG EXPOSER+++++++
      cls 128
      for d = 1 to DataMax
         Print d;".  ";Sort(d);": ";Person$(Sort(d),1) ; ", " ; Person$(Sort(d),2)
      next d
      sync
      wait key
      `-------BUG EXPOSER-------
   Next ent
EndFunction
`-----
Function DisplayData()
   DataMax=4
   `Label Constants
   LastName       = 1
   FirstName      = 2
   AddressLine1   = 3
   AddressLine2   = 4
   AddressTown    = 5
   PostCode       = 6
   SentCard       = 7
   ReceivedCard   = 8

   For entity = 1 to DataMax
      Print entity ; ".  " ; Person$(Sort(entity),Lastname) ; ", " ; Person$(Sort(entity),FirstName)
   Next entity
EndFunction

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
Sync on : Sync rate 0
Hide Mouse

rem **********************
rem The All-Important Logo
rem **********************

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"

rem Fade In/Fade out
For T = 1 to 255
   Set Gamma T, T, T
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 shoulfd 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
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

MainProgram:

Do
   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, 3) <> ""
         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, 2)
         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 Scroll through records
   If Scancode() = 0 and Mouseclick() = 0 then Held = 0

   If Held = 0
      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
         Held = 1
      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
         Held = 1
      endif
   endif

   rem Create the Buttons
   Make Button(100, 700, "Add Data")
   Make Button(900, 700, "Help")
   Make Large Button(512, 700, "Compact Data")

   rem Clicking the buttons


   rem Refresh the screen
   Text 890, 680, "Current FPS: " + Str$(Screen FPS())
   sync : cls
Loop



rem *******************
rem Program Subroutines
rem *******************

NewRecord:
Do
   Text 10, 2, "Add a new record"
   rem Refresh the screen
   sync : cls
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

`------------------------
` Panes
` By Obese87
`------------------------
`------------------------
` SETUP
`------------------------
set display mode 1024,768,16
hide mouse
sync on : sync rate 0

`colours
DIM colour(3)
colour(0) = rgb(255,255,255)
colour(1) = rgb(100,100,255)
colour(2) = rgb(0,0,128)
colour(3) = rgb(0,0,64)

`Windows
DIM win(1,4)
win(1,0) = 1 : `0 = closed >1 = order (1 at front)
win(1,1) = 50 : `window x origin
win(1,2) = 100 : `window y origin
win(1,3) = 200 : `window width
win(1,4) = 200 : `window height

set text font "courier new",1
set text size 14

`------------------------
` MAIN LOOP
`------------------------
DO
`* Control
If mouseclick() = 1
   repeat : until mouseclick() = 0

   If action > 0 : `stop current action
      action = 0
   Else : `new action
      if mousey() > win(1,2) and Mousey() < win(1,2)+15 : `title bar actions
         if mousex() > win(1,1) and mousex() < (win(1,1)+win(1,3))-40 : `main title bar click = move window
            action = 1
         endif
         if mousex() > (win(1,1)+win(1,3))-32 and mousex() < (win(1,1)+win(1,3))-18 : `resize window
            position mouse win(1,1)+win(1,3),win(1,2)+win(1,4) : `set mouse to bottom left of window
            action = 2
         endif
         if mousex() > (win(1,1)+win(1,3))-18 and mousex() < (win(1,1)+win(1,3))-2 : `close window
            win(1,0) = 1-win(1,0) : `pretty stupid as toggling would obviously be impossible!
         endif
      endif
   Endif
Endif

`----
`* Calculations
SELECT action
   case 1 : move_win(1) : endcase
   case 2 : resize_win(1) : endcase
ENDSELECT

bind_win(1)

`----
`* Display
cls colour(3)
print screen fps()

`if window visible then draw it
if win(1,0) = 1
   draw_win(win(1,1),win(1,2),win(1,1)+win(1,3),win(1,2)+win(1,4),"Welcome To The Agency","Welcome agent. Get to work!")
endif
mouse(mousex(),mousey()) : `control mouse cursor
sync
LOOP

`------------------------
` FUNCTIONS
`------------------------
`Draw Mouse Cursor
FUNCTION mouse(x,y)
   ink colour(0),0
   dline(x,y,x,y+3,1) : dline(x,y,x+3,y,1) : dline(x,y,x+5,y+5,1)
ENDFUNCTION

`Draw Window
FUNCTION draw_win(l,t,r,b,title$,body$)
   ink colour(2),0
   box l,t,r,b : `window background

   ink colour(1),0
   box l+1,t+1,r-1,t+15 : `title bar
   wire_box(l+2,t+17,r-2,b-2,1) : `frame
   wire_box(r-17,t+17,r-2,b-2,1) : `scroll bar frame
   wire_box(r-17,t+17,r-2,t+31,1) : `top scroll button frame
   wire_box(r-17,t+17,r-2,b-16,1) : `bottom scroll button frame

   ink colour(0),0
   wire_box(r-30,t+4,r-22,t+12,2) : wire_box(r-30,t+4,r-24,t+10,1) : `resize button
   dline(r-12,t+8,r-8,t+8,1) : `close button
   dline(r-12,t+25,r-10,t+23,1) : dline(r-10,t+23,r-8,t+25,1) : `top scroll button
   dline(r-12,b-10,r-10,b-8,1) : dline(r-10,b-8,r-8,b-10,1) : `top scroll button
   title$ = clip_string(title$,win(1,3)-40)
   body$ = clip_string(body$,win(1,3)-25)
   text l+4,t+1,title$ : `title (add clipping if title is too long [Welc...])
   text l+6,t+21,body$ : `text box (add wordwrap and scrolling)
ENDFUNCTION

`Draw Wireframe Rectangle
FUNCTION wire_box(l,t,r,b,s)
   dline(l,t,r,t,s) : dline(r,t,r,b,s) : dline(r,b,l,b,s) : dline(l,b,l,t,s) : `clockwise box
ENDFUNCTION

`Dotted Line
FUNCTION dline(l,t,r,b,sp) : `sp=1 normal, sp=2 dotted
   w = r-l : h = b-t
   if w >= 0 then xstep = 1*sp else xstep = -1*sp
   if h >= 0 then ystep = 1*sp else ystep = -1*sp
   w# = ABS(w) : h# = ABS(h)
   if w#=0 then w#=0.1
   if h#=0 then h#=0.1
   xfact# = w#/h#
   yfact# = h#/w#

   x = 0 : y = 0
   repeat
      `don't overshoot
      if abs(x+xstep) > abs(w) then xstep = 0
      if abs(y+ystep) > abs(h) then ystep = 0

      dot x+l,y+t
      if yfact# > xfact#
         inc y,ystep
         if ABS(x) < ABS(y*xfact#) then inc x,xstep
      else
         inc x,xstep
         if ABS(y) < ABS(x*yfact#) then inc y,ystep
      endif
   until xstep = 0 and ystep = 0
ENDFUNCTION

`Bind Window To Screen
FUNCTION bind_win(w)
   `bind size
   if win(w,3) < 100 then win(w,3) = 100
   if win(w,4) < 50 then win(w,4) = 50
   `bind position
   if win(w,1)+win(w,3) > screen width()-1 then win(w,1)=(Screen width()-1-win(w,3))
   if win(w,2)+win(w,4) > screen height()-1 then win(w,2)=(Screen height()-1-win(w,4))
ENDFUNCTION

`Move Window
FUNCTION move_win(w)
   win(w,1) = mousex()
   win(w,2) = mousey()
ENDFUNCTION

`Re-Size Window
FUNCTION resize_win(w)
   mx = mousex() : my = mousey()
   win(w,3) = mx - win(w,1)
   win(w,4) = my - win(w,2)
ENDFUNCTION

`Clip String
FUNCTION clip_string(main$,width)
   While text width(main$) > width
      main$ = left$(main$,len(main$)-4)
      main$ = main$ + "..."
   Endwhile
ENDFUNCTION main$

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 gives 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



rem **********************
rem The All-Important Logo
rem **********************
remstart
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"

rem Fade In/Fade out
For T = 1 to 255
   Set Gamma T, T, T
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
remend


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
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 Scroll through records
   If Scancode() = 0 and Mouseclick() = 0 then Held = 0

   If Screenmode = 0
      If Held = 0
         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
            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
            Held = 1
            GoSub GenerateScreen
         endif

         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
                  GoTo MainProgram
               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

                  For T = 1 to NumberOfCards
                     If RecievedCard$(T) = "No"
                        Name$(T, 1) = "" : Name$(T, 2) = ""
                        Address$(T, 1) = "" : Address$(T, 2) = "" : Address$(T, 3) = "" : Address$(T, 4) = ""
                        CardType$(T) = ""
                        RecievedCard$(T) = ""
                     endif
                  Next T

                  rem Now compact the Data
                  For T = 1 to CardLimit
                     If Name$(T, 1) = "" and Name$(T+1, 1) <> ""
                        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)
                     endif
                  Next T

                  rem Return to data screen
                  GoSub GenerateScreen
               endif
               Sync
            Loop
         endif
      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, 3) <> ""
         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, 2)
         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 Button(900, 700, "Help")
   Make Large Button(512, 700, "Compact Data")

   rem Refresh the screen
   Text 890, 680, "Current FPS: " + Str$(Screen FPS())

   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

   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, 3) <> ""
         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, 2)
         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


   Make Large Button(512, 700, "Apply This Data")

   Copy Bitmap 1, 0
   Delete Bitmap 1
   GoTo MainProgram
return



rem *******************
rem Program Subroutines
rem *******************

NewRecord:
Do
   Text 10, 2, "Add a new record"
   rem Refresh the screen
   sync : cls
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

gosub makeGUI
copy bitmap 1,0
set current bitmap 0
gosub prepArray
sync on

set text size 10
do
gosub showdata
set cursor 400,400
`print testing data
sync
loop




function eBox(x1,y1,x2,y2)
line x1,y1,x1,y2
line x1,y1,x2,y1
line x2,y1,x2,y2
line x2,y2,x1,y2
endfunction




showdata:
copy bitmap 1,0
ink rgb(200,200,200),0
for t=0 to (nEnt-1)
	Text 10,50+(t*15),Detail$(t,1)
next t
ink rgb(255,255,255),0
Text 10,50+(selected*15),Detail$(selected,1)
For t=0 to 4
	Text 400,100+(t*20),Detail$(selected,t+1)
next t
text 570,180,Detail$(selected,6)
if mousey()>50 and mousey()<470 and mousex()<320
	if mouseclick()=1
		selected=INT((mousey()-50)/15)
	endif
endif
rty=0
sty=0
rly=0
sly=0
brs$=bin$(Val(Detail$(selected,0)))
lrs=LEN(brs$)
If Val(Mid$(brs$,lrs-3))=1 then rty=1
If Val(Mid$(brs$,lrs-2))=1 then sty=1
If Val(Mid$(brs$,lrs-1))=1 then rly=1
If Val(Mid$(brs$,lrs))=1 then sly=1
if rty=1 then box 452,45,458,51
if sty=1 then box 602,45,608,51
if rly=1 then box 452,65,458,71
if sly=1 then box 602,65,608,71
return



prepArray:
dim Detail$(49,6)
nEnt=2
Detail$(0,0)="11"
Detail$(0,1)="Smith, Frank"
Detail$(0,2)="15 Poo Street"
Detail$(0,3)="Weebum Village"
Detail$(0,4)="Bottom"
Detail$(0,5)="England"
Detail$(0,6)="NE346HZ"

Detail$(1,0)="7"
Detail$(1,1)="Jones, Bernard"
Detail$(1,2)="82 Goodheart Lane"
Detail$(1,3)="Birmingham"
Detail$(1,5)="England"
Detail$(1,6)="GQ388Z"
return


makeGUI:
create bitmap 1,640,480
set text font "arial"
ink rgb(100,100,100),0
box 0,0,639,30
ink rgb(255,255,255),0
set text size 16
center text 320,0,"Christmas Card List"
line 0,30,639,30
line 320,30,320,479
set text size 10
text 330,40,"Recieved This Year" : eBox(450,43,460,53)
text 510,40,"Sent This Year" : eBox(600,43,610,53)
text 330,60,"Recieved Last Year" : eBox(450,63,460,73)
text 510,60,"Sent Last Year" : eBox(600,63,610,73)
text 330,100,"Name:"  : eBox(390,100,630,116)
text 330,120,"Address:"  : eBox(390,120,630,136)  : eBox(390,140,630,156)  : eBox(390,160,630,176)  
text 330,180,"Country:" : eBox(390,180,495,196) : text 502,180,"Postcode:" : eBox(565,180,630,196)
line 320,230,639,230
line 320,250,639,250
line 320,255,639,255
line 320,275,639,275
line 320,280,639,280
line 320,300,639,300
line 320,305,639,305
line 320,325,639,325
line 320,330,639,330
line 320,350,639,350
set text size 14
center text 480,230,"+ ADD CONTACT +"
center text 480,255,"+ EDIT CONTACT DETAILS +"
center text 480,280,"+ DELETE CONTACT +"
center text 480,305,"+ SAVE DATABASE +"
center text 480,330,"+ ORDER ALPHABETICALLY +"
for t=50 to 470 step 15
	line 0,t,300,t
next t
`displays 28 on screen at once
line 300,50,300,470
eBox(300,50,320,70)
eBox(300,450,320,470)
ink rgb(200,200,200),0
box 301,51,319,69
box 301,451,319,469
return

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
   ReceivedCard$(Cardlimit) : Did you recieve a card from them last year?
remend



rem ****************
rem Startup commands
rem ****************

rem 1024x 768 display mode - still gives 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



rem **********************
rem The All-Important Logo
rem **********************
remstart
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"

rem Fade In/Fade out
For T = 1 to 255
   Set Gamma T, T, T
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
remend


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 ReceivedCard$(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, ReceivedCard$(T)
   Next T
Else
   `Obese's Data
   DataMax=10
   ddd:
   Data "Martin", "Adams", "11 Brook Street", "Chiswick", "Shropshire", "SH12 8JU", "Yes", "No"
   Data "James", "Kelly", "5 Brook Street", "Chiswick", "Shropshire", "SH12 5TE", "Yes", "Yes"
   Data "Sophie", "Richards", "24 Arthurs Court", "Bristol", "Dorset", "BR6 1TY", "Yes", "Yes"
   Data "Terry", "Harrison", "Flat 2 Reading House", "Barnstable", "Wiltshire", "SP9 8RF", "No", "Yes"
   Data "Arnold", "Palmer", "1 The Views", "Maidstone", "Kent", "KT43 3RT", "No", "Yes"

   For D = 1 to DataMax
      if D=6 then restore ddd
      Read Name$(D,1) : Read Name$(D,2)
      Read Address$(D,1) : Read Address$(D,2) : Read Address$(D,3) : Read Address$(D,4)
      Read CardType$(D) : Read ReceivedCard$(D)
   Next D
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 Scroll through records
   If Scancode() = 0 and Mouseclick() = 0 then Held = 0

   If Screenmode = 0
      If Held = 0
         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
            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
            Held = 1
            GoSub GenerateScreen
         endif

         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
                  GoTo MainProgram
               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

                  For T = 1 to NumberOfCards
                     If ReceivedCard$(T) = "No"
                        Name$(T, 1) = "" : Name$(T, 2) = ""
                        Address$(T, 1) = "" : Address$(T, 2) = "" : Address$(T, 3) = "" : Address$(T, 4) = ""
                        CardType$(T) = ""
                        ReceivedCard$(T) = ""
                     endif
                  Next T

                  rem Now compact the Data
                  For T = 1 to CardLimit
                     If Name$(T, 1) = "" and Name$(T+1, 1) <> ""
                        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)
                        ReceivedCard$(T) = ReceivedCard$(T+1)
                     endif
                  Next T

                  rem Return to data screen
                  GoSub GenerateScreen
               endif
               Sync
            Loop
         endif
      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, 3) <> ""
         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, 2)
         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, ReceivedCard$(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 Button(900, 700, "Help")
   Make Large Button(512, 700, "Compact Data")

   rem Refresh the screen
   Text 890, 680, "Current FPS: " + Str$(Screen FPS())

   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

   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, 3) <> ""
         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, 2)
         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, ReceivedCard$(T)

      Inc Counter
   Next T


   Make Large Button(512, 700, "Apply This Data")

   Copy Bitmap 1, 0
   Delete Bitmap 1
   GoTo MainProgram
return



rem *******************
rem Program Subroutines
rem *******************

NewRecord:
Do
   Text 10, 2, "Add a new record"
   rem Refresh the screen
   sync : cls
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

NewRecord:
Do
   Text 10, 2, "Add a new record"
   rem Refresh the screen
   sync : cls
Loop
return

if mouseclick()=1 and timer()-waitbtn>250
  waitbtn=timer()
  Print "Would scroll down a record"
endif

`ooooooooooooooooooooooooo
` Christmas Card Database
`       By OBese87
`ooooooooooooooooooooooooo

gosub Setup
gosub CreateArrays
gosub MakePersons

`-------------------------
` Main Program
`-------------------------
SortData(LastName)
cls 128
Print "Sorted by surname."
DisplayData()
sync

wait key

SortData(FirstName)
cls 128
Print "Sorted by first name."
DisplayData()
sync

END

`-------------------------
` Gosubs
`-------------------------
Setup:
hide mouse
sync on
return
`-----
CreateArrays:
   DIM Person$(100,9) :`Don't use Person$(0)!
   `Label Constants
   LastName       = 1
   FirstName      = 2
   AddressLine1   = 3
   AddressLine2   = 4
   AddressTown    = 5
   AddressCounty  = 6
   PostCode       = 7
   SentCard       = 8
   ReceivedCard   = 9
   DIM Sort(100) :`used to sort entries for display
return
`-----
MakePersons:
   DataMax=7
   Data "Palmer","Luke","2 Hillside","Abbotts Ann","Andover","Hampshire","~","NO","NO"
   Data "Powell","Thomas","151 Bury Hill Close","Anna Valley","Andover","Hampshire","SP11 7LL","NO","NO"
   Data "Spencer","Thomas","22 Winchester Road","","Andover","Hampshire","~","NO","NO"
   Data "Jackson","Laurianne","76 Tavistock Road","~","Fleet","Hampshire","~","NO","NO"
   Data "Burt","Andrew","12 Stoney Court","Stoney Lane","Winchester","Hampshire","~","NO","NO"
   Data "Burto","Andre","12 Stoney Court","Stoney Lane","Winchester","Hampshire","~","NO","NO"
   Data "Spence","Laura","12 Stoney Court","Stoney Lane","Winchester","Hampshire","~","NO","NO"

   For e = 1 to DataMax
      For f = 1 to 9
         read Person$(e,f)
      Next f
   Next e
return

`-------------------------
` Functions
`-------------------------
Function SortData(field)
   DataMax=7

   `Wipe Previous Sort Data
   For clr = 1 to DataMax
      Sort(clr)=0
   Next clr

   `Sort Data
   For entity = 1 to DataMax
      For pos = 1 to DataMax-1
         `Is current position empty?
         If Sort(pos)=0 then Sort(pos)=entity : exit

         `Check for lower characters
         newc=1
         Repeat
            c=newc
            If ASC(mid$(Person$(entity,field),c)) < ASC(mid$(Person$(Sort(pos),field),c)) or c=Len(Person$(entity,field))
               `shift data to make space for current entity
               For shift = DataMax-1 to pos step -1
                  Sort(shift+1)=Sort(shift)
               Next shift
               `place current entity in Sort array
               Sort(pos)=entity
               `reset for loop for new entity
               pos=DataMax
            Else
               If ASC(mid$(Person$(entity,field),c)) = ASC(mid$(Person$(Sort(pos),field),c)) then newc=c+1
            Endif
         Until newc=c

         if pos=DataMax-1 then Sort(DataMax)=entity :`If we can't find a place for it then it belongs at the end
      Next pos
      `+++++++BUG EXPOSER+++++++
      cls 128
      for d = 1 to DataMax
         Print d;".  ";Sort(d);": ";Person$(Sort(d),1) ; ", " ; Person$(Sort(d),2)
      next d
      sync
      wait key
      `-------BUG EXPOSER-------
   Next entity
EndFunction
`-----
Function DisplayData()
   DataMax=10
   `Label Constants
   LastName       = 1
   FirstName      = 2
   AddressLine1   = 3
   AddressLine2   = 4
   AddressTown    = 5
   PostCode       = 6
   SentCard       = 7
   ReceivedCard   = 8

   For entity = 1 to DataMax
      Print entity ; ".  " ; Person$(Sort(entity),Lastname) ; ", " ; Person$(Sort(entity),FirstName)
   Next entity
EndFunction

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

Gosub Setup
Set Text Opaque
Do
  Mx=MouseX(): My=MouseY(): Mc=MouseClick(): Sc=ScanCode()
  Sprite 500,Mx,My,500
  If Sc <> 0 Then Gosub DecodeKey
  OverButton = Sprite Collision(500,0)
  If Mc=1 And OverButton > 0
    Sprite OverButton,Sprite X(OverButton),Sprite Y(OverButton),OverButton+1000
    Repeat
      Sync
    Until MouseClick()=0
    Gosub DecodeButton
    Sprite OverButton,Sprite X(OverButton),Sprite Y(OverButton),OverButton
    Sync
  Endif
  Sync
Loop
End

Rem ****************  Procedures  ****************

DecodeKey:
  Select Sc
    Case 24
      Rem Options
    EndCase
    Case 31
      Rem Sort
    EndCase
    Case 33
      Rem Find
    EndCase
    Case 46
      Rem Clear All
    EndCase
    Case 19
      Rem Remove
      rem Gosub EditBox
      Gosub RedrawGrid
      Gosub FillData
    EndCase
    Case 30
      Rem About
      rem Gosub AboutBox
      Gosub RedrawGrid
      Gosub FillData
    EndCase
    Case 16
      Rem Quit
      For N=1 To 15
        Delete Sprite N
      Next N
      CLS 0
      End
    EndCase
    Case 18
      Rem Edit
      Gosub EditBox
      Gosub RedrawGrid
      Gosub FillData
    EndCase
    Case 49
      Rem New Record
      Gosub InputBox
      Gosub RedrawGrid
      Gosub FillData
    EndCase
    Case 200
      Rem Previous Record
      Dec CurrentRec: If CurrentRec < 1 Then CurrentRec = 1
      Gosub RedrawGrid
      Gosub FillData
    EndCase
    Case 203
      Rem First Record
      CurrentRec = 1
      Gosub RedrawGrid
      Gosub FillData
    EndCase
    Case 205
      Rem Last Record
      CurrentRec = TotalRecs
      Gosub RedrawGrid
      Gosub FillData
    EndCase
    Case 208
      Rem Next Record
      Inc CurrentRec: If CurrentRec > TotalRecs Then CurrentRec = TotalRecs
      Gosub RedrawGrid
      Gosub FillData
    EndCase
  EndSelect
  Repeat
  Until ScanCode()=0
Return

DecodeButton:
  Select OverButton
    Case Clear

    EndCase
    Case 2
    EndCase
    Case 3
    EndCase
    Case Find

    EndCase
    Case Sort
      Print "Sort"
    EndCase
    Case 6
    EndCase
    Case 7
    EndCase
    Case Options

    EndCase
    Case About
      Print "About"
    EndCase
    Case Quit
      For N=1 To 15
        Delete Sprite N
      Next N
      CLS 0
      End
    EndCase
    Case FirstRec
      CurrentRec = 1
      Gosub RedrawGrid
      Gosub FillData
    EndCase
    Case PrevRec
      Dec CurrentRec: If CurrentRec < 1 Then CurrentRec = 1
      Gosub RedrawGrid
      Gosub FillData
    EndCase
    Case Add
      Gosub InputBox
    EndCase
    Case Remove

    EndCase
    Case Edit
      Gosub EditBox
    EndCase
    Case NextRec
      Inc CurrentRec: If CurrentRec > TotalRecs Then CurrentRec = TotalRecs
      Gosub RedrawGrid
      Gosub FillData
    EndCase
    Case LastRec
      CurrentRec = TotalRecs
      Gosub RedrawGrid
      Gosub FillData
    EndCase
  EndSelect
Return

RedrawGrid:
  Ink BCol,0: Box 0,81,799,559
  Rem Grey Lines
  Ink LCol,0
  For N=0 To 9
    Line TabStops(N),64,TabStops(N),559
  Next N
  For N=0 To 29
    Line 0,N*16+80,799,N*16+80
  Next N
Return

FillData:
  Ink TCol,BCol
  For N=0 To 29
    RecN$ = Str$(N+1)
    While Len(RecN$)<3
      RecN$="0"+RecN$
    EndWhile
    Text TabStops(0)+2,N*16+80,RecN$
    Text TabStops(1)+2,N*16+80,Data$(N+Offset+1,1)
    Text TabStops(2)+2,N*16+80,Data$(N+Offset+1,2)
    Text TabStops(3)+2,N*16+80,Data$(N+Offset+1,3)
    Text TabStops(4)+2,N*16+80,Data$(N+Offset+1,4)
    Text TabStops(5)+2,N*16+80,Data$(N+Offset+1,5)
    Text TabStops(6)+2,N*16+80,Data$(N+Offset+1,6)
    Text TabStops(7)+2,N*16+80,Data$(N+Offset+1,7)
    Text TabStops(8)+2,N*16+80,Data$(N+Offset+1,8)
    Text TabStops(9)+2,N*16+80,Data$(N+Offset+1,9)
  Next N
  Set Text Opaque
  Ink 0,RGB(192,192,192): Text 4,2,"Total Records: "+Str$(TotalRecs)+"  "
  Set Text Transparent
  If CurrentRec > 0 then Text 0,(CurrentRec-1)*16+82,"*"
  Sync
Return

SaveData:
  If File Exist("Cards.bak") = 1 Then Delete File "Cards.bak"
  If File Exist("Cards.dat") = 1 Then Rename File "Cards.dat","Cards.bak"
  Open To Write 1,"Cards.dat"
    Write String 1,Str$(TotalRecs)
    For N=1 To TotalRecs
      Write String 1,Data$(N,1)
      Write String 1,Data$(N,2)
      Write String 1,Data$(N,3)
      Write String 1,Data$(N,4)
      Write String 1,Data$(N,5)
      Write String 1,Data$(N,6)
      Write String 1,Data$(N,7)
      Write String 1,Data$(N,8)
      Write String 1,Data$(N,9)
    Next N
  Close File 1
Return

LoadData:
  If File Exist("Cards.dat") = 1
    Open To Read 1,"Cards.dat"
      Read String 1,T$
      TotalRecs = VAL(T$)
      For N=1 To TotalRecs
        Read String 1,T$: Data$(N,1) = T$
        Read String 1,T$: Data$(N,2) = T$
        Read String 1,T$: Data$(N,3) = T$
        Read String 1,T$: Data$(N,4) = T$
        Read String 1,T$: Data$(N,5) = T$
        Read String 1,T$: Data$(N,6) = T$
        Read String 1,T$: Data$(N,7) = T$
        Read String 1,T$: Data$(N,8) = T$
        Read String 1,T$: Data$(N,9) = T$
      Next N
    Close File 1
    CurrentRec=1: Offset=0
  Endif
Return

Alert:
Return

InputBox:
  BoxHeight = Fields*20+70: BoxTop = (600-BoxHeight)/2
  Ink RGB(255,255,255),0: Box 250,BoxTop,550,BoxTop+BoxHeight
  Ink 0,0: Box 251,BoxTop+1,550,BoxTop+BoxHeight-1
  Ink RGB(192,192,192),0: Box 251,BoxTop+1,549,BoxTop+BoxHeight-2
  Set Text Transparent
  Ink 0,0: Center Text 400,BoxTop+4,"Add New Record"
  For N=0 To Fields-1
    BoxYPos = N*22+BoxTop+25
    If DataType$(N+1)="T" Then BoxWid = 210
    If DataType$(N+1)="Y" Then BoxWid = 24
    Ink RGB(128,128,128),0: Box 330,BoxYPos,330+BoxWid+1,BoxYPos+20
    Ink RGB(255,255,255),0: Box 331,BoxYPos+1,331+BoxWid,BoxYPos+20
    Ink 0,0: Box 331,BoxYPos+1,331+BoxWid-1,BoxYPos+19
    Ink RGB(255,255,255),0: Text 255,BoxYPos+2,Data$(0,N+1)+":"
  Next N
  Sprite 18,400-ButtonWidth,BoxTop+BoxHeight-24,18
  Sprite 19,405,BoxTop+BoxHeight-24,19
  For N=0 To Fields-1
    TempField$(N)=""
  Next N
  ExitBox=False: CurrentBox=0: TextXPos = 334
  TextYPos = CurrentBox*22+BoxTop+26
  Ink RGB(255,255,255),0
  Repeat
    Mx=MouseX(): My=MouseY(): Mc=MouseClick(): Sc=ASC(Inkey$())
    If Sc > 0
      If Sc=8
        L=Len(TempField$(CurrentBox))
        TempField$(CurrentBox)=Left$(TempField$(CurrentBox),L-1)
      Else
        If Sc=13 Or Sc=9
          Rem Enter or Tab Key
          Ink 0,0: Box 331,TextYPos,331+BoxWid-1,TextYPos+18: Rem Blank Edit Box
          Ink RGB(255,255,255),0: Text TextXPos,TextYPos,TempField$(CurrentBox)
          Inc CurrentBox: If CurrentBox = Fields Then CurrentBox=0
          TextYPos = CurrentBox*22+BoxTop+26
        Else
          TempField$(CurrentBox)=TempField$(CurrentBox)+Chr$(Sc)
        Endif
      Endif
      Repeat
      Until ScanCode()=0
    Endif
    If DataType$(CurrentBox+1)="T" Then BoxWid = 210
    If DataType$(CurrentBox+1)="Y" Then BoxWid = 24
    Ink 0,0: Box 331,TextYPos,331+BoxWid-1,TextYPos+18
    Ink RGB(255,255,255),0: Text TextXPos,TextYPos,TempField$(CurrentBox)+"|"
    Sprite 500,Mx,My,500
    OverButton2 = Sprite Collision(500,0)
    If Mc=1 And OverButton2 = 18
      Rem OK
      Sprite OverButton2,Sprite X(OverButton2),Sprite Y(OverButton2),OverButton2+1000
      Inc TotalRecs: CurrentRec = TotalRecs
      For N=1 To Fields
        Data$(CurrentRec,N) = TempField$(N-1)
      Next N
      Gosub SaveData
      ExitBox=True
    Endif
    If Mc=1 And OverButton2 = 19
      Rem Cancel
      Sprite OverButton2,Sprite X(OverButton2),Sprite Y(OverButton2),OverButton2+1000
      ExitBox=True
      For N=1 To Fields
        TempField$(N) = ""
      Next N
    Endif
    Sync
  Until ExitBox=True
  Repeat
    Sync
  Until MouseClick()=0
  Sprite 18,-100,0,18: Sprite 19,-100,0,19
  Gosub RedrawGrid
  Gosub FillData
Return

EditBox:
  BoxHeight = Fields*20+70: BoxTop = (600-BoxHeight)/2
  Ink RGB(255,255,255),0: Box 250,BoxTop,550,BoxTop+BoxHeight
  Ink 0,0: Box 251,BoxTop+1,550,BoxTop+BoxHeight-1
  Ink RGB(192,192,192),0: Box 251,BoxTop+1,549,BoxTop+BoxHeight-2
  Set Text Transparent
  Ink 0,0: Center Text 400,BoxTop+4,"Edit Record"
  For N=0 To Fields-1
    TempField$(N)=Data$(CurrentRec,N+1)
  Next N
  For N=0 To Fields-1
    BoxYPos = N*22+BoxTop+25
    If DataType$(N+1)="T" Then BoxWid = 210
    If DataType$(N+1)="Y" Then BoxWid = 24
    Ink RGB(128,128,128),0: Box 330,BoxYPos,330+BoxWid+1,BoxYPos+20
    Ink RGB(255,255,255),0: Box 331,BoxYPos+1,331+BoxWid,BoxYPos+20
    Ink 0,0: Box 331,BoxYPos+1,331+BoxWid-1,BoxYPos+19
    Ink RGB(255,255,255),0: Text 255,BoxYPos+2,Data$(0,N+1)+":"
    Text 334,BoxYPos+2,TempField$(N)
  Next N
  Sprite 18,400-ButtonWidth,BoxTop+BoxHeight-24,18
  Sprite 19,405,BoxTop+BoxHeight-24,19
  ExitBox=False: CurrentBox=0: TextXPos = 334
  TextYPos = CurrentBox*22+BoxTop+26
  Ink RGB(255,255,255),0
  Repeat
  Until Inkey$()=""
  Repeat
    Mx=MouseX(): My=MouseY(): Mc=MouseClick(): Sc=ASC(Inkey$())
    If Sc > 0
      If Sc=8
        L=Len(TempField$(CurrentBox))
        TempField$(CurrentBox)=Left$(TempField$(CurrentBox),L-1)
      Else
        If Sc=13 Or Sc=9
          Rem Enter or Tab Key
          Ink 0,0: Box 331,TextYPos,331+BoxWid-1,TextYPos+18: Rem Blank Edit Box
          Ink RGB(255,255,255),0: Text TextXPos,TextYPos,TempField$(CurrentBox)
          Inc CurrentBox: If CurrentBox = Fields Then CurrentBox=0
          TextYPos = CurrentBox*22+BoxTop+26
        Else
          TempField$(CurrentBox)=TempField$(CurrentBox)+Chr$(Sc)
        Endif
      Endif
      Repeat
      Until ScanCode()=0
    Endif
    If DataType$(CurrentBox+1)="T" Then BoxWid = 210
    If DataType$(CurrentBox+1)="Y" Then BoxWid = 24
    Ink 0,0: Box 331,TextYPos,331+BoxWid-1,TextYPos+18
    Ink RGB(255,255,255),0: Text TextXPos,TextYPos,TempField$(CurrentBox)+"|"
    Sprite 500,Mx,My,500
    OverButton2 = Sprite Collision(500,0)
    If Mc=1 And OverButton2 = 18
      Rem OK
      Sprite OverButton2,Sprite X(OverButton2),Sprite Y(OverButton2),OverButton2+1000
      rem Inc TotalRecs: CurrentRec = TotalRecs
      For N=1 To Fields
        Data$(CurrentRec,N) = TempField$(N-1)
      Next N
      Gosub SaveData
      ExitBox=True
    Endif
    If Mc=1 And OverButton2 = 19
      Rem Cancel
      Sprite OverButton2,Sprite X(OverButton2),Sprite Y(OverButton2),OverButton2+1000
      ExitBox=True
      For N=1 To Fields
        TempField$(N) = ""
      Next N
    Endif
    Sync
  Until ExitBox=True
  Repeat
    Sync
  Until MouseClick()=0
  Sprite 18,-100,0,18: Sprite 19,-100,0,19
  Gosub RedrawGrid
  Gosub FillData
Return

Setup:
  Set Display Mode 800,600,16
  Sync On
  Sync Rate 0
  Set Gamma 0,0,0
  CLS RGB(255,255,255)
  Get Image 500,0,0,3,3
  Wait 20

  Rem Top/Bottom Panels
  Ink RGB(255,255,255),0: Box 0,0,799,63: Box 0,560,799,599
  Ink 0,0: Box 2,2,799,63: Box 2,562,799,599
  Ink RGB(192,192,192),0: Box 2,2,797,61: Box 2,562,797,597

  Set Text Font "Verdana",1
  Set Text Size 32
  Ink RGB(255,255,255),0: Center Text 400,2,"TDK's Christmas Card Database"
  Ink RGB(0,0,0),0: Center Text 401,3,"TDK's Christmas Card Database"
  Wait 20: Set Text Size 16

  NumButtons=17: ButtonWidth=75
  Clear=1: Find=4: Sort=5: Options=8: About=9: Quit=10
  FirstRec=11: PrevRec=12: Add=13: Remove=14: Edit=15: NextRec=16: LastRec=17
  BCol=RGB(255,200,200): LCol=RGB(192,192,192): TCol=0
  CurrentRec=0: TotalRecs=0: Fields=9
  True=1: False=0

  Dim TempField$(20)
  Dim ButtonLabels$(NumButtons)
  Create Bitmap 1,320,200
  rem Top Buttons
  For N=0 To 9
    Read ButtonLabels$(N)
    Button(N+1,N*(ButtonWidth+4)+7,40,ButtonWidth,20,ButtonLabels$(N))
  Next N
  rem Bottom Buttons
  For N = 10 To NumButtons-1
    Read ButtonLabels$(N)
    Button(N+1,(N-9)*(ButtonWidth+4)+50,570,ButtonWidth,20,ButtonLabels$(N))
  Next N

  Button(18,-100,BoxTop+BoxHeight-24,ButtonWidth,20,"OK")
  Button(19,-100,BoxTop+BoxHeight-24,ButtonWidth,20,"Cancel")

  Set Current Bitmap 0
  Delete Bitmap 1
  Set Text Opaque

  Dim Data$(999,9)
  Dim DataType$(9): Rem A=AutoIncrement  T=Text  Y=Yes/No
  Data$(0,0) = "#": DataType$(0)="A"
  Data$(0,1) = "Name": DataType$(1)="T"
  Data$(0,2) = "Address": DataType$(2)="T"
  Data$(0,3) = "Town": DataType$(3)="T"
  Data$(0,4) = "County": DataType$(4)="T": Rem <<< US users change this to "State"
  Data$(0,5) = "Country": DataType$(5)="T"
  Data$(0,6) = "Postcode": DataType$(6)="T": Rem <<< US users change this to "Zip"
  Data$(0,7) = "Telephone": DataType$(7)="T"
  Data$(0,8) = "R": DataType$(8)="Y"
  Data$(0,9) = "S": DataType$(9)="Y"

  Dim TabStops(9)
  Ink RGB(0,128,0),0: Box 0,64,799,80
  Ink RGB(255,255,255),RGB(0,128,0)
  For N=0 To 9
    Read TabStops(N)
    Text TabStops(N)+2,64,Data$(0,N)
  Next N
  Gosub LoadData
  Set Text Transparent
  Gosub RedrawGrid
  Gosub FillData
  Set Gamma 255,255,255
Return

Rem ****************  Functions  ****************

Function Button(ButtonNum,XPos,YPos,Width,Height,Label$)
  Rem Button Up
  CLS 0
  Ink RGB(255,255,255),0: Box 0,0,Width-1,Height-1
  Ink 0,0: Box 1,1,Width-1,Height-1
  Ink RGB(192,192,192),0: Box 1,1,Width-2,Height-2
  Rem Text Label Up
  Ink RGB(10,10,10),0: Center Text Width/2,2,Label$
  Get Image ButtonNum,0,0,Width,Height
  Rem Button Down
  CLS 0
  Ink 0,0: Box 0,0,Width-1,Height-1
  Ink RGB(255,255,255),0: Box 1,1,Width-1,Height-1
  Ink RGB(192,192,192),0: Box 1,1,Width-2,Height-2
  Rem Text Label Down
  Ink RGB(255,255,255),0: Center Text Width/2+1,3,Label$
  Get Image ButtonNum+1000,0,0,Width,Height
  Sprite ButtonNum,XPos,YPos,ButtonNum
  Set Sprite ButtonNum,0,0
EndFunction

Data "Clear","","","Find","Sort","","","Options","Help","Quit"
Data "|<","<","New","Delete","Edit",">",">|"
Data 10,40,160,310,400,500,580,650,764,782

remstart
   ==============================================================
   =  Title  : Address data base
   =  Author : latch
   =  Date   : 12/30/2007
   =  Update :
   =  Version:
   ==============================================================
   Comments    Simple array storage of names and addresses
   ==============================================================
remend

rem =============================================================
rem = SET UP DISPLAY
rem =============================================================
   autocam off
   set display mode 800,600,32
   sync on
   sync rate 60

rem =============================================================
rem = MAIN
rem =============================================================
   gosub _init
   do
      gosub _menu


      sync
   loop

   end

rem =============================================================
rem = SUBROUTINES - PROCEDURES
rem =============================================================
   _init:
      rem increase maxrec to increase the number of names to store
      rem each record will hold 8 fields - how you fill the fields
      rem is up to you
      rem suggestions:
      rem address(0) = name 1
      rem address(1) = name 2
      rem address(2) = apartment/flat
      rem address(3) = street
      rem address(4) = city, state prov codes etc
      rem address(5) = country, codes
      rem address(6) = misc
      rem address(7) = misc

      maxrec=100
      dim ncount(0)
      dim address$(maxrec,7)
      dim temp$(maxrec,7)

      set text font "courier new",1
      set text size 20

   return

`----------------------------------------------------------------
   _menu:
      text 0,0,"1.    Load Records"
      text 0,20,"2.    Add Records"
      text 0,40,"3.    View Records"
      text 0,60,"4.    Remove Record"
      text 0,80,"5.    Save Records"

      choose$="Type Number of Selection  : "
      text 0,120,choose$
      sync
      num=scancode()-1
      if num < 1 or num > 5 then goto _menu
      repeat
         sync
      until scancode()=0

      select num
         case 1
            set cursor 0,160
            Input "Enter Name of File to Load  : ";filename$
            result=load_records(filename$)
            if result=0
               print "File ";filename$;" does not exist"
               print "press Space"
               repeat
                  sync
               until spacekey()=1
               cls : goto _menu
            endif
         endcase
         case 2
            cls
            text 0,0,"ADD RECORDS"
            text 0,40,"Field 1 :"
            temp$=""
            while asc(inkey$())<>13
               if inkey$()<>""
                  temp$=temp$+inkey$()
                  repeat
                     sync
                  until scancode()=0
                  text 100,40,temp$
               endif
            endwhile
            address$(0)=temp$
            temp$=""
            text 0,60,"Field 2 :"
            text 0,80,"Field 3 :"
            text 0,100,"Field 4 :"
            text 0,120,"Field 5 :"
            text 0,140,"Field 6 :"
            text 0,160,"Field 7 :"
            text 0,180,"Field 8 :"

            sync
            wait key
         endcase

      endselect
   return



rem =============================================================
rem = FUNCTIONS
rem =============================================================
   function add_record(field1$,field2$,field3$,field4$,field5$,field6$,field7$,field8$)
      rem empty fields leave function
      if field1$ = "" and field2$="" and field3$="" and field4$=""
         if field5$="" and field6$="" and field7$="" and field8$=""
            exitfunction
         endif
      endif

      rem assign fields
      address$(0)=field1$
      address$(1)=field2$
      address$(2)=field3$
      address$(3)=field4$
      address$(4)=field5$
      address$(5)=field6$
      address$(6)=field7$
      address$(7)=field8$

      rem increase record count
      ncount(0)=ncount(0)+1
   endfunction
`----------------------------------------------------------------
   function get_record_count()
      result=ncount(0)
   endfunction result
`----------------------------------------------------------------
   function edit_record(record,field,value$)
      rem change a the value of a field in a record
      if record < 1 then record=1
      if field < 0 then field=1
      if field > 8 then field=8
      address$(record,field-1)=value$
   endfunction
`----------------------------------------------------------------
   function remove_record(record)
      rem remove a record from address$()
      rem return new record count
      tempcount=0
      for rec=1 to ncount(0)
         inc tempcount
         if rec=record then inc rec
         for field=0 to 7
             temp$(tempcount,field)=address$(rec,field)
         next field
      next rec

      for rec=1 to ncount(0)
         for field=0 to 7
            address$(rec,field)=temp$(rec,field)
         next field
      next rec

      ncount(0)=ncount(0)-1
      result=ncount(0)
   endfunction result
`----------------------------------------------------------------
   function save_records(filename$,replace)
      if replace > 1 then replace = 1
      if replace <=0 then replace = 0
      if file exist(filename$)=1 and replace=0
         bmp=1
         while bitmap exist(bmp)
            inc bmp
         endwhile
         create bitmap bmp,400,200
         cls rgb(255,0,0)
         oldf$=text font$()
         olds=text size()
         set text font "system",1
         set text size 32
         wait 0
         err$="FILE EXISTS - press any key"
         text 0,0,err$
         img=23000
         get image img,0,0,text width(err$)+1,text height(err$)
         sprite img,(screen width()/2)-(text width(err$)/2),(screen height()/2)-(text height(err$)/2),img
         wait key
         delete bitmap bmp
         delete sprite img
         delete image img
         set current bitmap 0
         set text font oldf$,1
         set text size olds
         sync
         exitfunction
      endif

      if file exist(filename$)=1
         delete file filename$
         save array filename$,address$(maxrec)
      endif
   endfunction
`----------------------------------------------------------------
   function load_records(filename$)
      result=0
      if file exist(filename$)=1
         load array filename$,address$(maxrec)
         result=1
      endif
   endfunction result
`----------------------------------------------------------------




rem =============================================================
rem = DATA STATEMENTS
rem =============================================================

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