program To256;
uses
Windows;
type
colour =packed record
case integer of
0:(r,g,b:byte);
1:(c:longword);
end;
function SetDCBrushColor(p:hdc;colour:COLORREF): COLORREF; stdcall external 'gdi32.dll' name 'SetDCBrushColor';
function SetDCPenColor(p:hdc;colour:COLORREF): COLORREF; stdcall external 'gdi32.dll' name 'SetDCPenColor';
function closest(v:colour):longword;forward;
type
circle=object
x:integer;
y:integer ;
r:integer;
c:colour;
procedure draw(h:hdc);
procedure draw256(h:hdc);
end;
procedure circle.draw(h:hdc) ;
begin
SetDCBrushColor(h,c.c);
SetDCPenColor(h,c.c);
ellipse(h,trunc(x-r)+50,trunc(y-r),trunc(x+r)+50,trunc(y+r));
end;
procedure circle.draw256(h:hdc) ;
begin
SetDCBrushColor(h,closest(c));
SetDCPenColor(h,closest(c));
ellipse(h,trunc(x-r+400),trunc(y-r),trunc(x+r+400),trunc(y+r));
end;
// constants
const
DC_BRUSH=18;
const
DC_PEN=19;
const clr:array[0..255] of colour=(
(r:0;g:0;b:0),
(r:0;g:170;b:0),
(r:0;g:0;b:170),
(r:0;g:170;b:170),
(r:170;g:0;b:0),
(r:170;g:170;b:0),
(r:170;g:0;b:85),
(r:170;g:170;b:170),
(r:85;g:85;b:85),
(r:85;g:255;b:85),
(r:85;g:85;b:255),
(r:85;g:255;b:255),
(r:255;g:85;b:85),
(r:255;g:255;b:85),
(r:255;g:85;b:255),
(r:255;g:255;b:255),
(r:0;g:0;b:0),
(r:20;g:20;b:20),
(r:32;g:32;b:32),
(r:44;g:44;b:44),
(r:56;g:56;b:56),
(r:68;g:68;b:68),
(r:80;g:80;b:80),
(r:97;g:97;b:97),
(r:113;g:113;b:113),
(r:129;g:129;b:129),
(r:145;g:145;b:145),
(r:161;g:161;b:161),
(r:182;g:182;b:182),
(r:202;g:202;b:202),
(r:226;g:226;b:226),
(r:255;g:255;b:255),
(r:0;g:255;b:0),
(r:64;g:255;b:0),
(r:125;g:255;b:0),
(r:190;g:255;b:0),
(r:255;g:255;b:0),
(r:255;g:190;b:0),
(r:255;g:125;b:0),
(r:255;g:64;b:0),
(r:255;g:0;b:0),
(r:255;g:0;b:64),
(r:255;g:0;b:125),
(r:255;g:0;b:190),
(r:255;g:0;b:255),
(r:190;g:0;b:255),
(r:125;g:0;b:255),
(r:64;g:0;b:255),
(r:0;g:0;b:255),
(r:0;g:64;b:255),
(r:0;g:125;b:255),
(r:0;g:190;b:255),
(r:0;g:255;b:255),
(r:0;g:255;b:190),
(r:0;g:255;b:125),
(r:0;g:255;b:64),
(r:125;g:255;b:125),
(r:157;g:255;b:125),
(r:190;g:255;b:125),
(r:222;g:255;b:125),
(r:255;g:255;b:125),
(r:255;g:222;b:125),
(r:255;g:190;b:125),
(r:255;g:157;b:125),
(r:255;g:125;b:125),
(r:255;g:125;b:157),
(r:255;g:125;b:190),
(r:255;g:125;b:222),
(r:255;g:125;b:255),
(r:222;g:125;b:255),
(r:190;g:125;b:255),
(r:157;g:125;b:255),
(r:125;g:125;b:255),
(r:125;g:157;b:255),
(r:125;g:190;b:255),
(r:125;g:222;b:255),
(r:125;g:255;b:255),
(r:125;g:255;b:222),
(r:125;g:255;b:190),
(r:125;g:255;b:157),
(r:182;g:255;b:182),
(r:198;g:255;b:182),
(r:218;g:255;b:182),
(r:234;g:255;b:182),
(r:255;g:255;b:182),
(r:255;g:234;b:182),
(r:255;g:218;b:182),
(r:255;g:198;b:182),
(r:255;g:182;b:182),
(r:255;g:182;b:198),
(r:255;g:182;b:218),
(r:255;g:182;b:234),
(r:255;g:182;b:255),
(r:234;g:182;b:255),
(r:218;g:182;b:255),
(r:198;g:182;b:255),
(r:182;g:182;b:255),
(r:182;g:198;b:255),
(r:182;g:218;b:255),
(r:182;g:234;b:255),
(r:182;g:255;b:255),
(r:182;g:255;b:234),
(r:182;g:255;b:218),
(r:182;g:255;b:198),
(r:0;g:113;b:0),
(r:28;g:113;b:0),
(r:56;g:113;b:0),
(r:85;g:113;b:0),
(r:113;g:113;b:0),
(r:113;g:85;b:0),
(r:113;g:56;b:0),
(r:113;g:28;b:0),
(r:113;g:0;b:0),
(r:113;g:0;b:28),
(r:113;g:0;b:56),
(r:113;g:0;b:85),
(r:113;g:0;b:113),
(r:85;g:0;b:113),
(r:56;g:0;b:113),
(r:28;g:0;b:113),
(r:0;g:0;b:113),
(r:0;g:28;b:113),
(r:0;g:56;b:113),
(r:0;g:85;b:113),
(r:0;g:113;b:113),
(r:0;g:113;b:85),
(r:0;g:113;b:56),
(r:0;g:113;b:28),
(r:56;g:113;b:56),
(r:68;g:113;b:56),
(r:85;g:113;b:56),
(r:97;g:113;b:56),
(r:113;g:113;b:56),
(r:113;g:97;b:56),
(r:113;g:85;b:56),
(r:113;g:68;b:56),
(r:113;g:56;b:56),
(r:113;g:56;b:68),
(r:113;g:56;b:85),
(r:113;g:56;b:97),
(r:113;g:56;b:113),
(r:97;g:56;b:113),
(r:85;g:56;b:113),
(r:68;g:56;b:113),
(r:56;g:56;b:113),
(r:56;g:68;b:113),
(r:56;g:85;b:113),
(r:56;g:97;b:113),
(r:56;g:113;b:113),
(r:56;g:113;b:97),
(r:56;g:113;b:85),
(r:56;g:113;b:68),
(r:80;g:113;b:80),
(r:89;g:113;b:80),
(r:97;g:113;b:80),
(r:105;g:113;b:80),
(r:113;g:113;b:80),
(r:113;g:105;b:80),
(r:113;g:97;b:80),
(r:113;g:89;b:80),
(r:113;g:80;b:80),
(r:113;g:80;b:89),
(r:113;g:80;b:97),
(r:113;g:80;b:105),
(r:113;g:80;b:113),
(r:105;g:80;b:113),
(r:97;g:80;b:113),
(r:89;g:80;b:113),
(r:80;g:80;b:113),
(r:80;g:89;b:113),
(r:80;g:97;b:113),
(r:80;g:105;b:113),
(r:80;g:113;b:113),
(r:80;g:113;b:105),
(r:80;g:113;b:97),
(r:80;g:113;b:89),
(r:0;g:64;b:0),
(r:16;g:64;b:0),
(r:32;g:64;b:0),
(r:48;g:64;b:0),
(r:64;g:64;b:0),
(r:64;g:48;b:0),
(r:64;g:32;b:0),
(r:64;g:16;b:0),
(r:64;g:0;b:0),
(r:64;g:0;b:16),
(r:64;g:0;b:32),
(r:64;g:0;b:48),
(r:64;g:0;b:64),
(r:48;g:0;b:64),
(r:32;g:0;b:64),
(r:16;g:0;b:64),
(r:0;g:0;b:64),
(r:0;g:16;b:64),
(r:0;g:32;b:64),
(r:0;g:48;b:64),
(r:0;g:64;b:64),
(r:0;g:64;b:48),
(r:0;g:64;b:32),
(r:0;g:64;b:16),
(r:32;g:64;b:32),
(r:40;g:64;b:32),
(r:48;g:64;b:32),
(r:56;g:64;b:32),
(r:64;g:64;b:32),
(r:64;g:56;b:32),
(r:64;g:48;b:32),
(r:64;g:40;b:32),
(r:64;g:32;b:32),
(r:64;g:32;b:40),
(r:64;g:32;b:48),
(r:64;g:32;b:56),
(r:64;g:32;b:64),
(r:56;g:32;b:64),
(r:48;g:32;b:64),
(r:40;g:32;b:64),
(r:32;g:32;b:64),
(r:32;g:40;b:64),
(r:32;g:48;b:64),
(r:32;g:56;b:64),
(r:32;g:64;b:64),
(r:32;g:64;b:56),
(r:32;g:64;b:48),
(r:32;g:64;b:40),
(r:44;g:64;b:44),
(r:48;g:64;b:44),
(r:52;g:64;b:44),
(r:60;g:64;b:44),
(r:64;g:64;b:44),
(r:64;g:60;b:44),
(r:64;g:52;b:44),
(r:64;g:48;b:44),
(r:64;g:44;b:44),
(r:64;g:44;b:48),
(r:64;g:44;b:52),
(r:64;g:44;b:60),
(r:64;g:44;b:64),
(r:60;g:44;b:64),
(r:52;g:44;b:64),
(r:48;g:44;b:64),
(r:44;g:44;b:64),
(r:44;g:48;b:64),
(r:44;g:52;b:64),
(r:44;g:60;b:64),
(r:44;g:64;b:64),
(r:44;g:64;b:60),
(r:44;g:64;b:52),
(r:44;g:64;b:48),
(r:0;g:0;b:0),
(r:0;g:0;b:0),
(r:0;g:0;b:0),
(r:0;g:0;b:0),
(r:0;g:0;b:0),
(r:0;g:0;b:0),
(r:0;g:0;b:0),
(r:0;g:0;b:0));
function closest(v:colour):longword;
function dist(cc:colour;pv:colour):single ;
var s:single;
begin
s:= (cc.r-pv.r)*(cc.r-pv.r) +(cc.g-pv.g)*(cc.g-pv.g)+(cc.b-pv.b)*(cc.b-pv.b) ;
exit(s);
end;
var
res:longword;
n:longword;
dt :single =1e20;
distance:single=0;
begin
res:=0;
for n :=0 to 255 do
begin
distance:=dist(clr[n],v);
if (dt > distance) then // catch the smallest
begin
dt := distance;res:=clr[n].c;
end;
end;
exit(res)
end;
function rgb(r:byte;g:byte;b:byte):longword;
var return:colour;
begin
return.r:=r;return.g:=g;return.b:=b;
exit(return.c);
end;
procedure hidecursor();
var
consoleHandle:handle;
info:CONSOLE_CURSOR_INFO ;
begin
consolehandle := GetStdHandle(STD_OUTPUT_HANDLE);
info.dwSize := 100;
info.bVisible := FALSE ;
SetConsoleCursorInfo(consoleHandle, @info);
End;
procedure setupcircles(var a:array of circle) ;
var i:integer;
begin
for i:=1 to length(a) do
begin
a[i].x:=5+random(300);
a[i].y:=50+random(500);
a[i].r:=3+random(10);
a[i].c.c:=rgb(random(255),random(255),random(255));
end;
end;
var
p:hwnd;
h:hdc;
circles:array[1..5000] of circle;
i:integer;
begin
p := GetConsoleWindow();
setwindowpos(p, HWND_TOPMOST, 100, 100, 800, 600, SWP_SHOWWINDOW);
hidecursor();
h:=GetDC(p);
setupcircles(circles);
SelectObject(h,GetStockObject(DC_BRUSH));
SelectObject(h,GetStockObject(DC_PEN));
write(' 32 bit');
writeln(' 256 colours');
for i:=1 to length(circles) do circles[i].draw(h);
for i:=1 to length(circles) do circles[i].draw256(h);
readln;
end.