Книга программиста/Задачи на графику в PascalABC.Net
К оглавлению | Назад | Вперёд
Все программы, код которых выложен здесь, являются работоспособными. На момент написания программ использовалась среда PascalABC.Net 3.0.
Построение графиков
правитьГрафик погоды
правитьПример входного файла:
9,3 8,5 8,8 8,0 9,9 11,3 12,2 11,4
Комментарии к коду
- Path - путь к файлу
- DisplacementX - смещение текста по оси X
- DisplacementY - смещение текста по оси Y
uses GraphABC;
const
Path = 'C:\Ilya\AlgoРитмы\Sankt-Peterburg.txt';
DisplacementX = 10;
DisplacementY = -10;
begin
SetWindowIsFixedSize(true);
var H := Window.Height;
var A := ReadAllText(Path).Replace(',', '.').ToReals();
var StepX := Window.Width / (A.Count - 1);
var Min := Abs(A.Min);
var Max := A.Max() + Min;
var B := A.Select((x, i) -> (x, Round(StepX * i), Round(H - (A[i] + Min) / Max * H))).ToList();
for var i := 0 to B.Count - 2 do
begin
var c := Round(255 - (B[i].Item3 + B[i].Item3) * 0.5 / H * 255);
SetPenColor(RGB(0, c, c));
SetBrushColor(RGB(0, c, c));
Polygon(Arr(new Point(B[i].Item2, H), new Point(B[i].Item2, B[i].Item3),
new Point(B[i + 1].Item2, B[i + 1].Item3), new Point(B[i + 1].Item2, H)));
end;
SetFontColor(clBlack);
SetBrushColor(ARGB(200, 255, 255, 255));
for var i := 0 to B.Count - 1 do
TextOut(B[i].Item2 + DisplacementX, B[i].Item3 + DisplacementY, FloatToStr(B[i].Item1));
end.
Круговая диаграмма
правитьКомментарии к коду
- N - количество секторов
- R - радиус диаграммы
- K - коэффициент, на который умножается радиус R, для получения расстояния текста от центра диаграммы
uses GraphABC;
const
N = 5;
R = 150;
K = 0.7;
var
A: array of integer;
Angle: real;
begin
SetWindowIsFixedSize(true);
SetWindowSize(500, 500);
var W := Window.Width div 2;
var H := Window.Height div 2;
SetLength(A, N);
for var i := 0 to N - 1 do
Readln(A[i]);
var Sum := A.Sum();
SetPenWidth(2);
var R2 := R * K;
for var i := 0 to N - 1 do
begin
var ang := Round(A[i] / Sum * 360);
SetBrushColor(clRandom());
Pie(W, H, R, Round(Angle), Round(Angle - ang));
var ang2 := DegToRad(360 - Angle + ang / 2);
SetBrushColor(clWhite);
TextOut(Round(W + R2 * Cos(ang2)), Round(H + R2 * Sin(ang2)), Format('{0} [~{1}%]', A[i], Round(A[i] / Sum * 100)));
Angle -= ang;
end;
end.
Простая графика
правитьПеремещение игрока в консоли
правитьКомментарии к коду
- W - ширина поля
- H - высота поля
- MapChar - заполнитель поля
uses Crt;
const
W = 40;
H = 20;
MapChar = '-';
var
PlayerX, PlayerY: byte;
procedure RedrawMap();
begin
TextColor(White);
GotoXY(PlayerX, PlayerY);
Write(MapChar);
end;
procedure RedrawPlayer();
begin
TextColor(LightGreen);
GotoXY(PlayerX, PlayerY);
Write('X');
end;
begin
HideCursor();
TextColor(White);
for var i := 0 to H - 1 do
begin
for var j := 0 to W - 1 do
Write(MapChar);
Writeln();
end;
PlayerX := W div 2;
PlayerY := H div 2;
RedrawPlayer();
while true do
begin
var key := readkey;
var codekey := Ord(key);
case codekey of
38: begin RedrawMap();if PlayerY > 1 then PlayerY := PlayerY - 1 else PlayerY := H;RedrawPlayer(); end;
40: begin RedrawMap();if PlayerY < H then PlayerY := PlayerY + 1 else PlayerY := 1;RedrawPlayer(); end;
37: begin RedrawMap();if PlayerX > 1 then PlayerX := PlayerX - 1 else PlayerX := W;RedrawPlayer(); end;
39: begin RedrawMap();if PlayerX < W then PlayerX := PlayerX + 1 else PlayerX := 1;RedrawPlayer(); end;
end;
end;
end.
Квадраты
правитьКомментарии к коду
- DisplacementX - смещение левой верхней точки левого верхнего квадрата относительно верхнего левого угла окна по оси X
- DisplacementY - смещение левой верхней точки левого верхнего квадрата относительно верхнего левого угла окна по оси Y
- Size - размер квадрата
- DistX - расстояние между квадратами по оси X
- DistY - расстояние между квадратами по оси Y
- Rows - количество квадратов по оси Y
- Cols - количество квадратов по оси X
uses GraphABC;
const
DisplacementX = 10;
DisplacementY = 10;
Size = 100;
DistX = 10;
DistY = 10;
Rows = 2;
Cols = 5;
begin
for var i := 0 to Rows - 1 do
for var j := 0 to Cols - 1 do
begin
var cx := Size + DistX;
var cy := Size + DistY;
DrawRectangle(DisplacementX + j * cx, DisplacementY + i * cy, DisplacementX + (j + 1) * cx - DistX, DisplacementY + (i + 1) * cy - DistY);
end;
end.
Анимация
правитьУправление движением шарика
правитьКомментарии к коду
- Speed - скорость движения шарика
uses GraphABC;
const
Speed = 0.1;
var
Moving: boolean;
procedure KeyDown(key: integer);
begin
case key of
VK_Space: Moving := not Moving;
end;
end;
begin
var X := 0.0;
SetBrushColor(clRed);
OnKeyDown := KeyDown;
Moving := true;
LockDrawing();
while true do
begin
while Moving do
begin
ClearWindow();
Circle(Round(X), 100, 10);
X += MillisecondsDelta() / 1.0 * Speed;
Redraw();
end;
MillisecondsDelta();
end;
end.
Планеты
правитьКомментарии к коду
- R1 - большой радиус
- R2 - малый радиус
uses GraphABC;
const
R1 = 120;
R2 = 50;
var
Rotation: real;
begin
SetWindowIsFixedSize(true);
SetWindowSize(400, 400);
LockDrawing();
var CX := Window.Width div 2;
var CY := Window.Height div 2;
while true do
begin
for var angle := 0 to 359 do
begin
ClearWindow(clBlack);
SetPenColor(clGray);
SetPenWidth(3);
SetPenStyle(GraphABC.DashStyle.DashDot);
DrawCircle(CX, CY, R1);
var angle2 := DegToRad(angle);
var x := Trunc(CX + R1 * Cos(angle2));
var y := Trunc(CY + R1 * Sin(angle2));
SetPenColor(clRed);
SetPenWidth(2);
SetPenStyle(GraphABC.DashStyle.Solid);
SetBrushColor(clYellow);
FillCircle(x, y, 10);
DrawCircle(x, y, 10);
SetPenColor(clGray);
SetPenWidth(3);
SetPenStyle(GraphABC.DashStyle.DashDot);
DrawCircle(x, y, R2);
angle2 := DegToRad(Rotation);
x := Trunc(x + R2 * Cos(angle2));
y := Trunc(y + R2 * Sin(angle2));
SetPenColor(clLightCyan);
SetPenWidth(2);
SetPenStyle(GraphABC.DashStyle.Solid);
SetBrushColor(clCyan);
FillCircle(x, y, 6);
DrawCircle(x, y, 6);
if Rotation + 5 < 360 then Rotation := Rotation + 5 else Rotation := 0;
Redraw();
Sleep(1);
end;
end;
end.
Перемещение строк матрицы
правитьКомментарии к коду
- N - количество строк матрицы
- M - количество столбцов матрицы
- MoveI - индекс первой перемещаемой строки
- MoveI2 - индекс второй перемещаемой строки
- DisplacementX - смещение левого верхнего угла верхнего левого квадрата относительно левого верхнего угла окна по оси X
- DisplacementY - смещение левого верхнего угла верхнего левого квадрата относительно левого верхнего угла окна по оси Y
- Size - размер квадрата
- DistanceX - расстояние между квадратами по оси X
- DistanceY - расстояние между квадратами по оси Y
- ShiftX - отступ правого нижнего угла окна относительно правого нижнего угла правого нижнего квадрата по оси X
- ShiftY - отступ правого нижнего угла окна относительно правого нижнего угла правого нижнего квадрата по оси Y
uses GraphABC, ABCObjects;
const
N = 5;
M = 10;
MoveI = 0;
MoveI2 = 3;
DisplacementX = 10;
DisplacementY = 10;
Size = 50;
DistanceX = 10;
DistanceY = 10;
ShiftX = 10;
ShiftY = 10;
var
A: array [0..N - 1, 0..M - 1] of SquareABC;
procedure SwapPair(j: integer);
begin
var targetY := A[MoveI2, j].Position.Y;
while A[MoveI, j].Position.Y <> targetY do
begin
A[MoveI, j].Position := new Point(A[MoveI, j].Position.X, A[MoveI, j].Position.Y + 1);
A[MoveI2, j].Position := new Point(A[MoveI2, j].Position.X, A[MoveI2, j].Position.Y - 1);
end;
end;
begin
SetWindowIsFixedSize(true);
SetWindowSize(DisplacementY + (Size + DistanceY) * M + ShiftY - DistanceY,
DisplacementX + (Size + DistanceX) * N + ShiftX - DistanceX);
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
begin
A[i, j] := new SquareABC(DisplacementY + (Size + DistanceY) * j,
DisplacementX + (Size + DistanceX) * i,
Size, (i = MoveI) or (i = MoveI2) ? clGreenYellow : clYellow);
A[i, j].Text := Format('{0} {1}', i, j);
end;
for var j := 0 to M - 1 do
SwapPair(j);
end.
Визуализация сортировок
правитьАнимация сортировки пузырьком
правитьКомментарии к коду
- N - длина массива
- DisplacementX - смещение левого верхнего угла верхнего левого квадрата относительно левого верхнего угла окна по оси X
- DisplacementY - смещение левого верхнего угла верхнего левого квадрата относительно левого верхнего угла окна по оси Y
- Size - размер квадрата
- DistanceX - расстояние между квадратами по оси X
- ShiftX - отступ правого нижнего угла окна относительно правого нижнего угла правого нижнего квадрата по оси X
- ShiftY - отступ правого нижнего угла окна относительно правого нижнего угла правого нижнего квадрата по оси Y
- NormalColor - цвет неактивного квадрата
- SelectedColor - цвет перемещаемого квадрата
uses GraphABC, ABCObjects;
const
N = 10;
DisplacementX = 10;
DisplacementY = 10;
Size = 30;
DistanceX = 10;
ShiftX = 10;
ShiftY = 10;
NormalColor = clYellow;
SelectedColor = ARGB(100, clOrange.R, clOrange.G, clOrange.B);
var
A: array [0..N - 1] of SquareABC;
procedure SwapPair(i, j: integer);
begin
A[i].Color := SelectedColor;
A[j].Color := SelectedColor;
var targetX := A[j].Position.X;
while A[i].Position.X <> targetX do
begin
A[i].Position := new Point(A[i].Position.X + 1, DisplacementY);
A[j].Position := new Point(A[j].Position.X - 1, DisplacementY);
Sleep(15);
end;
A[i].Color := NormalColor;
A[j].Color := NormalColor;
Swap(A[i], A[j]);
end;
begin
SetWindowIsFixedSize(true);
SetWindowSize(DisplacementX + (Size + DistanceX) * N + ShiftX - DistanceX, DisplacementY + Size + ShiftY);
CenterWindow();
for var i := 0 to N - 1 do
begin
A[i] := new SquareABC(DisplacementX + (Size + DistanceX) * i, DisplacementY, Size, NormalColor);
A[i].Number := Random(30);
end;
for var i := N - 1 downto 0 do
for var j := 0 to i - 1 do
if A[j].Number > A[j + 1].Number then
SwapPair(j, j + 1);
end.
Анимация сортировки выбором
правитьuses GraphABC, ABCObjects;
const
N = 8;
DisplacementX = 10;
DisplacementY = 10;
Size = 50;
DistanceX = 10;
ShiftX = 10;
ShiftY = 10;
NormalColor = clYellow;
SelectedColor = ARGB(100, clOrange.R, clOrange.G, clOrange.B);
var
A: array [0..N - 1] of SquareABC;
procedure SwapPair(i, j: integer);
begin
A[i].Color := SelectedColor;
A[j].Color := SelectedColor;
var targetX := A[j].Position.X;
while A[i].Position.X <> targetX do
begin
A[i].Position := new Point(A[i].Position.X + 1, DisplacementY);
A[j].Position := new Point(A[j].Position.X - 1, DisplacementY);
Sleep(15);
end;
A[i].Color := NormalColor;
A[j].Color := NormalColor;
Swap(A[i], A[j]);
end;
begin
SetWindowIsFixedSize(true);
SetWindowSize(DisplacementX + (Size + DistanceX) * N + ShiftX - DistanceX, DisplacementY + Size + ShiftY);
for var i := 0 to N - 1 do
begin
A[i] := new SquareABC(DisplacementX + (Size + DistanceX) * i, DisplacementY, Size, NormalColor);
A[i].Number := Random(30);
end;
for var i := 0 to N - 1 do
for var j := i + 1 to N - 1 do
if A[i].Number > A[j].Number then
SwapPair(i, j);
end.
Веселые точки
правитьКомментарии к коду
- DisplacementX - смещение левого верхнего угла верхнего левого круга относительно левого верхнего угла окна по оси X
- DisplacementY - смещение левого верхнего угла верхнего левого круга относительно левого верхнего угла окна по оси Y
- CountX - количество кругов по оси X
- CountY - количество кругов по оси Y
- MinR - минимальный радиус
- MaxR - максимальный радиус
- MaxW - максимальная толщина кисти
- MinW - минимальная толщина кисти
- C1 - первый цвет кругов
- C2 - второй цвет кругов
- C3 - третий цвет кругов
uses GraphABC;
const
DisplacementX = 50;
DisplacementY = 50;
Distance = 60;
CountX = 9;
CountY = 7;
MinR = 10;
MaxR = 40;
MaxW = 15;
MinW = 1;
C1 = clRed;
C2 = clCyan;
C3 = clOrange;
var
D: integer := Distance div 2;
Colors1: array [0..2] of Color := (C3, C1, C2);
Colors2: array [0..2] of Color := (C2, C3, C1);
Percent: real;
R: integer;
K: integer;
MinR2:integer:=MinR - MaxW;
function Interpolation(a, b, p: real) := a + (b - a) * p;
procedure Draw();
var
c: Color;
begin
for var i := 0 to CountY - 1 do
for var j := 0 to CountX - 1 do
begin
var x := DisplacementX + j * Distance;
var y := DisplacementY + i * Distance;
if i mod 2 = 0 then
c := Colors1[j mod 3]
else
begin
c := Colors2[j mod 3];
Inc(x, D);
end;
SetBrushColor(c);
SetPenColor(c);
if c = Colors1[K mod 3] then
DrawCircle(x, y, R);
FillCircle(x, y, MinR);
end;
end;
begin
SetWindowIsFixedSize(true);
LockDrawing();
while true do
begin
SetPenWidth(Round(Interpolation(MaxW, MinW, Percent)));
R := Round(Interpolation(MinR2, MaxR, Percent));
ClearWindow(clBlack);
Draw();
Redraw();
Percent += 0.03;
if Percent > 1.0 then
begin
Percent := 0;
Inc(K);
end;
Sleep(5);
end;
end.
Действия с объектами
правитьПеремещение объекта мышкой
правитьuses ABCObjects, GraphABC;
const
Size = 100;
var
A: RoundSquareABC;
Dx, Dy: integer;
Move: boolean;
procedure MouseUp(x, y, mb: integer);
begin
if mb = 1 then Move := false;
end;
procedure MouseMove(x, y, mb: integer);
begin
if mb = 1 then
begin
if not Move then
begin
if A.PtInside(x, y) then Move := true;
Dx := A.Position.X - x;
Dy := A.Position.Y - y;
end
else
A.Position := new Point(x + Dx, y + Dy);
end;
end;
begin
var Size2 := Size div 2;
A := new RoundSquareABC(Window.Width div 2 - Size2, Window.Height div 2 - Size2, Size, 10, clYellow);
Move := false;
OnMouseMove := MouseMove;
OnMouseUp := MouseUp;
end.
Изменение размера объекта
правитьКомментарии к коду
- Width - изначальная ширина прямоугольника
- Height - изначальная высота прямоугольника
uses ABCObjects, GraphABC;
const
Width = 200;
Height = 100;
var
A: RoundRectABC;
Dx, Dy: integer;
Move: boolean;
Resize: boolean;
procedure MouseUp(x, y, mb: integer);
begin
if mb = 1 then Move := false;
if mb = 2 then Resize := false;
end;
procedure MouseMove(x, y, mb: integer);
begin
if mb = 1 then
begin
if not Move then
begin
if A.PtInside(x, y) then Move := true;
Dx := A.Position.X - x;
Dy := A.Position.Y - y;
end
else
A.Position := new Point(x + Dx, y + Dy);
end
else if mb = 2 then
begin
if not Resize then
begin
if A.PtInside(x, y) then Resize := true;
Dx := A.Position.X + A.Width - x;
Dy := A.Position.Y + A.Height - y;
end
else
if (x > A.Position.X) and (y > A.Position.Y) then
begin
A.Width := x + Dx - A.Position.X;
A.Height := y + Dy - A.Position.Y;
end;
end;
end;
begin
A := new RoundRectABC(Window.Width div 2 - Width div 2, Window.Height div 2 - Height div 2, Width, Height, 10, clYellow);
Move := false;
OnMouseMove := MouseMove;
OnMouseUp := MouseUp;
end.
Простой Paint
правитьuses ABCObjects, GraphABC;
var
DrawBorder: RectangleABC;
DrawRectangles: boolean;
Drawn: boolean;
X1, Y1, X2, Y2: integer;
Move: boolean;
Obj: ObjectABC;
Dx, Dy: integer;
procedure MouseUp(x, y, mb: integer);
begin
if mb = 1 then
begin
if DrawRectangles then
new RectangleABC(X1, Y1, Abs(X2 - X1), Abs(Y2 - Y1), clRandom())
else
new EllipseABC(X1, Y1, Abs(X2 - X1), Abs(Y2 - Y1), clRandom());
Drawn := false;
end;
if mb = 2 then Move := false;
end;
procedure MouseMove(x, y, mb: integer);
begin
if mb = 1 then
begin
DrawBorder.Visible := true;
if not Drawn then
begin
X1 := x;
Y1 := y;
Drawn := true;
DrawBorder.Position := new Point(X1, Y1);
DrawBorder.ToFront();
RedrawObjects();
end
else
begin
X2 := x;
Y2 := y;
DrawBorder.Width := Abs(X2 - X1);
DrawBorder.Height := Abs(Y2 - Y1);
end;
end
else if mb = 2 then
begin
DrawBorder.Visible := false;
if not Move then
begin
for var i := 0 to Objects.Count - 1 do
if (Objects[i] <> DrawBorder) and Objects[i].PtInside(x, y) then
begin
if Objects[i] is RectangleABC then
Obj := Objects[i] as RectangleABC
else
Obj := Objects[i] as EllipseABC;
Dx := Obj.Position.X - x;
Dy := Obj.Position.Y - y;
Move := true;
break;
end;
end
else
begin
Obj.Position := new Point(x + Dx, y + Dy);
Obj.ToFront();
end;
end;
end;
procedure KeyDown(key: integer);
begin
case key of
VK_A: DrawRectangles := not DrawRectangles;
end;
if DrawRectangles then SetWindowCaption('Rectangles') else SetWindowCaption('Ellipses');
end;
begin
DrawBorder := new RectangleABC(1, 1, 1, 1, ARGB(100, 0, 0, 0));
Drawn := false;
DrawRectangles := true;
Move := false;
KeyDown(0);
OnMouseUp := MouseUp;
OnMouseMove := MouseMove;
OnKeyDown := KeyDown;
end.
Графики
правитьОкружность
правитьКомментарии к коду
- MaxV - 2Pi
- K - коэффициент масштабирования (радиус)
- Speed - скорость изменения угла
uses GraphABC;
const
MaxV = 2 * Pi;
K = 40;
Speed = 0.01;
var
A: real := Speed;
begin
SetCoordinateOrigin(Window.Width div 2, Window.Height div 2);
while A <= MaxV do
begin
var pA := A - Speed;
Line(Round(Cos(pA) * K), Round(Sin(pA) * K),
Round(Cos(A) * K), Round(Sin(A) * K));
A += Speed;
end;
end.
Спираль
правитьuses GraphABC;
const
MaxV = 5 * Pi;
K = 10;
Speed = 0.01;
var
A: real := Speed;
begin
SetCoordinateOrigin(Window.Width div 2, Window.Height div 2);
while A <= MaxV do
begin
var pA := A - Speed;
Line(Round(pA * Sin(pA) * K), Round(pA * Cos(pA) * K),
Round(A * Sin(A) * K), Round(A * Cos(A) * K));
A += Speed;
end;
end.
Дельтоида
правитьuses GraphABC;
const
MaxV = 2 * Pi;
K = 40;
Speed = 0.01;
var
A: real;
procedure Draw(angle: real);
begin
A := Speed;
while A <= MaxV do
begin
var pA := A - Speed - angle;
var pA2 := (pA + angle) * 2 - angle;
var A1 := A - angle;
var A2 := A * 2 - angle;
Line(Round((2 * Cos(pA) + Cos(pA2)) * K), Round((2 * Sin(pA) - Sin(pA2)) * K),
Round((2 * Cos(A1) + Cos(A2)) * K), Round((2 * Sin(A1) - Sin(A2)) * K));
A += Speed;
end;
end;
begin
SetCoordinateOrigin(Window.Width div 2, Window.Height div 2);
LockDrawing();
while true do
for var i := 0 to 359 do
begin
ClearWindow();
Draw(DegToRad(i));
Redraw();
end;
end.