Создание поверхности по заданой функции

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