home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / keyboard / not2pt / prtscrn.bas < prev    next >
Encoding:
BASIC Source File  |  1994-04-17  |  9.8 KB  |  471 lines
  1. '********************************PRTSCRN.BAS*******************************
  2. '
  3. 'JRD NOTE:
  4. '
  5. 'Another "not to be found" little program, how to disable and re-enable
  6. 'the Print Screen Key. Tossed in a Print Screen Toggle and the Print
  7. 'Screen INTERRUPT too. But the INTERRUPT was easy as that is described
  8. 'everywhere.....
  9. '
  10. 'Since I know that some of you will pound away at that Print Screen key,
  11. 'I decided to trap it.... Ha! easier said than done. The Print Screen key
  12. 'is handled by the ROM BIOS; there is no scan code, no ASCII code, no
  13. 'INTERRUPT, no nothin' way to trap that key short of Assembly, "C" or ...?
  14. '
  15. 'What I have done is... use KEY ON. And even with that you have to trap
  16. 'five (5) key states which do not include the Caps Locks or Num Lock keys.
  17. '
  18. 'Made a SUB to disable or toggle those keys.
  19. '
  20. '4/17/94
  21. '
  22. DEFINT A-Z
  23. '$INCLUDE: 'qb.bi'
  24. DIM SHARED Regs AS RegType
  25. 'CONST False = 0, True = -1
  26.  
  27. 'Declares from JOHN_SUB.BAS
  28. 'SUBs
  29. DECLARE SUB ColorIt (Fgd%, Bkg%)
  30. DECLARE SUB CursorOff ()
  31. DECLARE SUB CursorOn ()
  32. DECLARE SUB LocateIt (Row%, Message$)
  33. DECLARE SUB SetBorder (ColrByte%)
  34. DECLARE SUB TextBoxShadow (Row%, Col%, Message$, Outline%, Shadow%, Length%)
  35. DECLARE SUB TwoColrs (Fgd%, Bkg%, Colr%)
  36. DECLARE SUB ToggleNumCapLock (OnOff%)
  37. DECLARE SUB WaitKey ()
  38.  
  39. 'Functions
  40. DECLARE FUNCTION Center% (text$)
  41.  
  42. 'Declares in PRTSCRN.BAS
  43. DECLARE SUB EnablePrtScrn ()
  44. DECLARE SUB DisablePrtScrn ()
  45. DECLARE SUB PrintScreen ()
  46. DECLARE SUB WhatKey (TheKee$)
  47. DECLARE SUB WhatKeyPrint (TheKee$)
  48.  
  49. 'executable code below
  50.     Copyright$ = "■Copyright (c) 1994 LearnWare (c) ■ John De Palma■"
  51.     REDIM SHARED Box$(1 TO 56)
  52.     Q$ = CHR$(34)
  53.     CALL ColorIt(15, 1)
  54.     CLS
  55.   
  56.     FOR i = 1 TO 25
  57.         LOCATE i, 1
  58.         PRINT STRING$(80, 96 + i);
  59.     NEXT
  60.     CALL SetBorder(2)
  61.     CALL DisablePrtScrn
  62.   
  63.     CursorOff
  64.     CALL ColorIt(11, 2)
  65.     text$ = "Press Print Screen, BUT... it Won't WORK!"
  66.     Message$ = SPACE$(LEN(text$))
  67.     CALL TextBoxShadow(2, 0, Message$, 4, 1, 2)
  68.     CALL LocateIt(3, TIME$)
  69.     CALL LocateIt(4, text$)
  70.     CALL ColorIt(14, 2)
  71.     text$ = "PRESS: {Enter} to Continue"
  72.     CALL LocateIt(5, text$)
  73.    
  74.     CALL ToggleNumCapLock(True)            'turns the Caps/Num Locks off
  75.                                            'or the next won't work
  76.    
  77.     KEY 15, CHR$(&H0) + CHR$(&H37)         'Standard no SHIFTs
  78.     KEY 16, CHR$(&H2) + CHR$(&H37)         'Standard LEFT SHIFT
  79.     KEY 17, CHR$(&H1) + CHR$(&H37)         'Standard RIGHT SHIFT
  80.     KEY 18, CHR$(&H80) + CHR$(&H2A)        'Extended no SHIFTs
  81.     KEY 19, CHR$(&H82) + CHR$(&H2A)        'Extended LEFT SHIFT
  82.     KEY 20, CHR$(&H81) + CHR$(&H2A)        'Extended RIGHT SHIFT
  83.    
  84.     FOR i% = 15 TO 20
  85.         ON KEY(i%) GOSUB PrintScreenPressed:
  86.         KEY(i%) ON
  87.     NEXT
  88.    
  89.     WhatKeyPrint (CHR$(13))
  90.   
  91.     CALL ColorIt(15, 1)
  92.   
  93.     CALL EnablePrtScrn
  94.     CALL ColorIt(15, 4)
  95.     text$ = "Now Press Print Screen, 'cause it WORKS!"
  96.     Message$ = SPACE$(LEN(text$))
  97.     CALL TextBoxShadow(9, 0, Message$, 6, 6, 2)
  98.     CALL LocateIt(10, TIME$)
  99.     CALL LocateIt(11, text$)
  100.     CALL ColorIt(14, 4)
  101.     text$ = "PRESS: <SPACE-BAR> to Continue)"
  102.     CALL LocateIt(12, text$)
  103.  
  104.     WhatKey (" ")
  105.     CALL ColorIt(15, 3)
  106.     Message$ = "Sending a Form Feed for a Laser Printer..."
  107.     CALL TextBoxShadow(15, 0, Message$, 1, 0, 0)
  108.     LPRINT CHR$(12)
  109.  
  110.     CALL ColorIt(15, 2)
  111.     text$ = "PRESS: " + Q$ + "P" + Q$ + " to Do a Print Screen"
  112.     Message$ = SPACE$(LEN(text$))
  113.     CALL TextBoxShadow(19, 0, Message$, 5, 1, 2)
  114.     CALL LocateIt(20, TIME$)
  115.     CALL LocateIt(21, text$)
  116.   
  117.     WhatKey ("P")
  118.     CALL PrintScreen
  119.   
  120.     CALL ColorIt(14, 6)
  121.     text$ = " Demonstration is ENDed "
  122.     CALL LocateIt(22, text$)
  123.     BEEP
  124.     CALL SetBorder(0)
  125.     WaitKey
  126.     CALL ColorIt(7, 0)
  127.     CursorOn
  128.     CALL ToggleNumCapLock(False)         'Toggles the Caps/Num Lock keys
  129.     END
  130.  
  131.  
  132. PrintScreenPressed:
  133.  
  134.     Message$ = "PrntScrn PRESSED!"
  135.     CALL TextBoxShadow(9, 0, Message$, 6, 1, 0)
  136.     RETURN
  137.  
  138. FUNCTION Center% (text$)
  139.     Center% = 41 - LEN(text$) \ 2
  140. END FUNCTION
  141.  
  142. SUB ColorIt (Fgd, Bkg)
  143.     COLOR Fgd, Bkg
  144. END SUB
  145.  
  146. SUB CursorOff
  147.     LOCATE , , 0
  148. END SUB
  149.  
  150. SUB CursorOn
  151.     LOCATE , , 1
  152. END SUB
  153.  
  154. SUB DisablePrtScrn
  155.   
  156.     DEF SEG = 0
  157.     POKE &H500, 1
  158.     DEF SEG
  159.  
  160. END SUB
  161.  
  162. SUB EnablePrtScrn
  163.   
  164.     DEF SEG = 0
  165.     POKE &H500, 0
  166.     DEF SEG
  167.  
  168. END SUB
  169.  
  170. SUB LocateIt (Row%, text$)
  171.      LOCATE Row%, Center(text$)
  172.      PRINT text$;
  173. END SUB
  174.  
  175. SUB PrintScreen STATIC
  176.  
  177.     'DIM Regs AS RegType
  178.     CALL INTERRUPT(&H5, Regs, Regs)
  179.     LPRINT CHR$(12)
  180.  
  181. END SUB
  182.  
  183. SUB SetBorder (ColrByte%) STATIC
  184.  
  185.     'DIM Regs AS RegType
  186.     Regs.ax = &H1001
  187.     Regs.bx = ColrByte% * &H100
  188.     CALL INTERRUPT(&H10, Regs, Regs)
  189.  
  190. END SUB
  191.  
  192. SUB TextBoxShadow (Row%, Col%, Message$, Outline%, Shadow%, Length%)
  193.  
  194.     'got to have a REDIM SHARED Box$(1 to 56) in main module
  195.     'Other SUBs Needed for this are:
  196.     'TwoColrs(Fgd%, Bkg%, Colr%)
  197.     'LocateIt(Row%, Text$)
  198.     '
  199.     'Puts a message into a three line box -or-
  200.     'draw a box without a message using Message$=SPACE$(x)
  201.     'where "x" is the width of the box and Length%= number of lines > 3
  202.     'Boxes are centered if Col% = 0; else left side of box = Col%.
  203.     'Boxes display a true shadow if Shadow% <> 0
  204.     'True = -1: False = 0
  205.  
  206.     ReturnRow% = CSRLIN
  207.     ReturnCol% = POS(0)
  208.     STATIC BoxReadFlag
  209.     Message$ = LEFT$(Message$, 60)
  210.     BoxWidth% = LEN(Message$) + 4
  211.     SELECT CASE Outline%
  212.         CASE 0
  213.             j = 8 * 6 + 1
  214.         CASE 1
  215.             j = 1
  216.         CASE 2
  217.             j = 8 + 1
  218.         CASE 3
  219.             j = 8 * 2 + 1
  220.         CASE 4
  221.             j = 8 * 3 + 1
  222.         CASE 5
  223.             j = 8 * 4 + 1
  224.         CASE 6
  225.             j = 8 * 5 + 1
  226.         CASE ELSE
  227.             j = 8 * 6 + 1
  228.     END SELECT
  229.  
  230.     IF BoxReadFlag THEN GOTO Skip
  231.     REDIM Box$(1 TO 56)
  232.     BoxReadFlag = True
  233.  
  234. 'single line box
  235.     Box$(1) = "┌"
  236.     Box$(2) = "─"
  237.     Box$(3) = "┐"
  238.     Box$(4) = "│"
  239.     Box$(5) = "│"
  240.     Box$(6) = "└"
  241.     Box$(7) = "─"
  242.     Box$(8) = "┘"
  243.  
  244. 'double top box
  245.     Box$(9) = "╒"
  246.     Box$(10) = "═"
  247.     Box$(11) = "╕"
  248.     Box$(12) = "│"
  249.     Box$(13) = "│"
  250.     Box$(14) = "╘"
  251.     Box$(15) = "═"
  252.     Box$(16) = "╛"
  253.  
  254. 'double side box
  255.     Box$(17) = "╓"
  256.     Box$(18) = "─"
  257.     Box$(19) = "╖"
  258.     Box$(20) = "║"
  259.     Box$(21) = "║"
  260.     Box$(22) = "╙"
  261.     Box$(23) = "─"
  262.     Box$(24) = "╜"
  263.  
  264. 'double box
  265.     Box$(25) = "╔"
  266.     Box$(26) = "═"
  267.     Box$(27) = "╗"
  268.     Box$(28) = "║"
  269.     Box$(29) = "║"
  270.     Box$(30) = "╚"
  271.     Box$(31) = "═"
  272.     Box$(32) = "╝"
  273.  
  274. 'bold box
  275.     Box$(33) = "█"
  276.     Box$(34) = "▀"
  277.     Box$(35) = "█"
  278.     Box$(36) = "█"
  279.     Box$(37) = "█"
  280.     Box$(38) = "█"
  281.     Box$(39) = "▄"
  282.     Box$(40) = "█"
  283.  
  284. 'bold and thick box
  285.     Box$(41) = "█"
  286.     Box$(42) = "█"
  287.     Box$(43) = "█"
  288.     Box$(44) = "█"
  289.     Box$(45) = "█"
  290.     Box$(46) = "█"
  291.     Box$(47) = "█"
  292.     Box$(48) = "█"
  293.  
  294. 'no box
  295.     Box$(49) = " "
  296.     Box$(50) = " "
  297.     Box$(51) = " "
  298.     Box$(52) = " "
  299.     Box$(53) = " "
  300.     Box$(54) = " "
  301.     Box$(55) = " "
  302.     Box$(56) = " "
  303.  
  304. Skip:
  305.  
  306.     IF Col% = 0 THEN
  307.  
  308.             BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  309.             CALL LocateIt(Row%, BoxText$)
  310.             Row2% = CSRLIN: Col2% = POS(0)
  311.             Colr% = SCREEN(Row2%, Col2% - 1, 1)
  312.             CALL TwoColrs(Fgd%, Bkg%, Colr%)
  313.   
  314.             FOR i = 1 TO Length% + 1
  315.             BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  316.             CALL LocateIt(Row% + i, BoxText$)
  317.  
  318.             IF Shadow% THEN
  319.                 COLOR 7, 0
  320.                     FOR k = 1 TO 2
  321.                         PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  322.                     NEXT
  323.                 COLOR Fgd%, Bkg%
  324.             END IF
  325.             NEXT i
  326.  
  327.             BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  328.             CALL LocateIt(Row% + i, BoxText$)
  329.     
  330.             IF Shadow% THEN
  331.                 COLOR 7, 0
  332.                 FOR k = 1 TO 2
  333.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  334.                 NEXT
  335.             'COLOR Fgd%, Bkg%
  336.   
  337.             COLOR 7, 0
  338.             LOCATE Row% + i + 1, Center(BoxText$) + 2
  339.     
  340.                 FOR k = 1 TO BoxWidth% + 2
  341.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  342.                 NEXT
  343.                 COLOR Fgd%, Bkg%
  344.             END IF
  345.     ELSE
  346.  
  347.             BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  348.             LOCATE Row%, Col%
  349.             PRINT BoxText$;
  350.             Row2% = CSRLIN: Col2% = POS(0)
  351.             Colr% = SCREEN(Row2%, Col2% - 1, 1)
  352.             CALL TwoColrs(Fgd%, Bkg%, Colr%)
  353.  
  354.             FOR i = 1 TO Length% + 1
  355.             BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  356.             LOCATE Row% + i, Col%
  357.             PRINT BoxText$;
  358.     
  359.             IF Shadow% THEN
  360.                 COLOR 7, 0
  361.                 FOR k = 1 TO 2
  362.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  363.                 NEXT
  364.                 COLOR Fgd%, Bkg%
  365.             END IF
  366.     
  367.             NEXT i
  368.  
  369.             BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  370.             LOCATE Row% + i, Col%
  371.             PRINT BoxText$;
  372.     
  373.             IF Shadow% THEN
  374.                 COLOR 7, 0
  375.                 FOR k = 1 TO 2
  376.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  377.                 NEXT
  378.             'COLOR Fgd%, Bkg%
  379.             'COLOR 7,0
  380.                 LOCATE Row% + i + 1, Col% + 2
  381.                 FOR k = 1 TO BoxWidth% + 2
  382.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  383.                 NEXT
  384.                 COLOR Fgd%, Bkg%
  385.             END IF
  386.  
  387.     END IF
  388.             LOCATE ReturnRow%, ReturnCol%
  389. END SUB
  390.  
  391. SUB ToggleNumCapLock (OnOff%)
  392.  
  393.     'If OnOff% = True then turns them off, else toggles them
  394.     DEF SEG = 0
  395.     Address = &H417
  396.     'Status = PEEK(Address)
  397.  
  398.     IF OnOff% THEN
  399.         POKE (Address), PEEK(Address) AND NOT 32
  400.         POKE (Address), PEEK(Address) AND NOT 64
  401.     ELSE
  402.         'Num Lock Toggle
  403.         POKE (Address), PEEK(Address) XOR 32
  404.         'Caps Lock Toggle
  405.         POKE (Address), PEEK(Address) XOR 64
  406.     END IF
  407.  
  408.     DEF SEG
  409.   
  410. END SUB
  411.  
  412. SUB TogglePrntScrn STATIC
  413.   
  414.     'If PrntScreen is disabled, it is enabled
  415.     'If PrntScreen is enabled, it is disabled
  416.     'A Toggle SUB
  417.     'So you call it once to disable and again to enable
  418.     DEF SEG = 0
  419.     Toggle = PEEK(&H500)
  420.     IF Toggle THEN
  421.         POKE &H500, 0
  422.     ELSE
  423.         POKE &H500, 1
  424.     END IF
  425.     DEF SEG
  426.  
  427. END SUB
  428.  
  429. SUB TwoColrs (Fgd%, Bkg%, Colr%)
  430.  
  431.     Fgd% = (Colr% AND 128) \ 8 + (Colr% AND 15)
  432.     Bkg% = (Colr% AND 112) \ 16
  433.  
  434. END SUB
  435.  
  436. SUB WaitKey
  437.  
  438.     WHILE INKEY$ <> "": WEND
  439.     DO
  440.         Kee$ = INKEY$
  441.     LOOP UNTIL LEN(Kee$)
  442.     IF Kee$ = CHR$(27) THEN END
  443.  
  444. END SUB
  445.  
  446. SUB WhatKey (TheKee$)
  447.   
  448.     TheKee$ = UCASE$(TheKee$)
  449.     DO UNTIL UCASE$(Kee$) = TheKee$
  450.         Kee$ = INKEY$
  451.     LOOP
  452.  
  453. END SUB
  454.  
  455. SUB WhatKeyPrint (TheKee$)
  456.   
  457.     TheKee$ = UCASE$(TheKee$)
  458.     DO UNTIL UCASE$(Kee$) = TheKee$
  459.         Kee$ = INKEY$
  460.        
  461.         DO
  462.             FColr = INT((15 - 0 + 1) * RND + 0)
  463.             BColr = INT((7 - 0 + 1) * RND + 0)
  464.         LOOP UNTIL FColr <> BColr
  465.         CALL ColorIt(FColr, BColr)
  466.         CALL LocateIt(14, "PrntScrn Waiting...")
  467.     LOOP
  468.  
  469. END SUB
  470.  
  471.