1 { GRX color allocation test. 2 3 Copyright (C) 2001 Frank Heckenbach <frank@pascal.gnu.de> 4 5 This file is free software; as a special exception the author 6 gives unlimited permission to copy and/or distribute it, with or 7 without modifications, as long as this notice is preserved. 8 9 This program is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY, to the extent permitted by law; without 11 even the implied warranty of MERCHANTABILITY or FITNESS FOR A 12 PARTICULAR PURPOSE. } 13 14 {$X+} 15 16 program ColorTest; 17 18 uses GRX; 19 20 var 21 Dummy, i, x, y, j: Integer = 0; 22 Color: array [0 .. 1023] of Integer; 23 s : string[255]; 24 25 begin 26 Dummy := GrSetMode (Gr_Width_Height_BPP_Graphics, 800, 300, 16, 0, 0); 27 for x := 0 to 1023 do 28 begin 29 { GrAllocCell; GrSetColor (x, x, x, x); } 30 if x < 256 then 31 Color[x] := GrAllocColor (x, x, x) 32 else if x < 512 then 33 Color[x] := GrAllocColor (x - 256, 0, 0) 34 else if x < 768 then 35 Color[x] := GrAllocColor (0, x - 512, 0) 36 else 37 Color[x] := GrAllocColor (0, 0, x - 768); 38 Inc (j); 39 if Color[x] <= $100000 then Inc (i) 40 end; 41 WriteStr (s, i, ' of ', j, ' colors allocated.'); 42 for y := 0 to 299 do 43 for x := 0 to 799 do 44 GrPlot (x, y, Color[(x + y) mod 1024]); 45 GrTextXY(300, 10, s, GrWhite, GrNoColor); 46 i := GrKeyRead 47 end. 48