PDA

View Full Version : 3D Test



peter
29-11-2013, 15:52
Hi,


Uses "ui","math"
#INCLUDE "abc.inc"


DWord hdc, hwnd
hwnd = Canvas_Window("ThinBasic",xMiddle(640),yMiddle(480),640,480)
Canvas_Attach(hwnd,0,%TRUE)
hdc = Canvas_GetDC()
SetHandleDC hdc, hwnd
SetFont 14,28,%FW_BOLD,""


Long ox,oy,cx,cy,pen
ox = 640 /2
oy = 480 /2
pen=1


Sub Pos(x As Long,y As Long)
If pen Then DrawLine(ox+cx,oy-cy,ox+x,oy-y, 1, Rgb 240,240,240)
cx = x
cy = y
End Sub


Sub iPoint(a As Single,b As Single,c As Single )
pos((a-c)*0.886, b-(a+c)*0.5)
End Sub


Sub Cone(r As Single,l As Single)
r= l/2
pen=0
Local h, v As Single
For h=0 To l Step 10
For v=0 To 360 Step 20
iPoint((h/2)*Cos(DegToRad(v)), h, (h/2)*Sin(DegToRad(v)))
pen=1
Next
pen=0
Next
For v=0 To 360 Step 20
For h=0 To l Step 10
iPoint((h/2)*Cos(DegToRad(v)), h, (h/2)*Sin(DegToRad(v)))
pen=1
Next
pen=0
Next
End Sub


Sub Ellipsoid(r1 As Single,r2 As Single,r3 As Single)
Local u, v, l, m, n As Single
pen=0
For u=0 To 360 Step 20
For v=0 To 180 Step 20
l = (r1 * Cos(DegToRad(u))) * Sin(DegToRad(v))
m = r3 * Sin(DegToRad(u))
n = (r2 * Cos(DegToRad(u))) * Cos(DegToRad(v))
iPoint(100 + l, -30 + m, 100 + n)
pen=1
Next
pen=0
Next
For v=0 To 180 Step 20
For u=0 To 360 Step 20
l = (r1 * Cos(DegToRad(u))) * Sin(DegToRad(v))
m = r3 * Sin(DegToRad(u))
n = r2 * Cos(DegToRad(u)) * Cos(DegToRad(v))
iPoint(100 + l, -30 + m, 100 + n)
pen=1
Next
pen=0
Next
End Sub


Sub Cylinder(r As Single, l As Single)
Local h, v As Long
pen=0
For h=0 To l Step 10
For v=0 To 360 Step 20
iPoint(120+r*Cos(DegToRad(v)), -100+h, -120+r*Sin(DegToRad(v)))
pen=1
Next
pen=0
Next
For v=0 To 360 Step 20
For h=0 To l Step 10
iPoint(120+r*Cos(DegToRad(v)), -100+h, -120+r*Sin(DegToRad(v)))
pen=1
Next
pen=0
Next
End Sub


Sub Sphere(r As Single)
Local u, v, l, m, n As Single
pen=0
For u=0 To 360 Step 20
For v=0 To 180 Step 20
l = (r * Cos(DegToRad(u))) * Sin(DegToRad(v))
m = r * Sin(DegToRad(u))
n = (r * Cos(DegToRad(u))) * Cos(DegToRad(v))
iPoint(-120 + l, -100 + m, 120 + n)
pen=1
Next
pen=0
Next
For v=0 To 180 Step 20
For u=0 To 360 Step 20
l = (r * Cos(DegToRad(u))) * Sin(DegToRad(v))
m = r * Sin(DegToRad(u))
n = (r * Cos(DegToRad(u))) * Cos(DegToRad(v))
iPoint(-120 + l, -100 + m, 120 + n)
pen=1
Next
pen=0
Next
End Sub


Canvas_Clear 0
While IsWindow(hwnd) And KeyDown(27)=0
Sphere(40)
Cone(40, 70)
Cylinder(30, 90)
Ellipsoid(60, 40, 25)
DrawText 250,20,"3D TEST", Rgb(255,255,255)
Canvas_Redraw
Sleep 10
Wend
Canvas_Window End

peter
29-11-2013, 15:56
I am missing:

CANVAS_GETWIDTH
CANVAS_GETHEIGHT

Petr Schreiber
29-11-2013, 21:38
You can extract these two parameters using:


Canvas_BitmapGet(width, height)



Petr

peter
29-11-2013, 23:48
Thank you.