'===========================================================================
' Subject: GRAPHICAL EVENT ORGANIZER         Date: 06-19-99 (03:20)       
' Author:  David A. Wicker                   Code: QB, QBasic, PDS        
' Origin:  topaz817@fastlane.net           Packet: MISC.ABC
'===========================================================================
' * Graphic Event Organizer v0.1 -- Written by David A. Wicker -- Jun 4, 1999
' Fort Worth Fastlane Internet Account >> topaz817@fastlane.net
' ---------------------------------------------------------------------------
' As always, if you borrow anything from any source code for your personal
' projects, please give credit to the original author!
' ---------------------------------------------------------------------------
DEFINT A-Z
'$DYNAMIC
DECLARE SUB Center (A, A$)
DECLARE SUB TTR (T$)
DECLARE SUB Ask (T$)
DECLARE SUB GetUKey ()
DECLARE SUB Title (T$)
DECLARE SUB Wdw (HH, V, XX, Y)
DECLARE SUB DEC (N)
DECLARE SUB INC (N)
DECLARE SUB Stor (N, I$)
DECLARE SUB TR (H, V, T$)
DECLARE SUB GetKey ()
DECLARE SUB ShutDown ()
DECLARE SUB Startup ()
DECLARE SUB RGB (N, R, G, B)
DECLARE SUB Main ()
DECLARE FUNCTION FILELEN& (F$)

' This is a kinna improvement on Wayne L.'s "Event" program.
' He did ask for suggestions on it so . . .
' The basic concept behind his program is sound, but the source code
' is too big!  Here is a smaller one showing my little potpourri of 8x8
' EGA images as well.  :)  (Use the [ALT]-A through [ALT]-Z to show them!)
' I don't know much about leap years and stuff so it'll take any day up to
' 31 even if the month doesn't allow it.  Yah well.

' Wayne, I was looking over your source code for the registration and the
' string, Disk1$ is never initialized but referenced ?  Check it out !
' Anyways QB programs are FREEWARE!

' Limitations!  If you want to schedule more than 32767 appointments,
' change the top command to read DEFLNG A-Z, then you can have
' up to 1,073,741,823 of them.
' If =THAT= is not enough, you are one very busy person and should get at
' least one secretary to handle your appointments for you!

' If you have more than one appointment in a single day, checkmarking it
' will place it at the end of the day for easy reference.
' Also, everything is sorted so when things jump around, it's just
' alphabetizing and sorting the calendar.

' The FreeSpace indicator and Sort may not work outside Win98!
' Also this code is not commented much because it's a quick hack.  Hang on!

DEF FNO$ (A$) = LEFT$(A$, 1)
DEF FNZ$ (A$) = RIGHT$(A$, 1)
DEF FNC$ (A$, A) = MID$(A$, A, 1)
DEF FNN$ (A) = MID$(STR$(A), 2 + (A < 0))
DEF FNPad$ (A$, A) = LEFT$(A$ + SPACE$(A - LEN(LEFT$(A$, A))), A)
DEF FNDot$ (A$, A) = A$ + STRING$(A - LEN(A$), ".")
DEF FNZPad$ (A, B) = STRING$(B - LEN(FNN$(A)), "0") + FNN$(A)
DEF FNSPad$ (A, B) = SPACE$(B - LEN(FNN$(A))) + FNN$(A)
DEF FNCTRL$ (A$) = CHR$(ASC(A$) - 64)
DEF FND$ (A$) = LEFT$(A$, LEN(A$) - 1)

DEF FNNow$
  D$ = DATE$
  FNNow$ = MID$(D$, 7) + LEFT$(D$, 2) + MID$(D$, 4, 2)
END DEF

DEF FNDate$ (A$)
  B$ = MID$("JanFebMarAprMayJunJulAugSepOctNovDec", VAL(MID$(A$, 5, 2)) * 3 - 2, 3)
  ' ^ Chee!  I bet you couldn't write that in Asic! ^
  B$ = B$ + FNSPad$(VAL(MID$(A$, 7, 2)), 2) + "," + LEFT$(A$, 4)
  FNDate$ = B$
END DEF

DIM I.TR(17, 127)

A$(0) = "freeware gr_event v0.1 written in quickbasic 4.5"
A$(1) = "you like ?  please send a postcard to let me know !"
A$(2) = "david wicker ÄÄ 3436 clayton road east ÄÄ fort worth, texas  76116"
   
FOR I = 0 TO 2
  FOR J = 1 TO LEN(A$(I))
    A = A + ASC(FNC$(A$(I), J))
  NEXT
NEXT

WHILE A <> 14857: WEND

ON TIMER(1) GOSUB Tick

Startup
Main
ShutDown
END

Tick:
  PT = PadTR
  PadTR = 0
  T$ = TIME$
  Sec = VAL(MID$(T$, 7))
  TR 35, 24, FNC$(": ", (Sec MOD 2) + 1)
  Min = VAL(MID$(T$, 4, 2))
  IF LastMin <> Min THEN
    LastMin = Min
    Hr = VAL(LEFT$(T$, 2))
    IF Hr > 11 THEN APm = 1 ELSE APm = 0
    IF Hr = 0 THEN Hr = 12
    IF Hr > 12 THEN Hr = Hr - 12
    TR 33, 24, FNSPad$(Hr, 2) + ":" + FNZPad$(Min, 2) + FNC$("ap", 1 + APm) + "m"
  END IF
  D$ = DATE$
  Day = VAL(MID$(D$, 4, 2))
  IF LastDay <> Day THEN
    LastDay = Day
    TR 22, 24, FNDate$(RIGHT$(D$, 4) + LEFT$(D$, 2) + MID$(D$, 4, 2))
    SHELL "echo.|date>date.___"
    F = FREEFILE
    OPEN "i", F, "date.___"
    LINE INPUT #F, T$
    CLOSE F
    KILL "date.___"
    TR 18, 24, MID$(T$, 17, 3)
  END IF
  PadTR = PT
RETURN
    

ErrFound:
  ErrFlag = 1
  RESUME NEXT

FontData:
DATA 8,8,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,8,8,3327,3084
DATA 7421,7196,14585,14392,12531,12288,231,0,24831,24576,207,0,255,0,8
DATA 8,26367,26214,26350,26214,204,0,255,0,255,0,255,0,255,0,255,0,8,8
DATA 27903,27756,-257,-258,27884,27756,-257,-512,27884,27648,201,0,255
DATA 0,255,0,8,8,6399,6168,16127,15934,24800,24672,15615,15360,1767,1536
DATA 31996,31744,6361,6144,243,0,8,8,255,0,26367,26214,27884,27756,6361
DATA 6144,14071,13824,26342,26112,204,0,255,0,8,8,28927,28784,-10017,-10024
DATA 30455,30326,-8996,-9216,-13107,-13312,30455,30208,196,0,255,0,8,8
DATA 6399,6168,6395,6168,12531,12336,231,0,255,0,255,0,255,0,255,0,8,8
DATA 3327,3084,12529,12336,24807,24672,24815,24576,12543,12288,3311,3072
DATA 249,0,255,0,8,8,24831,24672,6367,6168,3327,3084,3325,3072,6393,6144
DATA 24819,24576,207,0,255,0,8,8,12543,12336,-18697,-18762,-772,-772,-769
DATA -1024,-18761,-18944,12532,12288,231,0,255,0,8,8,255,0,6399,6168,6395
DATA 6168,32511,32256,6360,6144,6395,6144,243,0,255,0,8,8,255,0,255,0,255
DATA 0,255,0,6399,6144,6395,6144,12531,12288,231,0,8,8,255,0,255,0,255
DATA 0,-1,-256,0,0,255,0,255,0,255,0,8,8,255,0,255,0,255,0,255,0,6399,6144
DATA 6395,6144,243,0,255,0,8,8,1791,1542,3838,3598,7420,7196,14585,14336
DATA 28915,28672,24807,24576,207,0,255,0,8,8,31999,31868,-14649,-14650
DATA -10530,-10538,-10752,-10538,-14832,-14650,31872,31868,193,0,255,0
DATA 8,8,14591,14392,6395,6168,6395,6168,6371,6168,6371,6168,15555,15420
DATA 225,0,255,0,8,8,15615,15420,26343,26214,1742,1542,6372,6168,24723
DATA 24672,32385,32382,192,0,255,0,8,8,32511,32382,1734,1542,7420,7196
DATA 1777,1542,1784,1542,31872,31868,193,0,255,0,8,8,3839,3598,6392,6168
DATA 14071,13878,26240,26214,32384,32382,1728,1542,252,0,255,0,8,8,32511
DATA 32382,24800,24672,31999,31868,1729,1542,26264,26214,15552,15420,225
DATA 0,255,0,8,8,7423,7196,12529,12336,27887,27756,26249,26214,26248,26214
DATA 15552,15420,225,0,255,0,8,8,32511,32382,1734,1542,3324,3084,6369,6168
DATA 12483,12336,12487,12336,231,0,255,0,8,8,15615,15420,26343,26214,15612
DATA 15420,26241,26214,26248,26214,15552,15420,225,0,255,0,8,8,15615,15420
DATA 26343,26214,26350,26214,14024,13878,3296,3084,14529,14392,227,0,255
DATA 0,8,8,6399,6168,6395,6168,243,0,255,0,6399,6144,6395,6144,243,0,255
DATA 0,8,8,6399,6168,6395,6168,243,0,6399,6144,6395,6144,4339,4096,8423
DATA 8192,239,0,8,8,1791,1542,6392,6168,24803,24672,6367,6144,1783,1536
DATA 252,0,255,0,255,0,8,8,255,0,32511,32382,192,0,32511,32256,192,0,255
DATA 0,255,0,255,0,8,8,24831,24672,6367,6168,1783,1542,6392,6144,24803
DATA 24576,207,0,255,0,255,0,8,8,15615,15420,26343,26214,1742,1542,7420
DATA 7168,241,0,6399,6144,243,0,255,0,8,8,14591,14392,17639,17476,-25889
DATA -25958,-21830,-22016,-17218,-17408,16609,16384,14591,14336,227,0,8
DATA 8,16127,15934,26342,26214,26350,26214,28398,28160,26350,26112,26350
DATA 26112,204,0,255,0,8,8,31999,31868,26343,26214,27884,27756,26351,26112
DATA 26350,26112,31996,31744,193,0,255,0,8,8,16127,15934,24800,24672,24815
DATA 24672,24815,24576,12543,12288,7935,7680,240,0,255,0,8,8,30975,30840
DATA 27887,27756,26351,26214,26350,26112,26350,26112,31996,31744,193,0
DATA 255,0,8,8,32511,32382,24800,24672,30975,30840,24803,24576,24815,24576
DATA 16127,15872,224,0,255,0,8,8,16127,15934,24800,24672,30975,30840,24803
DATA 24576,24815,24576,24815,24576,207,0,255,0,8,8,15615,15420,24801,24672
DATA 24815,24672,28399,28160,26350,26112,16126,15872,224,0,255,0,8,8,26367
DATA 26214,26350,26214,32510,32382,26342,26112,26350,26112,26350,26112
DATA 204,0,255,0,8,8,15615,15420,6393,6168,6395,6168,6395,6144,6395,6144
DATA 15615,15360,225,0,255,0,8,8,7935,7710,1782,1542,1790,1542,1790,1536
DATA 26366,26112,15612,15360,225,0,255,0,8,8,26367,26214,27884,27756,30969
DATA 30840,30971,30720,27887,27648,26351,26112,204,0,255,0,8,8,24831,24672
DATA 24815,24672,24815,24672,24815,24576,25327,25088,32510,32256,192,0
DATA 255,0,8,8,-14593,-14650,-4354,-4370,-258,-258,-10538,-10752,-14634
DATA -14848,-14626,-14848,156,0,255,0,8,8,26367,26214,30462,30326,32510
DATA 32382,28398,28160,26350,26112,26350,26112,204,0,255,0,8,8,15615,15420
DATA 26343,26214,26350,26214,26350,26112,26350,26112,15612,15360,225,0
DATA 255,0,8,8,31999,31868,26343,26214,26350,26214,27884,27648,24809,24576
DATA 24815,24576,207,0,255,0,8,8,15615,15420,26351,26214,26350,26214,26350
DATA 26112,27374,27136,11502,11264,1775,1536,252,0,8,8,31999,31868,26351
DATA 26214,26350,26214,30972,30720,27887,27648,26351,26112,236,0,255,0
DATA 8,8,3839,3598,6392,6168,6395,6168,6395,6144,6395,6144,28915,28672
DATA 199,0,255,0,8,8,32511,32382,192,0,6399,6168,6395,6144,6395,6144,6395
DATA 6144,243,0,255,0,8,8,26367,26214,26350,26214,26350,26214,26350,26112
DATA 28398,28160,14078,13824,228,0,255,0,8,8,28415,28270,26350,26214,27884
DATA 27756,30969,30720,28915,28672,24807,24576,207,0,255,0,8,8,-12545,-12594
DATA -14626,-14650,-14626,-14650,-10530,-10752,-258,-512,28398,28160,200
DATA 0,255,0,8,8,26367,26214,15612,15420,6393,6168,6395,6144,15615,15360
DATA 26343,26112,204,0,255,0,8,8,26367,26214,26350,26214,26350,26214,15612
DATA 15360,6393,6144,6395,6144,243,0,255,0,8,8,32511,32382,19660,19532
DATA 6361,6168,12531,12288,25319,25088,32510,32256,192,0,255,0,8,8,254
DATA 256,253,513,251,1027,247,2311,239,4879,479,10015,959,20287,192,0,8
DATA 8,24831,24672,28927,28784,14591,14392,7423,7168,3839,3584,1790,1536
DATA 252,0,255,0,8,8,255,128,127,64,63,32,31,16,15,8,7,4,3,2,0,0,8,8,24767
DATA 24608,-8637,-14782,-12876,-12924,28056,3080,3520,2304,505,257,255
DATA 0,255,0,8,8,255,0,255,0,255,0,255,0,255,0,-32001,-32126,-258,-258
DATA 128,0,8,8,15615,15420,7421,7196,3325,3084,1277,1024,253,0,255,0,255
DATA 0,255,0,8,8,255,0,15615,15420,1767,1542,14078,13824,26342,26112,16126
DATA 15872,224,0,255,0,8,8,24831,24672,27887,27756,26351,26214,26350,26112
DATA 27884,27648,30969,30720,195,0,255,0,8,8,255,0,15615,15420,24801,24672
DATA 24815,24576,24815,24576,15615,15360,225,0,255,0,8,8,1791,1542,14078
DATA 13878,26342,26214,26350,26112,26350,26112,16126,15872,224,0,255,0
DATA 8,8,255,0,15615,15420,26343,26214,28398,28160,24808,24576,15615,15360
DATA 225,0,255,0,8,8,3839,3598,6392,6168,16127,15934,6392,6144,6395,6144
DATA 6395,6144,28915,28672,199,0,8,8,255,0,16127,15934,26350,26214,26350
DATA 26112,14078,13824,1766,1536,15612,15360,225,0,8,8,24831,24672,31999
DATA 31868,26343,26214,26350,26112,26350,26112,26350,26112,204,0,255,0
DATA 8,8,6399,6168,243,0,14591,14392,6395,6144,6395,6144,6395,6144,243
DATA 0,255,0,8,8,3327,3084,249,0,7423,7196,3325,3072,3325,3072,3325,3072
DATA 30969,30720,195,0,8,8,24831,24672,26351,26214,27884,27756,30969,30720
DATA 27887,27648,26351,26112,204,0,255,0,8,8,14591,14392,6395,6168,6395
DATA 6168,6395,6144,6395,6144,7423,7168,241,0,255,0,8,8,255,0,-4865,-4884
DATA -257,-258,-10538,-10752,-14634,-14848,-14626,-14848,156,0,255,0,8
DATA 8,255,0,27903,27756,30463,30326,26342,26112,26350,26112,26350,26112
DATA 204,0,255,0,8,8,255,0,15615,15420,26343,26214,26350,26112,26350,26112
DATA 15612,15360,225,0,255,0,8,8,255,0,31999,31868,26351,26214,26350,26112
DATA 27884,27648,24809,24576,24815,24576,207,0,8,8,255,0,31999,31868,-13091
DATA -13108,-13091,-13312,27901,27648,3277,3072,7935,7680,240,0,8,8,255
DATA 0,27903,27756,30463,30326,24804,24576,24815,24576,24815,24576,207
DATA 0,255,0,8,8,255,0,3839,3598,6392,6168,6395,6144,6395,6144,28915,28672
DATA 199,0,255,0,8,8,12543,12336,15615,15420,12529,12336,12535,12288,12535
DATA 12288,7423,7168,241,0,255,0,8,8,255,0,26367,26214,26350,26214,26350
DATA 26112,28398,28160,14078,13824,228,0,255,0,8,8,255,0,26367,26214,26350
DATA 26214,26350,26112,15612,15360,6393,6144,243,0,255,0,8,8,255,0,-14593
DATA -14650,-14626,-14650,-10530,-10752,-258,-512,28398,28160,200,0,255
DATA 0,8,8,255,0,26367,26214,15612,15420,6393,6144,15615,15360,26343,26112
DATA 204,0,255,0,8,8,255,0,26367,26214,26350,26214,26350,26112,14078,13824
DATA 1766,1536,15612,15360,225,0,8,8,255,0,32511,32382,19660,19532,6361
DATA 6144,13043,12800,32510,32256,192,0,255,0,8,8,255,14,254,1598,766,7806
DATA 766,7806,254,1598,254,14,248,0,255,0,8,8,6395,6168,6395,6168,6395
DATA 6168,6395,6144,6395,6144,6395,6144,6395,6144,6395,6144,8,8,255,112
DATA 255,24700,16639,30846,16638,30846,252,24700,241,112,199,0,255,0,8
DATA 8,255,0,255,0,-16321,0,-21421,-23552,-13147,-13180,-21415,-29688,3617
DATA 2048,248,0,8,8,15615,15420,17091,16962,-16961,-16963,-20047,-20224
DATA -17985,-18176,-20045,-20224,17126,16896,15613,15360,8,8,12543,0,24807
DATA 0,-1,-32640,-1800,-32640,-1797,-32640,-3853,-32640,-32633,-32640,191
DATA 0,8,8,765,514,1786,1030,3316,2060,22697,20568,28883,8304,8423,32,239
DATA 0,255,0,8,8,1279,3598,2300,7196,4345,14392,15615,32382,2300,7196,4345
DATA 14392,8435,28784,199,0,8,8,255,0,255,0,-499,12,-444,14404,-444,14404
DATA -416,96,128,0,255,0,8,8,255,0,2287,4104,2287,4334,254,-258,-512,254
DATA -8680,222,-8680,222,144,0,8,8,14535,14392,21635,21588,-10751,-10538
DATA -512,-258,-17920,-17734,17536,17476,14529,14392,227,0,8,8,255,0,255
DATA 4096,4343,4096,14591,31760,4337,4096,247,4096,247,0,255,0,8,8,255
DATA 0,4335,4112,14575,4152,-511,-258,14464,14392,27847,10348,17545,17476
DATA 221,0,8,8,255,0,147,108,16449,27902,0,31998,128,14460,193,4152,227
DATA 16,247,0,8,8,10455,4096,24735,7168,-28051,27648,-18872,18432,11984
DATA -12288,8412,23552,12489,2048,227,0,8,8,-28417,8336,-28945,18078,-3856
DATA 26366,-29042,26366,-32640,1678,-32584,128,-32577,128,191,0,8,8,21759
DATA -428,21758,-428,10492,31784,4345,14352,251,4152,4347,14392,251,4152
DATA 227,0,8,8,31999,31868,-28013,-28014,-27978,-28014,27884,27756,14585
DATA 14392,227,0,14591,14392,227,0,8,8,255,0,2303,7176,4349,15376,10493
DATA 31776,22781,31808,253,31744,193,0,255,0,8,8,199,14392,131,17476,153
DATA 17476,153,17476,193,14392,227,4112,199,14392,231,4112,8,8,255,4096
DATA 255,14336,247,21504,213,4096,251,14336,197,17408,221,17408,249,14336
DATA 8,8,239,4096,199,10256,147,17464,169,4220,4165,14590,4096,31998,14480
DATA 31868,193,0,8,8,4351,4096,4343,4096,14591,12296,14587,8216,28927,27664
DATA 28925,27664,8441,6176,227,0,8,8,14591,4152,10475,40,27887,10348,-17733
DATA -27974,-28014,146,14526,4152,10475,10280,10475,40,8,8,3327,1036,6393
DATA 24,6651,2329,8191,3103,16126,4158,28912,8304,-7953,16608,-16161,192
DATA 8,8,255,0,255,60,4351,6270,8446,15486,254,15486,254,6270,252,60,225
DATA 0,8,8,255,0,195,60,4241,6270,8352,15486,128,15486,128,6270,192,60
DATA 225,0,8,8,255,0,195,15360,6289,30232,15520,25148,15488,16956,6272
DATA 26136,192,15360,225,0,8,8,255,0,15555,60,32401,6270,32416,15486,32384
DATA 15486,32384,6270,15552,60,225,0,8,8,255,0,15555,0,32401,6160,32416
DATA 15392,32384,15360,32384,6144,15552,0,225,0,8,8,255,0,255,15360,6399
DATA 32272,15614,32288,15614,32256,6398,32256,252,15360,225,0,8,8,255,0
DATA 0,0,255,-256,-1,-1,-1,-256,255,-256,0,0,255,0,8,8,255,0,192,0,159
DATA 7936,4031,16143,8127,16152,7359,16144,6334,15888,6332,15376,8,8,255
DATA 0,3,0,249,-2048,-3843,-784,-1795,-1008,14589,-1008,6269,31760,6205
DATA 15376,8,8,6332,15376,6334,15888,7359,16144,8127,16159,4031,16128,159
DATA 7936,192,0,255,0,8,8,6333,15376,6333,15376,6333,15376,6333,15376,6333
DATA 15376,6333,15376,6333,15376,6333,15376,8,8,6205,15376,6269,31760,14589
DATA -976,-1795,-800,-3843,-1024,249,-2048,3,0,255,0

REM $STATIC
SUB Ask (T$) : SHARED K$
  TR -1, 16, "^~X=ERASE text and start over"
  DO
    TR 6, 18, FNPad$(T$ + "_", 28)
    GetKey
    IF K$ >= " " AND LEN(K$) = 1 AND LEN(T$) < 28 THEN T$ = T$ + K$
    IF K$ = "BS" AND T$ > "" THEN T$ = FND$(T$)
    IF K$ = FNCTRL$("X") THEN T$ = ""
  LOOP UNTIL K$ = "CR" OR K$ = "ES"
  IF K$ = "ES" THEN T$ = ""
END SUB

SUB Center (A, A$) : SHARED ColFlip
  LOCATE , 40 - LEN(A$) \ 2
  ColFlip = A
  TTR A$
  PRINT
  PRINT
END SUB

SUB ChkErr : SHARED ErrFlag
  ErrFlag = 0
  ON ERROR GOTO ErrFound
END SUB

SUB DEC (N)
  N = N - 1
END SUB

FUNCTION FILELEN& (F$)
  F = FREEFILE
  OPEN "a", F, F$
  A& = LOF(F)
  IF A& = 0 THEN
    CLOSE F
    KILL F$
  ELSE
    CLOSE F
    FILELEN& = A&
  END IF
END FUNCTION

SUB GetKey : SHARED K$
' Hey there folks!  Let's leave source code for others that aren't a one-shot
' =only=for=this=one=program kinna thingy like my keyboard nipper here!
' Feel free to borrow just give credit to me somewhere in the source or
' documentation!
  Z$ = CHR$(0)
  DO
    K$ = INKEY$
  LOOP UNTIL K$ > ""
  IF K$ = CHR$(0) THEN K$ = K$ + INKEY$
  SELECT CASE K$
    CASE CHR$(27): K$ = "ES"
    CASE CHR$(9): K$ = "TA"
    CASE CHR$(13): K$ = "CR"
    CASE CHR$(8): K$ = "BS"
    CASE Z$ + "G": K$ = "HO"
    CASE Z$ + "H": K$ = "UP"
    CASE Z$ + "I": K$ = "PU"
    CASE Z$ + "K": K$ = "LF"
    CASE Z$ + "M": K$ = "RT"
    CASE Z$ + "O": K$ = "EN"
    CASE Z$ + "P": K$ = "DN"
    CASE Z$ + "Q": K$ = "PD"
    CASE Z$ + "R": K$ = "IN"
    CASE Z$ + "S": K$ = "DE"
    CASE Z$ + CHR$(15): K$ = "BT"
  END SELECT
  IF FNO$(K$) = Z$ THEN
    FOR I = 1 TO 26
      IF FNN$(ASC(FNZ$(K$))) = MID$("3048463218333435233637385049242516193120224717452144", I * 2 - 1, 2) THEN
        K$ = CHR$(128 + I): ' << we're gonna do a little icon!
        ' ^ Change this to:  K$="ALT-"+CHR$(64+I)
        ' if you wanna have K$ return back with the true keystroke
        ' but you knew that!
        EXIT FOR
      END IF
    NEXT
  END IF
' >> Leaving a Hot Key to exit anywhere in your program is nice!
  IF K$ = FNCTRL$("Q") THEN ShutDown
END SUB

SUB GetUKey : SHARED K$
  GetKey
  K$ = UCASE$(K$)
END SUB

SUB INC (N)
  N = N + 1
END SUB

SUB Main : SHARED K$, InsFlag, PadTR, DelFlag
  TR 0, 11, CHR$(128)
Main.2:
  IF FILELEN&("events.dat") = 0 THEN
    OPEN "o", 1, "events.dat"
    PRINT #1, FNNow$ + " I'm your first Event!"
    CLOSE 1
  END IF
  SHELL "sort events.dat>events2.dat"
  ' ^ This may not work outside Win98! ^
  KILL "events.dat"
  NAME "events2.dat" AS "events.dat"
  OPEN "i", 1, "events.dat"
  L = 0
  T2$ = T$
  WHILE EOF(1) = 0
    LINE INPUT #1, T$
    IF T2$ > "" AND T$ = T2$ THEN P = L
    INC L
  WEND
  CLOSE 1
  IF P >= L THEN P = L - 1
  IF P < 0 THEN P = 0
Main.3:
  LP = P
  InsFlag = 0
  DelFlag = 0
  TR 0, 11, CHR$(128)
  OPEN "i", 1, "events.dat"
  FOR I = 1 TO P - 8
    LINE INPUT #1, T$
  NEXT
  FOR I = -8 TO 8
    T$ = ""
    IF I + P >= 0 AND EOF(1) = 0 THEN
      LINE INPUT #1, T$
      IF I = 0 THEN CT$ = T$
    END IF
    IF T$ > "" THEN T$ = FNDate$(LEFT$(T$, 8)) + MID$(T$, 9)
    PadTR = 1
    TR 1, 11 + I, T$
  NEXT
  CLOSE 1
Main.4:
  GetUKey
  IF K$ = " " THEN
    T$ = CT$
    IF MID$(T$, 9, 1) = " " THEN
      MID$(T$, 9, 1) = CHR$(129)
    ELSE
      MID$(T$, 9, 1) = " "
    END IF
    Stor P, T$
    GOTO Main.2
  END IF
  IF K$ = "UP" OR K$ = "LF" THEN DEC P
  IF K$ = "DN" OR K$ = "RT" OR K$ = "CR" THEN INC P
  IF K$ = "PU" THEN P = P - 16
  IF K$ = "PD" THEN P = P + 16
  IF K$ = "HO" OR P < 0 THEN P = 0
  IF K$ = "EN" OR P > L - 1 THEN P = L - 1
  IF K$ = "DE" THEN
    TR 0, 11, " "
    Title "delete"
    TR -1, 10, FNDate$(LEFT$(CT$, 8))
    TR -1, 12, CHR$(34) + MID$(CT$, 10) + CHR$(34)
    TR -1, 14, STRING$(30, "-")
    TR -1, 16, "Really okay to " + CHR$(130) + "ZAP" + CHR$(130) + " it?"
    TR -1, 18, CHR$(128) + " {Y}es / {N}o"
    GetUKey
    IF K$ = "Y" THEN
      DelFlag = 1
      Stor P, ""
      GOTO Main.2
    END IF
    GOTO Main.3
  END IF
  IF K$ = "IN" OR K$ = "E" THEN
    TR 0, 11, " "
    IF K$ = "IN" THEN InsFlag = 1
    IF InsFlag = 1 THEN Title "insert" ELSE Title "edit"
    TR -1, 10, "Use all 4 arrow keys and"
    TR -1, 11, "{ENTER} to select date"
    TR -1, 12, "of appointment"
    IF InsFlag = 1 THEN D$ = FNNow$ ELSE D$ = LEFT$(CT$, 8)
    Y = VAL(LEFT$(D$, 4))
    M = VAL(MID$(D$, 5, 2))
    D = VAL(RIGHT$(D$, 2))
Main.Edit:
    D$ = FNZPad$(Y, 4) + FNZPad$(M, 2) + FNZPad$(D, 2)
    IF F$ = "" OR InsFlag = 1 THEN F$ = " "
    TR -1, 14, CHR$(128) + FNDate$(D$)
    GetKey
    IF K$ = "LF" THEN DEC D
    IF K$ = "RT" THEN INC D
    IF D < 1 THEN K$ = "UP"
    IF D > 31 THEN K$ = "DN"
    IF D < 1 OR K$ = "EN" THEN D = 31
    IF D > 31 OR K$ = "HO" THEN D = 1
    IF K$ = "UP" THEN DEC M
    IF K$ = "DN" THEN INC M
    IF M < 1 THEN DEC Y
    IF M > 12 THEN INC Y
    IF M < 1 OR K$ = "PD" THEN M = 12
    IF M > 12 OR K$ = "PU" THEN M = 1
    IF K$ <> "ES" AND K$ <> "CR" THEN GOTO Main.Edit
    IF K$ = "ES" THEN
      GOTO Main.3
    END IF
    TR 15, 14, " "
    IF InsFlag = 0 THEN T$ = MID$(CT$, 10) ELSE T$ = ""
    TR 5, 18, CHR$(128)
    Ask T$
    IF T$ > "" THEN
      T$ = D$ + F$ + T$
      Stor P, T$
      GOTO Main.2
    END IF
    LP = -1
  END IF
  IF K$ = "S" THEN
    TR 0, 11, " "
    Title "search"
    TR -1, 10, "What would you like"
    TR -1, 11, "to search for ?"
    TR -1, 13, "-Upper/Lowercase ignored-"
    TR -1, 14, STRING$(30, "-")
    T$ = ST$
    Ask T$
    IF T$ = "" THEN GOTO Main.3
    ST$ = T$
    LP = P
    P2 = P
    Title "search"
    TR -1, 14, "Searching . . ."
    OPEN "i", 1, "events.dat"
    FOR I = 1 TO P
      LINE INPUT #1, T$
    NEXT
    OK = 0
    WHILE OK <> 2
      LINE INPUT #1, T$
      IF INSTR(UCASE$(T$), UCASE$(ST$)) > 0 AND (OK = 1 OR P <> LP) THEN
        CLOSE 1
        GOTO Main.3
      END IF
      IF OK = 1 AND P = LP THEN OK = 2
      INC P
      IF P >= L THEN
        CLOSE 1
        OPEN "i", 1, "events.dat"
        IF OK = 0 THEN OK = 1
        P = 0
      END IF
    WEND
    CLOSE 1
    Title "error"
    TR -1, 12, "String Not Found!"
    TR -1, 14, CHR$(128) + " {OKAY}"
    ST$ = ""
    GetKey
    P = P2
    GOTO Main.3
  END IF
  IF K$ = "ES" THEN ShutDown
  IF P <> LP THEN GOTO Main.3 ELSE GOTO Main.4
END SUB

SUB Nano : SHARED TT!
  WHILE TIMER = TT!: WEND
  TT! = TIMER
END SUB

SUB NoChkErr : SHARED ErrFlaga
  ErrFlag = 0
  ON ERROR GOTO 0
END SUB

SUB PushWdw

END SUB

SUB RGB (N, R, G, B)
  OUT &H3C8, N
  OUT &H3C9, R
  OUT &H3C9, G
  OUT &H3C9, B
END SUB

SUB ShutDown : SHARED A$()
  TIMER OFF
  SCREEN 0, 1, 0, 0
  WIDTH 80
  COLOR 7, 0
  CLS
  PRINT STRING$(80, " ");
  LOCATE 10
  Center 1, A$(0)
  Center 5, A$(1)
  Center 4, A$(2)
  COLOR 7, 0
  LOCATE 23, 1, 1
  TT! = TIMER: WHILE (TIMER - TT! < 1 AND TIMER >= TT!) OR INKEY$ > "": WEND
  DO: LOOP UNTIL INKEY$ = ""
  DO: LOOP UNTIL INKEY$ > ""
  END
END SUB

SUB Startup : SHARED I.TR(), LastMin, LastDay
  CLS
  LOCATE 12, 32
  PRINT "Just A Moment ..."
  RESTORE FontData
  FOR I = 0 TO 127
    FOR J = 0 TO 17
      READ A
      I.TR(J, I) = A
    NEXT
  NEXT
  SCREEN 7
  RGB 3, 63, 50, 50: ' Gotta have our fleshtone for our pointing hand!
  LINE (0, 0)-(319, 199), 1, BF
  TR 15, 0, CHR$(127) + "reeware GrEvent v0.1 []"
  TR 0, 1, STRING$(40, "-")
  TR 0, 23, STRING$(40, "-")
  SHELL "dir>dir.___"
  OPEN "i", 1, "dir.___"
  WHILE EOF(1) = 0
    LINE INPUT #1, T$
  WEND
  CLOSE 1
  KILL "dir.___"
 
  A$ = MID$(T$, 18)
  ' ^ The position where we start to read the amount of disk space left ^
  ' This number may need to be "fudged" for operating systems other than
  ' Win98.

  T$ = ""
  FOR I = 1 TO LEN(A$)
    C$ = FNC$(A$, I)
    IF C$ <> "," THEN T$ = T$ + C$
  NEXT
  HDSpac! = VAL(T$) \ 100000

  ' Very gross error if we divide 721 by 10 in a longint& variable!
  ' HDSpac&=721:PRINT HDSpac&/10   'Yields a mess!
  ' So, we use variable HDSpac!  instead.

  TR 0, 24, "HD=" + MID$(STR$(HDSpac! / 10), 2) + "megs"
  TR -1, 20, "{INS}ert {E}dit {DEL}ete {S}earch"
  TR -1, 22, "{SPACE}=Mark {ESC}=Quit"
  LastMin = -1
  LastDay = -1
  TIMER ON
END SUB

SUB Stor (N, I$) : SHARED InsFlag, DelFlag
  OPEN "i", 1, "events.dat"
  OPEN "o", 2, "events2.dat"
  FOR I = 1 TO N
    LINE INPUT #1, T$
    PRINT #2, T$
  NEXT
  IF InsFlag = 0 THEN LINE INPUT #1, T$
  IF DelFlag = 0 THEN PRINT #2, I$
  WHILE EOF(1) = 0
    LINE INPUT #1, T$
    PRINT #2, T$
  WEND
  CLOSE
  KILL "events.dat"
  NAME "events2.dat" AS "events.dat"
END SUB

SUB Title (T$)
  FOR I = 1 TO LEN(T$)
    A$ = A$ + UCASE$(FNC$(T$, I))
    IF I < LEN(T$) THEN A$ = A$ + " "
  NEXT
  Wdw -1, 3, LEN(A$) + 4, 7
  Wdw -1, 8, 32, 19
  TR -1, 5, A$
END SUB

SUB TR (HH, V, T$) : SHARED I.TR(), PadTR
  H = HH
  IF H < 0 THEN H = 20 - LEN(T$) \ 2
  FOR I = 1 TO LEN(T$)
    PUT ((H + I - 1) * 8, V * 8), I.TR(0, ASC(FNC$(T$, I)) - 32), PSET
  NEXT
  IF PadTR = 1 THEN
    PadTR = 0
    LINE ((H + I - 1) * 8, V * 8)-(319, V * 8 + 7), 1, BF
  END IF
END SUB

SUB TTR (T$) : SHARED ColFlip
  FOR I = 1 TO LEN(T$)
    C$ = FNC$(T$, I)
    IF C$ = "_" THEN
      NextUp = 1
      INC I
      C$ = FNC$(T$, I)
      COLOR ColFlip + 8
    END IF
    IF C$ = "`" THEN C$ = CHR$(34)
    IF C$ < "A" OR I = 1 THEN COLOR ColFlip + 8: NextUp = 1
    IF NextUp = 1 THEN C$ = UCASE$(C$)
    PRINT C$;
    IF C$ <> " " THEN COLOR ColFlip: NextUp = 0
  NEXT
END SUB

SUB Wdw (HH, V, XX, Y)
  H = HH
  X = XX
  IF H < 0 THEN
    H = 20 - (X \ 2)
    X = H + X - 1
  END IF
  LINE (H * 8, V * 8)-(X * 8 + 7, Y * 8 + 7), 1, BF
  FOR I = V TO Y
    FOR J = H TO X
      C = 0
      IF I = V OR I = Y THEN C = 154
      IF J = H OR J = X THEN C = 158
      IF I = V AND J = H THEN C = 155
      IF I = V AND J = X THEN C = 156
      IF I = Y AND J = H THEN C = 157
      IF I = Y AND J = X THEN C = 159
      IF C > 0 THEN TR J, I, CHR$(C)
    NEXT
  NEXT
END SUB