Dim RGBcolor As Integer цвет грани

Dim RGBcolor As Integer ' цвет грани

Dim z_byfer(200, 200) As Double

Dim kadr(200, 200) As Double

Sub Z_четырехугольник(xa, ya, za, xb, yb, zb, _

xc, yc, zc, xd, yd, zd)

'заполняет Z буфер для четырехугольника

'определение направление сканирования четырехугольника

'ось y

If ya > yc Then

stepy = -1

Else

stepy = 1

End If

' ось х

If xa > xc Then

stepx = -1

Else

stepx = 1

End If

' ось z

If za > zc Then

stepz = -1

Else

stepz = 1

End If

' Наблюдатель находиться в точке с координатами

Xnabl = 200

Ynabl = 200

Znabl = 0

'Ему видно три вида граний

'грань паралельна плоскости YX

If za = zb And zb = zc And zc = zd Then

' цикл по y

For y = ya To yc Step stepy

' цикл по оси x

For x = xa To xc Step stepx

' определяем где на экране находиться данная точка

Call XYZ(x, y, za, X_zbyf, Y_zbyf)

' определяем квадрат расстояние от рассматриваемой точки до наблюдателя

Rnabl = ((Xnabl - x) ^ 2 + (Ynabl - y) ^ 2 + (Znabl - za) ^ 2) ^ 0.5

' извлекаем данные о значении координаты Y в Z буфере

Zbyf = z_byfer(Y_zbyf, X_zbyf)

' если новое значение ближе к наблюдателю то заменняем значение в

' z буфере и в буфере кадра

If Rnabl < Zbyf Then

z_byfer(Y_zbyf, X_zbyf) = Rnabl

kadr(Y_zbyf, X_zbyf) = RGBcolor

End If

Next x

Next y

Else

'грань паралельна плоскости ZX

If ya = yb And yb = yc And yc = yd Then

' цикл по y

For Z = za To zc Step stepz

' цикл по оси x

For x = xa To xc Step stepx

' определяем где на экране находиться данная точка

Call XYZ(x, ya, Z, X_zbyf, Y_zbyf)

' определяем квадрат расстояние от рассматриваемой точки до наблюдателя

Rnabl = ((Xnabl - x) ^ 2 + (Ynabl - ya) ^ 2 + (Znabl - Z) ^ 2) ^ 0.5

' извлекаем данные о значении координаты Y в Z буфере

Zbyf = z_byfer(Y_zbyf, X_zbyf)

' если новое значение ближе к наблюдателю то заменняем значение в

' z буфере и в буфере кадра

If Rnabl < Zbyf Then

z_byfer(Y_zbyf, X_zbyf) = Rnabl

kadr(Y_zbyf, X_zbyf) = RGBcolor

End If

Next x

Next Z

Else

'грань паралельна плоскости ZY

If xa = xb And xb = xc And xc = xd Then

' цикл по y

For y = ya To yc Step stepy

' цикл по оси x

For Z = za To zc Step stepz

' определяем где на экране находиться данная точка

Call XYZ(xa, y, Z, X_zbyf, Y_zbyf)

' определяем квадрат расстояние от рассматриваемой точки до наблюдателя

Rnabl = ((Xnabl - xa) ^ 2 + (Ynabl - y) ^ 2 + (Znabl - Z) ^ 2) ^ 0.5

' извлекаем данные о значении координаты Y в Z буфере

Zbyf = z_byfer(Y_zbyf, X_zbyf)

' если новое значение ближе к наблюдателю то заменняем значение в

' z буфере и в буфере кадра

If Rnabl < Zbyf Then

z_byfer(Y_zbyf, X_zbyf) = Rnabl

kadr(Y_zbyf, X_zbyf) = RGBcolor

End If

Next Z

Next y

Else

'Грань расположенная под углом

'вычисляем угол наклона

tanA = (yb - ya) / (zb - za)

For Z = za To zc Step stepz

y = ya + Z * tanA

For x = xa To xc Step stepx

Call XYZ(x, y, Z, X_zbyf, Y_zbyf)

' определяем квадрат расстояние от рассматриваемой точки до наблюдателя

Rnabl = ((Xnabl - x) ^ 2 + (Ynabl - y) ^ 2 + (Znabl - Z) ^ 2) ^ 0.5

' извлекаем данные о значении координаты Y в Z буфере

Zbyf = z_byfer(Y_zbyf, X_zbyf)

' если новое значение ближе к наблюдателю то заменняем значение в

' z буфере и в буфере кадра

If Rnabl < Zbyf Then

z_byfer(Y_zbyf, X_zbyf) = Rnabl

kadr(Y_zbyf, X_zbyf) = RGBcolor

End If

Next x

Next Z

End If

End If

End If

End Sub

Sub Z_пятиугольник(xa, ya, za, xb, yb, zb, _

xc, yc, zc, xd, yd, zd, xe, ye, ze)

'заполняет Z буфер для пятиугольника

'определение направление сканирования пятиугольника

'ось y

If ya > yd Then

stepy = -1

Else

stepy = 1

End If

' ось х

If xa > xd Then

stepx = -1

Else

stepx = 1

End If

' ось z

If za > zd Then

stepz = -1

Else

stepz = 1

End If

' Наблюдатель находиться в точке с координатами

Xnabl = 200

Ynabl = 200

Znabl = 0

'Ему видно три вида граний

'грань паралельна плоскости ZY

tanA = Abs(yc - yb) / Abs(zc - zb)

If xa = xb And xb = xc And xc = xd Then

' цикл по z

For Z = za To zb Step stepz

' цикл по оси y

For y = ya To yd Step stepy

' определяем где на экране находиться данная точка

Call XYZ(xa, y, Z, X_zbyf, Y_zbyf)

' определяем квадрат расстояние от рассматриваемой точки до наблюдателя

Rnabl = ((Xnabl - xa) ^ 2 + (Ynabl - y) ^ 2 + (Znabl - Z) ^ 2) ^ 0.5

' извлекаем данные о значении координаты Y в Z буфере

Zbyf = z_byfer(Y_zbyf, X_zbyf)

' если новое значение ближе к наблюдателю то заменняем значение в

' z буфере и в буфере кадра

If Rnabl < Zbyf Then

z_byfer(Y_zbyf, X_zbyf) = Rnabl

kadr(Y_zbyf, X_zbyf) = RGBcolor

End If

Next y

Next Z

For Z = zb To zc Step stepz

For y = ya + (Z - zb) * tanA To yd Step stepy

' определяем где на экране находиться данная точка

Call XYZ(xa, y, Z, X_zbyf, Y_zbyf)

' определяем квадрат расстояние от рассматриваемой точки до наблюдателя

Rnabl = ((Xnabl - xa) ^ 2 + (Ynabl - y) ^ 2 + (Znabl - Z) ^ 2) ^ 0.5

' извлекаем данные о значении координаты Y в Z буфере

Zbyf = z_byfer(Y_zbyf, X_zbyf)

' если новое значение ближе к наблюдателю то заменняем значение в

' z буфере и в буфере кадра

If Rnabl < Zbyf Then

z_byfer(Y_zbyf, X_zbyf) = Rnabl

kadr(Y_zbyf, X_zbyf) = RGBcolor

End If

Next y

Next Z

End If

End Sub

Sub экран_буфер_кадра(Ymin, Ymax, Xmin, Xmax)

'переносим данные из буфера кадра на экран

For x = Xmin To Xmax

For y = Ymin To Ymax

RGBcolor = kadr(y, x)

Call plott(x, y, RGBcolor)

Next y

Next x

End Sub

Sub Z_буфер()

'очистка экрана

Worksheets("экран").Range("A1:iv200").Interior. ColorIndex = xlNone

'заполнение Z буфера фоновым значением

For x = 1 To 200

For y = 1 To 200

z_byfer(y, x) = 10000

Next y

Next x

RGBcolor = 10

Call Z_figure

Call Zvoksel(10, 5, -24, 18, 18, 18)

Call экран_буфер_кадра(50, 200, 50, 200)

End Sub

Private Sub Z_figure()

'программа рисования фигуры 3

'Координаты нижнего основания

xa = -20: ya = -20: za = -20

xb = 20: yb = -20: zb = -20

xc = 20: yc = 10: zc = -20

xd = -20: yd = 10: zd = -20

'Координаты верхнего основания

xa1 = -20: ya1 = -10: za1 = 20

xb1 = 20: yb1 = -10: zb1 = 20

xc1 = 20: yc1 = 10: zc1 = 20

xd1 = -20: yd1 = 10: zd1 = 20

'Координаты сечения

xe = -20: ye = -20: ze = 0

xf = 20: yf = -20: zf = 0

Call Zсемигранник(xa, ya, za, xb, yb, zb, xc, yc, zc, xd, yd, zd, _

xa1, ya1, za1, xb1, yb1, zb1, xc1, yc1, zc1, xd1, yd1, zd1, _

xe, ye, ze, xf, yf, zf)

End Sub

Sub Zvoksel(xa, ya, za, dlina, shirina, vusota)

'программа рисования куба

'координата нижней точки A

'xa = 0: ya = 0: za = -30

'dlina = 70 'длина

'vusota = 50 'высота

'shirina = 30 'ширина

'определенние координат всех 8 вершин куба

'нижнее основание

xb = xa + dlina: yb = ya: zb = za

xc = xb: yc = ya + shirina: zc = za

xd = xa: yd = yc: zd = za

'верхнее

xa1 = xa: ya1 = ya: za1 = za + vusota

xb1 = xb: yb1 = yb: zb1 = zb + vusota

xc1 = xc: yc1 = yc: zc1 = zc + vusota

xd1 = xd: yd1 = yd: zd1 = zd + vusota

Call Zшестигранник(xa, ya, za, xb, yb, zb, xc, yc, zc, xd, yd, zd, _

xa1, ya1, za1, xb1, yb1, zb1, xc1, yc1, zc1, xd1, yd1, zd1)

End Sub

Sub Zсемигранник(xa, ya, za, xb, yb, zb, xc, yc, zc, xd, yd, zd, _

xa1, ya1, za1, xb1, yb1, zb1, xc1, yc1, zc1, xd1, yd1, zd1, _

xe, ye, ze, xf, yf, zf)

'рисование семигранника по координатам 10 точек

'вернее основание точки a, b,c, d

'нижнее основание точки a1,b1,c1,d1

'рисуем 7 граней

Call Z_пятиугольник(xb, yb, zb, xf, yf, zf, xb1, yb1, zb1, xc1, yc1, zc1, xc, yc, zc)

RGBcolor = 1

Call Z_пятиугольник(xa, ya, za, xe, ye, ze, xa1, ya1, za1, xd1, yd1, zd1, xd, yd, zd)

RGBcolor = 4

Call Z_четырехугольник(xa1, ya1, za1, xd1, yd1, zd1, xc1, yc1, zc1, xb1, yb1, zb1)

RGBcolor = 3

Call Z_четырехугольник(xa, ya, za, xb, yb, zb, xc, yc, zc, xd, yd, zd)

RGBcolor = 6

Call Z_четырехугольник(xc, yc, zc, xc1, yc1, zc1, xd1, yd1, zd1, xd, yd, zd)

RGBcolor = 14

Call Z_четырехугольник(xa, ya, za, xe, ye, ze, xf, yf, zf, xb, yb, zb)

RGBcolor = 12

Call Z_четырехугольник(xe, ye, ze, xa1, ya1, za1, xb1, yb1, zb1, xf, yf, zf)

End Sub

Sub Zшестигранник(xa, ya, za, xb, yb, zb, xc, yc, zc, xd, yd, zd, _

xa1, ya1, za1, xb1, yb1, zb1, xc1, yc1, zc1, xd1, yd1, zd1)

'рисование шестиграннико по координатам 8 точек

'вернее основание точки a, b,c, d

'нижнее основание точки a1,b1,c1,d1

'рисуем 6 граней

Call Z_четырехугольник(xb1, yb1, zb1, xb, yb, zb, xc, yc, zc, xc1, yc1, zc1)

RGBcolor = 1

Call Z_четырехугольник(xa, ya, za, xa1, ya1, za1, xd1, yd1, zd1, xd, yd, zd)

RGBcolor = 7

Call Z_четырехугольник(xa1, ya1, za1, xb1, yb1, zb1, xc1, yc1, zc1, xd1, yd1, zd1)

RGBcolor = 3

Call Z_четырехугольник(xa, ya, za, xb, yb, zb, xc, yc, zc, xd, yd, zd)

RGBcolor = 6

Call Z_четырехугольник(xc1, yc1, zc1, xc, yc, zc, xd, yd, zd, xd1, yd1, zd1)

RGBcolor = 14

Call Z_четырехугольник(xa, ya, za, xa1, ya1, za1, xb1, yb1, zb1, xb, yb, zb)

End Sub

Public Sub XYZ(wx, vy, uz, qX, qY)

'отображение точки с координатами x, y,z на экране

'wx, vy, uz - входные трехмерные координаты

'qX, qY - выходные экранные координаты

'1 шаг отметка по оси Y

'определение угла между осями

al = 3 * 3.14 / 4

Call поворот(al, 0, 0, vy, 0, qX, qY)

' по оси X

Call сдвиг(100 + wx, 0, qX, qY, qX, qY)

'осьZ

Call сдвиг(0, 100 - uz, qX, qY, qX, qY)

End Sub

Public Sub поворот(ugol, x0, y0, x, y, xx, yy)

'ygol - угол поворота

'х0,y0 центр поворота

'x, y входные координаты

'ХХ, YY выходные координаты

'поворот точки вокруг произвольного центра

alpha = ugol

'massiv 2

Dim a(3, 3) As Single

a(1, 1) = 1: a(1, 2) = 0: a(1, 3) = x0

a(2, 1) = 0: a(2, 2) = 1: a(2, 3) = y0

a(3, 1) = 0: a(3, 2) = 0: a(3, 3) = 1

Dim b(3, 3) As Single

b(1, 1) = Cos(alpha): b(1, 2) = -Sin(alpha): b(1, 3) = 0

b(2, 1) = Sin(alpha): b(2, 2) = Cos(alpha): b(2, 3) = 0

b(3, 1) = 0: b(3, 2) = 0: b(3, 3) = 1

'massiv 3

Dim c(3, 3) As Single

c(1, 1) = 1: c(1, 2) = 0: c(1, 3) = - x0

c(2, 1) = 0: c(2, 2) = 1: c(2, 3) = - y0

c(3, 1) = 0: c(3, 2) = 0: c(3, 3) = 1

'massiv 4

Dim E(3, 3) As Single

E(1, 1) = Cos(alpha)

E(1, 2) = - Sin(alpha)

E(1, 3) = (a(1, 1) * b(1, 1) + a(1, 2) * b(2, 1) + a(1, 3) * b(3, 1)) * c(1, 3) + (a(1, 1) * b(1, 2) + a(1, 2) * b(2, 2) + a(1, 3) * b(3, 2)) * c(2, 3) + (a(1, 1) * b(1, 3) + a(1, 2) * b(2, 3) + a(1, 3) * b(3, 3)) * c(3, 3)

E(2, 1) = Sin(alpha)

E(2, 2) = Cos(alpha)

E(2, 3) = (a(2, 1) * b(1, 1) + a(2, 2) * b(2, 1) + a(2, 3) * b(3, 1)) * c(1, 3) + (a(2, 1) * b(1, 2) + a(2, 2) * b(2, 2) + a(2, 3) * b(3, 2)) * c(2, 3) + (a(2, 1) * b(1, 3) + a(2, 2) * b(2, 3) + a(2, 3) * b(3, 3)) * c(3, 3)

E(3, 1) = 0

E(3, 2) = 0

E(3, 3) = 1

Dim D(3, 3) As Single

D(1, 1) = x

D(2, 1) = y

D(3, 1) = 1

xx = E(1, 1) * D(1, 1) + E(1, 2) * D(2, 1) + E(1, 3) * D(3, 1)

yy = E(2, 1) * D(1, 1) + E(2, 2) * D(2, 1) + E(2, 3) * D(3, 1)

End Sub

Public Sub сдвиг(x0, y0, x, y, xx, yy)

'х0,y0 величина сдвига

'x, y входные координаты

'ХХ, YY выходные координаты

'massiv A

a11 = 1: a12 = 0: a13 = x0

a21 = 0: a22 = 1: a23 = y0

a31 = 0: a32 = 0: a33 = 1

'massiv B

b11 = x

b21 = y

b31 = 1

'massiv rezultat

xx = a11 * b11 + a12 * b21 + a13 * b31

yy = a21 * b11 + a22 * b21 + a23 * b31

End Sub

Public Sub отрезокЦДА(x1, y1, X2, Y2)

'Алгоритм вычерчивания отрезков

'Цифровой дифференциальный анализ (ЦДА)

'Описываем тип переменных

'Определяем по какой координате большее приращение

If Abs(X2 - x1) >= Abs(Y2 - y1) Then

dlina = Abs(X2 - x1)

Else

dlina = Abs(Y2 - y1)

End If

'Полагаем, большее из приращений равным единице растра

dx = (X2 - x1) / dlina

dy = (Y2 - y1) / dlina

'Основной цикл рисования

'начальная точка

i = 0

xr = x1 'расчетное значение х

yr = y1 ' расчетное значение y

Do While i <= dlina

'Закраска ячейки

Call plott(xr, yr, 1)

'Определение новых координат

xr = xr + dx

yr = yr + dy

'на каждом шаге происходит приращение по одной из координат

i = i + 1

Loop

End Sub

Sub plott(xx, yy, color)

'процедура закраски ячейки

If xx >= 1 And yy >= 1 Then

Worksheets(1).Cells(Int(yy), Int(xx)).Interior. ColorIndex = color

End If

End Sub