- Code: Tout sélectionner
' *****************************
' 3D BOUNCING BALLS
' Original QB64 code by harixxx
' GFW code by Fantomas
' *****************************
'
obj% = 16 ' ball count
DIM bd%(9, obj%) ' ball array dimensions
FOR i = 1 TO obj% ' Generate ball positions
FOR j = 0 TO 2
bd%(j, i) = RND * 300 - 100
bd%(j + 3, i) = RND * 6 + 2
NEXT j
NEXT i
OPENW #1,(_X / 2) - 320,(_Y / 2) - 240,640,500,80
TITLEW #1, " 3D Bouncing Balls"
'
Hscreen1& = CREATEBMP(640,480)
Hsc1& = MEMDC(_DC(1))
SETBMP Hsc1&,Hscreen1&
SETDC Hsc1&
DEFFILL 0
'
DO
' Background
FOR i = 0 TO 100 STEP 5
j = 220 - i * 2
RGBCOLOR RGB(j / 3,j / 3,j)
PBOX i,i,640 - i,480 - i
NEXT i
' Record old ball positions
FOR i = 1 TO obj%
k = bd%(2, i) / 800 + 1
FOR j = 6 TO 9
bd%(j, i) = bd%(j - 6, i) / k * -(j = 6 OR j = 7) + bd%(2, i) * -(j = 8) + 200 / k * -(j = 9)
NEXT j
NEXT i
' Sorting ball positions
FOR i = 1 TO obj% - 1
FOR j = i + 1 TO obj%
IF bd%(8, i) < bd%(8, j)
FOR k = 6 TO 9
SWAP bd%(k,i),bd%(k,j)
NEXT k
ENDIF
NEXT j
NEXT i
' Draw balls shadow
FOR i = 1 TO obj%
r = (256 - bd%(8, i)) / 40 * ((bd%(7, i) / 100 + 1) / 3 * 4)
x = bd%(6, i) + 320
y = bd%(9, i) + r + 240 - r / 128 * 20
k = 240 - (bd%(8, i) / 100 + 1) / 3 * 200
FOR j = 0 TO r STEP .25
RGBCOLOR RGB(k / 4, k / 4, k)
PELLIPSE x,y,j,j / 2 ' CIRCLE in QB64 version, better with PELLIPSE !
NEXT j
NEXT i
' Draw balls
FOR i = 1 TO obj%
x = bd%(6, i) + 320
y = bd%(7, i) + 240
r = (256 - bd%(8, i)) / 10
r = 6 * -(r < 6) + r * -(r >= 6)
s = r / 10 * 255
FOR j = 0 TO r STEP .25
k = s - j / r * (s / 1.2)
RGBCOLOR RGB(100 + k, 100 + k / 2, 0)
PCIRCLE x, y, j
NEXT j
NEXT i
' Set balls moving
FOR i = 1 TO obj%
xd = bd%(3, i)
yd = bd%(4, i)
zd = bd%(5, i)
x = bd%(0, i) + xd
y = bd%(1, i) + yd
z = bd%(2, i) + zd
yd = yd + 1
xd = (xd - 1) * -(xd > 8) + (xd + 1) * -(xd < -8) + xd * -(ABS(xd) <= 8)
zd = (zd - 1) * -(zd > 8) + (zd + 1) * -(zd < -8) + zd * -(ABS(zd) <= 8)
yd = -(yd = 0) + 20 * -(yd > 20) + yd * -(yd <> 0 AND yd <= 20)
IF ABS(x) > 275
xd = -xd
x = 275 * -(x > 0) - 275 * -(x < 0)
ENDIF
IF ABS(y) > 200
yd = -yd
y = y * -(y > 0) - 200 * -(y < 0)
ENDIF
IF ABS(z - 125) > 175
zd = -zd
z = 300 * -(z > 300) - 50 * -(z < -50)
ENDIF
IF y > 200
y = 200
yd = (yd + 6) * -(yd < 0) + yd * -(yd >= 0)
ENDIF
IF i < obj%
FOR j = i + 1 TO obj%
dx = x - bd%(0, j)
dy = y - bd%(1, j)
dz = z - bd%(2, j)
' Set bouncing speed
d = SQR(dx ^ 2 + dy ^ 2 + dz ^ 2) / 10
IF d < 5
xd = xd + dx / d
yd = yd + dy / d
zd = zd + dz / d
bd%(3, j) = bd%(3, j) - dx / d
bd%(4, j) = bd%(4, j) - dy / d - RND * 16
bd%(5, j) = bd%(5, j) - dz / d
ENDIF
NEXT j
ENDIF
bd%(0, i) = x
bd%(1, i) = y
bd%(2, i) = z
bd%(3, i) = xd
bd%(4, i) = yd
bd%(5, i) = zd
NEXT i
' Display
BITBLT Hsc1&,0,0,640,480,_DC(1),0,0,SRCCOPY
' Any key to logout
LOOP UNTIL INKEY$ > ""
CLOSEW #1
Fantomas
On n'en voit qu'une petite partie mais on peut scroller pour voir le reste...