3D Modelling I - Minimal Code

Category: 3D

Date: 03-28-2012

Return to Index


 
Sub LoadObject
   ReDim P(4), T(4)
   P(1).x = -30 : P(1).y = -30  : P(1).z = -30
   P(2).x = 30  : P(2).y = -30  : P(2).z = -30
   P(3).x = 0   : P(3).y = -30  : P(3).z = 30
   P(4).x = 0   : P(4).y = 30   : P(4).z = 0
   T(1).p1 = 1  : T(1).p2 = 3   : T(1).p3 = 4
   T(2).p1 = 1  : T(2).p2 = 2   : T(2).p3 = 4
   T(3).p1 = 2  : T(3).p2 = 3   : T(3).p3 = 4
   T(4).p1 = 1  : T(4).p2 = 2   : T(4).p3 = 3
End Sub
 
 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "Win32API.inc"
#Resource "gbsnippets.pbr"     'misc icons
 
Type PointX : X As Single : Y As Single : Z As Single : End Type
Type TriangleX : p1 As Long  : p2 As Long  : p3 As Long : End Type
Type Polypoints
   Count As Long : x1 As Single : y1 As Single : x2 As Single : y2 As Single : x3 As Single : y3 As Single
End Type
 
   %IDC_Graphic = 500 : %IDC_Timer = 501
 
   Global hDlg As DWord, P() As PointX, T() As TriangleX
 
Function PBMain()
   Dialog New Pixels, 0, "3D Objects",,,200,200, %WS_SysMenu Or %WS_ClipChildren, To hDlg
   Control Add Graphic, hDlg, %IDC_Graphic, "", 10,10,180,180
   Graphic Attach hDlg, %IDC_Graphic, Redraw
   Graphic Color %Black, %rgb_Wheat
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case CB.Msg
      Case %WM_InitDialog
         LoadObject
         SetTimer(hDlg, %IDC_Timer, 40, %NULL)    'sends %WM_Timer to dialog callback
      Case %WM_Timer
         Graphic Clear : RotateXYZ : DrawObject : Graphic Redraw
   End Select
End Function
 
Sub RotateXYZ
   Local i As Long, NewX As Single, NewY As Single, NewZ As Single, Angle As Single
   Angle = 0.05
   For i = 1 To UBound(P)
      NewY = P(i).Y * Cos(Angle) - P(i).Z * Sin(Angle)    'X rotation
      NewZ = P(i).Y * Sin(Angle) + P(i).Z * Cos(Angle)    'X rotation
      P(i).Y = NewY : P(i).Z = NewZ
      NewX = P(i).Z * Sin(Angle) + P(i).X * Cos(Angle)    'Y rotation
      NewZ = P(i).Z * Cos(Angle) - P(i).X * Sin(Angle)    'Y rotation
      P(i).X = NewX : P(i).Z = NewZ
      NewX = P(i).X * Cos(Angle) - P(i).Y * Sin(Angle)    'Z rotation
      NewY = P(i).X * Sin(Angle) + P(i).Y * Cos(Angle)    'Z rotation
      P(i).X = NewX : P(i).Y = NewY
   Next i
End Sub
 
Sub DrawObject()
   Local i As Long, PTS As PolyPoints, OffsetY As Long, OffsetX As Long
   OffsetX = 90 : OffsetY = 90 : PTS.Count = 3
   For i = 1 To UBound(T)
      PTS.x1 = P(T(i).p1).x + OffsetX : PTS.y1 = P(T(i).p1).y + OffsetY
      PTS.x2 = P(T(i).p2).x + OffsetX : PTS.y2 = P(T(i).p2).y + OffsetY
      PTS.x3 = P(T(i).p3).x + OffsetX : PTS.y3 = P(T(i).p3).y + OffsetY
      Graphic Polygon PTS, %Blue  ', %Red, 0, 0    'can shade also
   Next i
End Sub
 
Sub LoadObject
   ReDim P(4), T(4)
   P(1).x = -30 : P(1).y = -30  : P(1).z = -30
   P(2).x = 30  : P(2).y = -30  : P(2).z = -30
   P(3).x = 0   : P(3).y = -30  : P(3).z = 30
   P(4).x = 0   : P(4).y = 0   : P(4).z = 30
   T(1).p1 = 1  : T(1).p2 = 3   : T(1).p3 = 4
   T(2).p1 = 1  : T(2).p2 = 4   : T(2).p3 = 2
   T(3).p1 = 3  : T(3).p2 = 2   : T(3).p3 = 4
   T(4).p1 = 1  : T(4).p2 = 2   : T(4).p3 = 3
End Sub
 
'gbs_00560
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm