6.3

分形理论及算法

writeln;
writeln('Now we start...');
writeln('Please press any key to continue');
readln;
Clrscr;TextColor(RED);
writeln('Hint: -3.0 < pmin < +2.0');
write('Please input pmin=3D ');
readln(pmin);
writeln;
writeln('Hint: -3.0 < qmin < +2.0');
Write('Please input qmin=3D '); readln(qmin);
qmin:=3D-qmin;{=BD=AB=C6=C1=C4=BB=D7=F8=B1=EA=D7=AA=BB=AF=B3=C9=D5=FD=B3=A3=
=D7=F8=B1=EA}
writeln;
writeln('Hint: 50 < number < 5000');
write('Please input the number of pixels on one direction=3D');
Readln(PixelNumber);
win.width :=3DPixelNumber;
win.height :=3Dround(PixelNumber/scalewidthheight);
bps:=3D8;
scale:=3DPixelNumber div 400+1;
win.xstart:=3D0; win.ystart:=3D0;
pmax:=3Dpmin+5.8;
qmax:=3Dqmin+5.8*(win.height-1)/(win.width-1);
{Set Palette}
FOR i:=3D0 TO 20 do BEGIN
pal=A3=DB3*i=A3=DD:=3Dchr(255-10*i);
pal=A3=DB3*i+1=A3=DD:=3Dchr(255-10*i);
pal=A3=DB3*i+2=A3=DD:=3Dchr(55+10*i)  END;
FOR i:=3D21 TO 30 do BEGIN
pal=A3=DB3*i=A3=DD:=3Dchr(11);
pal=A3=DB3*i+1=A3=DD:=3Dchr(255-21*(i-21));
pal=A3=DB3*i+2=A3=DD:=3Dchr(11)  END;
FOR i:=3D31 TO 43 do BEGIN
pal=A3=DB3*i=A3=DD:=3Dchr(255-11*(i-31));
pal=A3=DB3*i+1=A3=DD:=3Dchr(20);
pal=A3=DB3*i+2=A3=DD:=3Dchr(20) END;
FOR i:=3D44 TO 53 do BEGIN
pal=A3=DB3*i=A3=DD:=3Dchr(60);
pal=A3=DB3*i+1=A3=DD:=3Dchr(255-21*(i-44));
pal=A3=DB3*i+2=A3=DD:=3Dchr(60) END;
=A1=AD
FOR i:=3D201 TO 255 do BEGIN
pal=A3=DBi*3=A3=DD:=3Dchr(255-20*(201-i));
pal=A3=DBi*3+1=A3=DD:=3Dchr(0);
pal=A3=DBi+3+2=A3=DD:=3Dchr(i)  END;
{call procedure to write the initial part of image file}
PrepareFile(s);
gd:=3DVGA;  gm:=3DVGAHI;
initgraph(gd,gm,'');
SetColor(6);SetTextStyle(1,0,2);
OutTextXY(400,5,'Fractal Image!');
SetColor(4);
OutTextXY(400,50,'Please wait...');
REPEAT
deltap:=3D(pmax-pmin)/(win.width-1);
deltaq:=3D(qmax-qmin)/(win.height-1);
FOR nq:=3D0 TO win.height-1  do
FOR np:=3D0 TO win.width-1 do BEGIN
p0:=3Dpmin+np*deltap;
q0:=3Dqmin+nq*deltaq;
IteNumber:=3D0;
x0:=3D0;y0:=3D0;
{for Julia set=A3=ACx0:=3Dp0;y0:=3Dq0;}
10:
x1:=3Dx0*x0-y0*y0+p0;
y1:=3D2*x0*y0+q0;
{for Julia set=A3=ACuse other values in the place of p0,q0}
{x1:=3Dx0*x0*x0-3*x0*y0*y0-0.431183125;
y1:=3D3*x0*x0*y0-y0*y0*y0+0.01712875;}
{x1:=3Dsin(x0*x0)-y0*y0/3+0.0136;
y1:=3D3*x0*y0+0.21; }
{lins1:=3D(1+eps)*(2*x0*cos(pi/10)-y0*sin(pi/10));
lins2:=3D(1+eps)*(y0*cos(pi/10)-x0*sin(pi/10));
x1:=3Dx0*x0-y0*y0+lins1;
y1:=3D2*x0*y0+lins2+0.7;}
inc(IteNumber);
r:=3Dx1*x1+y1*y1;
IF r>Distance THEN BEGIN
FOR i:=3D1 TO IteNumber do BEGIN
IF (IteNumber>i)and(IteNumber<=3Di+1) THEN
kcolor:=3Di END;
putpixel(np div scale,nq div scale,kcolor);
b:=3Dchr(kcolor and 255);
blockwrite(f,b,sizeof(b)) END
ELSE IF (r&lt;=3DDistance) and (IteNumber<MAXITENUM) GraphResult< IF =
InitGraph(Gd,Gm,??); Gd:=3D"VGA;Gm:=3DVGAHI;" PrepareFile(s); =
CloseGraph; ClearViewPort; Sound(500);Delay(200);Nosound; =
qmax:=3D"(qmax-temp)*(yc+dy)*scale/win.height+temp;" =
qmin:=3D"(qmax-qmin)*yc*scale/win.height+temp;" temp:=3D"pmin;" =
pmax:=3D"(pmax-temp)*(xc+dx)*scale/win.width+temp;" =
pmin:=3D"(pmax-pmin)*xc*scale/win.width+pmin;" area(xc,yc,dx,dy); =
cross(xc,yc); movecross(xc,yc,5); Ratio:=3D"win.width/win.height;" =
dx:=3D"10;dy:=3D10;" scale; div 2 yc:=3D"win.height" xc:=3D"win.width" =
keyboard?); on keys arrow outtextxy(200,440,?use subarea,?); a amplify =
to want you outTextXY(200,400,?If !?); Completed Has =
OutTextXY(200,370,?It settextstyle(1,0,2); setcolor(2); close(f); 20: =
END; 20 GOTO THEN keypressed blockwrite(f,b,sizeof(b)) b:=3D"chr(0);" =
BEGIN ELSE END 10 x0:=3D"x1;y0:=3Dy1;">grOK THEN Halt(1);
SetTextStyle(1,0,4);
str(pmin,ppx); str(-qmin,qqy);
OutTextXY(10,380,'px=3D');
Moveto(80,380);
OutText(ppx);
OutTextXY(10,420,'qy=3D');
Moveto(80,420);
OutText(qqy);
settextstyle(1,0,2);
OutTextXY(10,200,'Press ESC to EXIT!!');
SetViewPort(win.xstart,win.ystart,
win.width,win.height,ClipOn);
ch:=3DReadKey;
if ch=3Desc then exit;
UNTIL (ch=3Desc);
Sound(500);Delay(200);nosound;
ClearViewPort;CloseGraph=A3=BB
END.</PRE></UL><PRE></PRE>
<P></P>
<P>
<CENTER><IMG=20
src=3D"http://www.phil.pku.edu.cn/personal/huajie/fractalart/html/p604.gi=
f">
<P></P>
<P>=CD=BC6.4=B6=D4=D3=A6=D3=DA=D3=D2=B2=E0=C3=A2=B5=C2=B2=AA=C2=DE=BC=AF=B5=
=C4=D6=EC=C0=F6=D1=C7=BC=AF=B5=C4=D0=CE=D7=B4</CENTER></P>
<P>=C9=CF=CA=F6=D6=F7=B3=CC=D0=F2=B5=F7=D3=C3=C1=CB=D2=BB=B8=F6=B5=A5=D4=AA=
Shelib.TPU=A3=AC=B4=CB=B5=A5=D4=AA=B5=C4=D4=B4=B3=CC=D0=F2=C8=E7=CF=C2=A3=
=BA</P>
<P>
<UL><PRE>{SHELIB.PAS,Huajie,1993}
Unit shelib;
interface
uses graph,crt,dos;
type  view=3DRecord
xstart,ystart,width,height:integer;
end;
var
gd,gm:integer;
c,d,i,j,xofinit0,xofinit1,yofinit0,yofinit1:integer;
K,Ratio,coef1,coef2,xs,ys,xe,ye,xsub,ysub:real;
xc,yc,step,dx,dy,dot:integer;
color,size:word;
x,y:integer;
s:string;
ch:char;
kofflag:boolean;
win:view;
const
esc=3D#27;up=3D#72;down=3D#80;left=3D#75;
right=3D#77;enter=3D#13;space=3D#32;
function FuncKey(var ch:char):boolean;
procedure cross(xc,yc:integer);
procedure movecross(var xc,yc:integer;step:integer);
procedure area(var xc,yc,dx,dy:integer);
implementation
function FuncKey(var ch:char):boolean;
begin
ch:=3DReadKey;
if ch&lt;&gt;#0 then FuncKey:=3DFalse else begin
FuncKey:=3DTrue;
Ch:=3DReadKey end;
end;
procedure cross(xc,yc:integer);
begin
if xc&lt;0 then xc:=3D0;
if xc&gt;GetMaxX then xc:=3DGetMaxX;
if yc&lt;0 then yc:=3D0;
if yc&gt;GetMaxY then yc:=3DGetMaxY;
if (GetMaxColor&gt;1) then
Setcolor(GetMaxColor-1);
SetLineStyle(SolidLn,0,NormWidth);
SetWriteMode(Xorput);
Line(xc-5,yc,xc+5,yc);
Line(xc,yc-4,xc,yc-1);
Line(xc,yc+1,xc,yc+4);
end;
procedure movecross(var xc,yc:integer;step:integer);
var
 x,y:integer;
begin
x:=3Dxc;y:=3Dyc;
repeat
kofflag:=3DFuncKey(ch);
if ch=3Desc then exit;
if (ch=3Dup) or (ch=3Ddown) or (ch=3Dleft) or (ch=3Dright) then
begin
case ch of
up: y:=3Dy-step;
down: y:=3Dy+step;
left: x:=3Dx-step;
right: x:=3Dx+step
end;
cross(xc,yc);
if x&lt;0 then x:=3D0;
if x&gt;GetMaxX then x:=3DGetMaxX;
if y&lt;0 then y:=3D0;
if y&gt;GetMaxY then y:=3DGetMaxY;
xc:=3Dx;yc:=3Dy;
cross(xc,yc)
end;
until (ch=3Denter)
end;
procedure area(var xc,yc,dx,dy:integer);
begin
setwritemode(Xorput);
rectangle(xc,yc,xc+dx,yc+dy);
step:=3D5;
repeat
kofflag:=3DFuncKey(ch);
if (ch=3Dup) or (ch=3Ddown) or (ch=3Dleft) or (ch=3Dright) then
begin
rectangle(xc,yc,xc+dx,yc+dy);
case ch of
up: dy:=3Ddy-step;
down: dy:=3Ddy+step;
left: dx:=3Ddx-step;
right: dx:=3Ddx+step
end;
end;
if (ch=3Dup) or (ch=3Ddown) then dx:=3Dround(dy*Ratio);
if (ch=3Dleft) or (ch=3Dright) then dy:=3Dround(dx/Ratio);
if ((xc+dx)&gt;win.width) then
dx:=3Ddx-step;
if ((xc+dx)&lt;0) then
dx:=3Ddx+step;
if ((yc+dy)&gt;win.height) then
dy:=3Ddy-step;
if ((yc+dy)&lt;0) then
dy:=3Ddy+step;
rectangle(xc,yc,xc+dx,yc+dy)
until (ch=3Denter);
rectangle(xc,yc,xc+dx,yc+dy);
end;
begin
end.</PRE></UL><PRE></PRE>
<P></P>
<P>=CA=B9=D3=C3=CA=B1=CF=C8=BD=ABSHELIB.PAS=B1=E0=D2=EB=B3=C9SHELIB.TPU=A3=
=AC=C8=BB=BA=F3=D4=D9=B1=E0=D2=EBFart1995.PAS=B5=C3=B5=BDFart1995.EXE=A1=A3=
=C4=E3=BB=E1=D7=A2=D2=E2=B5=BD=A3=ACFart1995.PAS=D6=D0=B5=C4=B5=FC=B4=FA=BA=
=AF=CA=FD=CA=B5=BC=CA=C9=CF=BF=C9=D2=D4=C8=A1=C8=CE=BA=CE=C4=E3=C4=DC=CF=EB=
=CF=F3=B5=C3=B3=F6=B5=C4=BA=AF=CA=FD=A1=A3=BE=E0=C0=EB=BA=AF=CA=FD=BF=C9=D2=
=D4=D3=C3=C6=E4=CB=FB=B7=BD=CA=BD=B6=A8=D2=E5=A1=A3=D2=F2=B6=F8=C9=CF=CA=F6=
=B3=CC=D0=F2=CD=EA=C8=AB=CA=CA=D3=C3=D3=DA=CF=C2=D2=BB=BD=DA=D2=AA=CB=B5=B5=
=C4=B9=E3=D2=E5<I>M</I>=BC=AF=BA=CD=B9=E3=D2=E5<I>J=20
</I>=BC=AF=B5=C4=BC=C6=CB=E3=A1=A3</P>
<P>=CA=B9=D3=C3=C9=CF=CA=F6=B3=CC=D0=F2=B5=C4=BA=C3=B4=A6=CA=C7=A3=AC<I>M=
</I>=BC=AF=D3=EB<I>J</I>=BC=AF=CD=B3=D2=BB=D3=DA=D2=BB=B8=F6=B3=CC=D0=F2=A3=
=AC=B6=D4=C8=CE=D2=E2=BA=AF=CA=FD=B6=BC=C8=E7=B4=CB=A1=A3=B4=CB=20
=CD=E2=A3=AC=CB=F9=D7=F7=CD=BC=D0=CE=B5=C4=B4=F3=D0=A1=B2=BB=CA=DC=CF=D4=CA=
=BE=BF=A8=C0=E0=D0=CD=CF=DE=D6=C6=A3=AC=D2=F2=CE=AA=CE=D2=C3=C7=D6=B1=BD=D3=
=CD=F9=CE=C4=BC=FE=D6=D0=D0=B4=CA=FD=BE=DD=A3=AC=C6=C1=C4=BB=D6=BB=C6=F0=D2=
=BB=B8=F6=BC=E0 =CA=D3=BD=F8=B3=CC=B5=C4=D7=F7=D3=C3=A1=A3</P>
<P>=B2=C9=D3=C3=C9=CF=CA=F6=B7=BD=B7=A8=B5=C3=B5=BD=B5=C4=CE=C4=BC=FE=D6=BB=
=CA=C7=B3=F5=BC=B6=B5=C4=B7=C7=B1=EA=D7=BC=CD=BC=D0=CE=CE=C4=BC=FE=A3=AC=D2=
=BB=B0=E3=C8=ED=BC=FE=BB=B9=B2=BB=C4=DC=D6=B1=BD=D3=B6=C1=C8=A1=A1=A3=CA=B9=
=D3=C3=CE=D2=C3=C7=B1=E0=D0=B4=B5=C4RAWTOGIF.EXE=B9=A4=BE=DF=C8=ED=BC=FE=A3=
=AC=BF=C9=D2=D4=BD=AB=CB=FC=C3=C7=D7=AA=BB=AF=B3=C9=B1=EA=D7=BC=B5=C4GIF=B8=
=F1=CA=BD=B5=C4=CE=C4=BC=FE=A3=AC=D3=C3=B7=A8=CA=C7=A3=BA</P>
<P></P>
<P>
<UL>RAWTOGIF myfile newfile.GIF </UL>
<P>=C6=E4=D6=D0myfile=CA=C7=B3=F5=BC=B6=CE=C4=BC=FE=A3=ACnewfile.GIF=CA=C7=
=D7=EE=D6=D5=C9=FA=B3=C9=B5=C4=B1=EA=D7=BCGIF=B8=F1=CA=BD=CE=C4=BC=FE=A1=A3=
RAWTOGIF.EXE=BF=C9=B4=D3=D3=EB=B1=BE=CA=E9=C5=E4=CC=D7=B5=C4=B9=E2=C5=CC=C9=
=CF=D5=D2=B5=BD=A3=AC=C8=E7=B9=FB=C3=BB=C2=F2=B5=BD=B9=E2=C5=CC=D2=B2=BF=C9=
=D2=D4=D7=D4=BC=BA=B1=E0=D2=EB=D2=BB=CF=C2=C8=E7=CF=C2=D4=B4=B3=CC=D0=F2(=
=B1=BE=B3=CC=D0=F2=D3=C9=C2=DE=BE=FC=B1=E0=D0=B4)=A1=A3</P>
<P>
<UL><PRE>//=B4=CB=B3=CC=D0=F2=D3=C3C=D3=EF=D1=D4=B1=E0=D0=B4=A3=AC=B9=B2=B0=
=FC=C0=A8=C8=FD=B2=BF=B7=D6=A3=BAGIF.H,GIFSAVE.C=BA=CDGIFMAIN.C
//=D2=D4=CF=C2=CA=C7GIF.H