home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / QBA201.ZIP / CALDEMO.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-12-31  |  1.6 KB  |  65 lines
  1. 'Calendar demo for QBAccel(Tm) copyright(c)1992 Crady vonPawlak
  2.  
  3. DEFINT A-Z
  4. SHELL "cls"
  5. SHELL "dir/w"
  6. PCOPY 0, 1
  7. CALL Bricks(71, 1, 24)
  8.  
  9.  d$ = DATE$
  10.  f = LEN(d$)
  11.  q = VAL(MID$(d$, 1, 2))
  12.  IF q < 10 THEN GOTO lomonths
  13.  
  14. himonths:
  15.  q$ = MID$(d$, 1, 2)
  16.   IF q$ = "10" THEN a$ = "October"
  17.   IF q$ = "11" THEN a$ = "November"
  18.   IF q$ = "12" THEN a$ = "December"
  19.  GOTO makedate
  20.  
  21. lomonths:
  22.   q$ = MID$(d$, 1, 2)
  23.    IF q$ = "01" THEN a$ = "January": GOTO makedate
  24.    IF q$ = "02" THEN a$ = "February": GOTO makedate
  25.    IF q$ = "03" THEN a$ = "March": GOTO makedate
  26.    IF q$ = "04" THEN a$ = "April": GOTO makedate
  27.    IF q$ = "05" THEN a$ = "May": GOTO makedate
  28.    IF q$ = "06" THEN a$ = "June": GOTO makedate
  29.    IF q$ = "07" THEN a$ = "July": GOTO makedate
  30.    IF q$ = "08" THEN a$ = "August": GOTO makedate
  31.    IF q$ = "09" THEN a$ = "September": GOTO makedate
  32.  
  33. makedate:
  34.   MID$(d$, 3, 1) = CHR$(0)
  35.   MID$(d$, 6, 1) = CHR$(0)
  36.   MID$(d$, 1, 2) = "  "
  37.   d$ = LTRIM$(d$)
  38.   dte$ = a$ + d$
  39. When$ = dte$
  40.  
  41. dt$ = DATE$
  42. dy = VAL(MID$(DATE$, 1, 2))
  43. mn = VAL(MID$(DATE$, 7, 4))
  44.  
  45. ' Print calendar to screen.
  46.  
  47. CALL GroWindow(40, 69, 12, 20, 1, 1, "l", 1, 8, 7, When$, 3, 0, 1, 0)
  48. CALL PrintCal(dy, mn, 14, 42, 15, 1)
  49. LOCATE 13, 42: CALL ZiPrint("S   M   T   W   T   F   S", 25)
  50.  
  51. LOCATE 1, 1: CALL ZiPrint(" Press any key to quit... ", 112)
  52.  
  53. ' Wait for keypress and update clock.
  54.  
  55. CALL WipeKBD
  56. DO
  57.    CALL DigiClock(Tme$):
  58.    LOCATE 20, 42: CALL ZiPrint("┤" + Tme$ + "├", 120)
  59. LOOP WHILE INKEY$ = ""
  60.  
  61. CALL Curtains(1): ' Restore old screen.
  62. LOCATE 24, 1
  63. END: ' End demo
  64.  
  65.