home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBII / ECO_VGA.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1993-03-08  |  3.8 KB  |  138 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. unit eco_vga;
  23. interface
  24. uses
  25.   dos, crt, eco_lib
  26.  
  27.   ;
  28.  
  29.  
  30. const
  31.   colors = 256;
  32.   delayamt   : byte    =   50;
  33.   steps      : byte    =   30;
  34.   vgapresent : boolean = true;
  35.  
  36.  
  37. type
  38.   paltype = array [0..colors-1] of record
  39.     r, g, b: byte;
  40.   end;
  41.  
  42. var
  43.   origpal : paltype;
  44.  
  45.  
  46.   procedure __palget(var origpal: paltype);
  47.   procedure __palfade(origpal: paltype; fadeout: boolean);
  48.   procedure __palblack(origpal: paltype);
  49.   procedure __palput(origpal: paltype);
  50.  
  51.  
  52.  
  53. implementation
  54.  
  55.  
  56.  
  57.   procedure __palget(var origpal: paltype);
  58.   var reg: registers;
  59.   begin
  60.     if vgapresent then with reg do begin
  61.       ax := $1017;
  62.       bx := 0;
  63.       cx := colors;
  64.       es := seg(origpal);
  65.       dx := ofs(origpal);
  66.       intr ($10, reg);
  67.     end;
  68.   end;
  69.  
  70.  
  71.  
  72.   procedure __palput(origpal: paltype);
  73.   var reg : registers;
  74.   begin
  75.     if vgapresent then with reg do begin
  76.       ax := $1012; bx := 0; cx := colors; es := seg(origpal);
  77.       dx := ofs(origpal); intr($10, reg);
  78.     end;
  79.   end;
  80.  
  81.  
  82.  
  83.  
  84.   procedure __palfade(origpal: paltype; fadeout: boolean);
  85.   var
  86.     reg     : registers;
  87.     workpal :   paltype;
  88.     fade    :      word;
  89.     pct     :      real;
  90.     i       :      word;
  91.  
  92.   begin
  93.     if vgapresent then with reg do for fade := 0 to steps do begin
  94.       pct := fade / steps;
  95.       if fadeout then pct := 1 - pct;
  96.       for i := 0 to colors - 1 do with workpal[i] do begin
  97.         r := round(origpal[i].r * pct);
  98.         g := round(origpal[i].g * pct);
  99.         b := round(origpal[i].b * pct);
  100.       end;
  101.       ax := $1012; bx := 0; cx := colors; es := seg(workpal);
  102.       dx := ofs(workpal); intr($10, reg); delay(delayamt);
  103.     end;
  104.   end;
  105.  
  106.  
  107.  
  108.   procedure __palblack(origpal: paltype);
  109.   var
  110.     reg     : registers;
  111.     workpal :   paltype;
  112.     fade    :      word;
  113.     pct     :      real;
  114.     i       :      word;
  115.  
  116.   begin
  117.     if vgapresent then with reg do begin
  118.       pct := 0;
  119.       for i := 0 to colors - 1 do with workpal[i] do begin
  120.         r := round(origpal[i].r * pct);
  121.         g := round(origpal[i].g * pct);
  122.         b := round(origpal[i].b * pct);
  123.       end;
  124.       ax := $1012; bx := 0; cx := colors; es := seg(workpal);
  125.       dx := ofs(workpal); intr($10, reg); delay(delayamt);
  126.     end;
  127.   end;
  128.  
  129.  
  130.  
  131.  
  132.  
  133. begin
  134.   vgapresent := (_vgaadapter <> _absent);
  135.   if vgapresent then __palget(origpal);
  136. end.
  137.  
  138.