Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
3DRender - more Polygontest
| Uploader: |  AndT |
| Datum/Zeit: | 05.12.2007 18:51:21 |
'Very Simple 3D-Rendering
'Programmed by AndT
'WITHOUT ASM, SCREENLOCK, SCREENSYNC, CLS and more
'This use only LINE ;)
'Simple Programmed, but Fast ;)
'Use the Mouse to Control and ESC to Exit
Type XYObj
X as double
Y as double
end type
Type XYZObj
X as double
Y as double
Z as double
end type
Type IntObj
X as Integer
Y AS INTEGER
end type
SUB Quad(BYVAL ax AS DOUBLE,BYVAL ay AS DOUBLE,BYVAL az AS DOUBLE,BYVAL col AS INTEGER)
LINE (ax,ay)-(ax+az,ay+az),col,bf
END SUB
DIm as String Taste
Dim as XYZObj Cam1
DIM AS IntObj Mouse
DIM AS IntObj Omouse
Dim as XYObj ScrRes = (1024,768) ' For SCREENRES (Set higher and the speed don't go slower ;)
Dim as XYObj ScrResHalf = (ScrRes.X/2,ScrRes.Y/2)
DIm as XYZObj Obj1 = (ScrResHalf.X,ScrResHalf.Y,100) 'XY for Obj1
DIM AS XYObj tst
dim as integer ms,dummy,mb
Screenres ScrRes.X,ScrRes.Y
setmouse ,,0
setmouse ScrResHalf.X,ScrResHalf.Y
'mouseblock=1
DO
getmouse Mouse.X,Mouse.Y,ms
tst.X=Mouse.X-ScrResHalF.X
tst.Y=Mouse.Y-ScrResHalF.Y
' this removes some Bugs..
if ms > -1 then
cam1.X+=tst.X
cam1.Y+=tst.Y
else
setmouse ,,1
locate 2,2:Print "Click in the Window to run it.."
Do
getmouse dummy,dummy,ms,mb
sleep 1
Loop until ms>-1
locate 2,2:Print " "
setmouse ,,0
end if
Quad(obj1.x+cam1.x/2,obj1.y+cam1.y/2,obj1.Z/2,20)
Quad(100+obj1.x+cam1.x/2,obj1.y+cam1.y/2,obj1.Z/2,20)
Line (obj1.x+cam1.x,obj1.y+cam1.y)-(obj1.x+cam1.x/2,obj1.y+cam1.y/2),23
Line (obj1.x+cam1.x+obj1.z,obj1.y+cam1.y)-(obj1.x+obj1.z/2+cam1.x/2,obj1.y+cam1.y/2),23
Line (obj1.x+cam1.x+obj1.z,obj1.y+cam1.y+obj1.z)-(obj1.x+obj1.z/2+cam1.x/2,obj1.y+obj1.z/2+cam1.y/2),23
Line (obj1.x+cam1.x ,obj1.y+cam1.y+obj1.z)-(obj1.x+cam1.x/2,obj1.y+obj1.z/2+cam1.y/2),23
Line (100+obj1.x+cam1.x,obj1.y+cam1.y)-(100+obj1.x+cam1.x/2,obj1.y+cam1.y/2),23
Line (100+obj1.x+cam1.x+obj1.z,obj1.y+cam1.y)-(100+obj1.x+obj1.z/2+cam1.x/2,obj1.y+cam1.y/2),23
Line (100+obj1.x+cam1.x+obj1.z,obj1.y+cam1.y+obj1.z)-(100+obj1.x+obj1.z/2+cam1.x/2,obj1.y+obj1.z/2+cam1.y/2),23
Line (100+obj1.x+cam1.x ,obj1.y+cam1.y+obj1.z)-(100+obj1.x+cam1.x/2,obj1.y+obj1.z/2+cam1.y/2),23
Quad(100+obj1.x+cam1.x,obj1.y+cam1.y,obj1.Z,25)
Quad(obj1.x+cam1.x,obj1.y+cam1.y,obj1.Z,25)
setmouse ScrResHalf.X,ScrResHalf.Y
sleep 2,1 'Needed!
'make the object black
Quad(obj1.x+cam1.x/2,obj1.y+cam1.y/2,obj1.Z/2,0)
Quad(100+obj1.x+cam1.x/2,obj1.y+cam1.y/2,obj1.Z/2,0)
Line (obj1.x+cam1.x,obj1.y+cam1.y)-(obj1.x+cam1.x/2,obj1.y+cam1.y/2),0
Line (obj1.x+cam1.x+obj1.z,obj1.y+cam1.y+obj1.z)-(obj1.x+obj1.z/2+cam1.x/2,obj1.y+obj1.z/2+cam1.y/2),0
Line (obj1.x+cam1.x+obj1.z,obj1.y+cam1.y)-(obj1.x+obj1.z/2+cam1.x/2,obj1.y+cam1.y/2),0
Line (obj1.x+cam1.x ,obj1.y+cam1.y+obj1.z)-(obj1.x+cam1.x/2,obj1.y+obj1.z/2+cam1.y/2),0
Line (100+obj1.x+cam1.x,obj1.y+cam1.y)-(100+obj1.x+cam1.x/2,obj1.y+cam1.y/2),0
Line (100+obj1.x+cam1.x+obj1.z,obj1.y+cam1.y)-(100+obj1.x+obj1.z/2+cam1.x/2,obj1.y+cam1.y/2),0
Line (100+obj1.x+cam1.x+obj1.z,obj1.y+cam1.y+obj1.z)-(100+obj1.x+obj1.z/2+cam1.x/2,obj1.y+obj1.z/2+cam1.y/2),0
Line (100+obj1.x+cam1.x ,obj1.y+cam1.y+obj1.z)-(100+obj1.x+cam1.x/2,obj1.y+obj1.z/2+cam1.y/2),0
Quad(100+obj1.x+cam1.x,obj1.y+cam1.y,obj1.Z,0)
Quad(obj1.x+cam1.x,obj1.y+cam1.y,obj1.Z,0)
LOOP until multikey(&h01)