Версия для печати темы

Program aero;
 uses crt,graph;
 const xp0=-2;xp1=0;yp0=-1;yp1=1;
      xs0=40;xs1=600;ys0=440;ys1=40;
Var h,x,y,xx,yy:real;
    dr,md:integer;
    i,j:integer;
    s1,s2,s:string;

 Function Ux(x,y:real):integer;
 begin
  Ux:=round((3*(-sqr(x+1)+y*y))/sqr(sqr(x+1)+y*y));
 end;

 Function Uy(x,y:real):integer;
 begin
  Uy:=round(-6*y*(x+1)/(sqr(sqr(x+1)+y*y)));
 end;

 Function xs(xx:real):integer;
 begin
  xs:=round(xs0+((xs1-xs0)*(xx-xp0))/(xp1-xp0));
 end;

 Function ys(yy:real):integer;
 begin
  ys:=round(ys0+((ys1-ys0)*(yy-yp0))/(yp1-yp0));
 end;

 Function lin1(t,c:real):real;
 begin
  lin1:=-3*sin(t)/c;
 end;

 Procedure arrow(x0,y0:integer;ux,uy:real;color:integer);
     var
     x1,y1,xr,yr,xl,yl:integer;
     v,co,si,b:real;
 Begin
 setcolor(color);
 x1:=round(ux)+x0;
 y1:=-round(uy)+y0;
 v:=sqrt(ux*ux+uy*uy);
 if v>1.e-5 then
 begin
 co:=(x1-x0)/v;
 si:=(y1-y0)/v;
 b:=v*0.35;
 xr:=x1-round(b*(co+0.35*si));
 yr:=y1-round(b*(si-0.35*co));
 xl:=x1-round(b*(co-0.35*si));
 yl:=y1-round(b*(si+0.35*co));
 line(x0,y0,x1,y1);
 line(x1,y1,xr,yr);
 line(x1,y1,xl,yl);
 end;
 end;


 Procedure osi;
    begin
     line(xs0,ys0,xs1,ys0);
     outtextXY(GetMaxX-42,ys0-3,'>');
     outtextXY(GetMaxX-40,ys0+5,'x');
     line(xs0,ys0,xs0,ys1);
     outtextXY(xs0-3,40,'^');
     outtextXY(xs0+6,40,'y');
      x:=-2;
       for i:=1 to 11 do
        begin
         h:=(getmaxx-80)/10;
         line(xs(x),ys0+2,xs(x),ys0-2);
         str(x:4:2,s);
         outtextXY(xs(x)-25,ys0+5,s);
         x:=x+(abs(xp0)/10);
        end;
     y:=-1;
     for j:=1 to 10 do
         begin
          Line(xs0-2,ys(y),xs0+2,ys(y));
            str(y:4:2,s);
            outtextXY(xs0-40,ys(y)-3,s);
          y:=y+(yp1/4);
         end;
    end;

Procedure vektorskorosti;
var dx,dy,xd,yd:real;
begin
 dx:=(xp1-xp0)/50;
 dy:=(yp1-yp0)/50;
 xd:=xp0;
  While xd<xp1 do begin
   yd:=yp0;
    While yd<yp1 do begin
      if (sqr(xd+1)+sqr(yd))>0.02 then begin
       arrow(xs(xd),ys(yd),ux(xd,yd)*0.25,uy(xd,yd)*0.25,2);
      end;
     yd:=yd+dy;
    end;
    xd:=xd+dx;
  end;
end;

Procedure linii;
var c,a,dxo:integer;
    x,y,dx,r,t,dt:real;
begin
 c:=-5;
 a:=5;
 dxo:=1;
 dt:=2*pi/1000;
  While c<=a do begin
  t:=0;
   While t<2*pi do begin
   t:=t+dt;
    if c<>0 then begin
    r:=lin1(t,c);
    x:=r*cos(t)-1;
    y:=r*sin(t);
    if (y<yp1)and(y>yp0)and(x>xp0)and(x<xp1)and((sqr(x+1)+sqr(y))>0.02) then
    putpixel(xs(x),ys(y),3);
    end;
  end;
  c:=c+dxo;
 end;
end;

begin
   dr:=detect;
   md:=0;
   filemode:=0;
   InitGraph(dr,md,'c:\langs\bp\bgi');
   osi;
   vektorskorosti;
   linii;
   readln;
   closegraph;
end.