home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / clockcal.zip / IBMCLOCK.PRG < prev    next >
Text File  |  1991-01-27  |  3KB  |  145 lines
  1. *** IBMCLOCK.prg
  2. *
  3. * (c) CTS, MRI 1991
  4. *
  5. private tl,tp,tr,bt,bl,br,lf,rt,li,ri,TM,mESCA,mCURS,mTALK,mFIX,TMALL
  6. DECL TM[11,3], TMALL[3]
  7. mESCA=SET('ESCA')='ON'
  8. mCURS=SET('CURS')='ON'
  9. mTALK=SET('TALK')='ON'
  10. mFIX=.F.
  11. SET TALK OFF
  12. SET ESCA OFF
  13. SET CURS OFF
  14. *=-
  15. *    If this was called by an ON KEY LABEL Command, you must
  16. *    deactivate the ON KEY LABEL by un-remarking the following
  17. *    line and enter the calling key name at the end of the line
  18. *
  19.    ON KEY LABEL F2
  20.    ON KEY LABEL CTRL-T DO TOGLTIME
  21. *=-
  22. IF TYPE('X')#'N' .OR. TYPE('Y')#'N' .OR. X>19 .OR. Y>39
  23.   IF TYPE('X')#"U" .OR. TYPE('Y')#"U"
  24.     x1=X
  25.     y1=Y
  26.     mFIX=.T.
  27.   ENDIF
  28.   X=1
  29.   Y=1
  30. ENDIF
  31. DEFINE WINDOW CLOCK FROM X,Y TO X+5,Y+30 DOUBLE COLOR W+/N,,GR+/R
  32. ACTI WIND CLOCK
  33. DO IBMCHRS
  34. *=-
  35. DO WHILE .T.
  36.   XTIME=IIF(SET('HOUR')=24,TIME(),IIF(VAL(LEFT(TIME(),2))>12,;
  37.         STR(VAL(LEFT(TIME(),2))-12,2)+SUBS(TIME(),3,6),TIME()))
  38.   HR1=VAL(LEFT(XTIME,1))+1
  39.   HR2=VAL(SUBS(XTIME,2,1))+1
  40.   MN1=VAL(SUBS(XTIME,4,1))+1
  41.   MN2=VAL(SUBS(XTIME,5,1))+1
  42.   SC1=VAL(SUBS(XTIME,7,1))+1
  43.   SC2=VAL(SUBS(XTIME,8,1))+1
  44.   TMALL[1]=TM[HR1,1]+" "+TM[HR2,1]+TM[11,1]+TM[MN1,1]+" "+TM[MN2,1]+TM[11,1]+TM[SC1,1]+" "+TM[SC2,1]
  45.   TMALL[2]=TM[HR1,2]+" "+TM[HR2,2]+TM[11,2]+TM[MN1,2]+" "+TM[MN2,2]+TM[11,2]+TM[SC1,2]+" "+TM[SC2,2]
  46.   TMALL[3]=TM[HR1,3]+" "+TM[HR2,3]+TM[11,3]+TM[MN1,3]+" "+TM[MN2,3]+TM[11,3]+TM[SC1,3]+" "+TM[SC2,3]
  47.   @0,1 SAY TMALL[1]
  48.   @1,1 SAY TMALL[2]
  49.   @2,1 SAY TMALL[3]
  50.   @3,20 SAY IIF(SET('HOUR')=24,'Military',"    "+IIF(VAL(LEFT(TIME(),2))>12,"P","A")+".M.")
  51.   I=INKEY()
  52.   IF I=27
  53.     EXIT
  54.   ENDIF
  55. ENDDO
  56. RELE WIND CLOCK
  57. IF mCURS
  58.   SET CURS ON
  59. ENDIF
  60. IF mESCA
  61.   SET ESCA ON
  62. ENDIF
  63. IF mTALK
  64.   SET TALK ON
  65. ENDIF
  66. IF mFIX
  67.   X=x1
  68.   Y=y1
  69. ENDIF
  70. *=-
  71. *    If this was called by an ON KEY LABEL Command, you must
  72. *    Reactivate the ON KEY LABEL by un-remarking the following
  73. *    line and enter the calling key name after LABEL and before
  74. *    the DO CALENDAR part of the command
  75. *
  76.   ON KEY LABEL F2 DO CLOCKIT
  77.   ON KEY LABEL CTRL-T
  78. *=-
  79. RETURN
  80. *** End of IBMCLOCK.prg
  81. *
  82. *=-    Procedures & Functions follow
  83. *
  84. PROC TOGLTIME
  85. ON KEY LABEL F5
  86. IF SET('HOUR')=12
  87.   SET HOUR TO 24
  88. ELSE
  89.   SET HOUR TO 12
  90. ENDIF
  91. ON KEY LABEL F5 DO TOGLTIME
  92. RETURN
  93. *
  94. PROC IBMCHRS
  95. tl=chr(201)
  96. tr=chr(187)
  97. bl=chr(200)
  98. br=chr(188)
  99. store chr(205) to tp,bt,mi
  100. store chr(186) to lf,rt
  101. li=chr(204)
  102. ri=chr(185)
  103. tn=chr(210)
  104. bn=chr(208)
  105. bx=CHR(220)
  106. mt=' '
  107. *
  108. tm[1,1]=tl+tp+tr
  109. tm[1,2]=lf+mt+rt
  110. tm[1,3]=bl+bt+br
  111. tm[2,1]=mt+mt+tn
  112. tm[2,2]=mt+mt+lf
  113. tm[2,3]=mt+mt+bn
  114. tm[3,1]=tp+tp+tr
  115. tm[3,2]=tl+mi+br
  116. tm[3,3]=bl+mi+mi
  117. tm[4,1]=tp+tp+tr
  118. tm[4,2]=mt+mi+ri
  119. tm[4,3]=bt+bt+br
  120. tm[5,1]=tn+mt+tn
  121. tm[5,2]=bl+mi+ri
  122. tm[5,3]=mt+mt+bn
  123. tm[6,1]=tl+tp+tp
  124. tm[6,2]=bl+mi+tr
  125. tm[6,3]=bt+bt+br
  126. tm[7,1]=tl+tp+tp
  127. tm[7,2]=li+mi+tr
  128. tm[7,3]=bl+bt+br
  129. tm[8,1]=tp+tp+tr
  130. tm[8,2]=mt+mt+rt
  131. tm[8,3]=mt+mt+bn
  132. tm[9,1]=tl+tp+tr
  133. tm[9,2]=li+mi+ri
  134. tm[9,3]=bl+mi+br
  135. tm[10,1]=tl+mi+tr
  136. tm[10,2]=bl+mi+ri
  137. tm[10,3]=mi+mi+br
  138. TM[11,1]=MT+BX+MT
  139. TM[11,2]=MT+BX+MT
  140. TM[11,3]=MT+MT+MT
  141.  
  142. RETURN
  143. *=- End of PROCEDURES
  144. *
  145.