home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / dbase / tclitebr / pulldown.prg < prev   
Encoding:
Text File  |  1987-07-25  |  15.6 KB  |  459 lines
  1. SET EXAC OFF
  2. SET BELL OFF
  3. SET TYPE TO 0
  4. set esca off
  5. ************** a more fully commented version of PULLDOWN with be available
  6. ************** to registered users -- RF
  7. SET TALK OFF
  8. SET PROC TO pulldown
  9. SET COLO TO w+/b
  10. esca_char=CHR(27)
  11. help_battr='31'     && background attr for help, this is color used to "erase"
  12. SET SCOR OFF        && set scoreboard off and cls
  13. LOAD DELAY          && delay.bin gives a constant delay on different machines
  14. LOAD litebar
  15. CLEA
  16. CALL LITEBAR WITH "0"           && turn off cursor
  17. CALL LITEBAR WITH "p0"
  18. m=1.3
  19. CALL DELAY WITH m
  20. CALL LITEBAR WITH "p1"
  21. CALL DELAY WITH m
  22. blankcolor=IIF(ISCO(),"17","0") && if color, our blank color is 17 (blue on blue)
  23. SET TYPE TO 1
  24. CALL litebar WITH "l0,0,0,24,79,"+blankcolor  && blank box
  25. @24,0 SAY "        Do you see snow on the screen? (Y/N)"
  26. key = 0
  27. CALL litebar  WITH CHR(6)
  28. DO WHIL .NOT. (LTRI(STR(key))$("78,110,121,89")) .OR. (key=0)
  29.     CALL litebar WITH "C0,0,23,79,"+blankcolor
  30.     key=INKEY()
  31. ENDDO
  32.  
  33. IF LTRI(STR(key))$("89,121")
  34.    CALL litebar WITH CHR(5)
  35. ENDI
  36. other_ret=CHR(3)                && returned by LITEBAR for trap of other chars
  37. funkreturn=CHR(4)               &&  "        "    "     "    "  "  function keys
  38. rememb_char="M"                 && char passed to "remember" last param & option
  39. locolor=IIF(ISCO(),"31","111")  && if color, "lolited" opts will be color 31
  40. && (hiwhite on blue)
  41. hicolor=IIF(ISCO(),"111","112") && and "hilited" options hiwhite on amber (W+/GR)
  42. funk_char="K"                   && char passed to trap fkeys
  43. help_char="H"                   && char passed for help prompts
  44. low_high="31,111,"              && as above
  45. time_str='T0,6,'                && display time at 0,6
  46. mchoice1="1,9, Menu(1) \1"
  47. mhelp1="\24,20, Press Return or '1' for menu 1 \"
  48. mchoice2="1,28, Menu(2) \2"
  49. mhelp2="\24,20, Press Return or '2' for menu 2 \"
  50. mchoice3="1,47, Menu(3) \3"
  51. mhelp3="\24,20, Press Return or '3' for menu 3 \"
  52. mchoice4="1,66, Menu(4) \4"
  53. mhelp4="\24,20, Press Return or '3' for menu 3 \"
  54. mchoice1=mchoice1+mhelp1
  55. mchoice2=mchoice2+mhelp2
  56. mchoice3=mchoice3+mhelp3
  57. mchoice4=mchoice4+mhelp4
  58. * now put it all together
  59. mchoice=help_char+help_battr+time_str+"/"+low_high+mchoice1+mchoice2+mchoice3+mchoice4
  60. msave=mchoice  && save choice 'cause LITEBAR will trash it
  61. REST FROM demomenus ADDI  && here's the rest of the menu params
  62. CLEA
  63. @0,0SAY 'Time:'
  64. DO WHIL .T.
  65.       SET COLO TO w+/b
  66.       CALL litebar WITH mchoice
  67.       IF mchoice=esca_char
  68.             EXIT
  69.       ENDI
  70.       IF mchoice=CHR(1)
  71.             @23,1 CLEA
  72.             @23,1 SAY "Whoops...something screwed up...whaddaya want for free?"
  73.             ?mchoice
  74.             WAIT ''
  75.             CANC
  76.       ENDI
  77.       @24,0SAY SPAC(60)
  78.       SET COLO TO w+/gr
  79.       
  80.       DO WHIL .t.
  81.             pchoice=mchoice
  82.             DO CASE
  83.             CASE mchoice='1'
  84.                   DO menu1
  85.             CASE mchoice='2'
  86.                   DO menu2
  87.             CASE mchoice='3'
  88.                   DO menu3
  89.             CASE mchoice='4'
  90.                   DO menu4
  91.             ENDC
  92.             IF pchoice=mchoice .OR. mchoice =esca_char
  93.                   EXIT
  94.             ENDI
  95.       ENDD
  96.       IF mchoice=esca_char
  97.             EXIT
  98.       ENDI
  99.       mchoice='*'+LEFT(pchoice,1)+msave && remember option with last selection
  100.                                         && hilited
  101. ENDD
  102.  
  103. CALL LITEBAR WITH "s0"              && save screen into buffer 0
  104. CLEA
  105. CALL LITEBAR WITH "j0,0,12,39"      && junk top left quadrant
  106. CALL LITEBAR WITH "j13,40,24,79"    && and bottom right
  107. CALL LITEBAR WITH "Q0,0,12,39"      && zap text from top left in "queer" fashion
  108. CALL LITEBAR WITH "NC178,0,0,12,39" && now add newbits to chars
  109. m=1
  110. CALL delay WITH m
  111. CALL LITEBAR WITH "XC178,0,0,12,39" && reverse those new bits with XOR
  112. CALL delay WITH m
  113. CALL LITEBAR WITH "NC178,0,0,12,39" && add 'em in again
  114. CALL delay WITH m
  115. CALL LITEBAR WITH "XC178,0,0,12,39" && reverse 'em again
  116. CALL delay WITH m
  117. CALL LITEBAR WITH "NC178,0,0,12,39" && add 'em
  118. CALL delay WITH m
  119. CALL LITEBAR WITH "Z0,0,24,79"      && zap all text on screen
  120. CALL LITEBAR WITH "XC8,0,0,12,39"   && turn on 8 bit of char
  121. CALL delay WITH m
  122. CALL LITEBAR WITH "Z0,0,24,79"      && zap all again
  123. CALL LITEBAR WITH "NC221,0,0,24,79" && fill with vertical stripe char
  124. CALL delay WITH m
  125. CALL LITEBAR WITH "XA64,0,0,12,79"  && XOR attribute for red
  126. CALL delay WITH m
  127. CALL LITEBAR WITH "Z0,0,24,79"      && zap text
  128. CALL LITEBAR WITH "NC14,0,0,24,79"  && fill screen with CHR(14)
  129. CALL LITEBAR WITH "XA32,13,0,24,79" && reverse green attribute
  130. CALL delay WITH m
  131. CALL LITEBAR WITH "Z0,0,24,79"      && zap text
  132. CALL LITEBAR WITH "NC15,0,0,24,79"  && fill with CHR(15)
  133. CALL LITEBAR WITH "XA32,13,0,24,79" && reverse green attribute again
  134. CALL delay WITH m
  135. CALL LITEBAR WITH "Z0,0,24,79"      && zap
  136. CALL LITEBAR WITH "NC9,0,0,24,79"   && fill with CHR(9)
  137. CALL LITEBAR WITH "XA16,13,0,24,79" && reverse blue attribute
  138. CALL delay WITH m
  139. CALL LITEBAR WITH "Z0,0,24,79"      && zap text again
  140. CALL LITEBAR WITH "NC8,0,0,24,79"   && fill with CHR(8)
  141. CALL delay WITH m
  142.  
  143.  
  144. tparam="R1,0,0,12,79,"+locolor      && param for scrolling top half of screen
  145. && 1 line to the right
  146. bparam="L1,13,0,24,79,"+locolor     && param to scroll left 1 line bottom half
  147. curtain=0
  148. DO WHIL curtain<79                  && do it 80 times
  149.       CALL LITEBAR WITH tparam
  150.       CALL LITEBAR WITH bparam
  151.       curtain=curtain+1
  152. ENDD
  153. SET ESCA ON
  154. CALL LITEBAR WITH "p0"              && pop screen from area 0
  155. CALL LITEBAR WITH "1"               && restore cursor
  156. RELE MODU litebar
  157. RELE MODU delay
  158. RETU
  159.  
  160.  
  161. PROC menu1
  162.  
  163. CALL litebar WITH "u0,2,4,9,21,"+blankcolor  && blank box
  164. SET COLO TO w+/gr
  165. @2,4TO 9,21 DOUBLE
  166. CALL litebar WITH "C1,9,1,17,"+hicolor       && hilite pulldown thingie
  167. m=menu1var
  168. DO WHIL .t.
  169.       CALL litebar WITH m
  170.       IF m=other_ret
  171.             mchoice=IIF(SUBS(m,2,1)=CHR(75),'4','2') && if right or left arrow returned
  172.             EXIT                                     && change active choice and we're
  173.       ENDI                                        && thru here
  174.       IF M="4"
  175.             CALL LITEBAR WITH "S0"                   && save screen into area 0
  176.             DO CHECKERS
  177.             CALL LITEBAR WITH "Z0,0,24,79"           && zap text
  178.             @23,0 SAY ''
  179.             WAIT
  180.             CALL LITEBAR WITH "U0,0,0,24,79,"+locolor && blank screen
  181.             CALL LITEBAR WITH "Z0,0,24,79"            && zap text
  182.             CALL LITEBAR WITH "NC221,0,0,24,79"       && fill with vertical stripes
  183.             @23,0 SAY ''
  184.             wait
  185.             CALL LITEBAR WITH "NC223,13,0,24,79"      && bottom half with horiz. stripes
  186.             @23,0 SAY ''
  187.             WAIT
  188.             curtain=0
  189.             DO WHIL curtain <12       && scroll top up and bottom to left and right
  190.                   CALL LITEBAR WITH "U1,0,0,12,79,"+locolor
  191.                   CALL LITEBAR WITH "R4,13,40,24,79,"+locolor
  192.                   CALL LITEBAR WITH "L4,13,0,24,39,"+locolor
  193.                   curtain=curtain+1
  194.             ENDDO
  195.             CALL LITEBAR WITH "P0"                    && pop screen from area 0
  196.       ENDI
  197.       IF m=esca_char                               && user hit escape?
  198.             EXIT
  199.       ENDI
  200.       m=rememb_char+SPAC(10)
  201. ENDD
  202. CALL litebar WITH "C2,4,13,23,"+blankcolor      && hide menu with blank color
  203. CALL litebar WITH "C1,9,1,17,"+locolor          && "uncolor" top menu selection
  204.  
  205. RETU
  206.  
  207. PROC menu2
  208.  
  209. accpt_resp=CHR(1)+CHR(2)+CHR(3)+CHR(4)
  210. CALL litebar WITH "u0,2,23,9,40,"+blankcolor
  211. @2,23TO 9,40 DOUBLE
  212. CALL litebar WITH "C1,28,1,36,"+hicolor
  213. m=menu2var
  214. CALL litebar WITH m
  215. DO WHIL .T.
  216.       IF m=funkreturn .AND.SUBS(m,2,1)$accpt_resp
  217.             choice=ASC(SUBS(m,2,1))
  218.             CALL litebar WITH "S0"
  219.             CALL litebar WITH "C2,23,9,40,"+blankcolor
  220.             IF choice=4
  221.                   CLEA
  222.                   LIST MEMO
  223.                   CALL LITEBAR WITH "C0,0,24,79,"+LTRI(STR(VAL(hicolor)+128))
  224.                   d1=2
  225.                   CALL DELAY WITH d1
  226.                   centerrow=12
  227.                   centercol=39
  228.                   windowsize=1
  229.                   windcount=0
  230.                   DO WHIL windcount<34
  231.                         mparam="C"+LTRI(STR(INT(centerrow-(windowsize/3))))+","+LTRI(STR(centercol-windowsize+2))+","+LTRI(STR(INT(centerrow+(windowsize/3))))+","+LTRI(STR(centercol+windowsize+2))+","+locolor
  232.                         CALL LITEBAR WITH mparam
  233.                         windcount=windcount+1
  234.                         windowsize=windowsize+1
  235.                   ENDD
  236.                   CALL LITEBAR WITH "P0"
  237.                   m=rememb_char+SPAC(80)
  238.                   CALL litebar WITH m
  239.                   LOOP
  240.             ENDI
  241.             EXIT
  242.       ENDI
  243.       IF m=other_ret
  244.             mchoice=IIF(SUBS(m,2,1)=CHR(75),'1','3')
  245.             EXIT
  246.       ENDI
  247.       IF m=esca_char
  248.             EXIT
  249.       ELSE
  250.             ??CHR(7)
  251.             @20,0SAY "You must press a func. key or escape to get out of this menu..any key to resume"
  252.             WAIT ''
  253.             CALL litebar WITH "C20,0,20,80,"+blankcolor
  254.       ENDI
  255.       m=rememb_char+SPAC(80)
  256.       CALL litebar WITH m
  257. ENDD
  258. CALL litebar WITH "C1,28,1,36,"+locolor
  259. CALL litebar WITH "C2,23,13,40,"+blankcolor
  260.  
  261.  
  262. RETU
  263.  
  264. PROC menu3
  265.  
  266. CALL litebar WITH "u0,2,42,9,59,"+blankcolor
  267. @2,42TO 9,59 DOUBLE
  268. CALL litebar WITH "C1,47,1,55,"+hicolor
  269. m=menu3var
  270. DO WHIL .t.
  271.       CALL litebar WITH m
  272.       IF m=other_ret
  273.             mchoice=IIF(SUBS(m,2,1)=CHR(75),'2','4')
  274.             EXIT
  275.       ENDI
  276.       IF m="3"
  277.             CALL LITEBAR WITH "S0"
  278.             CALL LITEBAR WITH "U0,11,21,20,58,"+LTRI(STR(VAL(hicolor)))
  279.             @12,24 SAY " ░▓▓░░░▓▓░░░▓▓▓░░░▓▓░░░▓▓░░░▓▓░░░"
  280.             @13,24 SAY "░░▓▓░░░▓▓░░▓▓░▓▓░░▓▓░░░▓▓░░▓▓▓▓░  "
  281.             @14,24 SAY " ░▓▓░░░▓▓░▓▓░░░▓▓░▓▓░░░▓▓░░▓▓▓▓░░"
  282.             @15,24 SAY "░░▓▓░▓░▓▓░▓▓░░░▓▓░▓▓░▓░▓▓░░░▓▓░░"
  283.             @16,24 SAY " ░▓▓▓▓▓▓▓░▓▓░░░▓▓░▓▓▓▓▓▓▓░░░▓▓░░░"
  284.             @17,24 SAY "░░▓▓▓░▓▓▓░░▓▓░▓▓░░▓▓▓░▓▓▓░░░░░░░"
  285.             @18,24 SAY " ░▓▓░░░▓▓░░░▓▓▓░░░▓▓░░░▓▓░░░▓▓░░░"
  286.             CALL LITEBAR WITH "C11,21,20,58,"+LTRI(STR(VAL(hicolor)+128))
  287.             d1=3
  288.             CALL DELAY WITH d1
  289.             d1=2
  290.             CALL LITEBAR WITH "Q11,21,20,58"
  291.             CLEA
  292.             call litebar with "B1,0, LITEBAR"
  293.             call litebar with "B9,0,  MAKES"
  294.             call litebar with "B17,0, BANNERS"
  295.             CALL DELAY WITH d1
  296.             CALL LITEBAR WITH "P0"
  297.             
  298.       ENDI
  299.       IF m=esca_char
  300.             EXIT
  301.       ENDI
  302.       m=rememb_char+SPAC(10)
  303. ENDD
  304. CALL litebar WITH "C1,47,1,55,"+locolor
  305. CALL litebar WITH "C2,42,13,63,"+blankcolor
  306.  
  307. RETU
  308.  
  309. PROC menu4
  310.  
  311. CALL litebar WITH "u0,2,61,9,78,"+blankcolor
  312. @2,61 TO 9,78 DOUBLE
  313. CALL litebar WITH "C1,66,1,74,"+hicolor
  314. m=menu4var
  315. DO WHIL .t.
  316.       CALL litebar WITH m
  317.       IF m=other_ret
  318.             mchoice=IIF(SUBS(m,2,1)=CHR(75),'3','1')
  319.             EXIT
  320.       ENDI
  321.       IF m="4"
  322.             CALL LITEBAR WITH "S0"
  323.             CALL LITEBAR WITH "C0,0,20,40,"+hicolor
  324.             @22,0 SAY ''
  325.             WAIT
  326.             CALL LITEBAR WITH "C0,0,10,79,"+locolor
  327.             @22,0 SAY ''
  328.             WAIT
  329.             CALL LITEBAR WITH "C0,0,24,79,"+hicolor
  330.             @22,0 SAY ''
  331.             WAIT
  332.             CALL LITEBAR WITH "NC255,0,0,24,79"
  333.             CALL LITEBAR WITH "XC255,0,0,24,79"
  334.             @22,0 SAY ''
  335.             WAIT
  336.             CALL LITEBAR WITH "NC36,0,0,12,79"
  337.             @22,0 SAY ''
  338.             WAIT
  339.             CALL LITEBAR WITH "U0,0,0,24,79,"+locolor
  340.             
  341.             *ascii table works better with FOX <grin>
  342.             SET COLO TO W+/B
  343.             @10,20 SAY "▄▄▄▄▄▄▄▄▄▄▄▄▄ ASCII TABLE ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄"
  344.             @11,20 SAY "█Dec████ (Better when compiled) █████Hex█"
  345.             mchar=0
  346.             mrow=12
  347.             @4,0 SAY "Litebar is fast==>"
  348.             @13,0 SAY "When dBASE is"
  349.             @14,0 SAY " just too slow==>"
  350.             DO WHIL mrow<20
  351.                   mcol=24
  352.                   @mrow,20 SAY mchar PICT "999"
  353.                   DO WHIL mcol<57 .AND. mchar < 256
  354.                         coords=LTRI(STR(mrow))+","+LTRI(STR(mcol))+","+LTRI(STR(mrow))+","+LTRI(STR(mcol))
  355.                         @mrow,mcol SAY CHR(mchar)
  356.                         CALL LITEBAR WITH "C"+coords+","+LTRI(STR(mchar))
  357.                         CALL LITEBAR WITH "C4,0,4,18,"+LTRI(STR(mchar))
  358.                         CALL LITEBAR WITH "C13,0,14,18,"+LTRI(STR(mchar))
  359.                         CALL LITEBAR WITH "U0,1,20,8,60,"+LTRI(STR(mchar))
  360.                         CALL LITEBAR WITH "Z1,20,8,60,"+LTRI(STR(mchar))
  361.                         CALL LITEBAR WITH "NC"+LTRI(STR(mchar))+",1,20,8,60,"
  362.                         mcol=mcol+1
  363.                         mchar=mchar+1
  364.                   ENDD
  365.                   lhchar=INT((mchar-1)/16)
  366.                   rhchar=(mchar-(lhchar*16))-1
  367.                   hexx_char=IIF(lhchar>9,CHR(lhchar+55),CHR(lhchar+48))+IIF(rhchar>9,CHR(rhchar+55),CHR(rhchar+48))
  368.                   @mrow,58 SAY hexx_char PICT "!!!"
  369.                   mrow=mrow+1
  370.             ENDD
  371.             @23,0 SAY ''
  372.             WAIT
  373.             CALL LITEBAR WITH "S1"
  374.             CALL LITEBAR WITH "L15,0,0,24,79,"+hicolor
  375.             @22,0 SAY ''
  376.             WAIT
  377.             CALL LITEBAR WITH "C0,0,24,79,"+locolor
  378.             @22,0 SAY ''
  379.             WAIT
  380.             CALL LITEBAR WITH "R15,0,0,24,79,"+locolor
  381.             @22,0 SAY ''
  382.             WAIT
  383.             CALL LITEBAR WITH "U0,0,0,24,79,"+blankcolor
  384.             @22,0 SAY ''
  385.             WAIT
  386.             CALL LITEBAR WITH "P1"
  387.             WAIT ''
  388.             RUN DIR /W
  389.             IF ISCO()
  390.                   DO LITESHOW
  391.             ENDI
  392.             
  393.             mparam="L1,0,8,24,79,"+locolor
  394.             curtain=0
  395.             DO WHIL curtain<72
  396.                   CALL LITEBAR WITH mparam
  397.                   curtain = curtain+1
  398.             ENDD
  399.             
  400.             mparam="U1,0,0,24,20,"+locolor
  401.             curtain=0
  402.             DO WHIL curtain<25
  403.                   CALL LITEBAR WITH mparam
  404.                   curtain=curtain+1
  405.             ENDD
  406.             CALL LITEBAR WITH "P0"
  407.       ENDI
  408.       IF m=esca_char
  409.             EXIT
  410.       ENDI
  411.       m=rememb_char+SPAC(10)
  412. ENDD
  413. CALL litebar WITH "C1,66,1,74,"+locolor
  414. CALL litebar WITH "C2,61,13,79,"+blankcolor
  415. RETU
  416.  
  417.  
  418. PROC LITESHOW
  419.  
  420.  
  421. centerrow=12
  422. centercol=39
  423. windowsize=1
  424. attrcount=0
  425.  
  426. DO WHIL attrcount<34
  427.       mparam="C"+LTRI(STR(INT(centerrow-(windowsize/3))))+","+LTRI(STR(centercol-windowsize+2))+","+LTRI(STR(INT(centerrow+(windowsize/3))))+","+LTRI(STR(centercol+windowsize+2))+","+LTRI(STR(attrcount*16))
  428.       CALL LITEBAR WITH mparam
  429.       attrcount=attrcount+1
  430.       windowsize=windowsize+1
  431. ENDD
  432. DO WHIL attrcount>0
  433.       mparam="C"+LTRI(STR(INT(centerrow-(windowsize/3))))+","+LTRI(STR(centercol-windowsize+2))+","+LTRI(STR(INT(centerrow+(windowsize/3))))+","+LTRI(STR(centercol+windowsize+2))+","+LTRI(STR(attrcount*16))
  434.       CALL LITEBAR WITH mparam
  435.       attrcount=attrcount-1
  436.       windowsize=windowsize-1
  437. ENDD
  438.  
  439. RETU
  440.  
  441. PROC CHECKERS
  442.  
  443. msrow=0
  444. attr=VAL(locolor)
  445. aatr=128
  446. DO WHIL msrow<19
  447.       mscol=0
  448.       merow=","+LTRI(STR(msrow+6))
  449.       attr=IIF(attr=VAL(locolor),VAL(hicolor),VAL(locolor))
  450.       DO WHIL mscol<61
  451.             mecol=","+LTRI(STR(mscol+19))+","
  452.             attr=IIF(attr=VAL(locolor),VAL(hicolor),VAL(locolor))
  453.             CALL LITEBAR WITH "C"+LTRI(STR(msrow))+","+LTRI(STR(mscol))+merow+mecol+LTRI(STR(attr+IIF(MOD(mscol,40)=0,128,0)))
  454.             mscol=mscol+20
  455.       ENDD
  456.       msrow=msrow+6
  457. ENDD
  458.  
  459. RETU