'===========================================================================
' Subject: EVENT REMINDER/CALENDAR           Date: 01-28-99 (22:19)       
' Author:  Wayne L.                          Code: QB, QBasic, PDS        
' Origin:  twenyaw@netactive.co.za         Packet: DATETIME.ABC
'===========================================================================
DECLARE SUB AboutEv ()
DECLARE SUB EvList ()
DECLARE SUB CopyFile (InFile$, OutFile$)
DECLARE SUB TbNotes ()
DECLARE SUB TicOver (Tic%)
DECLARE SUB EvPrint ()
DECLARE SUB EvSort ()
DECLARE SUB DumKey ()
DECLARE SUB EvAdd (AdEd%)
DECLARE SUB EvDel ()
DECLARE SUB DataWrite ()
DECLARE SUB CenterTxT (Row%, Fg%, Bg%, TxT$)
DECLARE SUB RegEv ()
DECLARE FUNCTION LeapYear% (Year%)
DECLARE SUB RowRoll (TxT$, Fg%, Bg%, Row%, Col%, Tic!)
DECLARE SUB EvStats ()
DECLARE FUNCTION Rpad$ (TxT$, MaxLen%)
DECLARE SUB ShowHelp ()
DECLARE SUB DrawScreen ()
DECLARE FUNCTION Crunch$ (TexT$, TxT$)
DECLARE FUNCTION DayWeek$ (DateX$)
DECLARE SUB DataRead ()
DECLARE FUNCTION Date2Year% (DateX$)
DECLARE FUNCTION Date2Month% (DateX$)
DECLARE FUNCTION Date2Day% (DateX$)
DECLARE FUNCTION DateSerial& (DateX$)
DECLARE FUNCTION Serial2Date$ (Serial&)
DECLARE FUNCTION MDY2Date$ (Month%, Day%, Year%)
DECLARE SUB SoundRep (Pl%, Tim%)
DECLARE SUB TempFile ()
DECLARE FUNCTION DeCode$ (TxT$)
DECLARE FUNCTION Code$ (t$)
DECLARE FUNCTION MsgBox$ (TxT$, Fg%, Hdr$, Allowed$)
DECLARE FUNCTION SayGet$ (TxT$, r%, c%, Fg%, Bg%, FLength%)
DECLARE SUB GetKey ()
DECLARE SUB ScreenRest (t%, l%, b%, r%, buff$)
DECLARE FUNCTION ScreenSave$ (t%, l%, b%, r%)
DECLARE SUB DrawBox (t%, l%, b%, r%, Fg%, Bg%, InOut%, Heading$, shado%, btype%)
DECLARE FUNCTION Lzero$ (Num%, Length%)
DECLARE FUNCTION CalDisp$ (Dtemp$)
'
' Thanks to all that have helped me in QBasic (i.e  William Yu & Ethan Winer)
' who made QBasic more simple to understand.
' To everyone else that I have not mentioned whose code and programming
' skills helped me write this program.
'
' Written with QB4.5 using Pentuim 166 - To register see SUB RegEv LINE 39
' This utility is for anyone to use - * FREEWARE *
' If someone can improve the code, decrease its size or
' who may have any comments please send me email. . . .
'
'            To:-  twenyaw@netactive.co.za
'
' Special thanks to MarkB who is a great programmer & a good friend :-)
'
'
DEFINT A-Z

CONST F1 = 59, F2 = 60, ESC = 27, INS = 82, DEL = 83
 CONST AltE = 18, AltP = 25, AltL = 38, AltS = 31, AltX = 45, AltF = 33
  CONST AroUp = 72, AroDn = 80, AroL = 75, AroR = 77, PgUp = 73, PgDn = 81
	CONST CHome = 71, CEnd = 79, AltF1 = 104, AltQ = 16, AltR = 19, AltA = 30

TYPE dbHeader
	HRecs AS LONG
	hDate AS STRING * 10
	hTime AS STRING * 8
	hName AS STRING * 20
	HRegN AS STRING * 20
	HRegi AS STRING * 9
	HNull AS STRING * 18
END TYPE

TYPE dbRecord
	dbDay AS STRING * 2
	dbMonth AS STRING * 2
	dbYear AS STRING * 4
	dbTag1 AS STRING * 2
	dbTag2 AS STRING * 2
	dbTag3 AS STRING * 2
	dbNote1 AS STRING * 35
	dbNote2 AS STRING * 35
	dbTnull AS STRING * 7
END TYPE

TYPE tbHeader
	Trecs AS LONG
	TDate AS STRING * 10
	TTime AS STRING * 8
	TNull AS STRING * 48
END TYPE

TYPE TbNotes
	tbName AS STRING * 75
END TYPE

DIM tb AS TbNotes, tbhd AS tbHeader, tbRecs, tbCurrent
 DIM db AS dbRecord, hd AS dbHeader, k$, k1, k2, Trecs
  DIM Day$(7), Months$(12), Days(12)

RESTORE DaysData
	FOR f = 1 TO 7: READ Day$(f): NEXT 'f
RESTORE MonthsData
	FOR f = 1 TO 12: READ Months$(f): NEXT 'f
RESTORE MonthEnd
	FOR f = 1 TO 12: READ Days(f): NEXT 'f

OPEN "C:\EVDATA._EV" FOR RANDOM AS #1 LEN = 91

GET #1, 1, hd
	Trecs = hd.HRecs
IF Trecs < 1 THEN
	TempFile
END IF

IF DeCode$(hd.HRegN) = "Unregistered" + (SPACE$(20 - LEN("Unregistered"))) THEN
 IF Trecs >= 5 THEN Trecs = 5
ELSE
	Trecs = hd.HRecs
END IF

IF COMMAND$ = "" THEN
GOTO ReStart
ELSEIF COMMAND$ = "." THEN
COLOR 7, 1: CLS
	EvList
GOTO TheEnd
	END IF

ReStart:
COLOR 7, 1: CLS
	DrawScreen
	
Choice = 1: Index = 1: Bott = Trecs: Rows = 10: Row = 4: Colm = 1

StartMenu:
	DumKey
IF DeCode$(hd.HRegN) = "Unregistered" + (SPACE$(20 - LEN("Unregistered"))) THEN
CALL CenterTxT(24, 30, 1, "* Unregistered *")
END IF

LOCATE 3, 72, 0: COLOR 3, 1: Tm$ = LEFT$(TIME$, 5)
	t% = VAL(Tm$): Tm$ = MID$(Tm$, INSTR(Tm$, ":")): am$ = "am"
	IF t% = 0 THEN t% = 12 ELSE IF t% > 12 THEN t% = t% - 12: am$ = "pm"
	Tm$ = RIGHT$(STR$(t%), 2) + Tm$: PRINT Tm$ + " " + am$;

FOR g = 0 TO Rows
IF g + Index <= Trecs THEN
	GET #1, g + Index + 1, db
	TempTxT$ = DeCode$(db.dbDay) + "-" + DeCode$(db.dbMonth) + "-" + DeCode$(db.dbYear)
	 TempTxT$ = TempTxT$ + DeCode$(db.dbNote1) + " " + LEFT$(DeCode$(db.dbNote2), 35)
END IF
	TxT$ = Crunch$(TempTxT$, " ")
IF Choice = (g + Index) THEN
	COLOR 15, 11: LOCATE Row + g, Colm, 0: PRINT TxT$ + SPACE$(80 - LEN(TxT$))
	GET #1, Choice + 1, db
	COLOR 13, 1
	IF DeCode$(db.dbTag1) = "01" THEN LOCATE 3, 1: PRINT "þ";  ELSE LOCATE 3, 1: PRINT " ";
	 IF DeCode$(db.dbTag2) = "01" THEN LOCATE 3, 4: PRINT "þ";  ELSE LOCATE 3, 4: PRINT " ";
	  'IF DeCode$(db.dbTag3) = "01" THEN LOCATE 3, 7: PRINT "þ";  ELSE LOCATE 3, 7: PRINT " ";
	  
ELSE
IF (g + Index) <= Bott THEN
	LOCATE Row + g, Colm: COLOR 7, 1
	PRINT TxT$ + SPACE$(80 - LEN(TxT$))
END IF
 END IF
IF (g + Index) > Bott THEN
	LOCATE Row + g, Colm: COLOR 7, 1
	PRINT SPACE$(80)
END IF
NEXT 'g

LoopMenu:
DO
	GetKey
SELECT CASE k2
CASE AltE
	Current = Choice
	DataRead
	EvAdd (0)
	CALL RowRoll("ú ù Main Menu ù ú", 11, 1, 23, 40, 10)

CASE DEL
	Current = Choice
	DataRead
	EvDel
	Bott = Trecs: Choice = 1: Index = 1
GOTO StartMenu

CASE INS
	EvAdd (1)
	Bott = Trecs
	CALL RowRoll("ú ù Main Menu ù ú", 11, 1, 23, 40, 10)

CASE CHome
	IF Choice = 1 AND Index = 1 THEN GOTO LoopMenu
	Choice = 1: Index = 1

CASE CEnd
IF Choice = Bott THEN GOTO LoopMenu
	Choice = Bott: Index = Bott - Rows
IF Index < 1 THEN Index = 1

CASE AroUp
IF Choice = 1 AND Index = 1 THEN GOTO LoopMenu
	Choice = Choice + (Choice > 1)
IF Choice < Index THEN Index = Choice

CASE AroDn
IF Choice = Bott THEN GOTO LoopMenu
	Choice = Choice - (Choice < Bott)
IF Index < (Choice - Rows) THEN Index = Choice - Rows

CASE PgUp
IF Choice = 1 AND Index = 1 THEN GOTO LoopMenu
	Choice = Choice - Rows: Index = Index - Rows
IF Choice < 1 THEN Choice = 1
 IF Index < 1 THEN Index = 1

CASE PgDn
IF Choice = Bott THEN GOTO LoopMenu
	Choice = Choice + Rows: Index = Index + Rows
 IF Choice + Rows > Bott THEN Choice = Bott: Index = Bott - Rows
 IF Index <= 0 THEN Index = 1: Choice = Bott

CASE AltX
CHDIR "C:\": COLOR 7, 0: CLS
	LOCATE 1, 1: PRINT "Event v1.1b"
	PRINT "Type EXIT to return to menu !": PRINT
	PLAY "MNT255L64O2CDEGB>DEFGA"
SHELL
GOTO ReStart
CASE F1
	ShowHelp

CASE F2
CALL DrawBox(17, 5, 19, 21, 15, 2, 0, "Find", 1, 1)
	FTxT$ = SayGet$("", 18, 6, 14, 2, 15)
	 FTxT$ = UCASE$(RTRIM$(FTxT$))
CALL DrawBox(17, 3, 21, 21, 1, 1, 0, "", 0, 0)
IF k1 = 27 OR FTxT$ = "" THEN GOTO StartMenu
FOR f = 1 TO Trecs
Current = f
DataRead
IF INSTR(UCASE$(db.dbDay + db.dbMonth + db.dbYear + db.dbNote1 + db.dbNote2), FTxT$) <> 0 THEN
	Current = f: Choice = Current: Index = Choice
GOTO StartMenu
END IF
NEXT 'f

CASE AltF1
	EvStats

CASE AltR
	RegEv
IF DeCode$(hd.HRegN) = "Unregistered" + (SPACE$(20 - LEN("Unregistered"))) THEN
 IF Trecs >= 5 THEN Trecs = 5
ELSE
	Trecs = hd.HRecs
END IF
GOTO ReStart

CASE AltS
	EvSort
	Choice = 1: Index = 1
GOTO StartMenu

CASE AltP
	EvPrint

CASE AltA
	AboutEv
GOTO ReStart

CASE ELSE
IF k2 = AltQ THEN GOTO TheEnd
 IF k2 = 38 THEN EvList: GOTO ReStart
  IF k1 = 96 THEN
	TbNotes
GOTO ReStart
END IF
 END SELECT

GOTO StartMenu
LOOP

TheEnd:
CLOSE #1
SCREEN 0, 0, 0: COLOR 7, 0: CLS
	PRINT "Thank You !"
END

MonthsData:
	DATA "January  ","Febuary  ","March    ","April    ","May      ","June     "
	 DATA "July     ","August   ","September","October  ","November ","December "
MonthEnd:
	DATA 31,28,31,30,31,30,31,31,30,31,30,31
DaysData:
	DATA "Sunday   " ,"Monday   ","Tuesday  ","Wednesday","Thursday ","Friday   ","Saturday "

AboutTxT:
DATA "1412 About Event 1.1b . . . . .","0101  "
 DATA "1101 This is a simple EVENT - CALENDER type program, which is very easy to use."
  DATA "1101 Keys used INSERT ,DELETE ,HOME ,END ,ESC ,ENTER ,PGUP ,PGDOWN & ARROWS."
	DATA "1101  . . . . . and some FUNCTION Keys.
	 DATA "1101           "
DATA "1101 All dates entered will be displayed on the Main Menu,"
 DATA "1101 but if you start the program with EV [.] then only the dates relevant to"
  DATA "1101 that month will be shown. (providing that the dates are TAGGED)
	DATA "1101 Tagday will show record daily,while Tagmonth will show the record on the DD/MM."
	 DATA"1201 If not TAGGED record shown = today,tomorrow,this week,this month.
	  DATA "1101    "
DATA "1503 Another utility of EVENT is Note Taker . . . . ."
 DATA "0701 This is started with the ~ key. (this key is above the TAB key)"
  DATA "0701 Keys used INSERT ,DELETE ,HOME ,END ,ESC ,ENTER ,PGUP ,PGDOWN & ARROWS."
	DATA "0701     "
	 DATA "0701 Use this to take extra notes, addresses ,telephone numbers or any information."
	  DATA "0701     "
		DATA "1401    [ Please remember all data is saved in files EVDATA._EV and TBDATA._EV ]"

SUB AboutEv
CLS
CALL DrawBox(1, 1, 2, 80, 9, 1, 1, "", 0, 1)
 CALL DrawBox(24, 1, 25, 80, 9, 1, 1, "", 0, 1)

RESTORE AboutTxT
	FOR f = 1 TO 19
	READ TempAbout$
	About$ = RIGHT$(TempAbout$, LEN(TempAbout$) - 4)
	Fg = VAL(LEFT$(TempAbout$, 2))
	Bg = VAL(MID$(TempAbout$, 3, 2))
	About$ = About$ + SPACE$(80 - LEN(About$))
CALL RowRoll(About$, Fg, Bg, 2 + f, 1, 2)

NEXT 'f

CALL CenterTxT(24, 14, 1, " Press any key ")
GetKey

END SUB

FUNCTION CalDisp$ (Dtemp$)

SHARED k$, k1, k2, Days(), Months$()

CALL DrawBox(4, 6, 13, 38, 14, 10, 1, "", 1, 2)
	LOCATE 5, 12: COLOR 15, 10: PRINT " Mon Tue Wed Thu Fri Sat "
	 LOCATE 5, 8: COLOR 1, 10: PRINT " Sun"
GOSUB DateInfo
SOUND 450, .15

Redraw:

	Dtemp$ = Lzero$(Tmonth, 2) + "-" + Lzero$(Tday, 2) + "-" + Lzero$(Tyear, 4)

GOSUB DateInfo
	Cola = DayOne * 4 + 9: Rowa = 6: Mend = Days(Tmonth)
 IF Leap = -1 THEN Mend = 29
IF Days(Tmonth) < Tday THEN Tday = Mend

FOR f = 1 TO Mend
IF f = Tday THEN
	COLOR 14, 12
ELSE
	COLOR 0, 10
END IF

LOCATE Rowa, Cola: PRINT f;
IF Cola >= 30 THEN Rowa = Rowa + 1: Cola = 5
	Cola = Cola + 4
NEXT 'f
	LOCATE 12, 16: COLOR 14, 10
	PRINT Crunch$(Months$(Tmonth) + STR$(Tyear), " ") + "     "

Redo:
DO
	GetKey
SELECT CASE k2
CASE 59 TO 68
	Tmonth = k2 - 58
	CALL DrawBox(6, 7, 12, 36, 14, 10, 0, "", 0, 0)
GOTO Redraw

CASE 133, 134
	Tmonth = k2 - 122
	CALL DrawBox(6, 7, 12, 36, 14, 10, 0, "", 0, 0)
GOTO Redraw

CASE CHome
IF Tday = VAL(MID$(DATE$, 4, 2)) AND Tmonth = VAL(LEFT$(DATE$, 2)) AND Tyear = VAL(RIGHT$(DATE$, 4)) THEN
GOTO Redo
ELSE
	Tday = VAL(MID$(DATE$, 4, 2)): Tmonth = VAL(LEFT$(DATE$, 2))
	Tyear = VAL(RIGHT$(DATE$, 4))
END IF

CALL DrawBox(6, 7, 12, 36, 14, 10, 0, "", 0, 0)
GOTO Redraw
CASE AroUp
	Rowa = Rowa - 1: Tday = Tday - 7
IF Tday < 1 THEN Tday = Mend
GOTO Redraw

CASE AroDn
	Rowa = Rowa + 1: Tday = Tday + 7
IF Tday > Mend THEN Tday = 1
GOTO Redraw

CASE PgUp
	Tmonth = Tmonth + 1
IF Tmonth > 12 THEN Tmonth = 1: Tyear = Tyear + 1
 IF Tyear > 2050 THEN Tyear = 1950
CALL DrawBox(6, 7, 12, 36, 14, 10, 0, "", 0, 0)
GOTO Redraw

CASE PgDn
	Tmonth = Tmonth - 1
IF Tmonth < 1 THEN Tmonth = 12: Tyear = Tyear - 1
 IF Tyear < 1950 THEN Tyear = 2050
CALL DrawBox(6, 7, 12, 36, 14, 10, 0, "", 0, 0)
GOTO Redraw

CASE AroL
	Cola = Cola - 1: Tday = Tday - 1
IF Tday < 1 THEN Tday = Mend
GOTO Redraw

CASE AroR
	Cola = Cola + 1: Tday = Tday + 1
IF Tday > Mend THEN Tday = 1
GOTO Redraw

CASE ELSE
IF k1 = 13 THEN
	CalDisp$ = Lzero$(Tmonth, 2) + "-" + Lzero$(Tday, 2) + "-" + Lzero$(Tyear, 4)
EXIT DO
END IF
IF k1 = 27 THEN GOTO EndCal

END SELECT
LOOP
GOTO EndCal

DateInfo:
	Tday = VAL(MID$(Dtemp$, 4, 2)): Tmonth = VAL(LEFT$(Dtemp$, 2))
	Tyear = VAL(RIGHT$(Dtemp$, 4))
	Done$ = (Lzero$(Tmonth, 2) + "-01-" + Lzero$(Tyear, 4))
	DayOne = ((DateSerial&(Done$) MOD 7) + 1)
	IF Tmonth = 2 THEN
	Leap = LeapYear(Tyear)
	ELSE
	Leap = 0
	END IF
	IF DayOne = 7 THEN DayOne = 0
RETURN

EndCal:

END FUNCTION

SUB CenterTxT (Row, Fg, Bg, TxT$)

COLOR Fg, Bg
	Tl = LEN(TxT$): Tl = INT((80 - Tl) / 2)
LOCATE Row, Tl: PRINT TxT$;

END SUB

FUNCTION Code$ (t$)
  
	Seed = 7: TxT$ = ""

FOR f = 1 TO LEN(t$)
	x = ASC(MID$(t$, f, 1))
	 x = x + Seed
DO WHILE x > 255
	x = x - 200
LOOP

	TxT$ = TxT$ + CHR$(x)
	Seed = Seed + ASC(MID$(t$, f, 1))

NEXT 'f

	Code$ = TxT$

END FUNCTION

SUB CopyFile (InFile$, OutFile$)

SHARED Trecs
CHDIR "C:\"

	File1% = FREEFILE
	OPEN InFile$ FOR BINARY AS #File1%
	File2% = FREEFILE
	OPEN OutFile$ FOR BINARY AS #File2%
	BytesRemaining& = LOF(File1%)
	Whole& = LOF(File1%): BarEnd& = Trecs

	DO
		IF BytesRemaining& > 4096 THEN
		  ThisPass = 4096
		ELSE
		  ThisPass = BytesRemaining&
		END IF
		Buffer$ = SPACE$(ThisPass)
		GET #File1%, , Buffer$
		PUT #File2%, , Buffer$
		BytesRemaining& = BytesRemaining& - ThisPass

		 IF BytesRemaining& = 0 THEN GOTO CloseCopy
	LOOP WHILE BytesRemaining&

CloseCopy:
	CLOSE #File1%, #File2%

END SUB

FUNCTION Crunch$ (TexT$, TxT$)

	Temp$ = "": x = 1
WHILE x <= LEN(TexT$)
	a$ = MID$(TexT$, x, 1)
	Temp$ = Temp$ + a$
IF a$ = TxT$ THEN
WHILE MID$(TexT$, x, 1) = TxT$
	x = x + 1
WEND
ELSE
	x = x + 1
END IF
WEND

	Crunch$ = Temp$

END FUNCTION

SUB DataRead

SHARED db AS dbRecord, Current

	GET #1, Current + 1, db

LSET db.dbDay = DeCode$(db.dbDay)
 LSET db.dbMonth = DeCode$(db.dbMonth)
  LSET db.dbYear = DeCode$(db.dbYear)
	LSET db.dbNote1 = DeCode$(db.dbNote1)
	 LSET db.dbNote2 = DeCode$(db.dbNote2)

END SUB

SUB DataWrite

SHARED hd AS dbHeader, db AS dbRecord, Current, Trecs

LSET db.dbDay = Code$(db.dbDay)
 LSET db.dbMonth = Code$(db.dbMonth)
  LSET db.dbYear = Code$(db.dbYear)
	LSET db.dbNote1 = Code$(db.dbNote1)
	 LSET db.dbNote2 = Code$(db.dbNote2)

	PUT #1, Current + 1, db

	TDate$ = (MID$(DATE$, 4, 2) + "-" + LEFT$(DATE$, 2) + "-" + RIGHT$(DATE$, 4))
	hd.HRecs = Trecs

LSET hd.hDate = Code$(TDate$)
 LSET hd.hTime = Code$(TIME$)

	PUT #1, 1, hd

END SUB

FUNCTION Date2Day% (DateX$)
  
	Date2Day% = VAL(MID$(DateX$, 4))

END FUNCTION

FUNCTION Date2Month% (DateX$)

	Date2Month% = VAL(DateX$)

END FUNCTION

FUNCTION Date2Year% (DateX$)

	Date2Year% = VAL(MID$(DateX$, 7))

END FUNCTION

FUNCTION DateSerial& (DateX$)

	Month% = Date2Month%(DateX$): Day% = Date2Day%(DateX$): Year% = Date2Year%(DateX$)

IF Month% > 2 THEN
	Month% = Month% - 3
ELSE
	Month% = Month% + 9: Year% = Year% - 1
END IF

	Ta& = 146097 * (Year% \ 100) \ 4
	tb& = 1461& * (Year% MOD 100) \ 4
	Tc& = (153 * Month% + 2) \ 5 + Day% + 1721119
	DateSerial& = Ta& + tb& + Tc&

END FUNCTION

FUNCTION DayWeek$ (DateX$)
SHARED Day$()

	ValDay = ((DateSerial&(DateX$) MOD 7) + 1)
IF ValDay = 7 THEN ValDay = 0
	DayWeek$ = Day$(ValDay + 1)

END FUNCTION

FUNCTION DeCode$ (TxT$)
  
	t$ = "": Seed = 7

FOR f = 1 TO LEN(TxT$)
	x = ASC(MID$(TxT$, f, 1))
	 x = x - Seed
DO WHILE x < 1
	x = x + 200
LOOP
	t$ = t$ + CHR$(x)
	Seed = Seed + ASC(MID$(t$, f, 1))
NEXT 'f
  
	DeCode$ = t$

END FUNCTION

SUB DrawBox (t, l, b, r, Fg, Bg, InOut, Heading$, shado, btype)

IF btype = 1 THEN
	b$ = "ÚÀÙ¿³Ä"
ELSEIF btype = 2 THEN
	b$ = "Éȼ»ºÍ"
ELSEIF btype = 3 THEN
	b$ = "ÕÔ¾¸³Í"
ELSEIF btype = 4 THEN
	b$ = "ÖÓ½·ºÄ"
ELSE
	b$ = "      "
END IF

IF InOut THEN COLOR 0, Bg ELSE COLOR Fg, Bg
	LOCATE t, l: PRINT MID$(b$, 1, 1);
	 LOCATE b, l: PRINT MID$(b$, 2, 1);
IF InOut THEN COLOR Fg, Bg ELSE COLOR 0, Bg
	LOCATE b, r: PRINT MID$(b$, 3, 1);
	 LOCATE t, r: PRINT MID$(b$, 4, 1);
FOR f = t + 1 TO b - 1
IF InOut THEN COLOR 0, Bg ELSE COLOR Fg, Bg
	LOCATE f, l: PRINT MID$(b$, 5, 1) + SPACE$(r - l - 1);
IF InOut THEN COLOR Fg, Bg ELSE COLOR 0, Bg
	PRINT MID$(b$, 5, 1);
NEXT 'f

FOR f = l + 1 TO r - 1
IF InOut THEN COLOR Fg, Bg ELSE COLOR 0, Bg
	LOCATE t, f: PRINT MID$(b$, 6, 1);
IF InOut THEN COLOR 0, Bg ELSE COLOR Fg, Bg
	LOCATE b, f: PRINT MID$(b$, 6, 1);
NEXT 'f

IF Heading$ <> "" THEN
	LOCATE t, l + 1: PRINT " "; Heading$; " ";
	COLOR 14, Bg: LOCATE t, l + 2: PRINT Heading$;
END IF

IF shado THEN
FOR g = t + 1 TO b + 1
	COLOR 8, 0
IF SCREEN(g, l - 1, 1) > 128 THEN COLOR 24, 0
	LOCATE g, l - 2: PRINT CHR$(SCREEN(g, l - 2)); CHR$(SCREEN(g, l - 1))
NEXT 'g
  
FOR h = l - 1 TO r - 1
	COLOR 8, 0
IF SCREEN(b + 1, h, 1) > 128 THEN COLOR 24, 0
	LOCATE b + 1, h: PRINT CHR$(SCREEN(b + 1, h));
NEXT 'h
	COLOR 7, 0
END IF

END SUB

SUB DrawScreen
SHARED hd AS dbHeader

CALL DrawBox(1, 1, 2, 80, 9, 1, 1, "", 0, 1)
 CALL DrawBox(15, 1, 16, 80, 9, 1, 1, "", 0, 1)
  CALL DrawBox(22, 1, 25, 80, 9, 1, 0, "OPTIONS", 0, 1)

	COLOR 10, 1
	LOCATE 23, 2: PRINT CHR$(24);
	 LOCATE 23, 4: PRINT CHR$(25);
	  LOCATE 23, 14: PRINT "INS";
		LOCATE 23, 24: PRINT "DEL";
		 LOCATE 23, 68: PRINT "Alt-Q";
	LOCATE 24, 6: PRINT "E";
	 LOCATE 24, 12: PRINT "S";
	  LOCATE 24, 18: PRINT "P";

	COLOR 2, 1
	LOCATE 23, 3: PRINT "/";
	 LOCATE 23, 6: PRINT "Scroll";
	  LOCATE 23, 13: PRINT "[";
		LOCATE 23, 17: PRINT "] Add";
		 LOCATE 23, 23: PRINT "[";
	LOCATE 23, 27: PRINT "] Delete";
	 LOCATE 23, 67: PRINT "[";
	  LOCATE 23, 73: PRINT "] Quit";
		LOCATE 24, 7: PRINT "dit";
		 LOCATE 24, 13: PRINT "ort";
		  LOCATE 24, 19: PRINT "rint";

CALL RowRoll("ú ù Main Menu ù ú", 11, 1, 23, 40, 10)

END SUB

SUB DumKey

	a$ = ""
FOR f = 1 TO 8
	a$ = INKEY$
NEXT 'f

END SUB

SUB EvAdd (AdEd)
SHARED hd AS dbHeader, db AS dbRecord, Current, Trecs, k$, k1, k2

IF DeCode$(hd.HRegN) = "Unregistered" + (SPACE$(20 - LEN("Unregistered"))) THEN
IF Trecs >= 5 THEN
Trecs = 5: SOUND 450, .15
m$ = m$ + CHR$(13)
 m$ = m$ + Rpad$(" Unregistered Version", 23) + CHR$(13)
  m$ = m$ + Rpad$(" Max records allowed!", 23)
	m$ = MsgBox$(m$, 14, "REGISTER", "")
  EXIT SUB
END IF
 END IF

	IF AdEd = 1 THEN
CALL RowRoll("ú ù Add Menu ù ú ", 11, 1, 23, 40, 10)
	TempDate$ = CalDisp$(DATE$)
T1 = 0: T2 = 0: T3 = 0
END IF

	IF AdEd = 0 THEN
CALL RowRoll("ú ù Edit Menu ù ú", 11, 1, 23, 40, 10)
	TempDate$ = CalDisp$(db.dbMonth + "-" + db.dbDay + "-" + db.dbYear)
T1 = VAL(DeCode$(db.dbTag1)): T2 = VAL(DeCode$(db.dbTag2)): T3 = VAL(DeCode$(db.dbTag3))
Tempn1$ = RIGHT$(db.dbNote1, 34): Tempn2$ = RIGHT$(db.dbNote2, 34)
END IF
																				
IF TempDate$ = "" THEN EXIT SUB

CALL DrawBox(6, 44, 11, 63, 15, 3, 1, "TAG DATE", 1, 1)
'CALL DrawBox(6, 44, 11, 73, 15, 3, 1, "TAG DATE", 1, 1)
 CALL DrawBox(7, 46, 9, 48, 0, 3, 1, "", 0, 1)
  CALL DrawBox(7, 54, 9, 56, 0, 3, 1, "", 0, 1)
	'CALL DrawBox(7, 63, 9, 65, 0, 3, 1, "", 0, 1)
COLOR 15, 3
LOCATE 8, 49: PRINT "DATE";
 LOCATE 8, 57: PRINT "MONTH";
  'LOCATE 8, 66: PRINT "YEAR";
	LOCATE 10, 46: PRINT "[1]     [2]"; '      [3]";
COLOR 14, 3
IF T1 = 1 THEN LOCATE 8, 47: PRINT "û";
 IF T2 = 1 THEN LOCATE 8, 55: PRINT "û";
  'IF T3 = 1 THEN LOCATE 8, 64: PRINT "û";

DO
GetKey
IF k1 = ESC THEN GOTO EvEnd
 IF k1 = 49 THEN
	SOUND 250, .15
IF T1 = 0 THEN
	T1 = 1: LOCATE 8, 47: PRINT "û";
ELSE
	T1 = 0: LOCATE 8, 47: PRINT " ";
END IF
END IF
IF k1 = 50 THEN
	SOUND 250, .15
IF T2 = 0 THEN
	T2 = 1: LOCATE 8, 55: PRINT "û";
ELSE
	T2 = 0: LOCATE 8, 55: PRINT " ";
END IF
 END IF

'IF k1 = 51 THEN
'   SOUND 250, .15
'IF T3 = 0 THEN
'   T3 = 1: LOCATE 8, 64: PRINT "û";
'ELSE
'   T3 = 0: LOCATE 8, 64: PRINT " ";
'END IF
' END IF
IF k1 = 13 THEN GOTO AddNote
LOOP

AddNote:
Temp$ = ScreenSave$(16, 2, 21, 39)
CALL DrawBox(16, 4, 19, 39, 14, 3, 1, "Notes", 1, 1)
Temp1$ = SayGet$(Tempn1$, 17, 5, 15, 3, 34)
IF k1 = 27 THEN
CALL ScreenRest(16, 2, 21, 39, Temp$)
GOTO EvEnd
END IF
Temp2$ = SayGet$(Tempn2$, 18, 5, 15, 3, 34)
IF k1 = 27 THEN
CALL ScreenRest(16, 2, 21, 39, Temp$)
GOTO EvEnd
END IF

IF AdEd = 0 THEN GOTO AdEdSkip
Trecs = Trecs + 1: Current = Trecs

AdEdSkip:
LSET db.dbDay = MID$(TempDate$, 4, 2)
 LSET db.dbMonth = LEFT$(TempDate$, 2)
  LSET db.dbYear = RIGHT$(TempDate$, 4)
	LSET db.dbNote1 = " " + Temp1$
	 LSET db.dbNote2 = " " + Temp2$

LSET db.dbTag1 = Code$(Lzero$(T1, 2))
 LSET db.dbTag2 = Code$(Lzero$(T2, 2))
  LSET db.dbTag3 = Code$(Lzero$(T3, 2))

DataWrite
EvSort

CALL ScreenRest(16, 2, 21, 39, Temp$)
EvEnd:

END SUB

SUB EvDel
SHARED db AS dbRecord, Trecs, Current

SOUND 450, .15
IF Trecs < 2 THEN
PLAY "MNT255L64O2CDEGB>DEFGAMNT255L64O2CDEGB>DEFGA"
Temp$ = MsgBox$(" Cannot delete last record ! ", 14, " Overwrite recommended ", "")
EXIT SUB
END IF

a$ = " Delete this record ! " + CHR$(13)
Answer$ = MsgBox$(a$, 14, "CONFIRM", "YN")
IF Answer$ = "Y" THEN
CALL SoundRep(5, 1)
RecD$ = ScreenSave$(2, 2, 5, 12)
TempCurrent = Current

FOR Current = (TempCurrent + 1) TO Trecs
DataRead
Current = Current - 1
DataWrite
Current = Current + 1
NEXT Current
Trecs = Trecs - 1
DataWrite
IF TempCurrent > Trecs THEN
Current = Trecs
ELSE
Current = TempCurrent
END IF

CALL ScreenRest(2, 2, 5, 12, RecD$)

END IF

END SUB

SUB EvList
SHARED db AS dbRecord, Current, Trecs, k$, k1, k2

	Current = 1: Top1 = 5: Bott1 = 15
	DateNow& = DateSerial&(DATE$)
CLS
CALL DrawBox(1, 1, 2, 80, 9, 1, 1, "", 0, 1)
 CALL DrawBox(24, 1, 25, 80, 9, 1, 1, "", 0, 1)
  CALL RowRoll("ú ù List Menu ù ú", 15, 1, 3, 1, 10)
	CALL RowRoll("Today,", 12, 1, 3, 21, 4)
	 CALL RowRoll("Tomorrow,", 14, 1, 3, 27, 4)
	  CALL RowRoll("This week,", 3, 1, 3, 36, 4)

CALL RowRoll("This Month,", 10, 1, 3, 46, 4)
 CALL RowRoll("Daily,", 13, 1, 3, 57, 4)
  CALL RowRoll("Monthly", 7, 1, 3, 63, 4)

DO
	DataRead
	DateFind& = DateSerial&(db.dbMonth + "-" + db.dbDay + "-" + db.dbYear)
	Tday = VAL(db.dbDay): Tmon = VAL(db.dbMonth): Tyear = VAL(db.dbYear)
TxT$ = Crunch$(db.dbDay + "/" + db.dbMonth + "/" + db.dbYear + db.dbNote1 + db.dbNote2, " ")

IF DateNow& - DateFind& = 0 THEN
	LOCATE Top1, 1:  COLOR 12, 1: PRINT TxT$;
	Top1 = Top1 + 1
	ELSEIF DeCode$(db.dbTag1) = "01" THEN
	LOCATE Top1, 1:  COLOR 13, 1: PRINT TxT$;
	Top1 = Top1 + 1
ELSEIF DateFind& - DateNow& = 1 THEN
	LOCATE Top1, 1: COLOR 14, 1: PRINT TxT$;
	Top1 = Top1 + 1
ELSEIF DateFind& - DateNow& <= 7 AND DateFind& - DateNow& >= 2 THEN
	LOCATE Top1, 1: COLOR 3, 1: PRINT TxT$;
	Top1 = Top1 + 1
ELSEIF Tmon = VAL(LEFT$(DATE$, 2)) THEN
 IF DateFind& - DateNow& >= 8 THEN
	LOCATE Top1, 1: COLOR 10, 1: PRINT TxT$;
	Top1 = Top1 + 1
ELSEIF DeCode$(db.dbTag2) = "01" THEN
	LOCATE Top1, 1: COLOR 7, 1: PRINT TxT$;
	Top1 = Top1 + 1
 END IF
  END IF
  
	COLOR 15, 1: Current = Current + 1
IF Current > Trecs THEN GOTO EndList
 IF Top1 >= 24 THEN
CALL CenterTxT(24, 14, 1, " ú ù More ù ú ")
	GetKey
CALL DrawBox(3, 1, 23, 80, 1, 1, 0, "", 0, 0)
	Top1 = 5
END IF
LOOP

EndList:
CALL SoundRep(9, 1)
CALL CenterTxT(24, 14, 1, " Press any key ")

TicOver (1500)

END SUB

SUB EvPrint

SHARED db AS dbRecord, Trecs, Current

CALL SoundRep(5, 1)

	Current = 1: Top = 0
	LPRINT "°°±±²² Little Event v1.1b ²²±±°°"
	 LPRINT CHR$(13)

FOR f = 1 TO Trecs
	Top = Top + 1
IF Top = 55 THEN
	LPRINT CHR$(13)
	 LPRINT "* ------------------------------------------------------------------------ *"
FOR g = 1 TO 2
	LPRINT CHR$(13)
NEXT 'f

	LPRINT "°°±±²² Little Event v1.1b ²²±±°°"
	 LPRINT CHR$(13)
	Top = 1
END IF
	Current = f
DataRead
	AllTxT$ = db.dbDay + "/" + db.dbMonth + "/" + db.dbYear + " " + db.dbNote1 + "," + db.dbNote2
	PrinTxT$ = Crunch$(AllTxT$, " ")
	LPRINT PrinTxT$
NEXT 'g
	LPRINT CHR$(13)
	 LPRINT "* ------------------------------------------------------------------------ *"
	
END SUB

SUB EvSort
SHARED Current, Trecs
IF Trecs <= 1 THEN EXIT SUB

DIM Srec1 AS dbRecord, Srec2 AS dbRecord
	BSort$ = ScreenSave$(3, 54, 9, 78)
CALL DrawBox(4, 56, 6, 68, 0, 3, 1, "", 1, 2)
	COLOR 0, 3: LOCATE 5, 58: PRINT "Sorting ";

	SortActive$ = "|/-\": SPointer = 1
	Center = Trecs \ 2: Iter = 1
DO WHILE Center > 0
	Boundary = (Trecs + 1) - Center
DO
Flag = 0
FOR i = 2 TO Boundary
GET #1, i, Srec1
GET #1, i + Center, Srec2

	TsT1$ = DeCode$(Srec1.dbMonth)
	TsT2$ = DeCode$(Srec1.dbDay)
	TsT3$ = DeCode$(Srec1.dbNote1)
	TsT4$ = DeCode$(Srec1.dbNote2)
	TsTa$ = TsT1$ + TsT2$ + TsT3$ + TsT4$
	TsT5$ = DeCode$(Srec2.dbMonth)
	TsT6$ = DeCode$(Srec2.dbDay)
	TsT7$ = DeCode$(Srec2.dbNote1)
	TsT8$ = DeCode$(Srec2.dbNote2)
	TsTb$ = TsT5$ + TsT6$ + TsT7$ + TsT8$

IF TsTa$ > TsTb$ THEN
PUT #1, i, Srec2
PUT #1, i + Center, Srec1
	Flag = i
END IF
NEXT i
	Boundary = Flag - Center
LOCATE 5, 66: PRINT MID$(SortActive$, SPointer, 1);
	SPointer = SPointer + 1
IF SPointer > 4 THEN SPointer = 1
LOOP WHILE Flag
	Center = Center \ 2: Iter = Iter + 1
LOOP
CALL ScreenRest(3, 54, 9, 78, BSort$)

END SUB

SUB EvStats
SHARED hd  AS dbHeader, Trecs

SOUND 450, .15
	Date1$ = DeCode$(hd.hDate)
	Time1$ = DeCode$(hd.hTime)
	Date2$ = LEFT$(Date1$, 2) + "/" + MID$(Date1$, 4, 2) + "/" + RIGHT$(Date1$, 4)

m$ = CHR$(4) + " Event Book Stats " + CHR$(4) + CHR$(13)
 m$ = m$ + CHR$(13)
  m$ = m$ + Rpad$("  Little Event v1.1b", 35) + CHR$(13) + CHR$(13)
	m$ = m$ + Rpad$("  DATABOOK PATH: C:\", 35) + CHR$(13)
	 m$ = m$ + Rpad$("  DATABOOK NAME: EVDATA._EV", 35) + CHR$(13)
	  m$ = m$ + Rpad$("  TOTAL RECORDS:" + STR$(Trecs), 35) + CHR$(13)
m$ = m$ + Rpad$("  LAST WRITE DATE: " + Date2$, 35) + CHR$(13)
 m$ = m$ + Rpad$("  LAST WRITE TIME: " + Time1$, 35) + CHR$(13) + CHR$(13)
  m$ = m$ + Rpad$("  ÷ Regestered to ÷", 35) + CHR$(13)
	m$ = m$ + Rpad$("     " + (DeCode$(hd.HRegN)), 35)
	 m$ = MsgBox$(m$, 14, "Stats", "")

END SUB

SUB GetKey

SHARED hd AS dbHeader, k$, k1, k2

	k$ = ""
DO WHILE k$ = ""

k$ = INKEY$
LOOP
	k1 = ASC(k$)
IF LEN(k$) = 2 THEN
	k2 = ASC(RIGHT$(k$, 1))
		ELSE
	k2 = 0
END IF

END SUB

FUNCTION LeapYear% (Year%)

	DivBy4% = (Year% MOD 4 = 0)
	Century% = (Year% MOD 100 = 0)
	Century400% = (Year% MOD 400 = 0)

	LeapYear% = DivBy4% AND (Century% IMP Century400%)

END FUNCTION

FUNCTION Lzero$ (Num, Length)

New$ = LTRIM$(STR$(Num))
	l = LEN(New$)

IF Length <= l THEN
	Lzero$ = New$
EXIT FUNCTION
END IF

IF Num < 0 THEN
	New$ = RIGHT$(New$, (l - 1))
END IF

	Diff = Length - l
	New$ = STRING$(Diff, "0") + New$

	Lzero$ = New$

END FUNCTION

FUNCTION MDY2Date$ (Month%, Day%, Year%)

	MDY2Date$ = RIGHT$("0" + MID$(STR$(Month%), 2), 2) + "-" + RIGHT$("0" + MID$(STR$(Day%), 2), 2) + "-" + RIGHT$("000" + MID$(STR$(Year%), 2), 4)

END FUNCTION

FUNCTION MsgBox$ (TxT$, Fg, Hdr$, Allowed$)

SHARED k$
	k$ = ""
	
DIM s$(20)
	Lins = 1
DO
	x = INSTR(TxT$, CHR$(13))
IF x <> 0 THEN
	s$(Lins) = LEFT$(TxT$, x - 1)
	TxT$ = MID$(TxT$, x + 1)
	Lins = Lins + 1
ELSE
	s$(Lins) = TxT$
END IF

LOOP WHILE x <> 0
IF Allowed$ <> "" THEN
	 Allowed$ = UCASE$(Allowed$)
	Lins = Lins + 1
	Temp$ = ""
FOR f = 1 TO LEN(Allowed$)
	Temp$ = Temp$ + "{" + MID$(Allowed$, f, 1) + "} "
NEXT 'f
	s$(Lins) = Temp$
END IF
	
	Max = 0
FOR f = 1 TO Lins
IF LEN(RTRIM$(LTRIM$(s$(f)))) > Max THEN
	Max = LEN(s$(f))
END IF
NEXT 'f
	
IF Max / 2 <> INT(Max / 2) THEN Max = Max + 1
	l = 40 - (Max / 2)
	
	Half = INT(Lins / 2) + 1
	MsgB$ = ScreenSave$(12 - Half, l - 2, 13 + Half, l + Max + 1)
CALL DrawBox(12 - Half, l, 12 + Half, l + Max + 1, 12, 4, 1, "", 1, 1)
	
IF Hdr$ <> "" THEN
	COLOR 12, 4: LOCATE 12 - Half, l + 1
	PRINT "[" + SPACE$(LEN(Hdr$)) + "]";
	COLOR 30, 4: LOCATE 12 - Half, l + 2: PRINT Hdr$;
END IF
	
COLOR Fg, 4
FOR f = 1 TO Lins
	m$ = s$(f)
LOCATE 12 - Half + f, 41 - (LEN(m$) / 2): PRINT m$;
NEXT 'f
	
IF Allowed$ <> "" THEN
DO
	GetKey
LOOP WHILE INSTR(Allowed$, UCASE$(k$)) = 0
ELSE
	GetKey
END IF
CALL ScreenRest(12 - Half, l - 2, 13 + Half, l + Max + 1, MsgB$)

	MsgBox = UCASE$(k$)

END FUNCTION

SUB RegEv

SHARED hd AS dbHeader, k$, k1, k2

COLOR 7, 1:  CLS
SHELL "dir c:\>dir.txt"
OPEN "dir.txt" FOR INPUT AS #2
DO WHILE NOT EOF(2)
LINE INPUT #2, ln$
	Temp$ = RIGHT$(ln$, 18)
IF LEFT$(Temp$, 9) = "umber is " THEN GOTO End2
LOOP

End2:
CLOSE #2
KILL "dir.txt"

CALL DrawBox(1, 2, 2, 79, 9, 1, 1, "", 0, 2)
 CALL DrawBox(24, 2, 25, 79, 9, 1, 1, "", 0, 2)
  CALL DrawBox(3, 2, 5, 79, 9, 1, 0, "", 0, 1)
	LOCATE 4, 4: COLOR 14, 1: PRINT " Event v1.1b"
CALL CenterTxT(4, 15, 1, "REGISTRATION")
 CALL DrawBox(6, 3, 7, 78, 9, 1, 1, "", 0, 1)
  CALL DrawBox(9, 3, 11, 78, 9, 1, 0, "", 0, 1)
	CALL DrawBox(13, 3, 14, 78, 9, 1, 1, "", 0, 1)
SOUND 450, .15
RedoReg:
	COLOR 14, 1
	Reginput$ = SayGet$(" User Name ?", 10, 5, 15, 2, 16)
	IF k1 = 27 THEN GOTO RegEnd
	a2$ = Reginput$ + RIGHT$(Disk1$, 9) + "AE:9791367443:CE"
	B2$ = a2$: C2$ = Code$(B2$): CodeLen& = 0: RealLen& = 0
FOR f = 1 TO LEN(C2$)
	CodeLen& = (CodeLen& + ASC(MID$(C2$, f, 1)) * 105) + (RealLen& * 777)
	RealLen& = RealLen& + ASC(MID$(C2$, f, 1))
NEXT f

' LOCATE 10, 65: PRINT "<"; RealLen&             '*** real code input ! ***
 LOCATE 10, 25: PRINT "[" + STR$(CodeLen&) + " ]"
	Regcode$ = SayGet$(" Registration Code ", 10, 40, 15, 4, 20)
IF k1 = 27 THEN GOTO RegEnd
	TempReg$ = RIGHT$(Disk1$, 9)
	Regin$ = (UCASE$(MID$(Reginput$, 1, 1)) + (LCASE$(MID$(Reginput$, 2, 16))))
IF Reginput$ = "" THEN
	BEEP: GOTO RedoReg
END IF
IF Reg > 16 THEN
	BEEP: LOCATE 10, 10: PRINT SPACE$(17);
GOTO RedoReg
END IF
IF VAL(Regcode$) <> RealLen& THEN
	Regin$ = "Unregistered"
IF Trecs > 5 THEN Trecs = 5
END IF

	Reglen = LEN(Reginput$)
IF Regin$ = "Unregistered" THEN Reglen = 12
CALL DrawBox(9, 3, 11, 78, 9, 1, 0, "", 0, 1)
IF Regin$ = "Unregistered" THEN
CALL CenterTxT(10, 15, 4, "  * Unregistered *  ")
ELSE
CALL CenterTxT(10, 15, 4, " Registered to  * " + Regin$ + " * ")
END IF

	PLAY "MNT150L64O2C>AGBGCGDGEGFG"
CALL DrawBox(16, 4, 19, 77, 15, 13, 1, "", 1, 1)
 CALL CenterTxT(17, 14, 13, "* Event has put a data file in your root. ie C:\ *")
  CALL CenterTxT(18, 14, 13, "*      THIS FILE IS EVDATA._EV       *")
	GetKey

CLOSE #2
	Putreg$ = Regin$ + SPACE$(20 - Reglen)
	New$ = Code$(Putreg$)
LSET hd.hName = New$
 LSET hd.HRegN = New$
	PUT #1, 1, hd

RegEnd:

END SUB

SUB RowRoll (TxT$, Fg, Bg, Row, Col, Tic!)

	Tic! = Tic! * 100
	COLOR Fg, Bg: LOCATE Row, Col: PRINT SPACE$(LEN(TxT$));
	m$ = TxT$

FOR f = 1 TO LEN(m$)
	LOCATE Row, LEN(m$) - f + Col: PRINT LEFT$(m$, f);
FOR g! = 1 TO Tic!
IF INKEY$ <> "" THEN EXIT FOR
NEXT 'g
 NEXT 'f

END SUB

FUNCTION Rpad$ (TxT$, MaxLen)

IF LEN(TxT$) < MaxLen THEN
	Rpad$ = TxT$ + SPACE$(MaxLen - LEN(TxT$))
EXIT FUNCTION
END IF

	Rpad$ = LEFT$(TxT$, MaxLen)

END FUNCTION

FUNCTION SayGet$ (TxT$, r, c, Fg, Bg, FLength)

SHARED k$, k1, k2

	COLOR Fg, Bg: False = 0: True = NOT False
	Insert = True: OValue$ = TxT$
	LOCATE r, c: PRINT SPACE$(FLength);
	Curt = 7: CurB = 7: CPos = c
DO

	LOCATE r, c
IF LEN(TxT$) < FLength THEN
	PRINT TxT$ + " ";
ELSE
	PRINT TxT$;
END IF

	LOCATE r, CPos, 1, Curt, CurB

	GetKey
IF (k1 >= 32 AND k1 <= 122) THEN
 IF CPos < FLength + c THEN
  IF Insert = True THEN
	TxT$ = LEFT$(TxT$, CPos - c) + k$ + MID$(TxT$, CPos - c + 1)
IF LEN(TxT$) > FLength THEN TxT$ = LEFT$(TxT$, FLength)
	CPos = CPos + 1
END IF
 END IF
ELSEIF k2 = INS THEN
	Insert = NOT Insert
IF Insert = True THEN
	Curt = 7: CurB = 7
ELSE
	Curt = 0: CurB = 7
END IF
ELSEIF k1 = 8 THEN
IF CPos > c THEN
	TxT$ = LEFT$(TxT$, CPos - c - 1) + MID$(TxT$, CPos + 1 - c)
	CPos = CPos - 1
END IF
ELSEIF k2 = 83 THEN
IF CPos >= c THEN
	TxT$ = LEFT$(TxT$, CPos - c) + MID$(TxT$, CPos + 2 - c)
END IF
ELSEIF k2 = 71 THEN
	CPos = c
ELSEIF k2 = 79 THEN
	CPos = c + LEN(TxT$) - 1
ELSEIF k2 = 75 THEN
IF CPos > c THEN CPos = CPos - 1
ELSEIF k2 = 77 THEN
IF CPos < (c + LEN(TxT$) - 1) THEN CPos = CPos + 1
ELSEIF k1 = ESC THEN
	TxT$ = OValue$
EXIT DO
ELSEIF k1 = 13 THEN
	SayGet$ = TxT$
EXIT DO
ELSE

END IF
LOOP

	LOCATE r, c, 0: PRINT TxT$;

SayGet$ = TxT$

END FUNCTION

SUB ScreenRest (t, l, b, r, buff$)

	x = 1
FOR f = t TO b
 FOR g = l TO r
	xcol = ASC(MID$(buff$, x, 1))
	xltr$ = MID$(buff$, x + 1, 1)
	x = x + 2
	Bg = INT(xcol / 16): Fg = xcol MOD 16
COLOR Fg, Bg: LOCATE f, g: PRINT xltr$;
NEXT 'g
 NEXT 'f

END SUB

FUNCTION ScreenSave$ (t, l, b, r)

TxT$ = ""
FOR f = t TO b
 FOR g = l TO r
TxT$ = TxT$ + CHR$(SCREEN(f, g, 1)) + CHR$(SCREEN(f, g, 0))
NEXT 'g
 NEXT 'f

ScreenSave$ = TxT$

END FUNCTION

SUB ScrSave

RedoScr:
Top1 = (RND * 17) + 2: Row1 = (RND * 64) + 4
TempScr$ = ScreenSave$(Top1, Row1 - 2, Top1 + 4, Row1 + 12)
CALL DrawBox(Top1, Row1, Top1 + 2, Row1 + 10, 14, 12, 1, "", 1, 1)
LOCATE Top1 + 1, Row1 + 1, 0: COLOR 15, 12: Tm$ = LEFT$(TIME$, 5)
	t% = VAL(Tm$): Tm$ = MID$(Tm$, INSTR(Tm$, ":")): am$ = "am"
	IF t% = 0 THEN t% = 12 ELSE IF t% > 12 THEN t% = t% - 12: am$ = "pm"
	Tm$ = RIGHT$(STR$(t%), 2) + Tm$: PRINT Tm$ + " " + am$;

TicOver (300)
CALL ScreenRest(Top1, Row1 - 2, Top1 + 4, Row1 + 12, TempScr$)
IF INKEY$ <> "" THEN
EXIT SUB
ELSE
GOTO RedoScr
END IF

END SUB

FUNCTION Serial2Date$ (Serial&)

	x& = 4 * Serial& - 6884477
	y& = (x& \ 146097) * 100
	d& = (x& MOD 146097) \ 4
	x& = 4 * d& + 3
	y& = (x& \ 1461) + y&
	d& = (x& MOD 1461) \ 4 + 1
	x& = 5 * d& - 3
	m& = x& \ 153 + 1
	d& = (x& MOD 153) \ 5 + 1

IF m& < 11 THEN
	Month% = m& + 2
ELSE
	Month% = m& - 10
END IF

	Day% = d&
	Year% = y& + m& \ 11
	DateX$ = MDY2Date$(Month%, Day%, Year%)
	Serial2Date$ = DateX$
  
END FUNCTION

SUB ShowHelp

SOUND 450, .15
m$ = CHR$(4) + " Keys Permitted " + CHR$(4) + CHR$(13)
 m$ = m$ + CHR$(13)
  m$ = m$ + Rpad$(" " + CHR$(24) + "/" + CHR$(25) + "   - Rolls Up/Down listing.", 40) + CHR$(13)
	m$ = m$ + Rpad$(" INS   - Add a new Event.", 40) + CHR$(13)
	 m$ = m$ + Rpad$(" DEL   - Delete the displayed item.", 40) + CHR$(13)
	  m$ = m$ + Rpad$(" Alt+E - Edit selected entry.", 40) + CHR$(13)
m$ = m$ + Rpad$(" Alt+P - Prints EVDATA listing.", 40) + CHR$(13)
 m$ = m$ + Rpad$(" Alt+S - Sorts EV by DD/MM/YY", 40) + CHR$(13)
  m$ = m$ + Rpad$(" Alt+R - To REGISTER this program.", 40) + CHR$(13)
	m$ = m$ + Rpad$(" Alt+F1- Shows Event stats.", 40) + CHR$(13)
	 m$ = m$ + Rpad$(" F2    - Finds the first RECORD entered.", 40) + CHR$(13)
	  m$ = m$ + Rpad$(" Alt+X - Shell to DOS", 40) + CHR$(13)
		m$ = m$ + Rpad$(" Alt+Q - Quit Program.", 40) + CHR$(13)
m$ = m$ + Rpad$(" Alt+A - About Event 1.1b", 40) + CHR$(13)
 m$ = m$ + Rpad$(" ~ KEY - To enter Notes Menu (above TAB)", 40) + CHR$(13)
  m$ = m$ + Rpad$(" Home  - Moves to the first record.", 40) + CHR$(13)
	m$ = m$ + Rpad$(" End   - Moves to the last record.", 40)
	 m$ = MsgBox$(m$, 14, "HELP", "")

END SUB

SUB SoundRep (Pl, Tim)

FOR f = 1 TO Tim
IF Pl = 1 THEN PLAY "MNT255L32O4mlDGD<G>DGDDGDGBAGF#EE"
 IF Pl = 2 THEN PLAY "MNT150L64MSO4BGEC<AFL16D"
  IF Pl = 3 THEN PLAY "MNT240L64MLO4EGEGEGCFCFCFGEGEGE"
	IF Pl = 4 THEN PLAY "MNT255L64O4CDEFGABO3CDEFGABO2CDEFGAB"
	 IF Pl = 5 THEN PLAY "MNT255L64MLO1BAGFEDC<BAGFEDCP16>CDEFGAB"
	  IF Pl = 6 THEN PLAY "MNT120L16O4C#.P16T255L64mlC#DD#EFF#GG#AA#BO5CC#DD#EF"
IF Pl = 7 THEN PLAY "MNT255L32mlO3CD<CD>>CD<<CD>>CD<<CD>CD"
 IF Pl = 8 THEN PLAY "MNT240L64MLO4EGEGEGEGEGEGEGEGEGEGEGEGEGEGEG"
  IF Pl = 9 THEN PLAY "MNO4T255L64MLB-BB-BAGAG.>EGG>EGG"
	IF Pl = 10 THEN PLAY "MNT255L64MsO4C#DD#EFF#GG#AA#B>CC#DD#EF"
	 IF Pl = 11 THEN PLAY "MNT55L64O2CDEGB>DEFGA"
	  IF Pl = 12 THEN PLAY "MNT255L64O2CDEB"
IF Pl = 13 THEN PLAY "MNT150L64O5DG+DG+AG+G+AP20"
 IF Pl = 14 THEN PLAY "MNT255L8O4CCL4DCFL2EL8CC"

NEXT 'f

END SUB

SUB TbNotes
SHARED hd AS dbHeader, tb AS TbNotes, k1, k2, k$

CLS : PLAY "MNT255L64MLO4EFGFE"
CALL CenterTxT(6, 14, 1, "* Extra Notes *")
 CALL DrawBox(22, 1, 25, 80, 9, 1, 0, "OPTIONS", 0, 1)
  CALL DrawBox(7, 1, 8, 80, 9, 1, 1, "", 0, 1)
	CALL DrawBox(15, 1, 16, 80, 9, 1, 1, "", 0, 1)
	
	COLOR 10, 1
	LOCATE 23, 2: PRINT CHR$(24);
	 LOCATE 23, 4: PRINT CHR$(25);
	  LOCATE 23, 14: PRINT "INS";
		LOCATE 23, 24: PRINT "DEL";
		 LOCATE 23, 70: PRINT "ESC";
	LOCATE 24, 6: PRINT "E";
	 LOCATE 24, 13: PRINT "P";

	COLOR 2, 1
	LOCATE 23, 3: PRINT "/";
	 LOCATE 23, 6: PRINT "Scroll";
	  LOCATE 23, 13: PRINT "[";
		LOCATE 23, 17: PRINT "] Add";
		 LOCATE 23, 23: PRINT "[";
	LOCATE 23, 27: PRINT "] Delete";
	 LOCATE 23, 69: PRINT "[";
	  LOCATE 23, 73: PRINT "] Exit";
		LOCATE 24, 7: PRINT "dit";
		 LOCATE 24, 14: PRINT "rint";

St:
OPEN "C:\TBDATA._EV" FOR RANDOM AS #2 LEN = 75
Size = LOF(2) / 75
	tbRecs = Size
IF tbRecs < 1 THEN
	tbRecs = 1: Size = 1
TexT$ = "Mr. Johnson v1.1b 4320015"
TexT1$ = TexT$ + SPACE$(75 - LEN(TexT$))
LSET tb.tbName = Code$(TexT1$)
	PUT #2, 1, tb
END IF

	tbRecs = Size: tbCurrent = 1
	Choice = 1: Index = 1: Bott = tbRecs: Rows = 5: Row = 9: Colm = 3
GOSUB SortNotes

StartPhone:
	DumKey
FOR g = 0 TO Rows
	IF g + Index <= tbRecs THEN
	GET #2, g + Index, tb
	TempTxT$ = DeCode$(tb.tbName)
	ELSE
	TempTxT$ = SPACE$(75)
	END IF
  
	TxT$ = " " + Crunch$(TempTxT$, " ")
IF Choice = (g + Index) THEN
 LOCATE Row + g, Colm: COLOR 4, 7
	PRINT (TxT$ + SPACE$(76 - LEN(TxT$)))
	ELSE
IF (g + Index) <= Bott THEN
	LOCATE Row + g, Colm: COLOR 7, 1
	PRINT TxT$ + SPACE$(76 - LEN(TxT$))
	END IF
		END IF
IF (g + Index) > Bott THEN
	LOCATE Row + g, Colm: COLOR 7, 1
	PRINT TxT$ + SPACE$(76 - LEN(TxT$))
		END IF
NEXT 'g

LoopGroup1:
DO
	GetKey
SELECT CASE k2
CASE AltE
GOSUB EditNotes
CASE DEL
	IF tbRecs <= 1 THEN
SOUND 450, .15
	TempTxT$ = " Cannot delete the last record ! " + CHR$(13) + "Overwrite recommended !"
	TempAns$ = MsgBox$(TempTxT$, 15, "ERROR", "")
	GetKey
GOTO LoopGroup1
END IF
GOSUB DelNotes
GOTO St
	CASE INS
GOSUB AddNotes
	CASE CHome
IF Choice = 1 AND Index = 1 THEN GOTO LoopGroup1
	Choice = 1: Index = 1
	CASE CEnd
IF Choice = Bott THEN GOTO LoopGroup1
	Choice = Bott: Index = Bott - Rows
IF Index < 1 THEN Index = 1
	CASE AroUp
IF Choice = 1 AND Index = 1 THEN GOTO LoopGroup1
	Choice = Choice + (Choice > 1)
IF Choice < Index THEN Index = Choice
	CASE AroDn
IF Choice = Bott THEN GOTO LoopGroup1
	Choice = Choice - (Choice < Bott)
IF Index < (Choice - Rows) THEN Index = Choice - Rows
	CASE PgUp
IF Choice = 1 AND Index = 1 THEN GOTO LoopGroup1
	Choice = Choice - Rows: Index = Index - Rows
IF Choice < 1 THEN Choice = 1
 IF Index < 1 THEN Index = 1
	CASE PgDn
IF Choice = Bott THEN GOTO LoopGroup1
	Choice = Choice + Rows: Index = Index + Rows
 IF Choice + Rows > Bott THEN Choice = Bott: Index = Bott - Rows
IF Index <= 0 THEN Index = 1: Choice = Bott
CASE AltP
GOTO PrintNotes
CASE F2
CALL DrawBox(17, 5, 19, 21, 15, 2, 0, "Find", 1, 1)
	FTxT$ = SayGet$("", 18, 6, 14, 2, 15)
	 FTxT$ = UCASE$(RTRIM$(FTxT$))
CALL DrawBox(17, 3, 21, 21, 1, 1, 0, "", 0, 0)
IF k1 = 27 OR FTxT$ = "" THEN GOTO StartPhone
FOR f = 1 TO tbRecs
GET #2, f, tb
IF INSTR(UCASE$(DeCode$(tb.tbName)), FTxT$) <> 0 THEN
Current = f: Choice = Current: Index = Choice
GOTO StartPhone
END IF
NEXT 'f
	CASE ELSE
TbExit:
IF k1 = 27 THEN CLOSE #2: EXIT SUB
END SELECT
GOTO StartPhone
LOOP

MainJump:
CALL DrawBox(18, 3, 20, 78, 1, 1, 0, "", 0, 0)
CALL RowRoll("ú ù Main Menu ù ú ", 11, 1, 23, 40, 10)
GOTO StartPhone

AddNotes:
CALL RowRoll("ú ù Add Menu ù ú  ", 11, 1, 23, 40, 10)
TempTxT$ = ""
CALL DrawBox(18, 3, 20, 78, 15, 3, 0, "Add", 0, 1)
RedoNotes:
	TempName$ = SayGet$(TempTxT$, 19, 4, 14, 3, 74)
		IF k1 = 27 THEN GOTO MainJump
LSET tb.tbName = Code$((TempName$) + SPACE$(75 - LEN(TempName$)))
tbRecs = tbRecs + 1: Bott = tbRecs
	PUT #2, tbRecs, tb
CALL DrawBox(18, 3, 20, 78, 15, 1, 0, "", 0, 0)
GOSUB SortNotes
RETURN

EditNotes:
CALL RowRoll("ú ù Edit Menu ù ú", 11, 1, 23, 40, 10)
GET #2, Choice, tb
TempTxT$ = DeCode$(LEFT$(tb.tbName, 74))
CALL DrawBox(18, 3, 20, 78, 15, 3, 0, "Edit", 0, 1)
	TempName$ = SayGet$(TempTxT$, 19, 4, 0, 3, 74)
		IF k1 = 27 THEN GOTO MainJump
LSET tb.tbName = Code$((TempName$) + SPACE$(75 - LEN(TempName$)))
	PUT #2, Choice, tb
	CALL DrawBox(18, 3, 20, 78, 15, 1, 0, "", 0, 0)
GOSUB SortNotes
RETURN

SortNotes:
NumRec = tbRecs
DIM a AS TbNotes
 DIM b AS TbNotes
FOR f = 1 TO NumRec
	Counter = 1
FOR g = 1 TO NumRec - 1
	GET #2, Counter, tb: a = tb
	 GET #2, Counter + 1, tb: b = tb
IF UCASE$(a.tbName) > UCASE$(b.tbName) THEN
	tb = b
PUT #2, Counter, tb: tb = a
PUT #2, Counter + 1, tb
END IF
	Counter = Counter + 1
NEXT 'g
NEXT 'f
CALL RowRoll("ú ù Notes Menu ù ú ", 11, 1, 23, 40, 10)
RETURN

PrintNotes:
CALL SoundRep(5, 1)
	tbCurrent = 1: Top = 0
	LPRINT "°°±±²² Little Event v1.1b ²²±±°°"
	 LPRINT CHR$(13)
FOR f = 1 TO tbRecs
	Top = Top + 1
IF Top = 55 THEN
	LPRINT CHR$(13)
	 LPRINT "* ------------------------------------------------------------------------ *"
FOR g = 1 TO 2
	LPRINT CHR$(13)
NEXT 'g
	LPRINT "°°±±²² Little Event v1.1b ²²±±°°"
	 LPRINT CHR$(13)
	Top = 1
END IF
	tbCurrent = f
	GET #2, f, tb
	AllTxT$ = DeCode$(tb.tbName)
	PrinTxT$ = Crunch$(AllTxT$, " ")
	LPRINT PrinTxT$
NEXT 'f
	LPRINT CHR$(13)
	 LPRINT "* ------------------------------------------------------------------------ *"
GOTO StartPhone
DelNotes:
CALL SoundRep(2, 1)
	TempTxT$ = " Delete this record ! " + CHR$(13)
	TempAns$ = MsgBox$(TempTxT$, 15, "DELETE", "YN")
 IF TempAns$ = "Y" THEN
OPEN "C:\Temp.$$$" FOR RANDOM AS #3 LEN = 75
NumRec = 1
FOR f = Choice + 1 TO tbRecs
GET #2, f, tb
PUT #3, NumRec, tb
	NumRec = NumRec + 1
NEXT 'f

FOR g = Choice - 1 TO 1 STEP -1
GET #2, g, tb
PUT #3, NumRec, tb
	NumRec = NumRec + 1
NEXT 'g
CLOSE #2, #3

KILL "C:\TBDATA._EV"
CALL CopyFile("C:\Temp.$$$", "C:\TBDATA._EV")
KILL "C:\Temp.$$$"
ELSE
GOTO LoopGroup1
END IF
RETURN

CLOSE #2

END SUB

SUB TempFile

SHARED hd AS dbHeader, db AS dbRecord, Current, Trecs

LSET db.dbDay = Code$("01")
 LSET db.dbMonth = Code$(LEFT$(DATE$, 2))
  LSET db.dbYear = Code$(RIGHT$(DATE$, 4))
	Tempn1$ = " * Event v1.1b *"
LSET db.dbNote1 = Code$((Tempn1$) + SPACE$(35 - LEN(Tempn1$)))
	Tempn2$ = "  Notes & Numbers "
LSET db.dbNote2 = Code$((Tempn2$) + SPACE$(35 - LEN(Tempn2$)))
 LSET db.dbTag1 = Code$("00")
  LSET db.dbTag2 = Code$("00")
	LSET db.dbTag3 = Code$("01")
PUT #1, 2, db

	hd.HRecs = 1
TDate$ = (MID$(DATE$, 4, 2) + "-" + LEFT$(DATE$, 2) + "-" + RIGHT$(DATE$, 4))

LSET hd.hDate = Code$(TDate$)
 LSET hd.hTime = Code$(TIME$)
	TempName$ = "Unregistered" + (SPACE$(20 - LEN("Unregistered")))
LSET hd.HRegN = Code$(TempName$)
 LSET hd.HRegi = Code$("9A1E-FF9F")
  LSET hd.hName = "Unregistered"
	
PUT #1, 1, hd
	Trecs = 1

END SUB

SUB TicOver (Tic)

	Curr& = TIMER
DO WHILE TIMER < (Curr& + Tic / 100)
IF INKEY$ <> "" THEN EXIT SUB
LOOP

END SUB