LED Scanner

[neil]

I just came up with an LED scanner.

Code: Select all

' LED Scanner by neil
WindowTitle "LED SCANNER"

Screenres 542,80
Dim As String key
Dim As Short i
Dim AS UByte c

c = 11 'color

Sub Ers
Dim As short j,speed
speed = 80

Sleep speed,1
ScreenLock
Cls
for j = 40 to 502 step 42
Circle(j,40),15,7
next
ScreenUnlock
End Sub

Do
for i = 40 to 502 step 42
Circle(i,40),15,c,,,,f
Ers
next

for i = 460 to 82 step -42
Circle(i,40),15,c,,,,f
Ers
next
key = Inkey
loop Until (key = Chr(27)) Or (key = Chr(255) & "k")
End

Here's an animated circle.

Code: Select all

'animated circle by neil

screenres 542,80
Dim As String key
Dim Shared As Short i
Dim AS UByte c

'color
c = 12

Declare Sub delay(ByVal amt As Single, ByVal thr As Ulong = 1 * 2)
Sub delay(ByVal amt As Single, ByVal thr As Ulong)
    Dim As Double t1 = Timer
    Dim As Double t2 = t1 + amt / 1000
    If amt > thr + 0.5 Then Sleep amt - thr, 1
    Do
    Loop Until Timer >= t2
End Sub

Do

for i = 40 to 502
ScreenLock
Cls
Circle(i,40),15,c,,,,f
ScreenUnlock
delay 2
next

for i = 502 to 40 step -1
ScreenLock
Cls
Circle(i,40),15,c,,,,f
ScreenUnlock
delay 2
next

key = Inkey
loop Until (key = Chr(27)) Or (key = Chr(255) & "k")
End

[David Watson]

Knight Rider style

Code: Select all

dim as short		c, dotx(31), i, x, z
dim as string		k

screenres 542, 80, 32

do
	for i = 40 to 964 step 2
		screenlock

		if i < 502 then x = i else x = 1004 - i

		for z = 0 to 30
			dotx(z) = dotx(z + 1)
		next z

		dotx(31) = x

		cls

		for z = 0 to 31
			c = 38 + z * 7
			circle (dotx(z), 40), 15, c shl 16, , , , f
		next z

		screenunlock
		sleep 3

		k = inkey
		if k = chr(27) or k = chr(255) + "k" then end
	next i
loop

[neil]

@David Watson Nice KITT car scanner.

[neil]

Here's an LED in a square.

Code: Select all

' LED in a square by neil

Screenres 720,720,8
Dim As String key
Dim As Short i
Dim Shared AS UByte c
c = 14   'color

Sub Ers
Dim As short j
Sleep 40,1
ScreenLock
Cls
for j = 40 to 670 step 42
Circle(j,40),15,7
next
for j = 40 to 670 step 42
Circle(670,j),15,7
next
for j = 40 to 670 step 42
Circle(40,j),15,7
next
for j = 40 to 628 step 42
Circle(j,670),15,7
next
ScreenUnlock
End Sub
Ers

Do
for i = 40 to 628 step 42
Circle(i,40),15,c,,,,f
Ers
next
for i = 40 to 670 step 42
Circle(670,i),15,c,,,,f
Ers
next
for i = 628 to 82 step -42
Circle(i,670),15,c,,,,f
Ers
next
for i = 670 to 82 step -42
Circle(40,i),15,c,,,,f
Ers
next

key = Inkey
loop Until (key = Chr(27)) Or (key = Chr(255) & "k")
End

[neil]

Here's another demo this looks more like LED lights. Adjust the 2 delays to slow it down.

Code: Select all

' three LED's by neil
Dim As Ubyte r, Red, Green, Blue,cnt,Achan
Dim As ULong i,x,y
ScreenRes 715,85,32
setmouse 0,0,0

Declare Sub delay(ByVal amt As Single, ByVal thr As Ulong = 2)
Sub delay(ByVal amt As Single, ByVal thr As Ulong)
    Dim As Double t1 = Timer
    Dim As Double t2 = t1 + amt / 1000
    If amt > thr + 0.5 Then Sleep amt - thr, 1
    Do
    Loop Until Timer >= t2
End Sub

Dim As String key
Dim As Any Ptr DrwLed = ImageCreate( 64, 64,RGB(0, 0, 0)) 

x = 32: y = 32:Achan = 255
Red = 255:Green = 0:blue = 0:r = 26

FOR cnt = 1 TO r
  CIRCLE DrwLed, (x, y ),cnt, RGBA(Red, Green, Blue,Achan)
  CIRCLE DrwLed, (x, y + 1), cnt, RGBA(Red, Green, Blue,Achan)
  red = red - 8
next
Cls

Do
x = 5 :y = 10
for i = 1 to 525
 screenlock
 Put (X, Y), DrwLed,Alpha:put (X + 58, Y), DrwLed,Alpha:put (X + 116, Y), DrwLed,Alpha
 x += 1
 screenunlock
 delay 2
 key = inkey
 if (key = Chr(27)) Or (key = Chr(255) & "k") then ImageDestroy DrwLed:end
next
 
for i = 1 to 525
 screenlock
 Put (X, Y), DrwLed,Alpha:Put (X + 58, Y), DrwLed,Alpha:put (X + 116, Y), DrwLed,Alpha
 x -= 1
 screenunlock
 delay 2
 key = inkey
 if (key = Chr(27)) Or (key = Chr(255) & "k") then ImageDestroy DrwLed:end
 next

Loop

[neil]

Another demo six flashing LED's.

Code: Select all

' six flashing LED's by neil
Dim As String key
Dim As Ubyte r, Red, Green, Blue,cnt,Achan
Dim As ULong i,x,y
ScreenRes 400,85,32
setmouse 0,0,0

Declare Sub delay(ByVal amt As Single, ByVal thr As Ulong = 2)
Sub delay(ByVal amt As Single, ByVal thr As Ulong)
    Dim As Double t1 = Timer
    Dim As Double t2 = t1 + amt / 1000
    If amt > thr + 0.5 Then Sleep amt - thr, 1
    Do
    Loop Until Timer >= t2
End Sub

Dim As Any Ptr DrwLed = ImageCreate( 64, 64,RGB(0, 0, 0)) 
Dim As Any Ptr ErsLed = ImageCreate( 64, 64,RGB(0, 0, 0))

x = 32: y = 32:Achan = 255
Red = 0:Green =255:blue = 0:r = 26

FOR cnt = 1 TO r
  CIRCLE ErsLed, (x, y ),cnt, RGBA(0, 0, 0,Achan)
  CIRCLE ErsLed, (x, y + 1), cnt, RGBA(0, 0, 0,Achan)
next

FOR cnt = 1 TO r
  CIRCLE DrwLed, (x, y ),cnt, RGBA(0, green, 0,Achan)
  CIRCLE DrwLed, (x, y + 1), cnt, RGBA(0, green, 0,Achan)
green -= 8
next

x = 5 :y = 10

Do 

delay 200
Put (X, Y), DrwLed,Alpha:Put (X + 64, Y), DrwLed,Alpha:Put (X + 128, Y), DrwLed,Alpha
Put (X + 192, Y), DrwLed,Alpha:Put (X + 256, Y), DrwLed,Alpha:Put (X + 320, Y), DrwLed,Alpha
delay 200
Put (X, Y), ErsLed,Alpha:Put (X + 64, Y), ErsLed,Alpha:Put (X + 128, Y), ErsLed,Alpha
Put (X + 192, Y), ErsLed,Alpha:Put (X + 256, Y), ErsLed,Alpha:Put (X + 320, Y), ErsLed,Alpha

key = inkey
if (key = Chr(27)) Or (key = Chr(255) & "k") Then
 ImageDestroy ErsLed
 ImageDestroy DrwLed
 End
End If
Loop