program spiralrainbow;
uses
Windows,crt;
const
DC_BRUSH=18;
const
DC_PEN=19;
const
pi=3.141592653589793;
var
m:array[1 .. 7] of ansistring =('Robin','of ','York ','goes ','back ','in ','vain ');
p:hwnd;
h:hdc;
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 Printf(mask : pchar):integer; cdecl; varargs; external 'msvcrt.dll' name 'printf';
function rgb(r:word;g:word;b:word) :longword;
begin
exit(((b Shl 16) Or ((g) Shl 8) Or (r) Or $FF000000)- $FF000000)
end;
function rainbow( x:single ):longword ;
var
r,g,b:word;
begin
r := trunc(sin( (pi/180)*(x) ) * 127 + 128) ;
g := trunc(sin( (pi/180)*(x -120) ) * 127 + 128) ;
b := trunc(sin( (pi/180)*(x + 120) ) * 127 + 128) ;
exit (rgb( r and 255 , g and 255 , b and 255 ));
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 spiral(h:hdc;col:longword;col2:longword);
label
start;
var
z,rad,x,y,dd,slug,lastslug:single;
i:integer;
begin
SelectObject(h,GetStockObject(DC_BRUSH));
SelectObject(h,GetStockObject(DC_PEN));
rad:=0.0;
dd:=2.0;
z:=0.0;
slug:=0;
lastslug:=0;
i:=6;
start:
if lastslug>2*pi then lastslug:=0;
if lastslug = 0 then
begin
if i=7 then i:=0;
i+=1;
gotoxy(21,6);
printf('%s',pchar(m[i]));
end;
rad:=0;
z:=slug;
repeat
SetDCpenColor(h,rainbow(z*8));
SetDCBrushColor(h,rainbow(z*8));
z+=0.01;
rad+=0.05;
x:=400+rad*cos(z);
y:=270-rad*sin(z);
ellipse(h,trunc(x-dd),trunc(y-dd),trunc(x+dd),trunc(y+dd));
until z>15*pi+slug ;
slug:=slug+0.2;
lastslug:=lastslug+0.2;
goto start;
end;
begin
p := GetConsoleWindow();
setwindowpos(p, HWND_TOPMOST, 100, 100, 800, 600, SWP_SHOWWINDOW);
hidecursor;
h:=GetDC(p);
spiral(h,rgb(10,10,200),rgb(200,40,10));
end.
Recent
