home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBII / ECO_PASC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-08  |  5.5 KB  |  143 lines
  1. (*
  2.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  3.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  4.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  5.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  6.     ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
  7.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  8.     ▓▓▓▓▓▓▓▓   Unit was conceived, designed and written         ░░▓▓▓▓▓▓▓▓▓
  9.     ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
  10.     ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
  11.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  12.     ▓▓▓▓▓▓▓▓   (C) MCMXCII by EUROCON PANATIONAL CORPORATION.   ░░▓▓▓▓▓▓▓▓▓
  13.     ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
  14.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  15.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  16.     ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
  17.     ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
  18.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  19.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  20.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  21. *)
  22. {$O+}
  23. unit eco_pasc;
  24. interface
  25. uses
  26.   crt, eco_lib
  27.  
  28.   ;
  29.  
  30.   procedure __setpopascii(x, y, f1, b1: integer);
  31.   function __popascii : char;
  32.  
  33.  
  34.  
  35. implementation
  36.  
  37.  
  38. var
  39.   chnow, topleft,
  40.   xpos, ypos, cfore, cback : byte;
  41.  
  42.  
  43.   procedure errorbeep;
  44.   begin
  45.     sound(2000); delay(75); sound(1000); delay(75); nosound;
  46.   end;
  47.  
  48.  
  49.   procedure __setpopascii(x, y, f1, b1: integer);
  50.   begin
  51.     if x<1 then x := 1;                      { make sure x, y in bounds }
  52.     if y<1 then y := 1;
  53.     if x<63 then xpos := x else xpos := 62;
  54.     if y<8 then ypos := y else ypos := 7;
  55.     cfore := f1; cback := b1;
  56.   end;
  57.  
  58.  
  59.  
  60.   function __popascii : char;
  61.   var
  62.     cch          :       word;      {         used to read in cursor pad keys }
  63.     asciiexit    :    boolean;      {          set to true when ready to exit }
  64.     functkey     :    boolean;      { set to true when a function key read in }
  65.     r, c, lr, lc :    integer;      {   row,  column position of selector box }
  66.     sav          : _scnimageptr;
  67.  
  68.  
  69.     procedure showascii;
  70.     var ii, xi, yi : integer;
  71.     begin
  72.       for ii := 1 to 64 do begin
  73.         xi := ((ii-1) mod 8)*2+xpos+2;     { column on screen }
  74.         yi := ((ii+7) div 8)*2+ypos;       { row on screen    }
  75.         __write(xi, yi, cfore, cback, chr(topleft+ii-1));
  76.       end;
  77.     end;
  78.  
  79.  
  80.   begin
  81.     new(sav); __savscn(sav); asciiexit := false;
  82.     __bandwin(true, xpos, ypos, xpos+18, ypos+18, cfore, cback, sh_default, bt_single);
  83.     __betwscn(xpos, xpos+18, ypos, cfore, cback, 'ASCII Table');
  84.     showascii; lc := chnow mod 8 + 1; lr := (chnow-topleft) div 8 + 1;
  85.     repeat
  86.       c := chnow mod 8 + 1; r := (chnow-topleft)div 8 + 1;
  87.       __write(xpos-1+lc*2, lr*2+ypos-1, cfore, cback,  '   ');
  88.       __write(xpos+1+lc*2, lr*2+ypos,   cfore, cback,  ' ');
  89.       __write(xpos-1+lc*2, lr*2+ypos,   cfore, cback,  ' ');
  90.       __write(xpos-1+lc*2, lr*2+ypos+1, cfore, cback,  '   ');
  91.       __write(xpos-1+c*2,  r*2+ypos-1,  cfore, cback,  '┌─┐');
  92.       __write(xpos+1+c*2,  r*2+ypos,    cfore, cback,  '│');  
  93.       __write(xpos-1+c*2,  r*2+ypos,    cfore, cback,  '│');
  94.       __write(xpos-1+c*2,  r*2+ypos+1,  cfore, cback,  '└─┘');
  95.       lc := c; lr := r; __flushkey; cch := __retkey;
  96.       case cch of
  97.         _enter: asciiexit := true;
  98.         _esc: begin __popascii := #0; __resscn(sav); dispose(sav); exit end;
  99.         _down, _paddown: begin
  100.           if chnow+8<255 then chnow := chnow+8 else errorbeep;
  101.           if chnow>topleft+63 then begin topleft := topleft+8; showascii end;
  102.         end;
  103.         _up, _padup: begin
  104.           if chnow-8 >= 0 then chnow := chnow-8 else errorbeep;
  105.           if chnow<topleft then begin topleft := topleft-8; showascii end;
  106.         end;
  107.         _right, _padright: begin
  108.           if chnow<255 then chnow := succ(chnow) else errorbeep;
  109.           if chnow>topleft+63 then begin topleft := topleft+8; showascii end;
  110.         end;
  111.         _left, _padleft: begin
  112.           if chnow>0 then chnow := pred(chnow) else errorbeep;
  113.           if chnow<topleft then begin topleft := topleft-8; showascii end;
  114.         end;
  115.         _pgup, _padpgup: begin
  116.           if topleft = 0 then errorbeep;
  117.           if topleft>=64 then begin
  118.             topleft := topleft-64; chnow := chnow-64; showascii
  119.           end else begin chnow := chnow-topleft; topleft := 0; showascii end;
  120.         end;
  121.         _pgdn, _padpgdn: begin
  122.           if topleft = 192 then errorbeep;
  123.           if topleft<=128 then begin
  124.             topleft := topleft+64; chnow := chnow + 64; showascii
  125.           end else begin
  126.             chnow := chnow+192-topleft; topleft := 192; showascii
  127.           end;
  128.         end;
  129.         _home, _padhome: begin topleft := 0; chnow := 0; showascii end;
  130.         _end, _padend: begin topleft := 192; chnow := 255; showascii end;
  131.         else errorbeep;
  132.       end; { case cch }
  133.     until asciiexit; __resscn(sav); dispose(sav); __popascii := chr(chnow);
  134.   end;
  135.  
  136.  
  137.  
  138.  
  139. {initialization}
  140. begin
  141.   topleft := 0; chnow := 0; xpos := 20; ypos := 5; cfore := 7; cback := 0;
  142. end.  {unit}
  143.