Создание поверхности по заданой функции - VB
Формулировка задачи:
Помогите написать поверхность в Visual Basic по заданой функции
Решение задачи: «Создание поверхности по заданой функции»
textual
Листинг программы
Option Explicit Private Type Point X As Single Y As Single z As Single c As Long End Type Private Const Segments As Long = 30 ' Количество сегментов поверхности Dim Vertex() As Point ' Узлы поверхности Dim ort As Boolean ' Ортогональная/перспективная проеция Private Function GetPoint(X As Single, Y As Single) As Single ' Получить узел поверхности If Abs(X + Y) <= 2 Then GetPoint = X * X - 2 * Y * Y Else GetPoint = X - Y 'GetPoint = Sin(Sqr(X * X + Y * Y) * 4) ' Волны End Function Private Sub ChangeProjection() ' Изменить тип проекции ort = Not ort: Me.Caption = IIf(ort, "Ортогональная", "Перспективная"): Render Vertex End Sub Private Sub CreateSurface() ' Создание поверхности Dim X As Single, Y As Single, s As Single, i As Single s = 4 / Segments: ReDim Vertex((Segments + 1) * (Segments + 1)) For X = -2 To 2 Step s: For Y = -2 To 2 Step s Vertex(i).X = X: Vertex(i).Y = Y: Vertex(i).z = GetPoint(X, Y) Vertex(i).c = Abs(Vertex(i).z) * 30: Vertex(i).c = RGB(Vertex(i).c, 0, 255 - Vertex(i).c): i = i + 1 Next: Next End Sub Private Function Rotate(Pt As Point, X As Single, Y As Single, z As Single) As Point ' Поворот точки Dim cx As Single, sx As Single, cy As Single, sy As Single, cz As Single, sz As Single sx = Sin(X): sy = Sin(Y): sz = Sin(z): cx = Cos(X): cy = Cos(Y): cz = Cos(z) Rotate.X = Pt.X * (cz * cy + sz * sx * sy) + Pt.Y * (-sz * cy + cz * sx * sy) + Pt.z * (cx * sy) Rotate.Y = Pt.X * (sz * cx) + Pt.Y * (cz * cx) - Pt.z * sx Rotate.z = Pt.X * (-cz * sy + cy * sz * sx) + Pt.Y * (sz * sy + cz * sx * cy) + Pt.z * (cx * cy) Rotate.c = Pt.c End Function Private Sub Render(Points() As Point) ' Рендеринг Dim Pt As Point, i As Long, n As Long, col As Long, sw As Single, sh As Single, s As Long, s2 As Long Me.Cls: sw = Me.ScaleWidth / 2: sh = Me.ScaleHeight / 2: s = Segments + 1: s2 = s * s For n = 0 To UBound(Points) Pt = Points(n): Pt.z = Pt.z + 10 ' Отодвигаем от себя поверхность на 10 единиц If ort Then Pt.X = Pt.X / 7: Pt.Y = Pt.Y / 7 Else Pt.X = Pt.X / (Pt.z * 0.9): Pt.Y = Pt.Y / (Pt.z * 0.9) If n Mod s Then Me.Line -(Pt.X * sw + sw, Pt.Y * sh + sh), Pt.c _ Else Me.PSet (Pt.X * sw + sw, Pt.Y * sh + sh) Next For n = 0 To UBound(Points) i = ((n * s) Mod s2) + n \ s: Pt = Points(i): Pt.z = Pt.z + 10 If ort Then Pt.X = Pt.X / 7: Pt.Y = Pt.Y / 7 Else Pt.X = Pt.X / (Pt.z * 0.9): Pt.Y = Pt.Y / (Pt.z * 0.9) If n Mod s Then Me.Line -(Pt.X * sw + sw, Pt.Y * sh + sh), Pt.c _ Else Me.PSet (Pt.X * sw + sw, Pt.Y * sh + sh) Next Me.Refresh End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then ChangeProjection ' Переключить проекцию End Sub Private Sub Form_Load() Me.ScaleMode = vbPixels: Me.AutoRedraw = True: Me.BackColor = vbWhite: CreateSurface: ChangeProjection End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Static dx As Single, dy As Single Dim i As Long, ax As Single, ay As Single, az As Single If Button Then ax = -(Y - dy) / 100: ay = (X - dx) / 100: If Shift Then az = ay: ax = 0: ay = 0 ' При Ctrl|Shift|Alt вращать по Z For i = 0 To UBound(Vertex) Vertex(i) = Rotate(Vertex(i), ax, ay, az) Next Render Vertex End If dx = X: dy = Y End Sub Private Sub Form_Resize() Render Vertex End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д