home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / menu / overdriv / popascii.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1980-01-01  |  6.9 KB  |  217 lines
  1. UNIT POPASCII;
  2. INTERFACE
  3.   USES IOSTUFF,CRT;
  4.   PROCEDURE SetChooseASCII(X,Y:Integer);
  5.   FUNCTION ChooseASCII:Char;
  6. IMPLEMENTATION
  7.  VAR
  8.       ChNow      : Integer;
  9.       TopLeft    : Integer;
  10.       XPos       : Integer;   { These constants control the location }
  11.       YPos       : Integer;   { of the ASCII box on the Screen       }
  12.  
  13. {======================================================================}
  14. PROCEDURE SetChooseASCII(X,Y:Integer);       { Set location of ASCII box }
  15. BEGIN
  16.   If X < 1 then X := 1;                      { make sure X,Y in bounds }
  17.   If Y < 1 then Y := 1;
  18.   If X < 63 then XPos := X else XPos := 62;
  19.   If Y < 8 then YPos := Y else YPos := 7;
  20. END;
  21. {======================================================================}
  22. FUNCTION ChooseASCII:Char;
  23.  
  24. CONST
  25.  
  26.       UpArrow    = #72; { keys used to move the selector box }
  27.       LeftArrow  = #75;
  28.       RightArrow = #77;
  29.       DownArrow  = #80;
  30.       PageUp     = #73;
  31.       PageDown   = #81;
  32.       HomeKey    = #71;
  33.       EndKey     = #79;
  34.       EnterKey   = #13; { Enter selects a character }
  35.       EscKey     = #27; { Escape aborts by returning #0       }
  36.  
  37.       ColorF1    = LightGray;    { Foreground color - ASCII characters }
  38.       ColorB1    = Black;        { Background color - ASCII characters }
  39.       ColorF2    = Magenta;      { Foreground color - Border           }
  40.       ColorB2    = Black;        { Background color - Border           }
  41.       ColorF3    = Yellow;       { Foreground color - Selector Box     }
  42.       ColorB3    = Black;        { Background color - Selector Box     }
  43.  
  44. VAR
  45.       CCh        : Char;         { used to read in cursor pad keys }
  46.       ASCIIExit  : Boolean;      { set to true when ready to exit }
  47.       FunctKey   : Boolean;      { set to true when a function key read in }
  48.       R,C,LR,LC  : Integer;      { row, column position of selector box }
  49.       SaveAttr   : Byte;
  50. {===================================================}
  51. PROCEDURE ShowASCII;
  52.  
  53. { This procedure displays 64 ASCII characters on the screen    }
  54. { depending on the current setting of TopLeft.  TopLeft is the }
  55. { number of the current character in the top left position.    }
  56.  
  57. VAR
  58.    II,XI,YI : Integer;
  59.  
  60. BEGIN
  61.   SetColor(ColorF1,ColorB1);
  62.   For II := 1 to 64 do Begin
  63.      XI:=((II-1) mod 8)*2+XPos+2;     { Column on screen }
  64.      YI:=((II+7) div 8)*2+YPos;       { Row on screen    }
  65.      WriteCh(Chr(TopLeft+II-1),XI,YI);
  66.   End;
  67.  END;
  68. {===================================================}
  69. BEGIN
  70.  
  71.        { Miscellaneous initialization.  Note that ChNow is only     }
  72.        { initialized at startup so that the last character selected }
  73.        { may be remembered }
  74.  
  75.    SaveAttr := TextAttr;
  76.    ASCIIExit := False;
  77.    Hidecursor;
  78.  
  79.    SetColor(ColorF1,ColorB1);
  80.    Window(XPos,YPos,XPos+18,YPos+18);
  81.    ClrScr;
  82.    Window(1,1,80,25);
  83.    SetColor(ColorF2,ColorB2);
  84.    Border(XPos,YPos,XPos+18,YPos+18,'ASCII Table');
  85.  
  86.    ShowASCII;
  87.    LC := ChNow Mod 8 + 1;
  88.    LR := (ChNow-Topleft)div 8 + 1;
  89.  
  90.         { start of big cursor pad reading loop }
  91.   Repeat
  92.          C := ChNow Mod 8 + 1;                { figure the current column }
  93.          R := (ChNow-Topleft)div 8 + 1;       { and row to put the box.   }
  94.          SetColor(ColorF3,ColorB3);
  95.          WriteSt('   ',XPos-1+LC*2,LR*2+YPos-1); { erase the last box }
  96.          WriteCh(' '  ,XPos+1+LC*2,LR*2+YPos);
  97.          WriteCh(' '  ,XPos-1+LC*2,LR*2+YPos);
  98.          WriteSt('   ',XPos-1+LC*2,LR*2+YPos+1);
  99.          WriteSt('┌─┐',XPos-1+C*2,R*2+YPos-1);   { write a box around the }
  100.          WriteCh('│'  ,XPos+1+C*2,R*2+YPos);     { current selected char. }
  101.          WriteCh('│'  ,XPos-1+C*2,R*2+YPos);
  102.          WriteSt('└─┘',XPos-1+C*2,R*2+YPos+1);
  103.  
  104.          SetColor(ColorF1,ColorB1);
  105.          LC := C; LR := R;            { remember the last box location }
  106.  
  107.                { read a keystroke }
  108.         CCh := ReadKey;
  109.          If CCh <> #0 then FunctKey := False else
  110.          Begin
  111.           CCh := ReadKey;
  112.           FunctKey := True;
  113.          End;
  114.                { handle non function keys }
  115.         If not FunctKey then Case CCh of
  116.           EnterKey : ASCIIExit := True;      { prepare to exit }
  117.           EscKey   : Begin                   { abort }
  118.                       ChooseASCII := #0;     { #0 returned if escape hit }
  119.                       TextAttr := SaveAttr;
  120.                       Exit;
  121.                      End;
  122.           Else Beep;
  123.         End; {case CCh}
  124.  
  125.               { handle function keys }
  126.        If FunctKey then Case CCh of
  127.   DownArrow : Begin
  128.                If ChNow+8 < 255 then ChNow := ChNow+8
  129.                else Beep;
  130.                If ChNow > TopLeft+63 then Begin
  131.                  TopLeft := TopLeft+8;
  132.                  ShowASCII;
  133.                End;
  134.               End;
  135.  
  136.     UpArrow : Begin
  137.                If ChNow-8 >= 0 then ChNow := ChNow-8
  138.                else Beep;
  139.                If ChNow < TopLeft then Begin
  140.                  TopLeft := TopLeft-8;
  141.                  ShowASCII;
  142.                End;
  143.               End;
  144.  
  145.  RightArrow : Begin
  146.                If ChNow < 255 then ChNow := Succ(ChNow) else Beep;
  147.                If ChNow > TopLeft+63 then Begin
  148.                  TopLeft := TopLeft+8;
  149.                  ShowASCII;
  150.                End;
  151.               End;
  152.  
  153.   LeftArrow : Begin
  154.                If ChNow > 0 then ChNow := Pred(ChNow) else Beep;
  155.                If ChNow < TopLeft then Begin
  156.                  TopLeft := TopLeft-8;
  157.                  ShowASCII;
  158.                End;
  159.               End;
  160.  
  161.      PageUp : Begin
  162.                If TopLeft = 0 then Beep;
  163.                If TopLeft >= 64 then Begin
  164.                  TopLeft := TopLeft-64;
  165.                  ChNow := ChNow-64;
  166.                  ShowASCII;
  167.                End
  168.                else Begin
  169.                  ChNow := ChNow-TopLeft;
  170.                  TopLeft := 0;
  171.                  ShowASCII;
  172.                End;
  173.               End;
  174.  
  175.    PageDown : Begin
  176.                If TopLeft = 192 then Beep;
  177.                If TopLeft <= 128 then Begin
  178.                  TopLeft := TopLeft+64;
  179.                  ChNow := ChNow + 64;
  180.                  ShowASCII;
  181.                End
  182.                else Begin
  183.                  ChNow := ChNow + 192-TopLeft;
  184.                  TopLeft := 192;
  185.                  ShowASCII;
  186.                End;
  187.               End;
  188.  
  189.     HomeKey : Begin
  190.                 TopLeft := 0;
  191.                 ChNow := 0;
  192.                 ShowASCII;
  193.               End;
  194.  
  195.     EndKey  : Begin
  196.                 TopLeft := 192;
  197.                 ChNow := 255;
  198.                 ShowASCII;
  199.               End;
  200.  
  201.          Else Beep;
  202.          End; {case CCh}
  203.   Until ASCIIExit;          { bottom of keystroke loop }
  204.  
  205.   ChooseASCII := Chr(ChNow);  { return the chosen character }
  206.  
  207.   ShowCursor;
  208.   TextAttr := SaveAttr;
  209. END;
  210.  
  211. {INITIALIZATION}
  212. BEGIN
  213.    TopLeft := 0;
  214.    ChNow   := 0;
  215.    XPos    := 20;
  216.    YPos    := 5;
  217. END.  {UNIT}