Создание программы, реализующей алгоритм удаления невидимых линий и поверхностей методом Z-буфера

       
 
 
 
 

5.3. Листинг программы

  

unit Unit1; 

interface 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ExtCtrls, StdCtrls, ComCtrls;

type

  TPoints = record

    x:integer;

    y:integer;

    z:integer;

  end; 

  TFigures = record

    P:array[1..3]of TPoints;

    MinX,MinY,MaxX,MaxY:Word;

    A,B,C,D:integer;

    color:TColor;

  end; 

type

  TForm1 = class(TForm)

    Image: TImage;

    pb: TProgressBar;

    GroupBox1: TGroupBox;

    Label1: TLabel;

    CountEdit: TEdit;

    StartMainAlgoritm: TButton;

    StepBtn: TButton;

    ResetBtn: TButton;

    ExitBtn: TButton;

    GroupBox2: TGroupBox;

    procedure StartMainAlgoritmClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure StepBtnClick(Sender: TObject);

    procedure ResetBtnClick(Sender: TObject);

    procedure ExitBtnClick(Sender: TObject);

    procedure AboutBtnClick(Sender: TObject);

  private

    { Private declarations }

procedure InitZbuffer;

procedure InitScreenBuffer;

procedure DrawScreenBuffer;

function  InitFigure:TFigures;

  public

    { Public declarations }

  end; 

var

  Form1: TForm1;

  MaxX,MaxY:Word;

  MinDepth:byte;

  Screenbuffer:array[1..400,1..400] of TColor;

  Zbuffer:array[1..400,1..400]of Byte;

  fig:TFigures; 
 

implementation 

{$R *.dfm}

uses Unit2,Unit3; 

procedure TForm1.FormCreate(Sender: TObject);

begin

Randomize;

MaxX:=Image.Width;

MaxY:=Image.Height;

MinDepth:=0;

InitZbuffer;

InitScreenBuffer;

Image.Canvas.Refresh;

end; 

procedure MainAlgoritm(fig:TFigures);

var

i,j:integer;

z:Byte;

color:TColor;

begin

for j:=1 to MaxY do

begin

  for i:=1 to MaxX do

  begin

    color:=Form1.Image.Canvas.Pixels[i,j];

    if(color=fig.color)then

    begin

      z:=round(-(fig.A*i + fig.B*j + fig.D)/fig.C);

      if(z>Zbuffer[i,j])then

      begin

        Zbuffer[i,j]:=z;

        Screenbuffer[i,j]:=color;

      end;

    end;

  end;

end; 
 
 

end; 

procedure TForm1.StartMainAlgoritmClick(Sender: TObject);

var

i:integer;

Count:integer;

begin

image.Canvas.TextOut(150,150,'Пожалуйста  подождите');

try

  Count:=Strtoint(CountEdit.Text);

  pb.Max:=Strtoint(CountEdit.Text);

except

  on EConvertError do begin

  MessageDlg('Введите  правильное число!',mtWarning,[mbOK], 0);

  exit;

  end;

end;

pb.Position:=1;

  for i:=1 to Count do

  begin

    fig:=InitFigure;

    MainAlgoritm(fig);

    DrawScreenBuffer;

    pb.Position:=i+1;

  end;

  pb.Position:=0;

end; 
 

procedure TForm1.StepBtnClick(Sender: TObject);

begin

  pb.Max:=1;

  pb.Position:=1;

  fig:=InitFigure;

  MainAlgoritm(fig);

  DrawScreenBuffer;

  pb.Position:=0;

end; 

procedure TForm1.ResetBtnClick(Sender: TObject);

begin

InitZbuffer;

InitScreenBuffer;

DrawScreenBuffer;

end; 

procedure TForm1.AboutBtnClick(Sender: TObject);

begin

Form3.ShowModal;

end; 

procedure TForm1.ExitBtnClick(Sender: TObject);

begin

Close;

end; 

end. 

procedure InitZbuffer;

var

i,j:integer;

begin

for i:=1 to MaxX do

begin

  for j:=1 to MaxY do

  begin

    Zbuffer[i,j]:=MinDepth;

  end;

end;

end; 

procedure InitScreenBuffer;

var

i,j:integer;

begin

for i:=1 to MaxX do

begin

  for j:=1 to MaxY do

  begin

    ScreenBuffer[i,j]:=clWhite;

  end;

end;

end; 

procedure DrawScreenBuffer;

var

i,j:integer;

begin

with Form1.Image.Canvas do

begin

  for i:=1 to MaxX do

  begin

    for j:=1 to MaxY do

    begin

      Pixels[i,j]:=Screenbuffer[i,j];

    end;

  end;

end;

end; 

procedure Plane(var fig:TFigures);

begin

with fig do

begin

  A:=p[1].y*(p[2].z-p[3].z) + p[2].y*(p[3].z-p[1].z) + p[3].y*(p[1].z-p[2].z);

  B:=p[1].z*(p[2].x-p[3].x) + p[2].z*(p[3].x-p[1].x) + p[3].z*(p[1].x-p[2].x);

  C:=p[1].x*(p[2].y-p[3].y) + p[2].x*(p[3].y-p[1].y) + p[3].x*(p[1].y-p[2].y);

  D:=-( p[1].x*(p[2].y*p[3].z - p[3].y*p[2].z) + p[2].x*(p[3].y*p[1].z - p[1].y*p[3].z) +

  p[3].x*(p[1].y*p[2].z - p[2].y*p[1].z) );

end;

end; 

procedure BorderPoints(var fig:TFigures);

begin

  with fig do

  begin

    MinX:=Min(Min(p[1].x,p[2].x),p[3].x);

    MinY:=Min(Min(p[1].y,p[2].y),p[3].y);

    MaxX:=Max(Max(p[1].x,p[2].x),p[3].x);

    MaxY:=Max(Max(p[1].y,p[2].y),p[3].y);

  end;

end; 

function InitFigure:TFigures;

var

i:byte;

fig:TFigures;

poligon:array[1..3]of TPoint;

begin

for i:=1 to 3 do

begin

  fig.P[i].x:=Random(MaxX);poligon[i].X:=fig.P[i].x;

  fig.P[i].y:=Random(MaxY);poligon[i].Y:=fig.P[i].y;

  fig.P[i].z:=Random(254)+1;                   

end;

Plane(fig);

BorderPoints(fig);

fig.color:=Random($FFFFFF);

Form1.Image.Canvas.Brush.Color:=fig.color;

Form1.Image.Canvas.Pen.Color:=fig.color;

Form1.Image.Canvas.Polygon(poligon);

Result:=fig;

end; 
 

end. 

    6. ЛИТЕРАТУРА 

    1. П. В. Вельтмандер. Учебное пособие «Основные алгоритмы компьютерной графики».

    2. А. В. Казанцев. Тексты специального курса лекций «Основы компьютерной графики»

    3. А. Ю.  Дёмин, А.В. Кудинов. Учебное пособие «Компьютерная графика».

    4. Ньюмен. У., Спрулл Р. «Основы интерактивной машинной графики»

    5. Котов И. И. «Алгоритмы машинной графики»