Date: 02-16-2022
Return to Index
created by gbSnippets
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: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#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
http://www.garybeene.com/sw/gbsnippets.htm