{ GRAFMOVE.PAS Copyright (c) TrSek alias Zdeno Sekerak } { Program vykreslí graf funkcie y=10*sin(x)/cos(y) v 3D priestore } { pričom dovolí tento graf otáčať v roznych osiach súmernosti(X,Y,Z),} { prípadne zvačšovať zmenšovať mierku zobrazenia. } { Vykreslovaciu funkciu si program vyžiada z klávesnice. } { } { Datum:13.07.2013 http://www.trsek.com } program graf_move; uses crt,dos,graph,aritmet; const KROK=5; { sirka sietky a zaroven KROK_X, KROK_Y } KU=0.05; { krok otacania v stupnoch } PI=3.1425; var gd,gm:integer; x_zac, x_kon:real; { rozsah x-ovej osi } y_zac, y_kon:real; { rozsah y-ovej osi } z_zac, z_kon:real; { rozsah z-ovej osi } alpha1,beta1:real; xo, yo:real; alpha,beta,gama,delta:real; fnc:string; { vyhodnocovana funkcia } ch :char; procedure EGAVGA_dr; external; {$L EGAVGA.OBJ } { prepocita suradnice na mierku zvolenu uzivatelom } function MierkaX(x:real; smer:byte):real; var p1,p2:real; begin p1:=GetMaxX div 2; p2:=x_kon-x_zac; if( smer=1 )then MierkaX:=x*p1/p2 else MierkaX:=x*p2/p1; end; { prepocita suradnice na mierku zvolenu uzivatelom } function MierkaY(x:real; smer:byte):real; var p1,p2:real; begin p1:=GetMaxY div 3; p2:=y_kon-y_zac; if( smer=1 )then MierkaY:=x*p1/p2 else MierkaY:=x*p2/p1; end; { prepocita suradnice na mierku zvolenu uzivatelom } function MierkaZ(x:real; smer:byte):real; var p1,p2:real; begin p1:=GetMaxY div 3; p2:=z_kon-z_zac; if( smer=1 )then MierkaZ:=x*p1/p2 else MierkaZ:=x*p2/p1; end; { prevod z cisla na retazec } function ToStr(x:real):string; var s:string; err:integer; begin if((x>0) and (x<1))then Str(x:2:3,s) else Str(x:2:0,s); ToStr:=s; end; { definicia funkcie } function funcXY(x,y:real;var corr:boolean):real; var vys: real; begin corr:=false; funcXY:=0; x:=MierkaX(x,2); y:=MierkaY(y,2); vys:=Vyhodnot(fnc,x,y); { iba ak nieje ziadna chyba } if(pError=0)then begin corr:=true; funcXY:=MierkaZ(vys,1); end end; { GetX - vypocita x suradnicu vramci prevodu 3D->2D } procedure GetXY(x,y,z:real;var xr1,yr1:real); var XX0,YY0,ZZ0:real; XX,YY,ZZ:real; begin XX:=x; YY:=(y*cos(alpha)+z*sin(alpha)); ZZ:=(-y*sin(alpha)+z*cos(alpha)); XX0:=XX; YY0:=YY; ZZ0:=ZZ; XX:=(XX0*cos(beta)-ZZ0*sin(beta)); YY:=YY0; ZZ:=(XX0*sin(beta)+ZZ0*cos(beta)); XX0:=XX; YY0:=YY; ZZ0:=ZZ; XX:=(XX0*cos(gama)-YY0*sin(gama)); YY:=(XX0*sin(gama)+YY0*cos(gama)); ZZ:=ZZ0; xr1:=(xo-YY*cos(beta1*pi/180)+XX*cos(alpha1*pi/180)); yr1:=(yo+YY*sin(beta1*pi/180)+XX*sin(alpha1*pi/180)+ZZ); end; { vykresli ciaru transformovanu 3D na 2D } procedure mline(x1,y1,z1,x2,y2,z2:real); var xr1,yr1:real; xr2,yr2:real; kresli:boolean; begin kresli:=true; { prepocet x,y suradnic } GetXY(x1,y1,z1,xr1,yr1); GetXY(x2,y2,z2,xr2,yr2); { ak by bola ciara mimo obrazovku } if(( xr1<0 ) or (xr2<0) or ( yr1<0 ) or (yr2<0)) then kresli:=false; { ak by bola ciara mimo obrazovku } if(( xr1>GetMaxX ) or (xr2>GetMaxX) or ( yr1>GetMaxY ) or (yr2>GetMaxY)) then kresli:=false; if( kresli )then line( round(xr1), round(yr1), round(xr2), round(yr2)); end; { program na vyvolene cisla mierky } function VyvolCislo(d:real):real; var rad:integer; begin rad:=0; d:=d/5; { budeme zmensovat az po rad 10 } while(d>10) do begin inc(rad); d:=d/10; end; { budeme zvacsovat az po rad 10 } while(d<1) do begin dec(rad); d:=d*10; end; if(d<2)then d:=1; if((d>=2) and (d<4))then d:=2.5; if((d>=4) and (d<6))then d:=5; if((d>=6) and (d<8))then d:=7.5; if(d>8)then d:=10; { spat } while(rad>0) do begin dec(rad); d:=d*10; end; while(rad<0) do begin inc(rad); d:=d/10; end; VyvolCislo:=d; end; { nakresli osovy kriz } procedure oskriz; var i,krok_i:real; xr1,yr1:real; begin { ideme kreslit mierku x } SetColor(Red); mline( 0,0,0, GetMaxX div 2,0,0 ); { os x } i:=0; krok_i:=VyvolCislo(x_kon-x_zac); repeat mline( MierkaX(i,1),3,0, MierkaX(i,1),-3,0); GetXY( MierkaX(i,1),-12,0, xr1,yr1); OutTextXY( round(xr1), round(yr1), ToStr(i)); i:=i+krok_i; until (i>=x_kon); { ideme kreslit mierku y } SetColor(Green); mline( 0,0,0, 0,GetMaxY div 3,0 ); { os y } i:=0; krok_i:=VyvolCislo(y_kon-y_zac); repeat mline( 3, MierkaY(i,1),0, -3, MierkaY(i,1),0); GetXY( -20, MierkaY(i,1),0, xr1,yr1); OutTextXY( round(xr1), round(yr1), ToStr(i)); i:=i+krok_i; until (i>=y_kon); { os y len vykreslime } SetColor(Yellow); mline( 0,0,0, 0,0,GetMaxY div 3 ); { os z podobne ako y lebo je kratsia } SetColor(White); end; { vykresli obe grafy } procedure KresliGraf; var x,y :real; z1,z2:real; c1,c2:boolean; x1,y1,x2,y2:real; begin y:=0; repeat x:=0; repeat z1 := funcXY(x,y,c1); { zaciatocny bod } z2 := funcXY(x+KROK,y,c2); { ciara vpravo } if(c1 and c2 )then { ak sa da nakreslit } mline( x,y,z1, x+KROK,y,z2 ); z2 := funcXY(x,y+KROK,c2); { ciara nahor } if(c1 and c2 )then { ak sa da nakreslit } mline( x,y,z1, x,y+KROK,z2 ); x:=x+KROK; until (x>=(GetMaxX/2)); y:=y+KROK; until (y>=(GetMaxY/3)); end; { vypise uvodny help } procedure Help; begin writeln('Graf viewer'); writeln('-----------'); writeln('1,2 - otacanie v osi x'); writeln('3,4 - otacanie v osi y'); writeln('5,6 - otacanie v osi z'); writeln('Vlavo, Vpravo - zvacsovanie, zmensovanie osi x,y'); writeln('Hore, Dole - zvacsovanie, zmensovanie osi z'); writeln('ESC - koniec'); writeln('-------------------------------------------------'); writeln('Stlac klaves'); end; { vyziada od uzivatela funkciu } procedure VyziadajFunc; begin writeln; writeln('Zadaj funkciu ktoru mam zobrazovat'); write('f(x,y)='); fnc:='sin(x+y)'; readln(fnc); end; { hlavny program } begin Help; VyziadajFunc; { inicializacia grafickej karty } gd := Detect; RegisterBGIdriver(@egavga_dr); gd:=9;gm:=1; InitGraph(gd, gm,' '); if( GraphResult <> grOk )then begin WriteLn('Chyba pri inicalizacii grafickej karty. Asi chyba egavga.bgi.'); halt(1); end; { uhly zobrazenia 3D os kriza } alpha1:=0; beta1 :=135; alpha:=2.5; beta :=25.0; gama :=12.5; delta:=0.0; { definujeme koncove body } x_zac := 0; y_zac := 0; z_zac := 0; x_kon := 10; y_kon := 10; z_kon := 10; xo:=200; yo:=250; { pre zaciatok } ch:=#10; repeat { zvacseni, zmensenie grafu } if( ch='P' )then begin x_zac:=x_zac*2; x_kon:=x_kon*2; y_zac:=y_zac*2; y_kon:=y_kon*2; z_zac:=z_zac*2; z_kon:=z_kon*2; end; if( ch='H' )then begin x_zac:=x_zac/2; x_kon:=x_kon/2; y_zac:=y_zac/2; y_kon:=y_kon/2; z_zac:=z_zac/2; z_kon:=z_kon/2; end; { otacenie osi z } if( ch='1' )then alpha:=alpha-KU; if( ch='2' )then alpha:=alpha+KU; if( ch='3' )then beta:=beta-KU; if( ch='4' )then beta:=beta+KU; if( ch='5' )then gama:=gama-KU; if( ch='6' )then gama:=gama+KU; if( ch='7' )then delta:=delta-KU; if( ch='8' )then delta:=delta+KU; ClearDevice; OsKriz; KresliGraf; ch := readkey; { precitame sede klavesy } if( ch=#0 )then ch:=readkey; until (ch = #27); {ESC} { zatvorime graficku kartu } CloseGraph; end.