close

Вход

Забыли?

вход по аккаунту

?

5.10prog

код для вставкиСкачать
'вычисляем нормаль к грани
Call normal(xa, ya, za, xb, yb, zb, xc, yc, zc, xn, yn, zn)
'вычисляем кос угла между источн. света и нормалью к поверх
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
'интенсивность света
Call MyRGB(modsv(cus))
Call Z_четырехугольник(xa, ya, za, xb, yb, zb, xc, yc, zc, xd, yd, zd)
'вычисляем нормаль к грани
Call normal(xc1, yc1, zc1, xc, yc, zc, xd, yd, zd, xn, yn, zn)
'вычисляем кос угла между источн. света и нормалью к поверх
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
'интенсивность света
Call MyRGB(modsv(cus))
Call Z_четырехугольник(xc1, yc1, zc1, xc, yc, zc, xd, yd, zd, xd1, yd1, zd1)
'вычисляем нормаль к грани
Call normal(xa, ya, za, xa1, ya1, za1, xb1, yb1, zb1, xn, yn, zn)
'вычисляем кос угла между источн. света и нормалью к поверх
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
'интенсивность света
Call MyRGB(modsv(cus))
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)
'Алгоритм вычерчивания отрезков
'Цифровой дифференциальный анализ стр.50 (ЦДА)
'Описываем тип переменных
'Определяем по какой координате большее приращение
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
Sub normal(xxa, yya, zza, xxb, yyb, zzb, xxc, yyc, zzc, xxn, yyn, zzn)
'процедура вычисления нормали к поверхности
'входные величины координаты трех точек в мировых координатах
'xxn, yyn, zzn координаты радиус-вектора к нормале
xxn = (yyb - yya) * (zzc - zza) - (zzb - zza) * (yyc - yya)
yyn = (zzb - zza) * (xxc - xxa) - (xxb - xxa) * (zzc - zza)
zzn = (xxb - xxa) * (yyc - yya) - (yyb - yya) * (xxc - xxa)
End Sub
Function cosugolsun(xxsun, yysun, zzsun, xxn, yyn, zzn)
'xxsun, yysun, zzsun, - координаты источника света
'xxn, yyn, zzn - координаты нормали к поверхности
'вычислим длину радиус векторов
sun = (xxsun ^ 2 + yysun ^ 2 + zzsun ^ 2) ^ 0.5
n = (xxn ^ 2 + yyn ^ 2 + zzn ^ 2) ^ 0.5
Лист
Изм Лист №
.
докум.
Подп. Дата
'косинус угла между источником света и норалью к поверхности
cosugolsun = (xxsun * xxn + yysun * yyn + zzsun * zzn) / (sun * n)
End Function
Function modsv(cug)
'модель освещения матового тела
modsv = 160 * cug
End Function
Public Sub MyRGB(color)
'увеличиваем количество возможных цветов в зависимости от
'интенсивности освещения
If color > 150 Then
RGBcolor = 34
Exit Sub
End If
If color > 140 Then
RGBcolor = 35
Exit Sub
End If
If color > 130 Then
RGBcolor = 33
Exit Sub
End If
If color > 120 Then
RGBcolor = 42
Exit Sub
End If
If color > 110 Then
RGBcolor = 41
Exit Sub
End If
If color > 100 Then
RGBcolor = 13
Exit Sub
End If
If color > 90 Then
RGBcolor = 14
Exit Sub
End If
If color > 80 Then
RGBcolor = 10
Exit Sub
End If
If color > 70 Then
RGBcolor = 12
Exit Sub
End If
If color > 60 Then
RGBcolor = 9
Exit Sub
End If
If color > 50 Then
RGBcolor = 53
Лист
Изм Лист №
.
докум.
Подп. Дата
Exit Sub
End If
If color > 40 Then
RGBcolor = 51
Exit Sub
End If
If color > 30 Then
RGBcolor = 52
Exit Sub
End If
If color > 20 Then
RGBcolor = 56
Exit Sub
End If
RGBcolor = 56
End Sub
Лист
Изм Лист №
.
докум.
Подп. Дата
Документ
Категория
Радиоэлектроника
Просмотров
15
Размер файла
94 Кб
Теги
10prog
1/--страниц
Пожаловаться на содержимое документа