Program fuggveny2;
{
Kétváltozós függvények ábrázolása,
demonstrációs program
Megoldás.
}
Uses
{$IFNDEF FPC -- nem FreePascal=TurboPascal}
Newdelay,
{$ENDIF}
Crt,Graph;
Const
path = 'c:\langs\bp\bgi';
MaxN =50;
MaxMag =100;
{szintvonalak száma:}
SzvDb = 5;
{szintvonal-arányok:}
szv: Array [1..SzvDb] of Real=(0.2,0.4,0.6,0.8,1.0);
Type
TFvTabla = Array [1..MaxN,1..MaxN] of Real;
Var
MaxX,MaxY: Integer; {képméretek}
yMax,ny : Real; {legnagyobb fv-érték, y-nyújtás}
sDb,oDb, {rajzolandó sorok, oszlopok száma}
sk,ok : Integer; {rácsháló sor-, oszlopköz szélessége}
fvt : TFvTabla; {ábrázolandó függvény táblázata}
i,j : Integer; {főprogram ciklusváltozói}
(*
A megjelenítést segítő segédeljárások: ----------------------------
*)
Procedure Karkezd;
Begin
Window(1,1,80,25);
TextBackGround(blue);
ClrScr;
End;
Procedure Grafikusra;
Var
gd,gm: Integer;
Begin
DetectGraph(gd,gm);
InitGraph(gd,gm,path);
SetBkColor(black);
SetViewPort(0,0,GetMaxX,GetMaxY,true);
ClearViewPort;
MaxX:=GetMaxX; MaxY:=GetMaxY;
sDb:=MaxN; oDb:=MaxN;
End;
Procedure AblakTorles(cim:string);
Begin
{$IFDEF FPC -- FreePascal;
hogy a lássuk a vezérlő ablakban is a haladást:}
Writeln(cim);
{$ENDIF}
SetViewPort(0,0, MaxX,MaxY,ClipOn);
SetTextJustIfy(CenterText,TopText);
ClearViewPort;
Rectangle(0,0,MaxX,MaxY);
SetViewPort(2,2, MaxX-2,MaxY-2,ClipOn);
OutTextXY(MaxX Div 2,1,cim);
End;
Procedure Szovegesre;
Begin
CloseGraph;
RestoreCrtMode;
End;
(*
A függvény és hozzátartozó segédeljárások: ------------------------
*)
Function fv(i,j:Integer): Real;
Var
y: Real;
Begin
y:=(i-1); y:=y*(sDb-i)/sDb;
y:=y*(j-1); y:=y*(oDb-j)/oDb*i*(sDb-i)*j;
fv:=y;
End;
Function MaxMagassag: Real;
Var
i,j: Integer;
max: Real;
Begin
max:=fvt[1,1];
For i:=1 to sDb do For j:=1 to oDb do
Begin
If max<fvt[i,j] then max:=fvt[i,j];
End;
MaxMagassag:=max
End;
Procedure FuggvenyErtekek;
Var
i,j: Integer;
Begin
For i:=1 to sDb do For j:=1 to oDb do
Begin
fvt[i,j]:=fv(i,j);
End;
End;
(*
A rajzoló módszerek: ----------------------------------------------
*)
Function Szintvonal(fgvertek1,fgvertek2: Real):Boolean;
Var
k: Integer;
x: Real;
Begin
x:=szv[1]*yMax; k:=1;
while (x<fgvertek1) and (x<fgvertek2) do
Begin
k:=k+1; x:=szv[k]*yMax;
End;
Szintvonal:=(x<fgvertek1) or (x<fgvertek2);
End;
Procedure Rajzszint1;
{
Rajzolás merőleges szintvonalakkal
}
Var
i,j: Integer;
Procedure Fuggoleges(i,j: Integer);
Var
sor,oszlop: Integer;
Begin
sor:=MaxY-i*sk; oszlop:=j*ok;
Line(oszlop,sor,oszlop,sor+sk);
End;
Procedure Vizszintes(i,j: Integer);
Var
sor,oszlop: Integer;
Begin
sor:=MaxY-i*sk; oszlop:=j*ok;
Line(oszlop,sor,oszlop-ok,sor);
End;
Begin
AblakTorles('Szintvonal-1');
sk:=MaxY Div sDb; ok:=MaxX Div oDb;
For i:=1 to sDb-1 do For j:=1 to oDb-1 do
Begin
If szintvonal(fvt[i,j],fvt[i,j+1]) then Fuggoleges(i,j);
If szintvonal(fvt[i,j],fvt[i+1,j]) then Vizszintes(i,j);
End;
End;
Procedure Rajzszint2;
{
Rajzolás 4-irány szintvonalakkal
}
type TSzintPontok=array [1..4] of Record
sor,oszlop: Integer;
End;
Var
x : Real;
db,
i,j,k: Integer;
szint: TSzintPontok;
Procedure Egyenes(Const szint:TSzintPontok);
Var
sor1,oszlop1,sor2,oszlop2: Integer;
Begin
sor1:=MaxY-szint[1].sor*sk Div 2; oszlop1:=szint[1].oszlop*ok Div 2;
sor2:=MaxY-szint[2].sor*sk Div 2; oszlop2:=szint[2].oszlop*ok Div 2;
Line(oszlop1,sor1,oszlop2,sor2);
End;
Procedure Kereszt(Const szint:TSzintPontok);
Var
sor1,oszlop1,sor2,oszlop2: Integer;
sor3,oszlop3,sor4,oszlop4: Integer;
Begin
sor1:=MaxY-szint[1].sor*sk Div 2; oszlop1:=szint[1].oszlop*ok Div 2;
sor2:=MaxY-szint[2].sor*sk Div 2; oszlop2:=szint[2].oszlop*ok Div 2;
sor3:=MaxY-szint[3].sor*sk Div 2; oszlop3:=szint[3].oszlop*ok Div 2;
sor4:=MaxY-szint[4].sor*sk Div 2; oszlop4:=szint[4].oszlop*ok Div 2;
Line(oszlop1,sor1,oszlop3,sor3);
Line(oszlop2,sor2,oszlop4,sor4);
End;
Begin
AblakTorles('Szintvonal-2');
sk:=MaxY Div sDb; ok:=MaxX Div oDb;
For i:=1 to sDb-1 do For j:=1 to oDb-1 do
Begin
db:=0;
If szintvonal(fvt[i,j],fvt[i,j+1]) then
Begin
db:=db+1;
szint[db].sor:=i*2; szint[db].oszlop:=j*2+1;
End;
If szintvonal(fvt[i,j],fvt[i+1,j]) then
Begin
db:=db+1;
szint[db].sor:=i*2+1; szint[db].oszlop:=j*2;
End;
If szintvonal(fvt[i+1,j],fvt[i+1,j+1]) then
Begin
db:=db+1;
szint[db].sor:=i*2+2; szint[db].oszlop:=j*2+1;
End;
If szintvonal(fvt[i,j+1],fvt[i+1,j+1]) then
Begin
db:=db+1;
szint[db].sor:=i*2+1; szint[db].oszlop:=j*2+2;
End;
If db=2 then Egyenes(szint) else If
db=4 then Kereszt(szint);
End;
End;
Procedure Rajzpontfelho;
{
Rajzolás pontfelhőkkel
}
Var
i,j,ii,jj,k,db: Integer;
Begin
AblakTorles('Pontfelhö');
sk:=MaxY Div sDb; ok:=MaxX Div oDb;
For i:=1 to sDb do For j:=1 to oDb do
Begin
db:=round(sqr(fvt[i,j]/yMax)*sk*ok) Div 2;
For k:=1 to db do
Begin
ii:=Random(sk); jj:=Random(ok);
PutPixel(j*ok+jj,MaxY-i*sk+ii,1);
End;
End;
End;
Procedure Rajztegla(arnyekx,arnyeky: Integer);
Var
i,j,
oszlop,sor,sor0: Integer;
s,s2:String;
Begin
Str(arnyekx,s); Str(arnyeky,s2); s:='('+s+','+s2+')';
AblakTorles('Tégla '+s);
sk:=(MaxY-maxmag) Div sDb; ok:=MaxX Div (sDb+oDb+1);
For i:=sDb downto 1 do For j:=oDb downto 1 do
Begin
oszlop:=i*sk+j*ok; sor:=round(MaxY-i*sk-fvt[i,j]*ny);
sor0:=round(MaxY-i*sk);
SetFillStyle(SolidFill,Black);
Bar(oszlop+arnyekx-ok,sor-arnyeky,oszlop+arnyekx,sor0-arnyeky);
SetFillStyle(SolidFill,Blue); Bar(oszlop-ok,sor,oszlop,sor0);
End;
End;
Function Felul(o,s: Real): Boolean;
Begin
Felul:=(GetPixel(round(o),round(s))=0) and
(GetPixel(round(o),round(s)-1)=0);
End;
Function Belul(coszlop: Real; eoszlop,oszlop: Integer): Boolean;
Begin
Belul:=(coszlop>=eoszlop) and (coszlop<=oszlop) or
(coszlop<=eoszlop) and (coszlop>=oszlop);
End;
Procedure Vonalig(oszlop,sor,eoszlop,esor: Integer);
Var
dsor,doszlop,nt,
coszlop,csor : Real;
Begin
If Abs(esor-sor)>Abs(eoszlop-oszlop) then nt:=Abs(esor-sor)
else nt:=Abs(eoszlop-oszlop);
dsor:=(esor-sor)/nt; doszlop:=(eoszlop-oszlop)/nt;
csor:=sor; coszlop:=oszlop;
repeat
csor:=csor+dsor; coszlop:=coszlop+doszlop;
until not( felul(coszlop,csor) and belul(coszlop,eoszlop,oszlop) );
Line(oszlop,sor,round(coszlop-doszlop),round(csor-dsor));
End;
Procedure Rajzfuggveny1;
Var
i,j,eoszlop,esor,
ii,jj,
oszlop,sor : Integer;
latszik : Boolean;
omax : array [1..2*MaxN] of Integer;
Procedure Latszopont;
Begin
omax[i+j]:=sor;
If latszik then Line(eoszlop,esor,oszlop,sor)
else Vonalig(oszlop,sor,eoszlop,esor);
Latszik:=true;
End;
Procedure Nemlatszopont;
Begin
If latszik then Vonalig(eoszlop,esor,oszlop,sor);
Latszik:=false;
End;
Begin
AblakTorles('X fv-metszet, lepel');
sk:=(MaxY-maxmag) Div sDb; ok:=MaxX Div (sDb+oDb+1);
For i:=1 to 2*MaxN do omax[i]:=MaxY+1;
For ii:=1 to sDb Div 3 do
Begin
i:=ii*3-2;
eoszlop:=i*ok+1*ok; esor:=round(MaxY-i*sk-fvt[i,1]*ny);
latszik:=(esor<=omax[i+1]);
If latszik then omax[i+1]:=esor;
For jj:=2 to oDb Div 3 do
Begin
j:=jj*3-2;
oszlop:=i*ok+j*ok; sor:=round(MaxY-i*sk-fvt[i,j]*ny);
If sor<=omax[i+j] then Latszopont else Nemlatszopont;
eoszlop:=oszlop; esor:=sor;
End;
End;
End;
Procedure Rajzfuggveny2;
Var
i,j,eoszlop,esor,
ii,jj,k,l,
oszlop,sor : Integer;
omax,omin : array [0..800] of Integer;
Begin
AblakTorles('X fv-metszet, lepel');
sk:=(MaxY-maxmag) Div sDb; ok:=MaxX Div (sDb+oDb+1);
For i:=0 to MaxX do
Begin
omax[i]:=MaxY+1;
omin[i]:=0;
End;
For ii:=1 to sDb Div 3 do
Begin
i:=ii*3-2;
eoszlop:=i*ok+1*ok; esor:=round(MaxY-i*sk-fvt[i,1]*ny);
If esor<=omax[eoszlop] then
Begin
omax[eoszlop]:=esor; PutPixel(eoszlop,esor,1)
End;
If esor>=omin[eoszlop] then
Begin
omin[eoszlop]:=esor; PutPixel(eoszlop,esor,1)
End;
For jj:=2 to oDb Div 3 do
Begin
j:=jj*3-2;
oszlop:=i*ok+j*ok; sor:=round(MaxY-i*sk-fvt[i,j]*ny);
For k:=eoszlop+1 to oszlop do
Begin
l:=esor+(k-eoszlop)*(sor-esor) Div (oszlop-eoszlop);
If l<=omax[k] then Begin omax[k]:=l; PutPixel(k,l,1) End;
If l>=omin[k] then Begin omin[k]:=l; PutPixel(k,l,1) End;
End;
eoszlop:=oszlop; esor:=sor;
End;
End;
End;
Procedure Rajzfuggveny3;
Var
i,j,eoszlop,esor,
ii,jj,
oszlop,sor : Integer;
latszik : Boolean;
omax,ro,rs : array [1..2*MaxN] of Integer;
Procedure Latszopont;
Begin
omax[i+j]:=sor;
If latszik then Line(eoszlop,esor,oszlop,sor)
else Vonalig(oszlop,sor,eoszlop,esor);
Latszik:=true;
End;
Procedure Nemlatszopont;
Begin
If latszik then Vonalig(eoszlop,esor,oszlop,sor);
Latszik:=false;
End;
Begin
AblakTorles('X-Y fv-metszet, tömör');
sk:=(MaxY-maxmag) Div sDb; ok:=MaxX Div (sDb+oDb+1);
For i:=1 to 2*MaxN do omax[i]:=MaxY+1;
line(sk+ok-1,MaxY-sk,sk+ok*(oDb-4)-1,MaxY-sk);
line(sk+ok-1,MaxY-sk,sk+ok-1,MaxY-sk-round(fvt[1,1]*ny));
For ii:=1 to sDb Div 3 do
Begin
i:=ii*3-2;
eoszlop:=i*ok+1*ok; esor:=round(MaxY-i*sk-fvt[i,1]*ny);
latszik:=(esor<=omax[i+1]);
If latszik then omax[i+1]:=esor;
If (i>1) and latszik then line(ro[1],rs[1],eoszlop,esor);
ro[1]:=eoszlop; rs[1]:=esor;
For jj:=2 to oDb Div 3 do
Begin
j:=jj*3-2;
oszlop:=i*ok+j*ok; sor:=round(MaxY-i*sk-fvt[i,j]*ny);
If sor<=omax[i+j] then Latszopont else Nemlatszopont;
eoszlop:=oszlop; esor:=sor;
If (i>1) and latszik then line(ro[j],rs[j],oszlop,sor);
ro[j]:=oszlop; rs[j]:=sor;
End;
If (i>1) then line(eoszlop,MaxY-i*sk,
(ii*3-5)*ok+(oDb-4)*ok,MaxY-(ii*3-5)*sk);
line(eoszlop,esor,eoszlop,MaxY-i*sk);
End;
End;
Procedure Rajzfuggveny4;
Var
i,j,eoszlop,esor,
ii,jj,
oszlop,sor : Integer;
p : array [1..8] of Integer;
Begin
AblakTorles('Festett 4szögek');
sk:=(MaxY-maxmag) Div sDb; ok:=MaxX Div (sDb+oDb+1);
SetColor(1); SetFillStyle(1,0);
For ii:=sDb Div 3 downto 2 do
Begin
i:=ii*3-2;
For jj:=2 to oDb Div 3 do
Begin
j:=jj*3-2;
p[1]:=i*ok+(j-3)*ok; p[2]:=round(MaxY-i*sk-fvt[i,j-3]*ny);
p[3]:=(i-3)*ok+(j-3)*ok; p[4]:=round(MaxY-(i-3)*sk-fvt[i-3,j-3]*ny);
p[5]:=(i-3)*ok+j*ok; p[6]:=round(MaxY-(i-3)*sk-fvt[i-3,j]*ny);
p[7]:=i*ok+j*ok; p[8]:=round(MaxY-i*sk-fvt[i,j]*ny);
FillPoly(4,p);
End;
End;
End;
Begin
Karkezd;
Grafikusra;
FuggvenyErtekek;
yMax:=MaxMagassag; ny:=MaxMag/yMax;
Rajzszint1;
ReadKey;
Rajzszint2;
ReadKey;
Rajzpontfelho;
ReadKey;
Rajztegla(2,2);
ReadKey;
Rajztegla(1,1);
ReadKey;
Rajztegla(0,1);
ReadKey;
Rajztegla(1,0);
ReadKey;
Rajzfuggveny1;
ReadKey;
Rajzfuggveny3;
ReadKey;
For i:=1 to sDb do For j:=1 to oDb do fvt[i,j]:=Abs(yMax-fvt[i,j]);
Rajzfuggveny1;
ReadKey;
{
Rajzfuggveny2;
ReadKey;
}
Rajzfuggveny3;
ReadKey;
Rajzfuggveny4;
ReadKey;
Szovegesre;
End.