Викиучебник

Книга программиста/Алгоритмы компьютерной графики

< Книга программиста
(перенаправлено с «Алгоритмы компьютерной графики»)

К оглавлению | Назад | Вперёд

Все программы, код которых выложен здесь, являются работоспособными. На момент написания программ использовались среды PascalABC.Net 3.0 (и 3.3), FreePascal 1.0.12 и SharpDevelop 5.1.

Графика в GraphABC

править

PascalABC.Net

править

Алгоритм DDA

править 
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.

Алгоритм Брезенхема рисования окружности

править 
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.

Рисование в реальном времени

править 
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.

Капли на воде

править 
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
Источник — https://ru.wikibooks.org/w/index.php?title=Книга_программиста/Алгоритмы_компьютерной_графики&oldid=163490