Новые сообщения · Правила  
  • Страница 1 из 1
  • 1
Форум ПРОГРАММИСТОВ » КУРС ОПР - ПАСКАЛЬ » Лабораторные работы » Лабораторная работа №11 (Простейшая графика)
Лабораторная работа №11
Цель - научиться работать с графическими примитивами. В отчете - код программы, содержимое исходных файлов данных для разных примеров и скрины полученных рисунков.

Даны два файла вещественных чисел. В файле x.dat хранятся координаты точек по оси Ox, в файле y.dat – координаты точек по оси Oy (не менее 10 компонентов). Во всех вариантах выводить на экран координатные оси, все данные точки и соответствующие надписи на осях (варианты 1-12).

1. Определить наибольшее расстояние между точками. Соединить прямой линией все точки и выделить цветом наиболее удаленные друг от друга точки.

2. Определить наименьшее расстояние между точками. Соединить прямой линией все точки и выделить цветом наименее удаленные друг от друга точки.

3. Пусть координаты первых трех точек являются координатами вершин треугольника. Найти площадь этого треугольника. Построить получившийся треугольник, выделить его цветом. Закрасить треугольник.

4. По точкам построить треугольную пирамиду. Одну из граней закрасить.

5. Пусть первые три нечетные координаты являются координатами вершин треугольника. Найти длину одной из высот треугольника. Построить получившийся треугольник, его высоту, выделить цветом его вершины.

6. Пусть первые три четные координаты являются координатами вершин треугольника. Построить получившийся треугольник, его медианы, выделить цветом его вершины и точку пересечения медиан.

7. Дан круг с центром в точке C(x0,y0) и радиусом R, Определить координаты точек с целыми координатами, находящиеся внутри круга, и их количество. Изобразить круг и выделить цветом точки, находящиеся внутри круга.

8. Дана окружность с центром в точке C(x0,y0) и радиусом R, Определить координаты точек с целыми координатами, находящихся на окружности, и их количество. Изобразить окружность и выделить цветом точки, находящиеся на ней.

9. Дана парабола y=ax2+bx+c на отрезке [a,b]. Определить сколько точек c целыми координатами лежит на этой параболе. Изобразить параболу и выделить цветом точки, находящиеся на ней.

10. Пусть координаты первых двух точек являются координатами вершин квадрата. Найти площадь этого квадрата. Построить получившийся квадрат и вписанную в него окружность, выделить цветом.

11. Пусть координаты первых двух точек являются координатами вершин квадрата. Построить окружность, описанную вокруг квадрата и вычислить ее площадь. Выделить цветом квадрат. Заштриховать то что принадлежит окружности и не принадлежит квадрату.

Даны два файла вещественных чисел, в которых хранятся коэффициенты прямых y=akx+bk. В файле a.dat хранятся коэффициенты a, в файле b.dat – коэффициенты b (не менее 10 компонентов). Во всех вариантах выводить на экран координатные оси, все данные точки и соответствующие надписи на осях (варианты 12-17).

12. Определить количество параллельных прямых среди данных. Построить семейство прямых. Все параллельные выделить соответствующим цветом.

13. Определить, есть ли среди данных прямых перпендикулярные. Построить семейство прямых. Все перпендикулярные выделять одним цветом.

14. Определить, сколько среди данных прямых пересекающихся. Построить семейство разноцветных прямых. Точки пересечения выделить жирной точкой.

15. Дана окружность с центром в точке C(x0,y0) и радиусом R, Определить, пересекает ли какая либо из данных прямых эту окружность, если да, то найти точки пересечения. Изобразить окружность и прямые, ее пересекающие, выделить цветом точки пересечения.

16. Дана парабола y=ax2+bx+c. Определить, какая из данных прямых пересекает параболу, и в каких точках. Изобразить параболу и пересекающие ее прямые, выделить цветом точки пересечения.

17. Дано семейство прямых. Проверить, не образуют ли эти прямые пучок (пересекаются все в одной точке). Если образуют - построить этот пучок, раскрашивая каждый луч пучка разным цветом.
1 | Автор: admin | 2014-11-10, 22:13   |  Репутация: [ + 21 ]
3. Пусть координаты первых трех точек являются координатами вершин треугольника. Найти площадь этого треугольника. Построить получившийся треугольник, выделить его цветом. Закрасить треугольник.


Код

uses
   GraphABC;

var
   x1, x2, x3, y1, y2, y3: integer;
   i, x, y: integer;
   m: real;
   Pl: real;
s:string;

begin
    

   setwindowsize(500, 500);
   x := windowwidth div 2;
   y := x;
   line(0, y, 2 * x, y);
   line(x, 0, x, 2 * y);
   m := 25;
   for i := 1 to 10 do
   begin
     line(x + round(i * m), y + 3, x + round(i * m), y - 3);
     line(x - round(i * m), y + 3, x - round(i * m), y - 3);
     str(i * 25, s);
     textout(x + round(i * m), y - 30, s);
     textout(x - round(i * m), y + 15, '-' + s);
     line(x + 3, y - round(i * m), x - 3, y - round(i * m));
     line(x + 3, y + round(i * m), x - 3, y + round(i * m));
     textout(x - 30, y - round(i * m), s);
     textout(x + 20, y + round(i * m), '-' + s);
   end;
   line(500, 250, 460, 245);
   line(500, 250, 460, 255);
    
    
   line(250, 0, 245, 60);
   line(250, 0, 255, 60);
    
   textout(2 * x - 10, y - 15, 'X');
   textout(x + 5, 5, 'Y');
   textout(x + 5, y + 10, '0');
    
   writeln('Введите координаты точки А');
   write('X=');
   read(x1);
   write(x1);
   Write('Y=');
   read(y1);
   writeln(y1);
    
    
    
    
   writeln('Введите координаты точки В');
   write('X=');
   read(x2);
   write(x2);
   Write('Y=');
   read(y2);
   writeln(y2);
    
   writeln('Введите координаты точки С');
    
   write('X=');
   read(x3);
   write(x3);
   Write('Y=');
   read(y3);
   writeln(y3);
    
    
   moveto(x1 + 250, -y1 + 250);
   lineto(x2 + 250, -y2 + 250);
   lineto(x3 + 250, -y3 + 250);
   lineto(x1 + 250, -y1 + 250);
    
    
    
    
    
   textout(x1 + 260, -y1 + 260, 'A');
    
   textout(x2 + 260, -y2 + 260, 'B');
    
   textout(x3 + 260, -y3 + 260, 'C');
    
    
    
   PL := abs((x1 - x3) * (y2 - y3) - (x2 - x3) * (y1 - y3)) / 2;
   writeln('Площадь ▲ABC = ', Pl);
end.




AlenaKit♥
2 | Автор: AlenaKit | 2014-11-26, 19:48 | Изменено: AlenaKit - Ср, 2014-11-26, 21:30   |  Репутация: [ + 12 ]
15.Дана окружность с центром в точке C(x0,y0) и радиусом R, Определить, пересекает ли какая либо из данных прямых эту окружность, если да, то найти точки пересечения. Изобразить окружность и прямые, ее пересекающие, выделить цветом точки пересечения.
1.
Код
uses crt;
var f,f2:text;
     K:array[1..11] of integer;
     L:array[1..11] of integer;
     n,z,i,x,j:integer;
     r,a,b:real;
     a1,b1,c1,d,x1,y1,x2,y2:real;
BEGIN
begin
assign(f,'E:\a.dat');
reset(f);
n:=0;
while not eof(f) do
  begin
   inc(n);
   read(f,K[n]);
  end;
close(f);
writeln('Исходный массив1:');
for i:=1 to n do
write(K[i],' ');
end;
begin
assign(f2,'E:\b.dat');
reset(f2);
z:=0;
while not eof(f2) do
  begin
   inc(z);
   read(f2,L[z]);
   end;
close(f2);
writeln('Исходный массив2:');
for j:=1 to z do
write(L[j],' ');
end;
clrscr;
begin
write('R0=');
readln(r);
while i<=11 do begin
for i:=1 to 11 do
   begin
   readln(K[i]);
for j:=1 to 11 do
begin
readln(L[j]);
a1:=K[i]*K[i]+1;
b1:=2*K[i]*L[j];
c1:=L[j]*L[j]-r*r;
d:=b1*b1-4*a1*c1;
if d<0 then write('Прямая и окружность не пересекаются')
else if d=0 then
  begin
   x1:=-b1/(2*a1);
   y1:=K[i]*x1+L[j];
   write('Прямая касается окружности в точке (',x1:0:2,';',y1:0:2,')')
  end
else
  begin
   x1:=(-b1+sqrt(d))/(2*a1);
   x2:=(-b1-sqrt(d))/(2*a1);
   y1:=K[i]*x1+L[j];
   y2:=K[i]*x2+L[j];
   writeln('Прямая пересекает окружность в точках:');
   write('(',x1:0:2,';',y1:0:2,')  (',x2:0:2,';',y2:0:2,')');
  end;
readln
end;
end;
end;
end;
end.


2.
Код
uses graphABC;
var xn,xk,x,mx,my,dx:real;
     x0,y0,i:integer;
     s:string;
begin
x0:=windowwidth div 2;{центр экрана}
y0:=windowheight div 2;
xn:=-10;xk:=10;{интервал по Х}
mx:=(x0-30)/xk;{масштаб по Х}
my:=y0/10;{по У}
line(0,y0,windowwidth,y0);{оси}
line(x0,0,X0,windowheight);
for i:=1 to 10 do{максимальное количество засечек в одну сторону}
   begin
     line(x0+round(i*mx),y0-3,x0+round(i*mx),Y0+3); {засечки на оси Х}
     line(x0-round(i*mx),y0-3,x0-round(i*mx),Y0+3);
     line(x0+3,y0-round(i*my),x0-3,y0-round(i*my)); {засечки на оси Y}
     line(x0+3,y0+round(i*my),x0-3,y0+round(i*my));
     str(i,s);
     {подпись оси Х}
     textout(x0+round(i*mx),y0+10,s);
     textout(x0-round(i*mx),y0+10,'-'+s);
     {подпись оси Y}
     textout(x0-25,y0-round(i*my),s);
     textout(x0-25,y0+round(i*my),'-'+s);
   end;
{центр}
textout(x0+5,y0+10,'0');
{подписи концов осей}
textout(windowwidth-10,y0-10,'X');
textout(x0+5,10, 'Y');
Circle(320,200,30);
end.



25101996
3 | Автор: OlgaFrolova | 2014-11-26, 21:45   |  Репутация: [ + 0 ]
5. Пусть первые три нечетные координаты являются координатами вершин треугольника. Найти длину одной из высот треугольника. Построить получившийся треугольник, его высоту, выделить цветом его вершины.

Код
Program lab11;
  uses GraphABC;
   
  function storona(var x1,x2,y1,y2:integer):real;
  begin
  storona:=sqrt(sqr(x1-x2)+sqr(y1-y2));
  end;
  var a,b,c:real;
  h:real;
  xa,xb,xc,ya,yb,yc,i,x,y:integer;
  cl:Color;
  begin
  Line(0,250,500,250);
  Line(250,0,250,500);
  x:=10;
  for i:=1 to 49 do
     begin
      Line(x,245,x,255);
      x:=x+10;
     end;
  y:=10;
  for i:=1 to 49 do
     begin
      Line(245,y,255,y);
      y:=y+10;
     end;  
  cl:=clGreen;
  writeln('Масштаб: 10pix=1см, ввод координат - в см ');
  writeln('введите координаты первой точки по x ');
  readln(xa);
  writeln('введите координаты первой точки по y ');
  readln(ya);
  writeln('введите координаты второй точки по x ');
  readln(xb);
  writeln('введите координаты второй точки по y ');
  readln(yb);
  writeln('введите координаты третьей точки по x ');
  readln(xc);
  writeln('введите координаты третьей точки по y ');
  readln(yc);
   
  a:=storona(xa,ya,xb,yb);
  b:=storona(xb,yb,xc,yc);
  c:=storona(xc,yc,xa,ya);
  h:=(a*b)/c;
  writeln('высота треугольника =',h:7:2);  

  line(xa*10+250,ya*10+250,xb*10+250,yb*10+250,cl);   //*10 - так как масштаб =10, не понравится - убери
  line(xb*10+250,yb*10+250,xc*10+250,yc*10+250,cl);   //+250 - так как координаты смещены на 250 пикс
  line(xc*10+250,yc*10+250,xa*10+250,ya*10+250,cl);
  end.




Selena
4 | Автор: Selena | 2014-11-26, 21:49 | Изменено: Selena - Пт, 2014-11-28, 18:45   |  Репутация: [ + 2 ]


Selena
4 | Автор: Selena | 2014-11-26, 21:49 | Изменено: Selena - Пт, 2014-11-28, 18:45   |  Репутация: [ + 2 ]
6. Пусть первые три четные координаты являются координатами вершин треугольника. Построить получившийся треугольник, его медианы, выделить цветом его вершины и точку пересечения медиан. 


Код
uses
GraphABC;
Var z,a,m,i:integer;
  x,y:text;
   xp,yp:real;
   xs1,xs2,xs3,ys1,ys2,ys3:real;
   x1,x2,x3,y1,y2,y3:integer;
s:string;
Begin
Assign(x, 'x.dat');
   Reset(x);
   While not eof(x) do  
begin
read(x,x1,x2,x3);
end;
   
   Assign(y, 'y.dat');
   Reset(y);
   While not eof(y) do  
begin
read(y,y1,y2,y3);
end;
    
   xp:=(X1+X2+X3)/3;
   yp:=(Y1+Y2+Y3)/3;
    
   xs1:=(X1+X2)/2;
   ys1:=(Y1+Y2)/2;
   xs2:=(X2+X3)/2;
   ys2:=(Y2+Y3)/2;
   xs3:=(X3+X1)/2;
   ys3:=(Y3+Y1)/2;
   Close(x);
   Close(y);

setwindowsize(500, 500);
z := windowwidth div 2;
a := z;
line(0, a, 2 * z, a);
line(z, 0, z, 2 * a);
m := 25;
for i := 1 to 10 do
begin
line(z + round(i * m), a + 3, z + round(i * m), a - 3);
line(z - round(i * m), a + 3, z - round(i * m), a - 3);
str(i * 1, s);
textout(z + round(i * m), a - 30, s);
textout(z - round(i * m), a + 15, '-' + s);
line(z + 3, a - round(i * m), z - 3, a - round(i * m));
line(z + 3, a + round(i * m), z - 3, a + round(i * m));
textout(z - 30, a - round(i * m), s);
textout(z + 20, a + round(i * m), '-' + s);
end;
line(500,250,460,245);
line(500,250,460,255);
line(250, 0, 245, 60);
line(250, 0, 255, 60);

   Line(0,250,500,250);
   Line(250,500,250,0);
   Line(250+x1*25,250-y1*25,250+x2*25,250-y2*25);
   Line(250+x2*25,250-y2*25,250+x3*25,250-y3*25);
   Line(250+x3*25,250-y3*25,250+x1*25,250-y1*25);
   Line(250+round(xs1)*25,250-round(ys1)*25,250+x3*25,250-y3*25);
   Line(250+round(xs2)*25,250-round(ys2)*25,250+x1*25,250-y1*25);
   Line(250+round(xs3)*25,250-round(ys3)*25,250+x2*25,250-y2*25);
   circle(250+round(xp)*25,250-round(yp)*25,4);
   circle(250+x1*25,250-y1*25,4);
   circle(250+x2*25,250-y2*25,4);
   circle(250+x3*25,250-y3*25,4);
   FloodFill(250+x1*25,250-y1*25,clGreen);
   FloodFill(250+x2*25,250-y2*25,clGreen);
   FloodFill(250+x3*25,250-y3*25,clGreen);
End.

Медианы неправильно рисует из-за округления координат.


El_Magnifico with <3
5 | Автор: El_MAgnifico | 2014-11-26, 22:20   |  Репутация: [ + 8 ]
14. Определить, сколько среди данных прямых пересекающихся. Построить семейство разноцветных прямых. Точки пересечения выделить жирной точкой. 


Код
uses
    GraphABC;
   
  var
    x1,x2,y1,y2,i,n,x,y: integer;
    r: real;
    s:string;
    a: array [1..100] of integer;
    b: array [1..100] of integer;

  begin
    Randomize;   
    setwindowsize(500, 500);
    x := windowwidth div 2;
    y := x;
    line(0, y, 2 * x, y);
    line(x, 0, x, 2 * y);
    r := 50;
    for i := 1 to 10 do
    begin
      line(x + round(i * r), y + 3, x + round(i * r), y - 3);
      line(x - round(i * r), y + 3, x - round(i * r), y - 3);
      str(i * 50, s);
      textout(x + round(i * r), y - 30, s);
      textout(x - round(i * r), y + 15, '-' + s);
      line(x + 3, y - round(i * r), x - 3, y - round(i * r));
      line(x + 3, y + round(i * r), x - 3, y + round(i * r));
      textout(x - 30, y - round(i * r), s);
      textout(x + 20, y + round(i * r), '-' + s);
    end;
    line(500, 250, 480, 240);
    line(500, 250, 480, 260);
       
       
    line(250, 0, 240, 20);
    line(250, 0, 260, 20);
       
    textout(2 * x - 10, y - 15, 'X');
    textout(x + 5, 5, 'Y');
    textout(x + 5, y + 10, '0');

writeln('Введите кол-во коэфициентов: ');Readln(n);

writeln('Введите массив коэфициентов a: ');
for i:= 1 to n do Read(a[i]);
writeln('Введите массив коэфициентов b: ');
for i:= 1 to n do Read(b[i]);
x1:=0;x2:=2;
   for i:=1 to n do
   begin
     y1:=a[i]*x1+b[i];
     y2:=a[i]*x2+b[i];
     MoveTo (250,250);
     SetPenColor(RGB(random(256),random(256),random(256)));
     line(x1+100,y1+100,x2,y2);
   end;
end.

6 | Автор: Bun_Frith | 2014-11-26, 22:38   |  Репутация: [ + 4 ]

Код
uses graphABC;
type point=record
             x,y:integer;
             end;
var f,g:file of real;
      x,y,x1,y1,x2,y2,x3,y3,x4,y4,xc,yc,r,s,m:real;
      i,x0,y0:integer;
      p:array[1..5] of point;
      st:string;
      a:real;
begin
randomize;
assign(f,'X.dat');
rewrite(f);
assign(g,'Y.dat');
rewrite(g);
for i:=1 to 15 do
   begin
    a:=-10+20*random;
    write(f,a);
    a:=-10+20*random;
    write(g,a);
   end;
close(f);
close(g);
write('Ôàéëû êîîðäèíàò ñîçäàíû');
randomize;
assign(f,'X.dat');
rewrite(f);
assign(g,'Y.dat');
rewrite(g);
for i:=1 to 15 do
   begin
    a:=-10+20*random;
    write(f,a);
    a:=-10+20*random;
    write(g,a);
   end;
close(f);
close(g);
write('Ôàéëû êîîðäèíàò ñîçäàíû');
assign(f,'X.dat');
reset(f);
assign(g,'Y.dat');
reset(g);
i:=0;
while not eof(f) do
   begin
    read(f,x);
    read(g,y);
    inc(i);
    if i=1 then
     begin
      x1:=x;
      y1:=y
     end
    else if i=2 then
     begin
      x2:=x;
      y2:=y
     end;
   end;
xc:=(x1+x2)/2;
yc:=(y1+y2)/2;
r:=sqrt(sqr(xc-x1)+sqr(yc-y1));
s:=pi*r*r;
x3:=(x1+x2)/2-(y2-y1)/2;
y3:=(y1+y2)/2+(x2-x1)/2;
x4:=(x1+x2)/2+(y2-y1)/2;
y4:=(y1+y2)/2-(x2-x1)/2;
setwindowsize(500,500);
x0:=windowwidth div 2;
y0:=x0;
m:=(x0-30)/10;
setpencolor(clRed);
setbrushcolor(clRed);
setbrushstyle(bsCross);
circle(x0+round(xc*m),y0-round(yc*m),round(r*m));
p[1].x:=x0+round(x1*m); p[1].y:=y0-round(y1*m);
p[2].x:=x0+round(x3*m); p[2].y:=y0-round(y3*m);
p[3].x:=x0+round(x2*m); p[3].y:=y0-round(y2*m);
p[4].x:=x0+round(x4*m); p[4].y:=y0-round(y4*m);
p[5]:=p[1];
setpencolor(clYellow);
setbrushcolor(clYellow);
setbrushstyle(bsSolid);
polygon(p,5);
setpencolor(clBlack);
line(0,y0,windowwidth,y0);
line(x0,0,x0,windowheight);
setbrushstyle(bsClear);
for i:=1 to 10 do
   begin
    line(x0-3,y0+round(i*m),x0+3,y0+round(i*m));
    line(x0-3,y0-round(i*m),x0+3,y0-round(i*m));
    textout(x0-20,y0-round(i*m),inttostr(i));
    textout(x0-25,y0+round(i*m),inttostr(-i));
    line(x0+round(i*m),y0-3,x0+round(i*m),y0+3);
    line(x0-round(i*m),y0-3,x0-round(i*m),y0+3);
    textout(x0+round(i*m),y0+10,inttostr(i));
    textout(x0-round(i*m),y0+10,inttostr(-i));
   end;
textout(x0+5,y0+10,'0');
textout(windowwidth-15,y0-20,'X');
textout(x0+5,10, 'Y');
reset(f);
reset(g);
i:=0;
while not eof(f) do
   begin
    read(f,x);
    read(g,y);
    inc(i);
    if i in [1..2] then
     begin
      setpencolor(clBlue);
      setbrushcolor(clBlue);
      setbrushstyle(bsSolid);
      circle(x0+round(x*m),y0-round(y*m),3);
      setbrushstyle(bsClear);
      setfontcolor(clBlue);
      textout(x0+round(x*m)+5,y0-round(y*m)-5,inttostr(i));
     end
    else
     begin
      setpencolor(clBlack);
      setbrushcolor(clBlack);
      setbrushstyle(bsSolid);
      circle(x0+round(x*m),y0-round(y*m),2);
      setbrushstyle(bsClear);
      setfontcolor(clBlack);
      textout(x0+round(x*m)+5,y0-round(y*m)-5,inttostr(i));
     end;
   end;
close(f);
close(g);
str(s:0:2,st);
setfontsize(12);
textout(20,20,'площадь круга ='+st);
end.


11. Пусть координаты первых двух точек являются координатами вершин квадрата. Построить окружность, описанную вокруг квадрата и вычислить ее площадь. Выделить цветом квадрат. Заштриховать то что принадлежит окружности и не принадлежит квадрату.
7 | Автор: Forzorezor | 2014-11-26, 22:40 | Изменено: Forzorezor - Ср, 2014-11-26, 23:10   |  Репутация: [ + 4 ]
Код
program ira_butenko97
uses graphABC;
var driver,mode:integer;
var xc,yc,i:integer;   
f1,f2:text;
a,b:array[1..10]of integer;
m,k,z:integer;
begin
Begin    {записываем в массив координаты точек}
assign(f1,'d:\ox.txt');
reset(f1);
while not eof(f1) do
begin
inc(k);
read(f1,a[k]);
end;
close(f1);
for m:=1 to k do
write(a[m]);
assign(f2,'d:\oy.txt');
reset(f2);
while not eof(f2) do
begin
inc(z);
read(f2,b[z]);
end;
close(f2);
for m:=1 to z do
write(b[m]);
end;
end.

2.
Код
program ira_butenko97;
uses graphABC;
var i:integer;
xn,xk,x,mx,my,dx:real;
       x0,y0:integer;
       s:string;
   begin
   x0:=windowwidth div 2;
   y0:=windowheight div 2;
   xn:=-10;xk:=10;
   mx:=(x0-30)/xk;
   my:=y0/10;
   line(0,y0,windowwidth,y0);
   line(x0,0,X0,windowheight);
   for i:=1 to 10 do
     begin
       line(x0+round(i*mx),y0-3,x0+round(i*mx),Y0+3);   
       line(x0-round(i*mx),y0-3,x0-round(i*mx),Y0+3);
       line(x0+3,y0-round(i*my),x0-3,y0-round(i*my));   
       line(x0+3,y0+round(i*my),x0-3,y0+round(i*my));
       str(i,s);
       {по оси у}
       textout(x0-25,y0-round(i*my),s);
       textout(x0-25,y0+round(i*my),'-'+s);
       {по оси х}
       textout(x0+round(i*mx),y0+10,s);
       textout(x0-round(i*mx),y0+10,'-'+s);
     end;
begin
for i:=1 to 10 do
     begin
      x0:=windowwidth div 2;{центр экрана}
   y0:=windowheight div 2;
       line(x0+round(i*mx),y0-3,x0+round(i*mx),Y0+3); {засечки на оси Х}
       line(x0-round(i*mx),y0-3,x0-round(i*mx),Y0+3);
       line(x0+3,y0-round(i*my),x0-3,y0-round(i*my)); {засечки на оси Y}
       line(x0+3,y0+round(i*my),x0-3,y0+round(i*my));
       str(i,s);
       {подпись оси Х}
       textout(x0+round(i*mx),y0+10,s);
       textout(x0-round(i*mx),y0+10,'-'+s);
       {подпись оси Y}
       textout(x0-25,y0-round(i*my),s);
       textout(x0-25,y0+round(i*my),'-'+s);
     end;
       
line(100,300,200,200);
line(100,300,380,200);
line(200,200,380,200);
line(240,80,380,200);
line(240,80,100,300);
line(240,80,200,200);

{подписываем точки пирамиды}
   textout(100,300,'A');
   textout(380,200,'D');
   textout(240,65,'B');
   textout(199,205,'C');

end;
end.


4. По точкам построить треугольную пирамиду. Одну из граней закрасить.
8 | Автор: ira_butenko97 | 2014-11-26, 23:08 | Изменено: ira_butenko97 - Ср, 2014-11-26, 23:13   |  Репутация: [ + 4 ]
8. Дана окружность с центром в точке C(x0,y0) и радиусом R, Определить координаты точек с целыми координатами, находящихся на окружности, и их количество. Изобразить окружность и выделить цветом точки, находящиеся на ней. 

Код
program Mr_pozitiv;
    //('*****************************************************');
    //('*       laba #11  file: laba11.pas == ver.1.0       *');
    //('*                     exercise                      *');
    //('*   Malevanny V. A.  Group I-14-1 Date: 26/11/14    *');
    //('*****************************************************');
uses crt, graphAbc;
var t,t2 :text;
    x0,y0,xc,yc,x,y,r :integer;
  begin
     writeln('Введите координаты круга (х): ');
     readln(xc);
     writeln('Введите координаты круга (y): ');
     readln(yc);
     writeln('Введите радиус круга: ');
     readln(r);
      ClearWindow(clLightSeaGreen);
      x0:=WindowWidth div 2;
      y0:=WindowHeight div 2;
      xc:=xc+x0;
      yc:=yc+y0;
     line(x0 - 320, y0, x0 + 320, y0); //ось x
     line(x0, y0 - 240, x0, y0 + 240); //ось y
     line(x0 + 320, y0, x0 + 305, y0 + 7); //x
     line(x0 + 320, y0, x0 + 305, y0 - 7); //x
     line(x0, y0 -  240, x0 + 7, y0 - 225); //y
     line(x0, y0 - 240, x0 - 7, y0 - 225); //y
     textOut(x0 + 309, y0 + 9, 'X'); //надпись х
     textOut(x0 + 9, y0 - 236, 'Y'); //надпись у
      assign(t,'x.dat');
      assign(t2,'y.dat');
      reset(t);
      reset(t2);
      circle(xc,yc,r);
      while not eof(t) do //работаем с файлами
        begin
             readln(t,x);
             readln(t2,y);
             x:=x+x0;
             y:=y+y0;
             circle(x,y,3); //рисуем все точки
             floodFill(x,y,clViolet);
              if r>=sqrt(sqr(xc-x)+sqr(yc-y)) then
                begin
                    floodFill(x,y,clblack); //закрашиваем точки что пренадлежат окружности
                 end;
        end;
      close(t);
      close(t2);
  end.


perfect ;)
9 | Автор: Mr_Pozitiv | 2014-11-26, 23:49   |  Репутация: [ + 6 ]
Задание № 2. Определить наименьшее расстояние между точками. Соединить прямой линией все точки и выделить цветом наименее удаленные друг от друга точки. 


Код
uses graphABC;
  var xk,mx,my:real;
      x0,y0,i,z,m:integer;
      s:string;
      G,L:array[1..10] of integer;
            
  begin
  x0:=windowwidth div 2;
  y0:=windowheight div 2;
  xk:=10;
  mx:=(x0-30)/xk;
  my:=y0/10;
  line(0,y0,windowwidth,y0);
  line(x0,0,X0,windowheight);
  for i:=1 to 10 do
    begin
      line(x0+round(i*mx),y0-3,x0+round(i*mx),Y0+3);  
      line(x0-round(i*mx),y0-3,x0-round(i*mx),Y0+3);
      line(x0+3,y0-round(i*my),x0-3,y0-round(i*my));  
      line(x0+3,y0+round(i*my),x0-3,y0+round(i*my));
      str(i,s);
      textout(x0+round(i*mx),y0+10,s);
      textout(x0-round(i*mx),y0+10,'-'+s);
      textout(x0-25,y0-round(i*my),s);
      textout(x0-25,y0+round(i*my),'-'+s);
    end;
  textout(x0+5,y0+10,'0');
  textout(windowwidth-10,y0-10,'X');
  textout(x0+5,10, 'Y');
   
Writeln('Введите матрицу G');
   for z:=1 to 10 do
   read(G[z]);
  Writeln('Введите матрицу L');
   For m:=1 to 10 do
   read(L[m]);
   
   
  For m:=1 to 10 do  
  For z:=1 to 10 do
   Begin
   MoveTo (250,250);
   SetPenColor(RGB(random(256),random(256),random(256)));
   line(320,((-24)*(L[m])+240),(29*(G[z])+320),240);   
   end;
   
  end.


10 | Автор: beznoschenko | 2014-11-27, 21:14   |  Репутация: [ + 2 ]
Код
uses crt,graphABC;
var
x0,y0,i,xn,xk,x,mx,my,dx,n,z,j,xc,yc,r,a1,b1,c1,d,a,b:integer;
s:string;
f,f2:text;
x1,y1,x2,y2:integer;
begin
writeln('Введите координаты круга (х): ');
      readln(xc);
      writeln('Введите координаты круга (y): ');
      readln(yc);
      writeln('Введите радиус круга: ');
      readln(r);
x0:=windowwidth div 2;{центр экрана}
y0:=windowheight div 2;
xc:=xc+x0;
yc:=yc+y0;
xn:=-10;xk:=10;{интервал по Х}
mx:=Round((x0-30)/xk);{масштаб по Х}
my:=Round(y0/10);{по У}
line(0,y0,windowwidth,y0);{оси}
line(x0,0,X0,windowheight);
for i:=1 to 10 do{максимальное количество засечек в одну сторону}
begin
line(x0+round(i*mx),y0-3,x0+round(i*mx),Y0+3); {засечки на оси Х}
line(x0-round(i*mx),y0-3,x0-round(i*mx),Y0+3);
line(x0+3,y0-round(i*my),x0-3,y0-round(i*my)); {засечки на оси Y}
line(x0+3,y0+round(i*my),x0-3,y0+round(i*my));
str(i*10,s);
{подпись оси Х}
textout(x0+round(i*mx),y0+10,s);
textout(x0-round(i*mx),y0+10,'-'+s);
{подпись оси Y}
textout(x0-25,y0-round(i*my),s);
textout(x0-25,y0+round(i*my),'-'+s);
end;
{центр}
textout(x0+5,y0+10,'0');
{подписи концов осей}
textout(windowwidth-10,y0-10,'X');
textout(x0+5,10, 'Y');
assign(f,'E:\a.dat');
       assign(f2,'E:\b.dat');
       reset(f);
       reset(f2);
       circle(xc,yc,r);
       while not eof(f) do //работаем с файлами
         begin
              readln(f,a);
              readln(f2,b);
a1:=a*a+1;
b1:=2*a*b;
c1:=b*b-r*r;
d:=b1*b1-4*a1*c1;
if d<0 then write('Прямая и окружность не пересекаются')
else if d=0 then
  begin
   x1:=round(-b1/(2*a1));
   y1:=a*x1+b;
   write('Прямая касается окружности в точке (',x1,';',y1,')')
  end
else
  begin
   x1:=round((-b1+sqrt(d))/(2*a1));
   x2:=round((-b1-sqrt(d))/(2*a1));
   y1:=a*x1+b;
   y2:=a*x2+b;
   writeln('Прямая пересекает окружность в точках:');
   write('(',x1,';',y1,')  (',x2,';',y2,')');
     line(x1+400,x2+400,y1,y2);
  end;
readln
end;
close(f);
       close(f2);
end.


15. Дана окружность с центром в точке C(x0,y0) и радиусом R, Определить, пересекает ли какая либо из данных прямых эту окружность, если да, то найти точки пересечения. Изобразить окружность и прямые, ее пересекающие, выделить цветом точки пересечения.


25101996
11 | Автор: OlgaFrolova | 2014-11-27, 22:33   |  Репутация: [ + 0 ]
9. Дана парабола y=ax2+bx+c на отрезке [a,b]. Определить сколько точек c
целыми координатами лежит на этой параболе. Изобразить параболу и
выделить цветом точки, находящиеся на ней.

Код
program qwerty159;
uses graphABC;
var
x,y,a,b,c,z: real;
v: integer;
s: string;
begin

line(200,0,200,400);
line(0,200,400,200);

x:=-9;
a:=-1;
b:=-6;
c:=-1;
v:=0;
z:=frac(x);
while x<2 do
begin
if frac(x)=0 then begin
y:=a*sqr(x)+b*x+1;
circle(trunc(x*20+200),trunc(y*20+200),4);
v:=v+1;
end else begin
y:=a*sqr(x)+b*x+1;
circle(trunc(x*20+200),trunc(y*20+200),1);

end;
x:=x+1;
end;
str(v,s);
TextOut(10,420,'Точки с целыми координатами при а=-1, b=-6:');
TextOut(10,440, s);
end.


12 | Автор: @qwerty159 | 2014-11-27, 23:54   |  Репутация: [ + 0 ]
7. Дан круг с центром в точке C(x0,y0) и радиусом R, Определить координаты точек с целыми координатами, находящиеся внутри круга, и их количество. Изобразить круг и выделить цветом точки, находящиеся внутри круга.

Код
uses crt, graphABC;
const nmax=20;
  var my,mx,r,x,y,k,x0,y0,i:integer;
      s:string;
      MasX:array[1..1257]of integer;
      MasY:array[1..1257]of integer;
  begin
  clrscr;
repeat
write('Введите радиус от 1 до ',nmax,' n=');
readln(r);
until r in [1..nmax];
k:=0;
for x:=-r to r do
for y:=-r to r do
if x*x+y*y<=r*r then
begin
  k:=k+1;
MasX[k]:=x;
  MasY[k]:=y;
end;
write('k=',k);
readln;
  x0:=windowwidth div 2;{центр экрана}
  y0:=windowheight div 2;
  textout(windowwidth-10,y0-10,'X');
  textout(x0+5,10, 'Y');
  mx:=20;{масштаб по Х}
  Circle(x0,y0,r*mx);
   my:=20;{по У}
  line(0,y0,windowwidth,y0);{оси}
  line(x0,0,X0,windowheight);
  for i:=1 to 10 do{максимальное количество засечек в одну сторону}
    begin
      line(x0+(i*mx),y0-3,x0+(i*mx),Y0+3); {засечки на оси Х}
      line(x0-(i*mx),y0-3,x0-(i*mx),Y0+3);
      line(x0+3,y0-(i*my),x0-3,y0-(i*my)); {засечки на оси Y}
      line(x0+3,y0+(i*my),x0-3,y0+(i*my));
      str(i,s);
      {подпись оси Х}
      textout(x0+(i*mx),y0+10,s);
      textout(x0-(i*mx),y0+10,'-'+s);
      {подпись оси Y}
      textout(x0-25,y0-(i*my),s);
      textout(x0-25,y0+(i*my),'-'+s);
    end;
    for i:=1 to k do
     begin
      Circle (x0+MasX[i]*mx,y0+MasY[i]*mx,2);
     end;
  textout(x0+5,y0+10,'0');
end.



Ирина Зазноба
13 | Автор: iren456 | 2014-11-28, 22:51 | Изменено: iren456 - Пт, 2014-11-28, 22:56   |  Репутация: [ + 0 ]
Код
uses graphABC;  
  var xk,zx,zy:real;  
      x0,y0,i:integer;  
      s:string;  
begin  
x0:=windowwidth div 2;
y0:=windowheight div 2;  
xk:=10;
zx:=(x0-30)/xk;  
zy:=y0/10;
line(0,y0,windowwidth,y0);  
line(x0,0,X0,windowheight);  
for i:=1 to 10 do
begin  
line(x0+round(i*zx),y0-3,x0+round(i*zx),Y0+3);  
line(x0-round(i*zx),y0-3,x0-round(i*zx),Y0+3);  
line(x0+3,y0-round(i*zy),x0-3,y0-round(i*zy));  
line(x0+3,y0+round(i*zy),x0-3,y0+round(i*zy));  
str(i,s);  
textout(x0+round(i*zx),y0+10,s);  
textout(x0-round(i*zx),y0+10,'-'+s);  
textout(x0-25,y0-round(i*zy),s);  
textout(x0-25,y0+round(i*zy),'-'+s);  
end;  
textout(x0+5,y0+10,'0');  
textout(windowwidth-10,y0-10,'X');  
textout(x0+5,10, 'Y');  
rectangle(290,232,352,170);
setpencolor(clBlue);
setbrushcolor(clBlue);
Circle(320,200,30);
end.

14 | Автор: Awesome | 2014-11-29, 19:46   |  Репутация: [ + 2 ]
Код
uses crt ,graphABC;
var
x0,y0,i,xn,xk,x,mx,my,dx,n,z,j,xc,yc,a1,b1,c1,d,a,b,c,k1,k2,k:integer;
s:string;
f,f2:text;
x1,y1,x2,y2:integer;

v: integer;
y,h: real;
begin

x0:=windowwidth div 2;{центр экрана}
y0:=windowheight div 2;
xc:=xc+x0;
yc:=yc+y0;
xn:=-10;xk:=10;{интервал по Х}
mx:=Round((x0-30)/xk);{масштаб по Х}
my:=Round(y0/10);{по У}
line(0,y0,windowwidth,y0);{оси}
line(x0,0,X0,windowheight);
for i:=1 to 10 do{максимальное количество засечек в одну сторону}
begin
line(x0+round(i*mx),y0-3,x0+round(i*mx),Y0+3); {засечки на оси Х}
line(x0-round(i*mx),y0-3,x0-round(i*mx),Y0+3);
line(x0+3,y0-round(i*my),x0-3,y0-round(i*my)); {засечки на оси Y}
line(x0+3,y0+round(i*my),x0-3,y0+round(i*my));
str(i*10,s);
{подпись оси Х}
textout(x0+round(i*mx),y0+10,s);
textout(x0-round(i*mx),y0+10,'-'+s);
{подпись оси Y}
textout(x0-25,y0-round(i*my),s);
textout(x0-25,y0+round(i*my),'-'+s);
end;
{центр}
textout(x0+5,y0+10,'0');
{подписи концов осей}
textout(windowwidth-10,y0-10,'X');
textout(x0+5,10, 'Y');
assign(f,'C:\a.dat.txt');
assign(f2,'C:\b.dat.txt');
reset(f);
reset(f2);
y:=a*sqr(x)+b*x+1;
circle(trunc(x*20+200),trunc(y*20+200),1);

while not eof(f) do //работаем с файлами
begin
readln(f,k);
readln(f2,d);
d:=(b-k)*(b-k)-4*a*(c-d);
if d<0 then write('Прямая и парабола не пересекаются')
else if d=0 then
begin
x1:=round(-(b-k)/(2*a));
y1:=k*x1+d;
write('Прямая касается параболы в точке (',x1,';',y1,')')
end
else
begin
x1:=round((-(b-k)+sqrt(d))/(2*a));
x2:=round((-(b-k)-sqrt(d))/(2*a));
y1:=a*k1+d;
y2:=a*k2+d;
writeln('Прямая пересекает параболу в точках:');
write('(',x1,';',y1,') (',x2,';',y2,')');
line(x1+400,x2+400,y1,y2);
end;
readln
end;
close(f);
close(f2);
line(0,y0,windowwidth,y0);
line(x0,0,X0,windowheight);
line(200,10,20,100);
x:=-9;
a:=-1;
b:=-6;
c:=-1;
v:=0;
h:=frac(x);
while x<2 do
begin
if frac(x)=0 then begin
y:=a*sqr(x)+b*x+1;
circle(trunc(x*20+200),trunc(y*20+200),4);
v:=v+1;
end else begin
y:=a*sqr(x)+b*x+1;
circle(trunc(x*20+200),trunc(y*20+200),1);

end;
x:=x+1;
end;
str(v,s);
end.

15 | Автор: torres | 2014-11-29, 21:35   |  Репутация: [ + 0 ]
1. Определить наибольшее расстояние между точками. Соединить прямой линией все точки и выделить цветом наиболее удаленные друг от друга точки.


Код
program dimeshion;
uses graphABC;
const nmax=21;
var s:string;
      xk,mx,my,dmax,d:real;
      x0,y0,i,ii,jj,t1,t2:integer;
      x,y:array[1..nmax] of real;
BEGIN
    setwindowsize(500,500);
    x0:=windowwidth div 2;
    y0:=windowheight div 2;
    xk:=10;
    mx:=x0/xk;
    my:=y0/xk;
    line(0,y0,windowwidth,y0);
    line(x0,0,X0,windowheight);
    for i:=1 to 10 do
      begin
        line(x0+round(i*mx),y0-3,x0+round(i*mx),Y0+3);
        line(x0-round(i*mx),y0-3,x0-round(i*mx),Y0+3);
        line(x0+3,y0-round(i*my),x0-3,y0-round(i*my));
        line(x0+3,y0+round(i*my),x0-3,y0+round(i*my));
        str(i,s);
        textout(x0+round(i*mx),y0+10,s);
        textout(x0-round(i*mx),y0+10,'-'+s);
        textout(x0-25,y0-round(i*my),s);
        textout(x0-25,y0+round(i*my),'-'+s);
    end;
    textout(x0+5,y0+10,'0');
    textout(windowwidth-10,y0-10,'X');
    textout(x0+5,10, 'Y');
    for ii:=1 to nmax do
      begin
        moveto(250,250);
        write('X[ii]:=');
        read(X[ii]);
        write('Y[ii]:=');
        read(Y[ii]);
        circle(trunc(X[ii]*25+250),trunc(Y[ii]*(-25)+250),3);
        floodfill(trunc(X[ii]*25+250),trunc(Y[ii]*(-25)+250),clblack);
        textout(trunc(X[ii]*25+255),trunc(Y[ii]*(-25)+245),inttostr(ii));
        writeln(ii:4,X[ii]:8:2,Y[ii]:8:2);
    end;
    dmax:= 0;
    for ii:=1 to nmax do
      for jj:=ii+1 to nmax do
        begin
          d:= sqrt(sqr(X[ii]-X[jj])+sqr(Y[ii]-Y[jj]));
          if (ii=1) and (jj=2) then dmax:=d;
          if d >= dmax then
            begin
              dmax:= d;  t1:=ii; t2:=jj;
              write('+')
            end else write('-');
          setpencolor(RGB(random(256),random(256),random(256)));
          line(trunc(X[ii]*25+250),trunc(Y[ii]*(-25)+250),trunc(X[jj]*(25)+250),trunc(Y[jj]*(-25)+250));
          writeln(ii:4,jj:4,d:8:2);
    end;
     writeln;
     writeln('Наиб.расстояние = ',dmax:4:2,' точки: ',t1:3,' и ',t2);
     readln;
END.


16 | Автор: dimeshion | 2014-11-30, 03:38 | Изменено: dimeshion - Вс, 2014-11-30, 03:39   |  Репутация: [ + 2 ]
Код
program Bonyasik;
uses graphABC;
var a1,b1,a2,b2,s,i:integer;  
begin
  writeln('Введите коефициенты 1-й прямой');
  readln(a1,b1);
  writeln('Введите коефициенты 2-й прямой');
  readln(a2,b2);
  s:=a1*a2+b1*b2;
   
  setwindowsize(600,400);
  setbrushcolor(clBlack);
  line(200,200,600,200);
  line(400,0,400,400);
   for i:=1 to 19 do
    begin
     line(400+(i*10),199,400+(i*10),201);  
     line(400-(i*10),199,400-(i*10),201);
     line(401,200-(i*10),399,200-(i*10));
     line(401,200+(i*10),399,200+(i*10));
    end;
  line(595,197,600,200);
  line(595,203,600,200);
  line(397,5,400,0);
  line(403,5,400,0);
    
  setbrushcolor(clWhite);
  textout(590,210,'x');
  textout(410,1,'y');
  write('Первая прямая y=');write(a1);write('x+');writeln(b1);
  write('Вторая прямая y=');write(a2);write('x+');writeln(b2);
  if s=0 then begin
   writeln('Прямые перпендикулярны.');
   line(500,50,250,250);
   line(400,20,600,275); end
   else begin  
   writeln('Прамые не перпендикулярны.');
   line(480,0,300,300);
   line(400,20,450,350); end;
end.

17 | Автор: Бонясик | 2014-11-30, 15:56   |  Репутация: [ + 0 ]
Форум ПРОГРАММИСТОВ » КУРС ОПР - ПАСКАЛЬ » Лабораторные работы » Лабораторная работа №11 (Простейшая графика)
  • Страница 1 из 1
  • 1
Поиск: