Полезный материал: Рисование цветных прямоугольников.
Рисование графика функции:
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 | [ ] | 3 Кб |
| Draw_Sinus.pas | [ ] | 1 Кб |