pascal - работа с графикой

Полезный материал: Рисование цветных прямоугольников.

Рисование графика функции:

program grafik_func_01;

uses GraphABC;
var
  i, c, n,
  x, y, x0, y0: integer;
  a: real;

begin
  x0 := 400;
  y0 := 300;
  a := 0.1;
  c := -150;
  
  Line(x0,0,x0,600);
  Line(0,y0,800,y0);
  
  Pen.Color := clBlue;
  for x := -400 to 400 do  begin 
    y := Round(a * x * x + c);
    Line( x0 + x, y0 - y, x0 + x, y0 - y -1);
    y := Round(a * x + c);
    Line( x0 + x, y0 - y, x0 + x, y0 - y -1);    
  end;
  
end.

program touch_circles_01;

uses GraphABC;
var
  x, y, x0, y0, r1, r2, r3, r4, katet: integer;

begin
  x0 := 100;
  y0 := 400;
  
  Line(x0,0,x0,600);
  Line(0,y0,800,y0);

// нарисовать 3 окружности касающиеся в одной точке
  
  r1 := 100;
  r2 := 70;
  r3 := 50;
  r4 := 40;
  
  DrawCircle( x0 + 100,           y0 - 100,             r1);
  
  DrawCircle( x0 + 100 + r1 + r2, y0 - 100,             r2);
  DrawCircle( x0 + 100,           y0 - 100 - (r1 + r3), r3);
  katet := Round( sqrt(sqr(r1+r4) / 2));
  DrawCircle( x0 + 100 + katet,   y0 - 100 - katet,     r4);

end.

Рисуем координатную плоскость и график синуса:

program Draw_Sinus;

uses graphABC;

function f(x: real): real;
begin
  f := 10 * sin(x / 10);
end;

var
  xn, xk, x, mx, dx, my: real;
  ox, oy, i: integer;
  s: string;

begin
  ox := 300;
  oy := 200;
  xn := -100; xk := 100;{интервал по Х}
  mx := (windowwidth - ox - 30) / xk;{масштаб по Х}
  my := (oy - 40) / 10;{по У}
  line(0, oy, windowwidth, oy);{оси}
  line(ox, 0, ox, windowheight);
  for i := 1 to 10 do{максимальное количество засечек в одну сторону}
  begin
    line(ox + round(i * mx * 10), oy - 3, ox + round(i * mx * 10), oy + 3); {засечки на оси Х}
    line(ox - round(i * mx * 10), oy - 3, ox - round(i * mx * 10), oy + 3);
    str(i * 10, s);
    {подпись оси Х}
    textout(ox + round(i * mx * 10), oy + 10, s);
    textout(ox - round(i * mx * 10), oy + 10, '-' + s);
    line(ox + 3, oy - round(i * my), ox - 3, oy - round(i * my)); {засечки на оси Y}
    line(ox + 3, oy + round(i * my), ox - 3, oy + round(i * my));
    str(i, s);
    {подпись оси Y}
    textout(ox - 15, oy - round(i * my), s);
    textout(ox - 20, oy + round(i * my), '-' + s);
  end;
  textout(ox + 5, oy + 10, '0');
  textout(windowwidth - 15, oy - 20, 'X');
  textout(ox + 10, 10, 'Y');
  x := xn;
  dx := 0.001;
  while x <= xk do
  begin
    x := x + dx; {наращиваем х}
    setpixel(ox + round(x * mx), oy - round(f(x) * my), clRed);
  end;
end.

Рисуем координатную плоскость и график функции:

program Draw_Function;

uses
  graphABC; //Подключаем графический модуль

const
  W = 800; H = 500;//Размеры графического окна

function F(x: real): real;
begin
  F := (x + 1) * (x - 2) * (x - 3); //Функция
end;

var
  x0, y0, x, y, xLeft, yLeft, xRight, yRight, n: integer;
  a, b, fmin, fmax, x1, y1, mx, my, dx, dy, num: real;
  i: byte;
  s: string;

begin
  SetWindowSize(W, H); //Устанавливаем размеры графического окна
  //Координаты левой верхней границы системы координат:
  xLeft := 50;
  yLeft := 50;
  //Координаты правой нижней границы системы координат:
  xRight := W - 50;
  yRight := H - 50;
  //интервал по Х; a и b должно нацело делится на dx:
  a := -2; b := 6; dx := 0.5;
  //Интервал по Y; fmin и fmax должно нацело делится на dy:
  fmin := -10; fmax := 20; dy := 2;
  //Устанавливаем масштаб:
  mx := (xRight - xLeft) / (b - a); //масштаб по Х
  my := (yRight - yLeft) / (fmax - fmin); //масштаб по Y
  //начало координат:
  x0 := trunc(abs(a) * mx) + xLeft;
  y0 := yRight - trunc(abs(fmin) * my);
  //Рисуем оси координат:
  line(xLeft, y0, xRight + 10, y0); //ось ОХ
  line(x0, yLeft - 10, x0, yRight); //ось ОY
  SetFontSize(12); //Размер шрифта
  SetFontColor(clBlue); //Цвет шрифта
  TextOut(xRight + 20, y0 - 15, 'X'); //Подписываем ось OX
  TextOut(x0 - 10, yLeft - 30, 'Y'); //Подписываем ось OY
  SetFontSize(8); //Размер шрифта
  SetFontColor(clRed); //Цвет шрифта
  { Засечки по оси OX: }
  n := round((b - a) / dx) + 1; //количество засечек по ОХ
  for i := 1 to n do
  begin
    num := a + (i - 1) * dx; //Координата на оси ОХ
    x := xLeft + trunc(mx * (num - a)); //Координата num в окне
    Line(x, y0 - 3, x, y0 + 3); //рисуем засечки на оси OX
    str(Num:0:1, s);
    if abs(num) > 1E-15 then //Исключаем 0 на оси OX
      TextOut(x - TextWidth(s) div 2, y0 + 10, s)
  end;
  { Засечки на оси OY: }
  n := round((fmax - fmin) / dy) + 1; //количество засечек по ОY
  for i := 1 to n do
  begin
    num := fMin + (i - 1) * dy; //Координата на оси ОY
    y := yRight - trunc(my * (num - fmin));
    Line(x0 - 3, y, x0 + 3, y); //рисуем засечки на оси Oy
    str(num:0:0, s);
    if abs(num) > 1E-15 then //Исключаем 0 на оси OY
      TextOut(x0 + 7, y - TextHeight(s) div 2, s)
  end;
  TextOut(x0 - 10, y0 + 10, '0'); //Нулевая точка
  { График функции строим по точкам: }
  x1 := a; //Начальное значение аргумента
  while x1 <= b do
  begin
    y1 := F(x1); //Вычисляем значение функции
    x := x0 + round(x1 * mx); //Координата Х в графическом окне
    y := y0 - round(y1 * my); //Координата Y в графическом окне
    //Если y попадает в границы [yLeft; yRight], то ставим точку:
    if (y >= yLeft) and (y <= yRight) then SetPixel(x, y, clGreen);
    x1 := x1 + 0.001 //Увеличиваем абсциссу
  end
end.

program graphika_01;

uses GraphABC;

const
  masColor: array[1..6] of Color = (clBlack,clBlue,clRed,clYellow,clGreen,clViolet);

var
  i, c, n: integer;


begin
  readln( n);
  
  for c := 1 to 6 do  begin  
    Pen.Color := masColor[c];
    for i := 0 to n do
       Line(50+(i*7),50+(i*7),200,50);
    readln;   
  end;   

end.

program graphika_02;

uses GraphABC;

const
  masColor: array[1..6] of Color = (clBlack,clBlue,clRed,clYellow,clGreen,clViolet);

var
  c, n: integer;

procedure DrawColorLines(var cc, nn: integer);
var
  i: integer;
begin
    Pen.Color := masColor[cc];
    for i := 0 to nn do
       Line(50+(i*7),50+(i*7),200+(i*3),50+(i*3));
    circle( 300, 150, 100);
    circle( 250, 130, 10);
    circle( 350, 130, 10);
    Line( 250, 200, 350, 200)
end;
       
begin
  readln( n);
  
  for c := 1 to 6 do  begin  
    DrawColorLines(c, n);
    readln;   
  end;   

end.

Рисование квадратов двумя способами.

program Graphics_03_square;

uses GraphABC;

var
  a, b, R: integer;

procedure DrawSquare(x, y, dx, dy: integer; mycolor: Color);
begin
    Pen.Color := mycolor;
    Line( x, y, x, y + dy);
    Line( x, y + dy, x + dx, y + dy);
    Line( x + dx, y + dy, x + dx, y);
    Line( x + dx, y, x, y);
end;

procedure DrawSquareMove(x, y, dx, dy: integer; mycolor: Color);
begin
    Pen.Color := mycolor;
    MoveTo( x, y);
    LineTo( x, y + dy);
    LineTo( x + dx, y + dy);
    LineTo( x + dx, y);
    LineTo( x, y);
end;
       
begin
  readln( a, b, R);
  
  DrawSquare( a, b, R, R, clBlue);

  DrawSquareMove( a + 50, b + 50, R, R, clRed);

end.

Рисование квадрата с указанием вершин.

program Graphics_04_square;

uses GraphABC;

var
  a, b, R: integer;

procedure DrawSquare(x, y, dx, dy: integer; mycolor: Color);
begin
    Pen.Color := mycolor;
    Line( x, y, x, y + dy);
    Line( x, y + dy, x + dx, y + dy);
    Line( x + dx, y + dy, x + dx, y);
    Line( x + dx, y, x, y);
end;

procedure DrawSquareMove(x, y, dx, dy: integer; mycolor: Color);
begin
    Pen.Color := mycolor;
    MoveTo( x, y);
    LineTo( x, y + dy);
    LineTo( x + dx, y + dy);
    LineTo( x + dx, y);
    LineTo( x, y);
end;

procedure DrawSquareMoveText(x, y, dx, dy: integer; mycolor: Color);
begin
    Pen.Color := mycolor;
    MoveTo( x, y);
    TextOut( x - 12, y - 12, 'A');
    LineTo( x, y + dy);
    TextOut( x - 12, y + dy + 2, 'B');
    LineTo( x + dx, y + dy);
    TextOut( x + dx + 2, y + dy + 2, 'C');
    LineTo( x + dx, y);
    TextOut( x + dx + 2, y - 12, 'D');
    LineTo( x, y);
end;
       
begin
  readln( a, b, R);
  
  DrawSquare( a, b, R, R, clBlue);

  DrawSquareMove( a + 50, b + 50, R, R, clRed);

  DrawSquareMoveText( a + 150, b + 150, R, R, clViolet);
end.

Вывод вот такого прямоугольника:

program graphika_01_elagin;

uses
  GraphABC;

var
  x, y, z, c: integer;


begin
  x := 100;
  Y := 100;
  c := 255;
  z := 0;
  repeat
    Line(100, 500, x, y);
    x := x + 1;
    y := y + 1;
    PEN.Color := RGB(c, 0, z);
    z := z + 2;
    c := c - 2;
  until x = 500;
  x := 100;
  Y := 100;
  c := 255;
  z := 0;
  repeat
    Line(x, y, 500, 100);
    x := x + 1;
    y := y + 1;
    PEN.Color := RGB(c, 0, z);
    z := z + 2;
    c := c - 2;
  until x = 500;
  
end.

Вывод вот такого прямоугольника:

program graphika_02_elagin;

uses
  GraphABC;

var
  x, y, z: integer;


begin
  x := 100;
  Y := 100;
  
  repeat
    Line(100, 500, x, y);
    x := x + 1;
    y := y + 1;
    PEN.Color := RGB(0, z, 0);
    z := z + 1;
  until x = 500;
  x := 100;
  Y := 100;
  
  repeat
    Line(x, y, 500, 100);
    x := x + 1;
    y := y + 1;
    PEN.Color := RGB(0, z, 0);
    z := z + 1;
    
  until x = 500;
  
end.
Вложения:
Скачать этот файл (Draw_Function.pas)Draw_Function.pas[ ]3 Кб
Скачать этот файл (Draw_Sinus.pas)Draw_Sinus.pas[ ]1 Кб

Главное меню

Ссылки

Рейтинг

Проблемы с госуслугами, медленный интернет или плохая связь? Напишите об этом — Минцифры поможет с решением