Книга программиста/Алгоритмы компьютерной графики
(перенаправлено с «Алгоритмы компьютерной графики»)
К оглавлению | Назад | Вперёд
Все программы, код которых выложен здесь, являются работоспособными. На момент написания программ использовались среды PascalABC.Net 3.0 (и 3.3), FreePascal 1.0.12 и SharpDevelop 5.1.
Графика в GraphABC
[править]PascalABC.Net
[править]Алгоритм DDA
[править]Комментарии к коду
- R - длина отрезка
uses GraphABC;
const
R = 350;
procedure DrawLine(x, y, x1, y1: integer);
begin
var x2 := x * 1.0;
var y2 := y * 1.0;
var l := Max(Abs(x1 - x), Abs(y1 - y));
var incX := (x1 - x) / l;
var incY := (y1 - y) / l;
while not ((y = y1) and (x = x1)) do
begin
PutPixel(Trunc(x), Trunc(y), clBlack);
x2 := x2 + incX;
y2 := y2 + incY;
end;
end;
begin
SetWindowSize(800, 800);
LockDrawing();
var CXY := Window.Width div 2;
while true do
for var i := 0 to 360 do
begin
ClearWindow();
Line(CXY, CXY, Trunc(CXY + R * Cos(DegToRad(i))), Trunc(CXY + R * Sin(DegToRad(i))));
Redraw();
end;
end.
Алгоритм Брезенхема рисования линии
[править]uses GraphABC;
const
R = 200;
procedure DrawLine(x, y, x1, y1: integer);
var
incX, incY: integer;
errorX, errorY: integer;
currentX, currentY: integer;
begin
var dx := x1 - x;
var dy := y1 - y;
if dx > 0 then incX := 1
else if dx = 0 then incX := 0 else incX := -1;
if dy > 0 then incY := 1
else if dy = 0 then incY := 0 else incY := -1;
dx := Abs(dx);
dy := Abs(dy);
var l := Max(dx, dy);
errorX := 0;
errorY := 0;
currentX := x;
currentY := y;
while (currentX <> x1) or (currentY <> y1) do
begin
errorX += dx;
errorY += dy;
PutPixel(currentX, currentY, clBlack);
if errorX > l then
begin
errorX -= l;
Inc(currentX, incX);
end;
if errorY > l then
begin
errorY -= l;
Inc(currentY, incY);
end;
end;
end;
begin
var CX := Window.Width div 2;
var CY := Window.Height div 2;
LockDrawing();
while true do
for var i := 0 to 360 do
begin
ClearWindow();
var i2 := DegToRad(i);
DrawLine(CX, CY, Round(CX + R * Cos(i2)), Round(CY + R * Sin(i2)));
Redraw();
end;
end.
Алгоритм Брезенхема рисования окружности
[править]Комментарии к коду
- R - радиус окружности
uses GraphABC;
procedure DrawCircle(cx, cy, r: integer);
var
x, y: integer;
rd, rrd, rr: integer;
procedure DrawPoints(x, y: integer);
begin
PutPixel(cx + x, cy + y, clBlack);
PutPixel(cx + x, cy - y, clBlack);
PutPixel(cx - x, cy + y, clBlack);
PutPixel(cx - x, cy - y, clBlack);
end;
begin
x := 0;
y := r;
while ((y >= 0) or (x < r)) do
begin
Sleep(15);
DrawPoints(x, y);
rd := Abs(Sqr(r) - Sqr(x) - Sqr(y - 1));
rr := Abs(Sqr(r) - Sqr(x + 1) - Sqr(y));
rrd := Abs(Sqr(r) - Sqr(x + 1) - Sqr(y - 1));
if rd < rr then
begin
Dec(y);
if rrd < rd then Inc(x);
end
else
begin
Inc(x);
if rrd < rr then Dec(y);
end;
end;
end;
begin
DrawCircle(100, 100, 50);
end.
Рисование в реальном времени
[править]Комментарии к коду
- Speed - смещение окружности за секунду по оси X
uses GraphABC;
const
Speed = 10;
begin
var X := 0.0;
SetBrushColor(clRed);
Milliseconds();
LockDrawing();
while true do
begin
ClearWindow();
Circle(Round(X), 100, 10);
X += MillisecondsDelta() / 1000 * Speed;
Redraw();
end;
end.
Капли на воде
[править]Комментарии к коду
- R1 - радиус капли при первом появлении
- R2 - радиус капли перед удалением
- Speed - скорость роста радиуса
- First - цвет капли при появлении
- Second - цвет капли перед удалением
uses GraphABC;
const
R1 = 0;
R2 = 200;
Speed = 1;
First = clBlack;
Second = ARGB(0, 0, 0, 0);
function ByteInterpolation(a, b, p: byte) := Round(a + (b - a) * p / 100);
function InterpolateColor(c1, c2: Color; p: byte) := ARGB(ByteInterpolation(c1.A, c2.A, p), ByteInterpolation(c1.R, c2.R, p), ByteInterpolation(c1.G, c2.G, p), ByteInterpolation(c1.B, c2.B, p));
type
Drop = auto class
X, Y: integer;
P: byte;
constructor(px, py: integer);
begin
X := px;Y := py;
end;
procedure Draw();
begin
SetPenColor(InterpolateColor(First, Second, P));
DrawCircle(X, Y, ByteInterpolation(R1, R2, P));
if P <= 100 then
Inc(P, Speed);
end;
end;
var
S: List<Drop>;
procedure MouseDown(x, y, mb: integer) := S.Add(new Drop(x, y));
begin
LockDrawing();
S := new List<Drop>();
OnMouseDown := MouseDown;
while true do
begin
ClearWindow();
for var i := 0 to S.Count - 1 do
S[i].Draw();
for var i := S.Count - 1 downto 0 do
if S[i].P > 100 then
S.Remove(S[i]);
Redraw();
end;
end.
FreePascal
[править]Алгоритм DDA
[править]uses WinCrt, Graph;
var
GD, GM: integer;
Color: byte;
procedure DrawLine(x, y, x1, y1: integer);
var
cx, cy, l, incX, incY: real;
begin
cx := x * 1.0;
cy := y * 1.0;
if x1 - x > y1 - y then l := x1 - x else l := y1 - y;
incX := (x1 - x) / l;
incY := (y1 - y) / l;
while not ((cy = y1) and (cx = x1)) do
begin
PutPixel(Trunc(cx), Trunc(cy), Color);
cx := cx + incX;
cy := cy + incY;
end;
end;
begin
GD := Detect;
InitGraph(GD, GM, '');
if GraphResult <> GrOK then Halt(1);
Randomize();
Color := 4;
DrawLine(100, 100, 200, 200);
ReadKey();
CloseGraph();
end.
Графика в консоли
[править]PascalABC.Net
[править]Рисование с использованием System.Console
[править]Алгоритм DDA
[править]procedure DrawLine();
begin
while true do
begin
System.Console.Write('X: ');
var x := System.Convert.ToInt32(System.Console.ReadLine());
System.Console.Write('Y: ');
var y := System.Convert.ToInt32(System.Console.ReadLine());
System.Console.Write('X2: ');
var x1 := System.Convert.ToInt32(System.Console.ReadLine());
System.Console.Write('Y2: ');
var y1 := System.Convert.ToInt32(System.Console.ReadLine());
var l := Max(Abs(x1 - x), Abs(y1 - y));
var incX := (x1 - x) / l;
var incY := (y1 - y) / l;
var cx := x * 1.0;
var cy := y * 1.0;
System.Console.BackgroundColor := System.ConsoleColor.Green;
while not ((cy = y1) and (cx = x1)) do
begin
System.Console.SetCursorPosition(System.Convert.ToInt32(cx), System.Convert.ToInt32(cy));
System.Console.Write(' ');
cx += incX;
cy += incY;
end;
System.Console.ReadKey();
System.Console.BackgroundColor := System.ConsoleColor.Black;
System.Console.Clear();
end;
end;
begin
System.Console.Title := 'Console';
DrawLine();
end.
Алгоритм Брезенхема рисования линии
[править]procedure DrawLine();
var
incX, incY: integer;
errorX, errorY: integer;
currentX, currentY: integer;
begin
while true do
begin
System.Console.Write('X: ');
var x := System.Convert.ToInt32(System.Console.ReadLine());
System.Console.Write('Y: ');
var y := System.Convert.ToInt32(System.Console.ReadLine());
System.Console.Write('X2: ');
var x1 := System.Convert.ToInt32(System.Console.ReadLine());
System.Console.Write('Y2: ');
var y1 := System.Convert.ToInt32(System.Console.ReadLine());
var dx := x1 - x;
var dy := y1 - y;
if (dx > 0) then incX := 1
else if (dx = 0) then incX := 0 else incX := -1;
if (dy > 0) then incY := 1
else if (dy = 0) then incY := 0 else incY := -1;
dx := Abs(dx);
dy := Abs(dy);
var l := Max(dx, dy);
errorX := x;
errorY := y;
currentX := x;
currentY := y;
System.Console.BackgroundColor := System.ConsoleColor.Green;
while (currentX <> x1) or (currentY <> y1) do
begin
errorX += dx;
errorY += dy;
System.Console.SetCursorPosition(currentX, currentY);
System.Console.Write(' ');
if (errorX > l) then
begin
errorX -= l;
currentX += incX;
end;
if (errorY > l) then
begin
errorY -= l;
currentY += incY;
end;
end;
System.Console.ReadKey();
System.Console.BackgroundColor := System.ConsoleColor.Black;
System.Console.Clear();
end;
end;
begin
System.Console.Title := 'Console';
DrawLine();
end.
Алгоритм Брезенхема рисования окружности
[править]procedure PutPixel(x, y: integer);
begin
System.Console.SetCursorPosition(x, y);
System.Console.Write(' ');
end;
procedure DrawPoints(x, y, cx, cy: integer);
begin
PutPixel(cx + x, cy + y);
PutPixel(cx + x, cy - y);
PutPixel(cx - x, cy + y);
PutPixel(cx - x, cy - y);
end;
procedure DrawCircle();
var
rd, rrd, rr: integer;
begin
while true do
begin
System.Console.Write('X: ');
var cx := System.Convert.ToInt32(System.Console.ReadLine());
System.Console.Write('Y: ');
var cy := System.Convert.ToInt32(System.Console.ReadLine());
System.Console.Write('R: ');
var r := System.Convert.ToInt32(System.Console.ReadLine());
var x := 0;
var y := r;
System.Console.BackgroundColor := System.ConsoleColor.Green;
while (y >= 0) or (x < r) do
begin
DrawPoints(x, y, cx, cy);
rd := Abs(Sqr(r) - Sqr(x) - Sqr(y - 1));
rr := Abs(Sqr(r) - Sqr(x + 1) - Sqr(y));
rrd := Abs(Sqr(r) - Sqr(x + 1) - Sqr(y - 1));
if rd < rr then
begin
y -= 1;
if (rrd < rd) then x += 1;
end
else
begin
x += 1;
if rrd < rr then y -= 1;
end;
end;
System.Console.ReadKey();
System.Console.BackgroundColor := System.ConsoleColor.Black;
System.Console.Clear();
end;
end;
begin
System.Console.Title := 'Console';
DrawCircle();
end.
Рисование через модуль Crt
[править]Рисовать с помощью данного модуля не рекомендуется - он не содержит всех возможностей System.Console и отсутствует в других языках.
Алгоритм DDA
[править]uses Crt;
procedure DrawLine();
begin
while true do
begin
Write('X: ');
var x := ReadInteger();
Write('Y: ');
var y := ReadInteger();
Write('X2: ');
var x1 := ReadInteger();
Write('Y2: ');
var y1 := ReadInteger();
var l := Max(Abs(x1 - x), Abs(y1 - y));
var incX := (x1 - x) / l;
var incY := (y1 - y) / l;
var cx := x * 1.0;
var cy := y * 1.0;
TextBackground(LightGreen);
while not ((cy = y1) and (cx = x1)) do
begin
GotoXY(Round(cx), Round(cy));
Write(' ');
cx += incX;
cy += incY;
end;
ReadKey();
TextBackground(Black);
ClrScr();
end;
end;
begin
SetWindowCaption('Console');
DrawLine();
end.
Алгоритм Брезенхема рисования линии
[править]uses Crt;
procedure DrawLine();
var
incX, incY: integer;
errorX, errorY: integer;
currentX, currentY: integer;
begin
while true do
begin
Write('X: ');
var x := ReadInteger();
Write('Y: ');
var y := ReadInteger();
Write('X2: ');
var x1 := ReadInteger();
Write('Y2: ');
var y1 := ReadInteger();
var dx := x1 - x;
var dy := y1 - y;
if (dx > 0) then incX := 1
else if (dx = 0) then incX := 0 else incX := -1;
if (dy > 0) then incY := 1
else if (dy = 0) then incY := 0 else incY := -1;
dx := Abs(dx);
dy := Abs(dy);
var l := Max(dx, dy);
errorX := x;
errorY := y;
currentX := x;
currentY := y;
TextBackground(LightGreen);
while (currentX <> x1) or (currentY <> y1) do
begin
errorX += dx;
errorY += dy;
GotoXY(currentX, currentY);
Write(' ');
if (errorX > l) then
begin
errorX -= l;
currentX += incX;
end;
if (errorY > l) then
begin
errorY -= l;
currentY += incY;
end;
end;
ReadKey();
TextBackground(Black);
ClrScr();
end;
end;
begin
SetWindowCaption('Console');
DrawLine();
end.
Алгоритм Брезенхема рисования окружности
[править]uses Crt;
procedure PutPixel(x, y: integer);
begin
GotoXY(x, y);
Write(' ');
end;
procedure DrawPoints(x, y, cx, cy: integer);
begin
PutPixel(cx + x, cy + y);
PutPixel(cx + x, cy - y);
PutPixel(cx - x, cy + y);
PutPixel(cx - x, cy - y);
end;
procedure DrawCircle();
var
rd, rrd, rr: integer;
begin
while true do
begin
Write('X: ');
var cx := ReadInteger();
Write('Y: ');
var cy := ReadInteger();
Write('R: ');
var r := ReadInteger();
var x := 0;
var y := r;
TextBackground(LightGreen);
while (y >= 0) or (x < r) do
begin
DrawPoints(x, y, cx, cy);
rd := Abs(Sqr(r) - Sqr(x) - Sqr(y - 1));
rr := Abs(Sqr(r) - Sqr(x + 1) - Sqr(y));
rrd := Abs(Sqr(r) - Sqr(x + 1) - Sqr(y - 1));
if rd < rr then
begin
y -= 1;
if (rrd < rd) then x += 1;
end
else
begin
x += 1;
if rrd < rr then y -= 1;
end;
end;
ReadKey();
TextBackground(Black);
ClrScr();
end;
end;
begin
SetWindowCaption('Console');
DrawCircle();
end.
C#
[править]Возможно писать на C# в PascalABC.Net, однако, с ограничениями.
Алгоритм DDA
[править]using System;
namespace Алгоритм_DDA
{
class Program
{
public static void Main(string[] args)
{
Console.Title = "Console";
while (true)
{
Console.Write("X: ");
int x = Convert.ToInt32(Console.ReadLine());
Console.Write("Y: ");
int y = Convert.ToInt32(Console.ReadLine());
Console.Write("X2: ");
int x1 = Convert.ToInt32(Console.ReadLine());
Console.Write("Y2: ");
int y1 = Convert.ToInt32(Console.ReadLine());
int l = Math.Max(Math.Abs(x1 - x), Math.Abs(y1 - y));
double incX = (x1 - x) / l;
double incY = (y1 - y) / l;
double cx = x;
double cy = y;
Console.BackgroundColor = ConsoleColor.Green;
while (!((cy == y1) & (cx == x1)))
{
Console.SetCursorPosition(Convert.ToInt32(cx), Convert.ToInt32(cy));
Console.Write(' ');
cx += incX;
cy += incY;
}
Console.ReadKey();
Console.BackgroundColor = ConsoleColor.Black;
Console.Clear();
}
}
}
}
Алгоритм Брезенхема рисования линии
[править]using System;
namespace Алгоритм_Брезенхема
{
class Program
{
public static void Main(string[] args)
{
Console.Title = "Console";
while (true)
{
Console.Write("X: ");
int x = Convert.ToInt32(Console.ReadLine());
Console.Write("Y: ");
int y = Convert.ToInt32(Console.ReadLine());
Console.Write("X2: ");
int x1 = Convert.ToInt32(Console.ReadLine());
Console.Write("Y2: ");
int y1 = Convert.ToInt32(Console.ReadLine());
int incX, incY;
int errorX, errorY;
int currentX, currentY;
int dx = x1 - x;
int dy = y1 - y;
if (dx > 0) { incX = 1; }
else { if (dx == 0) { incX = 0; } else { incX = -1; }}
if (dy > 0) { incY = 1; }
else { if (dy == 0) { incY = 0; } else { incY = -1; }}
dx = Math.Abs(dx);
dy = Math.Abs(dy);
int l = Math.Max(dx, dy);
errorX = x;
errorY = y;
currentX = x;
currentY = y;
Console.BackgroundColor = ConsoleColor.Green;
while ((currentX != x1) || (currentY != y1))
{
errorX += dx;
errorY += dy;
Console.SetCursorPosition(currentX, currentY);
Console.Write(' ');
if (errorX > l)
{
errorX -= l;
currentX += incX;
}
if (errorY > l)
{
errorY -= l;
currentY += incY;
}
}
Console.ReadKey();
Console.BackgroundColor = ConsoleColor.Black;
Console.Clear();
}
}
}
}
Алгоритм Брезенхема рисования окружности
[править]using System;
namespace Алгоритм_Брезенхема_для_окружности
{
class Program
{
public static void PutPixel(int x, int y)
{
Console.SetCursorPosition(x, y);
Console.Write(" ");
}
public static void DrawPoints(int x, int y, int cx, int cy)
{
PutPixel(cx + x, cy + y);
PutPixel(cx + x, cy - y);
PutPixel(cx - x, cy + y);
PutPixel(cx - x, cy - y);
}
public static int Sqr(double x)
{
return Convert.ToInt32(Math.Pow(x, 2));
}
public static void Main(string[] args)
{
Console.Title = "Console";
while (true)
{
int rd, rrd, rr;
Console.Write("X: ");
int cx = Convert.ToInt32(Console.ReadLine());
Console.Write("Y: ");
int cy = Convert.ToInt32(Console.ReadLine());
Console.Write("R: ");
int r = Convert.ToInt32(Console.ReadLine());
int x = 0;
int y = r;
Console.BackgroundColor = ConsoleColor.Green;
while ((y >= 0) || (x < r))
{
DrawPoints(x, y, cx, cy);
rd = Math.Abs(Sqr(r) - Sqr(x) - Sqr(y - 1));
rr = Math.Abs(Sqr(r) - Sqr(x + 1) - Sqr(y));
rrd = Math.Abs(Sqr(r) - Sqr(x + 1) - Sqr(y - 1));
if (rd < rr)
{
y -= 1;
if (rrd < rd) { x += 1; }
}
else
{
x += 1;
if (rrd < rr) { y -= 1; }
}
}
Console.ReadKey();
Console.BackgroundColor = ConsoleColor.Black;
Console.Clear();
}
}
}
}
VB
[править]Алгоритм DDA
[править]Module Module1
Sub Inc(ByRef x As Double, ByVal a As Double)
x = x + a
End Sub
Sub Main()
While True
Dim x As Integer
Dim y As Integer
Dim x1 As Integer
Dim y1 As Integer
Console.Write("X: ")
x = Convert.ToInt32(System.Console.ReadLine())
Console.Write("Y: ")
y = Convert.ToInt32(System.Console.ReadLine())
Console.Write("X2: ")
x1 = Convert.ToInt32(System.Console.ReadLine())
Console.Write("Y2: ")
y1 = Convert.ToInt32(System.Console.ReadLine())
Dim l As Integer = Math.Max(Math.Abs(x1 - x), Math.Abs(y1 - y))
Dim incX As Double = (x1 - x) / l
Dim incY As Double = (y1 - y) / l
Dim cx As Double = x
Dim cy As Double = y
Console.BackgroundColor = System.ConsoleColor.Green
While Not ((cy = y1) And (cx = x1))
Console.SetCursorPosition(Math.Round(cx), Math.Round(cy))
Console.Write(" ")
Inc(cx, incX)
Inc(cy, incY)
End While
Console.ReadKey()
Console.BackgroundColor = System.ConsoleColor.Black
Console.Clear()
End While
End Sub
End Module
Алгоритм Брезенхема рисования линии
[править]Module Module1
Sub Inc(ByRef x As Integer, ByVal a As Integer)
x = x + a
End Sub
Sub Dec(ByRef x As Integer, ByVal a As Integer)
x = x - a
End Sub
Sub Main()
While True
Dim x As Integer
Dim y As Integer
Dim x1 As Integer
Dim y1 As Integer
Console.Write("X: ")
x = Convert.ToInt32(System.Console.ReadLine())
Console.Write("Y: ")
y = Convert.ToInt32(System.Console.ReadLine())
Console.Write("X2: ")
x1 = Convert.ToInt32(System.Console.ReadLine())
Console.Write("Y2: ")
y1 = Convert.ToInt32(System.Console.ReadLine())
Dim incX As Integer
Dim incY As Integer
Dim errorX As Integer
Dim errorY As Integer
Dim currentX As Integer
Dim currentY As Integer
Dim dx As Integer = x1 - x
Dim dy As Integer = y1 - y
If (dx > 0) Then
incX = 1
Else
If (dx = 0) Then
incX = 0
Else
incX = -1
End If
End If
If (dy > 0) Then
incY = 1
Else
If (dy = 0) Then
incY = 0
Else
incY = -1
End If
End If
dx = Math.Abs(dx)
dy = Math.Abs(dy)
Dim l as Integer = Math.Max(dx, dy)
errorX = x
errorY = y
currentX = x
currentY = y
Console.BackgroundColor = ConsoleColor.Green
While ((currentX <> x1) Or (currentY <> y1))
Inc(errorX, dx)
Inc(errorY, dy)
Console.SetCursorPosition(currentX, currentY)
Console.Write(" ")
If (errorX > l) Then
Dec(errorX, l)
Inc(currentX, incX)
End If
If (errorY > l) Then
Dec(errorY, l)
Inc(currentY, incY)
End If
End While
Console.ReadKey()
Console.BackgroundColor = System.ConsoleColor.Black
Console.Clear()
End While
End Sub
End Module
Алгоритм Брезенхема рисования окружности
[править]Module Program
Sub Inc(ByRef x As Integer)
x = x + 1
End Sub
Sub Dec(ByRef x As Integer)
x = x - 1
End Sub
Sub PutPixel(ByVal x As Integer, ByVal y As Integer)
Console.SetCursorPosition(x, y)
Console.Write(" ")
End Sub
Sub DrawPoints(ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer)
PutPixel(cx + x, cy + y)
PutPixel(cx + x, cy - y)
PutPixel(cx - x, cy + y)
PutPixel(cx - x, cy - y)
End Sub
Function Sqr(ByVal x As Integer) As Integer
Return Convert.ToInt32(Math.Pow(x, 2))
End Function
Sub Main()
Console.Title = "Console"
While True
Dim rd As Integer
Dim rrd As Integer
Dim rr As Integer
Console.Write("X: ")
Dim cx As Integer = Convert.ToInt32(Console.ReadLine())
Console.Write("Y: ")
Dim cy As Integer = Convert.ToInt32(Console.ReadLine())
Console.Write("R: ")
Dim r As Integer = Convert.ToInt32(Console.ReadLine())
Dim x As Integer = 0
Dim y As Integer = r
Console.BackgroundColor = System.ConsoleColor.Green
While ((y >= 0) Or (x < r))
DrawPoints(x, y, cx, cy)
rd = Math.Abs(Sqr(r) - Sqr(x) - Sqr(y - 1))
rr = Math.Abs(Sqr(r) - Sqr(x + 1) - Sqr(y))
rrd = Math.Abs(Sqr(r) - Sqr(x + 1) - Sqr(y - 1))
If (rd < rr) Then
Dec(y)
If (rrd < rd) Then
Inc(x)
End If
Else
Inc(x)
If (rrd < rr) Then
Dec(y)
End If
End If
End While
Console.ReadKey()
Console.BackgroundColor = System.ConsoleColor.Black
Console.Clear()
End While
End Sub
End Module