03-19-2005, 03:34 AM
Code:
option explicit
declare sub DrawClock()
declare sub ShakeDots()
declare sub SetValues()
const ScreenWidth = 800
const ScreenHeight = 600
const Columns = 9
const Rows = 5
const X = 0
const Y = 1
const X_Offset = 2
const Y_Offset = 3
const Visible = 4
const bcFALSE = 0
const bcTRUE = NOT(bcFalse)
const ShowTime = bcFALSE
'const ShowTime = bcTRUE
'Less than 255, the lower the darker
const OffLevel = 55
'Simulates a weak power supply, the higher the more the LEDs
'fade out
const FadeAmount = .005
'The amount of rest between shakes
const CyclePause = 10
'The random color offset value 255 or less
const RColor = 150
Randomize Timer
dim i as integer
dim j as integer
dim k as single
dim l as single
dim shared DC (Columns, Rows, 5) as single
dim shared Radius as single
dim shared XRandFactor as single
dim shared YRandFactor as single
k = ScreenWidth / (Columns + 1)
l = ScreenHeight / (Rows + 1)
'Play with this to make the dots bigger or smaller
Radius = k/3
'How far out of the orbit the LED's will shake
XRandFactor = Radius / 5
YRandFactor = Radius / 5
'Set-up the grid
for i = 0 to Columns
for j = 0 to Rows
DC (i,j,X) = k * (i + 0.5)
DC (i,j,Y) = l * (j + 0.5)
DC (i,j,X_Offset) = 0
DC (i,j,Y_Offset) = 0
DC (i,j,Visible) = 0
next j
next i
'if you change this, change the screenwidth and screenheight const above
'800x600 32bit color, 2 pages, full screen
screen 19, 32, 2, 1
color rgb(255,255,255),rgb(0,0,0)
'Work on Screen 1, display screen 0
SCREENSET 1, 0
'It will keep going till you say otherwise
do while inkey$=""
cls
ShakeDots
SetValues
DrawClock
screencopy
sleep CyclePause
loop
end
sub SetValues()
static tTime as string
static h as integer
static m as integer
static s as integer
dim i as integer
dim j as integer
if ShowTime = bcTRUE then
locate 1,1
? time$ 'h;":";m;":";s you could play with these to make your own output
end if
if tTime = time$ then
'just fade them a bit
for i = 0 to columns
for j = 0 to rows
if DC (i,j,Visible) <> 0 then DC (i,j,Visible) -= FadeAmount
next j
next i
else
dim h1 as integer
dim m1 as integer
dim s1 as integer
dim s2 as integer
dim m2 as integer
dim h2 as integer
dim fColon as integer
dim sColon as integer
dim Length as integer
dim bS as string
dim bS1 as string
dim bM as string
dim bM1 as string
dim bH as string
dim bH1 as string
tTime = time$
Length = len(tTime)
fColon = instr(1,tTime,":")
sColon = instr(fColon+1,tTime,":")
h = int(val(left$(tTime,fColon - 1)))
m = int(val(mid$(tTime,fColon+1,sColon-fColon-1)))
s = int(val(right$(tTime,Length-sColon)))
if h > 12 then h -= 12
h1 = int(h\10)
m1 = int(m\10)
s1 = int(s\10)
h2 = h mod 10
m2 = m mod 10
s2 = s mod 10
bS = right$(String$(4,"0") + bin$(s2),4)
bS1 = right$(String$(4,"0") + bin$(s1),4)
bM = right$(String$(4,"0") + bin$(m2),4)
bM1 = right$(String$(4,"0") + bin$(m1),4)
bH = right$(String$(4,"0") + bin$(h2),4)
bH1 = right$(String$(4,"0") + bin$(h1),4)
for i = 1 to 4
if mid$(Bs,i,1) = "1" then dc(8,i,Visible) = 10 else dc(8,i,Visible) = -1
if mid$(Bs1,i,1) = "1" then dc(7,i,Visible) = 10 else dc(7,i,Visible) = -1
if mid$(Bm,i,1) = "1" then dc(5,i,Visible) = 10 else dc(5,i,Visible) = -1
if mid$(Bm1,i,1) = "1" then dc(4,i,Visible) = 10 else dc(4,i,Visible) = -1
if mid$(Bh,i,1) = "1" then dc(2,i,Visible) = 10 else dc(2,i,Visible) = -1
if mid$(Bh1,i,1) = "1" then dc(1,i,Visible) = 10 else dc(1,i,Visible) = -1
next i
end if
end sub
sub ShakeDots()
dim i as integer
dim j as integer
for i = 0 to Columns
for j = 0 to Rows
if dc(i,j,Visible) then
dc(i,j,x_offset) = ((-1)^int(rnd + .5) + 1) * rnd*XRandFactor
dc(i,j,y_offset) = ((-1)^int(rnd + .5) + 1) * rnd*YRandFactor
end if
next j
next i
end sub
sub DrawClock()
dim i as integer
dim j as integer
for i = 1 to 2
for j = 1 to Rows-1
if dc(i,j,visible) > 0 then
circle (dc(i,j,x)+ dc(i,j,x_offset),dc(i,j,y) + dc(i,j,y_offset)),radius, rgb(255 / (11-dc(i,j,visible)),int(rnd*RColor) / (11-dc(i,j,visible)),0),,,,F
else
circle (dc(i,j,x),dc(i,j,y)),radius, rgb(OffLevel,0,0),,,,F
end if
next j
next i
for i = 4 to 5
for j = 1 to Rows-1
if dc(i,j,visible) > 0 then
circle (dc(i,j,x)+ dc(i,j,x_offset),dc(i,j,y) + dc(i,j,y_offset)),radius, rgb(0,255 / (11-dc(i,j,visible)),int(rnd*RColor)/ (11-dc(i,j,visible))),,,,F
else
circle (dc(i,j,x),dc(i,j,y)),radius, rgb(0,OffLevel,0),,,,F
end if
next j
next i
for i = 7 to 8
for j = 1 to Rows-1
if dc(i,j,visible) > 0 then
circle (dc(i,j,x)+ dc(i,j,x_offset),dc(i,j,y) + dc(i,j,y_offset)),radius, rgb(int(rnd*RColor)/ (11-dc(i,j,visible)),0,255 / (11-dc(i,j,visible))),,,,F
else
circle (dc(i,j,x),dc(i,j,y)),radius, rgb(0,0,OffLevel),,,,F
end if
next j
next i
end sub
Man, I need to get a hobby :bounce: