API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Apr 27th, 2015
187
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 9.64 KB | None | 0 0
raw download clone embed print report
  1. Program Figures;
  2. uses Crt, Graph;
  3. type
  4.     PointP=^Point;
  5.     Point=object
  6.     private
  7.         X:integer;
  8.         Y:integer;
  9.         Color:integer;
  10.     public
  11.         constructor Init(InitX, InitY, InitC:integer);
  12.         function GetX:integer;
  13.         function GetC:integer;
  14.         procedure PutX(NewX:integer);
  15.         procedure PutY(NewY:integer);
  16.         procedure PutColor(NewColor:integer);
  17.         procedure ShowP;
  18.         procedure HideP;
  19.         procedure MoveTo(XL,YL:integer);   
  20.     end;
  21.      
  22.     PointL=^Line;
  23.     Line=object
  24.     private
  25.         X:integer;
  26.         Y:integer;
  27.         Color:integer;
  28.         R:integer;
  29.         fi:double;
  30.         X1,X2,Y1,Y2:integer;
  31.     public
  32.         constructor Init(InitX,InitY,InitC,InitR:integer; Initfi:double);
  33.         function GetX:integer;
  34.         function GetY:integer;
  35.         function GetC:integer;
  36.         function Length:double;
  37.         procedure PutX(NewX:integer);
  38.         procedure PutY(NewY:integer);
  39.         procedure Putfi(Newfi:double);
  40.         procedure PutR(NewR:integer);
  41.         procedure PutColor(NewColor:integer);
  42.         procedure ShowL;
  43.         procedure HideL;
  44.         procedure TurnL(Dfi:double);
  45.         procedure MoveL(DR:integer);
  46.         procedure MoveToT(XL,YL:integer);
  47.     end;
  48.        
  49.     PointT=^Triangle;
  50.     Triangle=object
  51.     private
  52.         X:integer;
  53.         Y:integer;
  54.         Color:integer;
  55.         R:integer;
  56.         fi:double;
  57.         alpha:double;
  58.         X1,X2,Y1,Y2,X3,Y3:integer;
  59.         TempColor:integer;
  60.     public
  61.         constructor Init(InitX,InitY,InitC,InitR:integer; Initfi,Initalpha:double);
  62.         function GetX:integer;
  63.         function GetC:integer;
  64.         function Square:double;
  65.         procedure PutX(NewX:integer);
  66.         procedure PutY(NewY:integer);
  67.         procedure Putfi(Newfi:double);
  68.         procedure PutR(NewR:integer);
  69.         procedure Putalpha(Newalpha:double);
  70.         procedure PutColor(NewColor:integer);
  71.         procedure ShowT;
  72.         procedure HideT;
  73.         procedure TurnT(Dfi:double);
  74.         procedure MoveT(DR:integer);
  75.         procedure MoveToT(XL,YL:integer);
  76.     end;
  77.        
  78.     PointPr=^Prisma;
  79.     Prisma=object
  80.     private
  81.         X:integer;
  82.         Y:integer;
  83.         Color:integer;
  84.         R:integer;
  85.         fi:double;
  86.         alpha:double;
  87.         H:integer;
  88.         X1,X2,Y1,Y2,X3,Y3,X11,X22,Y11,Y22,X33,Y33:integer;
  89.         TempColor:integer;
  90.     public
  91.         constructor Init(InitX,InitY,InitC,InitR,InitH:integer; Initfi,Initalpha:double);
  92.         function GetX:integer;
  93.         function GetC:integer;
  94.         function Volume:double;
  95.         procedure PutX(NewX:integer);
  96.         procedure PutY(NewY:integer);
  97.         procedure Putfi(Newfi:double);
  98.         procedure PutR(NewR:integer);
  99.         procedure Putalpha(Newalpha:double);
  100.         procedure PutColor(NewColor:integer);
  101.         procedure ShowPr;
  102.         procedure HidePr;
  103.         procedure TurnPr(Dfi:double);
  104.         procedure MovePr(DR:integer);
  105.         procedure MoveToPr(XL,YL:integer);
  106.     end;
  107.    
  108. constructor Point.Init(InitX, InitY, InitC:integer);
  109. begin
  110.     X:=InitX;
  111.     Y:=InitY;
  112.     Color:=InitC;
  113. end;
  114. constructor Line.Init(InitX,InitY,InitC,InitR:integer; Initfi:double);
  115. begin
  116.     X:=InitX;
  117.     Y:=InitY;
  118.     Color:=InitC;
  119.     R:=InitR;
  120.     fi:=Initfi;
  121. end;
  122. constructor Triangle.Init(InitX,InitY,InitC,InitR:integer; Initfi,Initalpha:double);
  123. begin
  124.     X:=InitX;
  125.     Y:=InitY;
  126.     Color:=InitC;
  127.     R:=InitR;
  128.     fi:=Initfi;
  129.     alpha:=Initalpha;
  130. end;
  131. constructor Prisma.Init(InitX,InitY,InitC,InitR,InitH:integer; Initfi,Initalpha:double);
  132. begin
  133.     X:=InitX;
  134.     Y:=InitY;
  135.     Color:=InitC;
  136.     R:=InitR;
  137.     fi:=Initfi;
  138.     alpha:=Initalpha;
  139.     H:=InitH;
  140. end;
  141.  
  142. function Point.GetX; begin GetX:=X; end;
  143. function Point.GetC; begin GetC:=Color; end;
  144. procedure Point.PutX(NewX:integer);begin X:=NewX;end;
  145. procedure Point.PutY(NewY:integer);begin Y:=NewY;end;
  146. procedure Point.PutColor(NewColor:integer); begin Color:=NewColor; end;
  147. procedure Point.ShowP; begin PutPixel(X,Y,Color); end;
  148. procedure Point.HideP; begin PutPixel(X,Y,GetBkColor); end;
  149. procedure Point.MoveTo(XL,YL:integer);
  150. begin
  151.         HideP;
  152.         PutX(X+Xl);
  153.         PutY(Y+YL);
  154.         ShowP;
  155. end;
  156.  
  157. function Line.GetX; begin GetX:=X; end;
  158. procedure Line.PutX(NewX:integer);begin X:=NewX;end;
  159. procedure Line.PutY(NewY:integer);begin Y:=NewY;end;
  160. procedure Line.PutColor(NewColor:integer); begin Color:=NewColor; end;
  161. procedure Line.ShowL;
  162. var TempColor:integer;
  163. begin
  164.     X1:=X+round(R*sin(fi));
  165.     Y1:=Y-round(R*cos(fi));
  166.     X2:=X+round(R*sin(fi+Pi));
  167.     Y2:=Y-round(R*cos(fi+Pi));
  168.     TempColor:=getcolor;
  169.     setcolor(Color);
  170.     line(X1,Y1,X2,Y2);
  171.     SetColor(TempColor);
  172. end;
  173. function Line.Length;
  174. begin
  175.     X1:=X+round(R*sin(fi));
  176.     Y1:=Y-round(R*cos(fi));
  177.     X2:=X+round(R*sin(fi+Pi));
  178.     Y2:=Y-round(R*cos(fi+Pi));
  179.     Length:=sqrt((X1-X2)*(X1-X2)+(Y1-Y2)*(Y1-Y2));
  180. end;
  181. procedure Line.HideL;
  182. begin
  183.     TempColor:=GetC;
  184.     PutColor(GetBkColor);
  185.     ShowL;
  186.     PutColor(TempColor);
  187. end;
  188. procedure Line.MoveTo(XL,YL:integer);  
  189. begin
  190. procedure Line.TurnL(Dfi:double);
  191. begin
  192.     HideL;
  193.     Putfi(fi+Dfi);
  194.     ShowL;
  195. end;
  196. procedure Line.MoveL(Dr:integer)
  197. begin
  198.     HideL;
  199.     PutR(R-Dr);
  200.     ShowL;
  201. end;
  202. procedure Line.MoveToL(XL,Yl:integer);
  203. begin
  204.     HideL;
  205.     PutX(X+XL);
  206.     PutY(Y+YL);
  207.     ShowL;
  208. end;
  209.  
  210. //triangle
  211. function Triangle.GetX; begin GetX:=X; end;
  212. function Triangle.GetC; begin GetC:=Color; end;
  213. procedure Triangle.PutX(NewX:integer); begin X:=NewX;end;
  214. procedure Triangle.PutY(NewY:integer); begin Y:=NewY;end;
  215. procedure Triangle.Putfi(Newfi:double); begin fi:=Newfi;end;
  216. procedure Triangle.PutR(NewR:integer); begin R:=NewR;end;
  217. procedure Triangle.Putalpha(Newalpha:double);begin alpha:=Newalpha;end;
  218. procedure Triangle.PutColor(NewColor:integer); begin Color:=NewColor;end;
  219. procedure Triangle.ShowT;
  220. begin
  221.         X1:=X+round(R*sin(fi));
  222.         Y1:=Y-round(R*cos(fi));
  223.         X2:=X+round(R*sin(fi+Pi));
  224.         Y2:=Y-round(R*cos(fi+Pi));
  225.         X3:=X+round(R*sin(alpha));
  226.         Y3:=Y-round(R*cos(alpha));
  227.             TempColor:=GetColor;
  228.             SetColor(Color);
  229.             line(X1,Y1,X2,Y2);
  230.             line(X1,Y1,X3,Y3);
  231.             line(X2,Y2,X3,Y3);
  232.             SetColor(TempColor);
  233. end;
  234. function Triangle.Square;
  235. begin
  236.     X1:=X+round(R*sin(fi));
  237.     Y1:=Y-round(R*cos(fi));
  238.     X2:=X+round(R*sin(fi+Pi));
  239.     Y2:=Y-round(R*cos(fi+Pi));
  240.     X3:=X+round(R*sin(alpha));
  241.     Y3:=Y-round(R*cos(alpha));
  242.     Square:=(sqrt((X1-X2)*(X1-X2)+(Y1-Y2)*(Y1-Y2))*sqrt((X1-X3)*(X1-X3)+(Y1-Y3)*(Y1-Y3))*sqrt((X2-X3)*(X2-X3)+(Y2-Y3)*(Y2-Y3)))/(4*R);
  243. end;
  244. procedure Triangle.HideT;
  245. begin
  246.     TempColor:=GetC;
  247.     PutColor(GetBkColor);
  248.     ShowT;
  249.     PutColor(TempColor);
  250. end;
  251. procedure Triangle.TurnT(Dfi:double);
  252. begin
  253.     HideT;
  254.     Putfi(fi+Dfi);
  255.     Putalpha(alpha+Dalpha);
  256.     ShowT;
  257. end;
  258. procedure Triangle.MoveT(DR:integer);
  259. begin  
  260.     HideT;
  261.     PutR(R-Dr);
  262.     ShowT;
  263. end;
  264. procedure Triangle.MoveToT(XL,YL:integer);
  265. begin
  266.     HideT;
  267.     PutX(X+XL);
  268.     PutY(Y+YL);
  269.     ShowT;
  270. end;
  271.  
  272. //Prisma
  273. function Prisma.GetX; begin GetX:=X; end;
  274. function Prisma.GetC; begin GetC:=Color; end;
  275. procedure Prisma.PutX(NewX:integer); begin X:=NewX;end;
  276. procedure Prisma.PutY(NewY:integer); begin Y:=NewY;end;
  277. procedure Prisma.Putfi(Newfi:double); begin fi:=Newfi;end;
  278. procedure Prisma.PutR(NewR:integer); begin R:=NewR;end;
  279. procedure Prisma.Putalpha(Newalpha:double);begin alpha:=Newalpha;end;
  280. procedure Prisma.PutColor(NewColor:integer); begin Color:=NewColor;end;
  281. procedure Prisma.ShowPr;
  282. begin
  283.     X1:=X+round(R*sin(fi));
  284.     Y1:=Y-round(R*cos(fi));
  285.     X2:=X+round(R*sin(fi+Pi));
  286.     Y2:=Y-round(R*cos(fi+Pi));
  287.     X3:=X+round(R*sin(alpha));
  288.     Y3:=Y-round(R*cos(alpha));
  289.     X11:=(X+H)+round(R*sin(fi));
  290.     Y11:=(Y+H)-round(R*cos(fi));
  291.     X22:=(X+H)+round(R*sin(fi+M_PI));
  292.     Y22:=(Y+H)-round(R*cos(fi+M_PI));
  293.     X33:=(X+H)+round(R*sin(alpha));
  294.     Y33:=(Y+H)-round(R*cos(alpha));
  295.         TempColor:=GetColor;
  296.         SetColor(Color);
  297.         line(X1,Y1,X2,Y2);
  298.         line(X1,Y1,X3,Y3);
  299.         line(X2,Y2,X3,Y3);
  300.         line(X1,Y1,X11,Y11);
  301.         line(X2,Y2,X22,Y22);
  302.         line(X3,Y3,X33,Y33);
  303.         SetColor(TempColor);
  304. end;
  305.  
  306. function Triangle.Volume;
  307. begin
  308.     X1:=X+round(R*sin(fi));
  309.     Y1:=Y-round(R*cos(fi));
  310.     X2:=X+round(R*sin(fi+Pi));
  311.     Y2:=Y-round(R*cos(fi+Pi));
  312.     X3:=X+round(R*sin(alpha));
  313.     Y3:=Y-round(R*cos(alpha));
  314.     Volume:=((sqrt((X1-X2)*(X1-X2)+(Y1-Y2)*(Y1-Y2))*sqrt((X1-X3)*(X1-X3)+(Y1-Y3)*(Y1-Y3))*sqrt((X2-X3)*(X2-X3)+(Y2-Y3)*(Y2-Y3)))/(4*R))*H;
  315. end;
  316. procedure Prisma.HidePr;
  317. begin
  318.     TempColor:=GetC;
  319.     PutColor(GetBkColor);
  320.     ShowPr;
  321.     PutColor(TempColor);   
  322. end;
  323. procedure Prisma.TurnPr(Dfi:double);
  324. begin
  325.     HidePr;
  326.     Putfi(fi+Dfi);
  327.     Putalpha(alpha+Dalpha);
  328.     ShowPr;
  329. end;
  330. procedure Prisma.MovePr(DR:integer);
  331. begin  
  332.     HidePr;
  333.     PutR(R-Dr);
  334.     ShowPr;
  335. end;
  336. procedure prisma.MoveToPr(XL,YL:integer);
  337. begin
  338.     HidePr;
  339.     PutX(X+XL);
  340.     PutY(Y+YL);
  341.     ShowPr;
  342. end;
  343. var X,Y,GDriver,GMode,ErrCode:integer;
  344. var Pk,lr,xl,xt,xpr,xc:integer;
  345. P1,P2,P3:Point;L1,L2,L3:Line; T1,T2,T3:Triangle; Pr1,Pr2,Pr3:Prisma;
  346. begin
  347.     clrscr;
  348.     GDriver:=DETECT;
  349.     GMode:=DETECT;
  350.     InitGraph(GDriver,GMode,'');
  351.     ErrCode:=GraphResult;
  352.     if not (ErrCode=grOk) then
  353.     begin
  354.         writeln('GRAPHIC ERROR',GraphErrorMsg(ErrCode));
  355.         writeln('Use keyboard');
  356.         readln;
  357.         halt(1);
  358.     end;
  359.    
  360.     P1.Init(100,150,2);
  361.     P2.Init(100,270,6);
  362.     P3.Init(100,380,7);
  363.     P1.ShowP;
  364.     P2.ShowP;
  365.     P3.ShowP;
  366.    
  367.     L1.Init(200,150,2,30,170);
  368.     L2.Init(200,270,6,40,90);
  369.     L3.Init(200,380,7,30,100);
  370.     L1.ShowL();
  371.     L2.ShowL();
  372.     L3.ShowL();
  373.  
  374.     T1.Init(330,150,2,30,0,55);
  375.     T2.Init(330,270,6,30,50,30);
  376.     T3.Init(330,380,7,30,100,60);
  377.     T1.ShowT();
  378.     T2.ShowT();
  379.     T3.ShowT();
  380.  
  381.     Pr1.Init(450,150,2,30,0,70,30);
  382.     Pr2.Init(450,270,6,25,10,90,30);
  383.     Pr3.Init(450,380,7,35,10,80,30);
  384.     Pr1.ShowPr();
  385.     Pr2.ShowPr();
  386.     Pr3.ShowPr();  
  387.     readln;
  388.     Pk:=2;lr:=1;xl:=1;xt:=2;xpr:=1;xc:=1;
  389.         repeat
  390.                 P1.MoveTo(Pk,Pk);
  391.                 P2.MoveTo(Pk,0);
  392.                 P3.MoveTo(0,Pk);
  393.                 if(P1.GetX>=120)or(P1.GetX()<=80) then Pk:= -Pk;
  394.                
  395.                 L1.TurnL(0.1);
  396.                 T1.TurnT(0.1);
  397.                 Pr1.TurnPr(0.1);
  398.    
  399.                 L2.MoveL(lr);
  400.                 T2.MoveT(lr);
  401.                 Pr2.MovePr(lr);
  402.                 if(L2.GetR()<20)or(L2.GetR()>50) then lr:=-lr;
  403.    
  404.                 L3.MoveToL(xc,0);
  405.                 T3.MoveToT(xl,0);
  406.                 Pr3.MoveToPr(xpr,0);
  407.                 if(L3.GetX()>220)or(L3.GetX()<180) then xc:=-xc;
  408.                 if(T3.GetX()>345)or(T3.GetX()<315) then xl:=-xl;
  409.                 if(Pr3.GetX()>485)or(Pr3.GetX()<425) then xpr:=-xpr;
  410.             delay(100);
  411.         until KeyPressed;
  412.         closegraph;
  413.     end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!