home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / keyboard / loadky / load.bas < prev    next >
Encoding:
BASIC Source File  |  1993-12-20  |  5.9 KB  |  251 lines
  1. '*******************************LOADKYBD.BAS******************************
  2. 'More PEEK and POKES
  3. 'This program POKES a command into the keyboard type-ahead buffer so that you
  4. 'can execute a program -after- you exit a QuickBASIC program or EXIT
  5. 'and restart the QuickBASIC program with a batch file that restarts
  6. 'LOADKYBD.BAS.
  7. 'The SUB  ClearKeyBoard ==really==  clears the keyboard buffer
  8. 'not sure it is better than:
  9. 'WHILE INKEY$ <> "": WEND
  10. 'but the SUB ClearKeyBoard -erases- the keyboard buffer
  11. '
  12. 'ideas and code from Ethan Winer's book, an article by Phil Weber, &
  13. 'from QuickBASIC Bible examples on PEEK and POKE
  14. 'I just provided the glue code.
  15. '
  16. 'The executable file is made with Crescent's PDQ library to be tiny; the
  17. 'QuickBASIC program -looks- better but was 40K, LOAD.COM is less than 5K
  18. '
  19. '12/20/93
  20.  
  21. DEFINT A-Z
  22. CONST False = 0, True = NOT False
  23.  
  24. TYPE RegType
  25.      AX        AS INTEGER
  26.      BX        AS INTEGER
  27.      CX        AS INTEGER
  28.      DX        AS INTEGER
  29.      BP        AS INTEGER
  30.      SI        AS INTEGER
  31.      DI        AS INTEGER
  32.      Flags     AS INTEGER
  33.      DS        AS INTEGER
  34.      ES        AS INTEGER
  35. END TYPE
  36.  
  37. DECLARE SUB SetBorder (ColrByte%)
  38. DECLARE SUB CursorBlock ()
  39. DECLARE SUB CursorNone ()
  40. DECLARE SUB ColorIt (Fgd%, Bkgd%)
  41. DECLARE SUB PokeColor (Address%, Colr%)
  42. DECLARE SUB BackScreen (Char%)
  43. DECLARE SUB Shadowbox2 (top%, Bottom%, wide%, BoxColr%, Fgd%, Bkgd%, ColorFlag%)
  44. DECLARE SUB Mono (Flag%)
  45. DECLARE SUB CursorOn2 ()
  46. DECLARE SUB CursorOff2 ()
  47. DECLARE SUB Buffer (Cmd$)
  48. DECLARE SUB ClearKeyBoard ()
  49. DECLARE SUB LocateIt (Row%, text$)
  50. DECLARE SUB INTERRUPT (intNum AS INTEGER, Reg AS RegType)
  51.  
  52. 'executable code starts here
  53. DEF FnCenterit (text$) = 41 - (LEN(text$) \ 2)
  54. COLOR 15, 1
  55. CLS
  56. CALL CursorNone
  57. CALL SetBorder(4)
  58. CALL Mono(Flag)
  59.  
  60. IF Flag THEN
  61.     ColorFlag% = &H800           'if a mono screen this is where we
  62.                                  'must be to make the shadow with POKE
  63. ELSE
  64.     ColorFlag% = &HB800          'where I usually am... in color
  65. END IF
  66.  
  67. CALL BackScreen(178)
  68. 'STOP
  69. wide% = 60
  70. CALL Shadowbox2(2, 20, wide%, 4, 15, 4, ColorFlag%)
  71. 'STOP
  72. CALL ColorIt(14, 4)
  73. text$ = "Enter DOS command to run when this program EXITs"
  74. CALL LocateIt(4, text$)
  75. 'STOP
  76. text$ = "Command must not be more than 14 Characters"
  77. CALL LocateIt(6, text$)
  78.  
  79. CALL ColorIt(13, 4)
  80. text$ = STRING$(wide% - 4, 196)
  81. CALL LocateIt(8, text$)
  82.  
  83. text$ = " »»» Press {Enter} ─┘ when Finished Editing ««« "
  84. CALL ColorIt(11, 0)
  85. CALL LocateIt(18, text$)
  86.  
  87. text$ = STRING$(14, 32)
  88. CALL ColorIt(7, 0)
  89. CALL LocateIt(12, text$)
  90.  
  91. LOCATE 12, FnCenterit(text$)
  92. CALL CursorBlock
  93. CALL ClearKeyBoard
  94. INPUT "", Cmd$
  95. CALL CursorNone
  96. 'Cmd$ = "CLS" + CHR$(13) + "DIR/W"
  97. CALL Buffer(Cmd$)
  98. 'STOP
  99.  
  100. SUB BackScreen (Char%)
  101. CLS
  102. FOR i = 1 TO 24
  103.     PRINT STRING$(80, Char%);
  104.     NEXT
  105.     LOCATE 25, 1
  106.     PRINT STRING$(80, Char%);
  107. END SUB
  108.  
  109. 'from QuickBASIC Bible p 721
  110. SUB Buffer (Cmd$)
  111. Cmd$ = LEFT$(Cmd$, 14) + CHR$(13)
  112. length% = LEN(Cmd$)
  113. DEF SEG = &H40
  114. head% = &H1A
  115. tail% = &H1C
  116. start% = &H1E
  117. FOR i = 1 TO length%
  118.     POKE start% + (i - 1) * 2, ASC(MID$(Cmd$, i, 1))
  119. NEXT
  120. POKE tail%, start% + (i - 1) * 2
  121. POKE head%, start%
  122. DEF SEG
  123.  
  124. END SUB
  125.  
  126. SUB ClearKeyBoard
  127.  
  128.     DEF SEG = 0
  129.     Temp& = PEEK(&H41A) + (PEEK(&H41B) * 256&)
  130.     head = Temp& AND &HFFFF&                'Clear keyboard buffer
  131.     POKE &H41C, head AND 255                'by setting head ptr
  132.     POKE &H41D, head \ 256                  'equal to tail ptr.
  133.  
  134. END SUB
  135.  
  136. SUB ColorIt (Fgd%, Bkgd%)
  137. COLOR Fgd%, Bkgd%
  138. END SUB
  139.  
  140. SUB CursorBlock
  141. LOCATE , , 1, 4, 7
  142. END SUB
  143.  
  144. SUB CursorNone
  145. LOCATE , , 0
  146. END SUB
  147.  
  148. SUB LocateIt (Row%, text$)
  149. LOCATE Row%, FnCenterit(text$)
  150. PRINT text$;
  151. END SUB
  152.  
  153. SUB Mono (Flag%)
  154. IF PEEK(&H463) = &H4B THEN
  155.     'we got a monochrome screen
  156.     Flag% = True
  157. ELSE
  158.     'we gots color
  159.     Flag% = False
  160. END IF
  161. END SUB
  162.  
  163. SUB PokeColor (Address%, Colr%)
  164. 'POKE Address%, Character%
  165. POKE Address% + 1, Colr%
  166. END SUB
  167.  
  168. DEFSNG A-Z
  169. SUB SetBorder (ColrByte%) STATIC
  170. DIM Regs AS RegType
  171. Regs.AX = &H1001
  172. Regs.BX = ColrByte% * &H100
  173. CALL INTERRUPT(&H10, Regs)
  174. END SUB
  175.  
  176. DEFINT A-Z
  177. SUB Shadowbox2 (top%, Bottom%, wide%, BoxColr%, Fgd%, Bkgd%, ColorFlag%)
  178. DEF SEG = ColorFlag%
  179. REDIM box$(3)
  180. box$(1) = "█"
  181.  
  182. box$(2) = "▀"
  183. box$(3) = "▄"
  184.  
  185.  
  186. 'this sets the colors
  187.   COLOR Fgd%, Bkgd%
  188.     Left% = (80 - wide%) \ 2
  189.     right% = Left% + wide%
  190.     middle% = right% - Left%
  191.     rows% = top%
  192.  
  193.     boxtop% = wide% - 1
  194.  
  195. 'this prints the box and sets the background color of the box
  196. 'if you use a zero, you get a transparent box
  197. IF BoxColr% = 0 THEN GOTO MakeBox
  198.         COLOR , BoxColr%
  199.  
  200.         FOR boxsize% = top% TO Bottom%
  201.                 LOCATE rows%, Left%, 0
  202.                 PRINT SPACE$(middle%);
  203.                 rows% = rows% + 1
  204.         NEXT
  205.  
  206. 'this prints the box outline
  207.  
  208. MakeBox:
  209.                 LOCATE top%, Left%
  210.                 COLOR Fgd%, Bkgd%
  211.                 PRINT box$(1); STRING$(boxtop%, box$(2)); box$(1);
  212.                 FOR rows% = top% + 1 TO Bottom% - 1
  213.                         LOCATE rows%, Left%
  214.                         PRINT box$(1);
  215.                         LOCATE rows%, right%
  216.                         PRINT box$(1);
  217.                 NEXT rows%
  218.                 LOCATE Bottom%, Left%
  219.                 PRINT box$(1); STRING$(boxtop%, box$(3)); box$(1);
  220. 'STOP
  221.  
  222. 'Now the shadow
  223.  
  224. foregd = 7
  225. Backgd = 0
  226.  
  227. 'use the simple color formula
  228. Colr% = foregd + (16 * Backgd)
  229. 'prints the bottom
  230. FOR i = 0 TO wide%
  231. 'from QuickBASIC Bible, p 715
  232. offset% = (Bottom%) * 160 + (Left% + i) * 2
  233. Character% = PEEK(offset%)
  234. CALL PokeColor(offset%, Colr%)
  235. NEXT i
  236. 'STOP
  237. 'prints the right side
  238. FOR i = top% TO Bottom%
  239. offset% = (i) * 160 + (right%) * 2
  240. Character% = PEEK(offset%)
  241. CALL PokeColor(offset%, Colr%)
  242. offset% = (i) * 160 + (right% + 1) * 2
  243. Character% = PEEK(offset%)
  244. CALL PokeColor(offset%, Colr%)
  245.  
  246. NEXT
  247. 'STOP
  248. DEF SEG
  249. END SUB
  250.  
  251.