home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBII / ECO_PAL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-08  |  4.2 KB  |  124 lines
  1. (*
  2.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  3.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  4.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  5.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  6.     ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
  7.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  8.     ▓▓▓▓▓▓▓▓   eco_pal 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. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  22. unit eco_pal;
  23.  
  24. interface
  25.  
  26. uses
  27.   crt, eco_lib
  28.  
  29.   ;
  30.  
  31. type
  32.   attributes = record
  33.     fore, back: byte;
  34.   end;
  35.  
  36.   function getcolor(
  37.     x_pos, y_pos, winf, winb, wintype: byte;
  38.     var fore, back: byte;
  39.     msg: string
  40.   ): byte;
  41.  
  42.  
  43. implementation
  44.  
  45.  
  46.  
  47.   function getcolor;
  48.   var
  49.     f, b      : shortint;
  50.     key       :     word;
  51.     tempfore,
  52.     tempback  :     byte;
  53.     blink     :  boolean;
  54.  
  55.  
  56.     procedure __changecursor;
  57.     var
  58.       colbyte1,
  59.       colbyte2,
  60.       charbyte : byte;
  61.  
  62.     begin
  63.       colbyte1 := random(16); colbyte2 := random(16);
  64.       __write(f, b, colbyte1, colbyte2, 'Φ');
  65.       delay(150);
  66.     end;
  67.  
  68.  
  69.     procedure drawsquare;
  70.     var i, j: shortint;
  71.     begin
  72.       __setblwin(blink);
  73.       for i := 0 to 15 do for j := 0 to 15 do
  74.        __write(x_pos+2+i*2, y_pos+1+j, i, j, '■');
  75.     end;
  76.  
  77.  
  78. begin
  79.   blink := false; randomize;
  80.   if wintype=1 then wintype := 00 else wintype := 15;
  81.   tempfore := fore; tempback := back; tempfore := 0; tempback := 7;
  82.   if x_pos>46 then x_pos := 46; if x_pos<1  then x_pos := 1;
  83.   if y_pos>8  then y_pos := 8;  if y_pos<1  then y_pos := 1;
  84.   __bandwin(true, x_pos, y_pos, x_pos+34, y_pos+17, 0, 7, sh_default, wintype);
  85.   __clrscn(x_pos+1, y_pos+1, x_pos+33, y_pos+16, 7, 1, ' ');
  86.   __betwscn(x_pos, x_pos+34, y_pos+17, tempfore, tempback,
  87.     ' TAB: Blink ══ Intensity '
  88.   );
  89.   __betwscn(x_pos, x_pos+34, y_pos, 0, 7, msg); drawsquare;
  90.   f := x_pos+2+2*tempfore; b := y_pos+1+tempback;
  91.   __write(f, b, tempfore, tempback, chr(232));
  92.   repeat
  93.     while not keypressed do __changecursor;
  94.     key := __retkey;
  95.     __write(f, b, tempfore, tempback, '■');
  96.     if (key=_up) or (key=_padup) then dec(b);
  97.     if (key=_down) or (key=_paddown) then inc(b);
  98.     if (key=_left) or (key=_padleft) then dec(f, 2);
  99.     if (key=_right) or (key=_padright) then inc(f, 2);
  100.     if (key=_home) or (key=_padhome) then begin dec(b); dec(f, 2) end;
  101.     if (key=_end) or (key=_padend) then begin inc(b); dec(f, 2) end;
  102.     if (key=_pgdn) or (key=_padpgdn) then begin inc(b); inc(f, 2) end;
  103.     if (key=_pgup) or (key=_padpgup) then begin dec(b); inc(f, 2) end;
  104.     if (key=_tab) then begin blink := not(blink); drawsquare end;
  105.     if b<y_pos + 1  then b := y_pos + 16;
  106.     if b>y_pos + 16 then b := y_pos + 1;
  107.     if f<x_pos + 2  then f := x_pos + 32;
  108.     if f>x_pos + 32 then f := x_pos + 2;
  109.     tempfore := (f - x_pos) div 2 - 1;
  110.     tempback := b - y_pos - 1;
  111.     __betwscn(x_pos, x_pos+34, y_pos+17, tempfore, tempback,
  112.       ' TAB: Blink ══ Intensity ');
  113.   until (
  114.     (key=_esc) or (key=_enter) or (key=_padenter)
  115.   );
  116.   if (
  117.     (key=_enter) or (key=_padenter)
  118.   ) then begin fore := tempfore; back := tempback end;
  119.   getcolor := __attr(fore, back);
  120. end;
  121.  
  122.  
  123. end. { of unit, no begin }
  124.