Keskustelu: Koodit: VB6: Helppo 3D rautalanka

Private Type KoordPiste '3D coord piste
    X As Long
    Y As Long
    Z As Long
End Type
Private Type Viiva3D 'viiva
    StartP As KoordPiste
    EndP As KoordPiste
End Type
Private Const pi = 3.14159265368979
Private Const MaksKoord = 100 'maksimi määrä koordinaatteja, muuta jos tarviit
Private c(MaksKoord) As Viiva3D 'coordipisteet
Private Koordit As Integer  'montako coordii
Private rx, ry, rz 'rotaatti coordinaatit

Private Sub Rot(RotX, RotY, RotZ, d, vx, vy, vz) 'rotaattaa

    'rotx,roty,rotz:montako astetta rotataan joka akselilla
    'd=distance (etäisyys)
    'vx,vy,vz: shiftit paljonko palikkaa siirretään joka akselilla
    Cls 'tyhjäks
    For i = 0 To Koordit - 1 'piirretään joka viiva
        n1x = Laske(c(i).StartP, RotX, RotY, RotZ, vx, vy, vz, d, 0) 'lasketaan koordinaatit
        n1y = Laske(c(i).StartP, RotX, RotY, RotZ, vx, vy, vz, d, 1)
        n2x = Laske(c(i).EndP, RotX, RotY, RotZ, vx, vy, vz, d, 0)
        n2y = Laske(c(i).EndP, RotX, RotY, RotZ, vx, vy, vz, d, 1)
        Line (n1x, n1y)-(n2x, n2y), 0
        DoEvents
    Next

End Sub
Private Function Laske(pt As KoordPiste, rtx, rty, rtz, vx, vy, vz, d, xvaiy)  'lasku 3D:stä näytölle

    k = 10
    WA = rtx * pi / 180       'trigonometriaa
    CA = Cos(WA): SA = Sin(WA)
    WB = rtz * pi / 180
    CB = Cos(WB): SB = Sin(WB)
    WC = rty * pi / 180
    CC = Cos(WC): SC = Sin(WC)

    ' x-akseli rotaatio
    X1 = pt.X
    Y1 = CA * pt.Y - SA * pt.Z
    Z1 = SA * pt.Y + CA * pt.Z

    ' y-akseli rotaatio
    X2 = CB * X1 - SB * Z1
    Y2 = Y1
    Z2 = SB * X1 + CB * Z1

    ' z-akseli rotaatio
    X3 = CC * X2 - SC * Y2
    Y3 = SC * X2 + CC * Y2
    Z3 = Z2

    ' shiftit
    X4 = X3 + vx
    Y4 = Y3 + vz
    Z4 = Z3 + vy

    ' zoom
    U = -X4 / (Y4 + 1) * d
    V = -Z4 / (Y4 + 1) * d

    ' screenicoordeiks
    eks = k * U + ScaleWidth / 2
    yks = k * V + ScaleHeight / 2
    If xvaiy Then Laske = yks Else Laske = eks

End Function

Private Sub AddLn(sx, sy, sz, ex, ey, ez) 'uus viiva

    c(Koordit).StartP.X = sx
    c(Koordit).StartP.Y = sy
    c(Koordit).StartP.Z = sz
    c(Koordit).EndP.X = ex
    c(Koordit).EndP.Y = ey
    c(Koordit).EndP.Z = ez
    Koordit = Koordit + 1

End Sub

Private Sub AddCube(sx, sy, sz, ex, ey, ez) 'uus cuutio

    AddLn sx, sy, sz, sx, sy, ez
    AddLn sx, sy, sz, sx, ey, sz
    AddLn sx, sy, sz, ex, sy, sz
    AddLn ex, ey, ez, ex, ey, sz
    AddLn ex, ey, ez, ex, sy, ez
    AddLn ex, ey, ez, sx, ey, ez
    AddLn sx, ey, sz, ex, ey, sz
    AddLn ex, ey, sz, ex, sy, sz
    AddLn ex, sy, sz, ex, sy, ez
    AddLn sx, sy, ez, ex, sy, ez
    AddLn sx, ey, sz, sz, ey, ez
    AddLn sx, sy, ez, sx, ey, ez

End Sub

Private Sub Form_Load()

    AddCube -10, -10, -10, 10, 10, 10
    Timer1.Interval = 10
    Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer() 'rotaatti timeri

    Rot rx, ry, rz, 1000, 0, 0, -100
    rx = rx + 1 'pyöritetään
    ry = ry + 2
    rz = rz + 3

End Sub