Program fuggveny2;
{
Kétváltozós függvények ábrázolása,
demonstrációs keretprogram.
Keret.
}
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);
Begin
{...}
End;
Procedure Vizszintes(i,j: Integer);
Begin
{...}
End;
Begin
AblakTorles('Szintvonal-1');
sk:=MaxY Div sDb; ok:=MaxX Div oDb;
{...}
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);
Begin
{...}
End;
Procedure Kereszt(Const szint:TSzintPontok);
Begin
{...}
End;
Begin
AblakTorles('Szintvonal-2');
sk:=MaxY Div sDb; ok:=MaxX Div oDb;
{...}
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;
{...}
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);
{..}
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);
{...}
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);
{...}
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);
{...}
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);
{...}
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.