home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / jr_tools / jrkbd201.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-07-13  |  7.0 KB  |  163 lines
  1. Unit JRKBD201 ;
  2.  
  3. (*╔═════════════════════════════════════════════════════════════════════════╗*)
  4. (*║                                                                         ║*)
  5. (*║             JR Unit Library  -  Version 2.01  -  June xxrd 1988         ║*)
  6. (*║                                                                         ║*)
  7. (*║                     Keyboard functions and procedures                   ║*)
  8. (*║                                                                         ║*)
  9. (*╚═════════════════════════════════════════════════════════════════════════╝*)
  10.  
  11. Interface
  12.  
  13. (*───────────────────────────────────────────────────────────────────────────*)
  14.  
  15. Uses Crt , JRBIT201 , JRSCR201 ;
  16.  
  17. (*───────────────────────────────────────────────────────────────────────────*)
  18.  
  19. Const
  20.       _Nul = 0 ; _Bs = 8 ; _Tab = 9 ; _Lf  = 10 ; _Cr  = 13 ; _Esc = 27 ;
  21.       _ShTab = 271 ;
  22.       _F1 = 315  ;  _F2 = 316  ;  _F3 = 317  ;  _F4 = 318  ;  _F5 = 319  ;
  23.       _F6 = 320  ;  _F7 = 321  ;  _F8 = 322  ;  _F9 = 323  ;  _F10 = 324 ;
  24.       _Home = 327 ; _Up = 328   ; _PgUp = 329 ; _Left = 331 ; _Right = 333 ;
  25.       _End = 335  ; _Down = 336 ; _PgDn = 337 ; _Ins = 338  ; _Del = 339 ;
  26.  
  27.  
  28. (*───────────────────────────────────────────────────────────────────────────*)
  29.  
  30. Var
  31.       _KbdStatus1  : Byte         Absolute $0000:$0417 ;
  32.       _KbdStatus2  : Byte         Absolute $0000:$0418 ;
  33.  
  34. (*───────────────────────────────────────────────────────────────────────────*)
  35.  
  36. Function _GetKey : Integer ;
  37. Procedure _Lined(Var txt : String ; 
  38.                  x,y,txtlength : Integer ;
  39.                  esclist : Integer ;
  40.                  options : Integer ;
  41.                  Var key : Integer) ;
  42. (*───────────────────────────────────────────────────────────────────────────*)
  43.  
  44. Implementation
  45.  
  46. (*───────────────────────────────────────────────────────────────────────────*)
  47.  
  48. Function _GetKey ;
  49. (*  Version 2.00  *)
  50. Const NUL = #0 ;
  51. Var    ch : Char ;
  52. Begin ;
  53.    ch:=ReadKey ;
  54.    If (ch=NUL) Then Begin ;
  55.       ch:=ReadKey ; _GetKey:=Ord(ch)+256 ;
  56.    End Else _GetKey:=Ord(ch) ;
  57. End  (* Procedure _GetKey *) ;
  58.  
  59. (*───────────────────────────────────────────────────────────────────────────*)
  60.  
  61. Procedure _Lined ;
  62. (*  Version 2.00  *)
  63. (*╔═════════════════════════════════════════════════════════════════╗*)
  64. (*║ (* = Ej klar)                Esclist                            ║*)
  65. (*╠═════════════════════════════════════════════════════════════════╣*)
  66. (*║ Hög byte                         Låg byte                       ║*)
  67. (*║ 76543210                         76543210                       ║*)
  68. (*║ 1          -                     1         End                  ║*)
  69. (*║  1         Fyllt fält             1        Home                 ║*)
  70. (*║   1        ShTab                   1       PgDn                 ║*)
  71. (*║    1       Tab                      1      PgUp                 ║*)
  72. (*║     1      Right (vid radstart)      1     Down                 ║*)
  73. (*║      1     Right (alltid)             1    Up                   ║*)
  74. (*║       1    Left  (vid radslut)         1   Esc                  ║*)
  75. (*║        1   Left  (alltid)               1  Enter                ║*)
  76. (*╠═════════════════════════════════════════════════════════════════╣*)
  77. (*║                              Options                            ║*)
  78. (*╠═════════════════════════════════════════════════════════════════╣*)
  79. (*║ Hög byte                         Låg byte                       ║*)
  80. (*║                                  76543210                       ║*)
  81. (*║ Färgkod                          1         -                    ║*)
  82. (*║                                   1        -                    ║*)
  83. (*║                                    1       -                    ║*)
  84. (*║                                     1      -                    ║*)
  85. (*║                                      1    *Chr(32)-Chr(255)     ║*)
  86. (*║                                       1   *A-Ö,a-ö              ║*)
  87. (*║                                        1  *Numeriskt fält       ║*)
  88. (*║                                         1  Entré från höger     ║*)
  89. (*╚═════════════════════════════════════════════════════════════════╝*)
  90.  
  91. Var i,xpos : Integer ;
  92.     leave : Boolean ;
  93. Begin ;
  94.    TextColor(Hi(options) Mod 16) ;
  95.    TextBackground(Hi(options) Div 16) ;
  96.    leave:=False ; _Cursor(5,7) ;
  97.    If (_Bit(Lo(options),0)) Then xpos:=txtlength Else xpos:=1 ;
  98.    Repeat ;
  99.       GotoXY(x,y) ; Write(txt) ;
  100.       GotoXY(x+xpos-1,y) ;
  101.       key:=_GetKey ;
  102.       Case key Of
  103.          _Cr   : leave:=_Bit(Lo(esclist),0) ;
  104.          _Esc  : leave:=_Bit(Lo(esclist),1) ;
  105.          _Up   : leave:=_Bit(Lo(esclist),2) ;
  106.          _Down : leave:=_Bit(Lo(esclist),3) ;
  107.          _PgUp : leave:=_Bit(Lo(esclist),4) ;
  108.          _PgDn : leave:=_Bit(Lo(esclist),5) ;
  109.          _Home : Begin ; xpos:=1 ; leave:=_Bit(Lo(esclist),6) ; End ;
  110.          _Left : Begin ;
  111.                     Dec(xpos) ;
  112.                     If xpos<1 Then Begin ;
  113.                        xpos:=1 ; leave:=_Bit(Hi(esclist),1) ;
  114.                     End Else leave:=_Bit(Hi(esclist),0) ;
  115.                  End ;
  116.          _Right: Begin ;
  117.                     Inc(xpos) ;
  118.                     If xpos>txtlength Then Begin ;
  119.                        xpos:=txtlength ; leave:=_Bit(Hi(esclist),3) ;
  120.                     End Else leave:=_Bit(Hi(esclist),2) ;
  121.                  End ;
  122.          _End :  Begin ; xpos:=txtlength ; leave:=_Bit(Lo(esclist),7) ; End ;
  123.          _Ins :  Begin ;
  124.                     For i:=txtlength DownTo xpos Do txt(.i.):=txt(.i-1.) ;
  125.                     txt(.xpos.):=' ' ;
  126.                  End ;
  127.          _Del :  Begin ;
  128.                     For i:=xpos To txtlength Do txt(.i.):=txt(.i+1.) ;
  129.                     txt(.txtlength.):=' ' ;
  130.                  End ;
  131.          _Bs :  Begin ;
  132.                    If (xpos>1) Then Begin ;
  133.                       For i:=xpos-1 To txtlength-1 Do txt(.i.):=txt(.i+1.) ;
  134.                       txt(.txtlength.):=' ' ;
  135.                       Dec(xpos) ;
  136.                    End ;
  137.                 End ;
  138.          _Tab : leave:=_Bit(Hi(esclist),4) ;
  139.          _ShTab:leave:=_Bit(Hi(esclist),5) ;
  140.           Else  Begin ;
  141.                    If ((key In (.48..57.)) And _Bit(Lo(options),1)) Or
  142.                     ((key>=32) And (key<=255) And _Bit(Lo(options),3)) Or
  143.                     (((key>=65) And (key<=90)) Or ((key>=97) And (key<=122))
  144.                     Or (key=143) Or (key=142) Or (key=153) Or (key=134) Or
  145.                     (key=132) Or (key=148)) And _Bit(Lo(options),2) Then
  146.                    Begin ;
  147.                       txt(.xpos.):=Chr(key) ;
  148.                       Inc(xpos) ;
  149.                       If xpos>txtlength Then Begin ;
  150.                          xpos:=txtlength ; leave:=_Bit(Hi(esclist),6) ;
  151.                       End ;
  152.                    End ;
  153.                 End ;
  154.       End ;
  155.    Until leave ;
  156.    GotoXY(x,y) ; Write(txt) ;
  157.    _Cursor(0,0) ;
  158. End  (* Procedure _Lined *) ;
  159.  
  160. (*───────────────────────────────────────────────────────────────────────────*)
  161.  
  162. End  (* Of Unit JRKBD201 *).
  163.