Happy birthday, Steve! Have a good one.
- Dav
- Dav
Code: (Select All)
Randomize Timer
Screen _NewImage(800, 600, 32)
For x = 1 To _Width Step 20
For y = 1 To _Height Step 20
Line (x, y)-Step(20, 20), _RGBA(Rnd * 255, Rnd * 255, Rnd * 255, 155), BF
Next
Next
Play "MBO2L4G8G8AG>C<B2G8G8AG>DC2<G8G8>GEC<BA2>P8F8F8ECDC2"
m$ = "HAPPY"
x = 200
For l = 1 To Len(m$)
size = 64 + Int(Rnd * 50)
letter& = _NewImage(size, size, 32)
_Dest letter&
clr& = _RGB(100 + Rnd * 155, 100 + Rnd * 155, 100 + Rnd * 155)
PPRINT Int(size / 2), 1, size, clr&, 0, Mid$(m$, l, 1)
_Dest 0
UnExplodeImage x, 100, letter&
PPRINT x + (size / 2) + 4, 104, size, _RGB(255, 255, 255), 0, Mid$(m$, l, 1)
PPRINT x + (size / 2), 100, size, clr&, 0, Mid$(m$, l, 1)
_FreeImage letter&
x = x + size
Next
m$ = "BIRTHDAY"
x = 50
For l = 1 To Len(m$)
size = 64 + Int(Rnd * 50)
letter& = _NewImage(size, size, 32)
_Dest letter&
clr& = _RGB(100 + Rnd * 155, 100 + Rnd * 155, 100 + Rnd * 155)
PPRINT Int(size / 2), 1, size, clr&, 0, Mid$(m$, l, 1)
_Dest 0
UnExplodeImage x, 250, letter&
PPRINT x + (size / 2) + 4, 254, size, _RGB(255, 255, 255), 0, Mid$(m$, l, 1)
PPRINT x + (size / 2), 250, size, clr&, 0, Mid$(m$, l, 1)
_FreeImage letter&
x = x + size
Next
m$ = "STEVE!"
x = 100
For l = 1 To Len(m$)
size = 64 + Int(Rnd * 64)
letter& = _NewImage(size, size, 32)
_Dest letter&
clr& = _RGB(100 + Rnd * 155, 100 + Rnd * 155, 100 + Rnd * 155)
PPRINT Int(size / 2), 1, size, clr&, 0, Mid$(m$, l, 1)
_Dest 0
UnExplodeImage x, 400, letter&
PPRINT x + (size / 2) + 4, 404, size, _RGB(255, 255, 255), 0, Mid$(m$, l, 1)
PPRINT x + (size / 2), 400, size, clr&, 0, Mid$(m$, l, 1)
_FreeImage letter&
x = x + size
Next
_Delay 1
back& = _CopyImage(_Display)
ExplodeScreen back&
_FreeImage back&
End
Sub UnExplodeImage (x, y, image&)
back& = _CopyImage(_Display)
pixels& = _Width(image&) * _Height(image&)
ReDim PixX(pixels&), PixY(pixels&)
ReDim PixXDir(pixels&), PixYDir(pixels&)
ReDim PixClr&(pixels&)
_Source image&
pix& = 0
For x2 = 0 To _Width(image&) - 1
For y2 = 0 To _Height(image&) - 1
PixClr&(pix&) = Point(x2, y2)
PixX(pix&) = x + x2
PixY(pix&) = y + y2
Do
PixXDir(pix&) = Rnd * 8 - Rnd * 8
PixYDir(pix&) = Rnd * 8 - Rnd * 8
If PixXDir(pix&) <> 0 And PixYDir(pix&) <> 0 Then Exit Do
Loop
pix& = pix& + 1
Next
Next
_Source 0
alloff& = 0
loopcont = 0
Do
For pix& = 0 To pixels& - 1
PixX(pix&) = PixX(pix&) + PixXDir(pix&)
PixY(pix&) = PixY(pix&) + PixYDir(pix&)
If PixY(pix&) < 0 Or PixY(pix&) > _Height Then
If PixX(pix&) < 0 Or PixX(pix&) > _Width Then
alloff& = alloff& + 1
End If
End If
Next
If alloff& > pixels& - 1 Then Exit Do
loopcount = loopcount + 1
Loop
For a = 0 To loopcount
_PutImage (0, 0), back&
For pix& = pixels& - 1 To 0 Step -1
PixX(pix&) = PixX(pix&) - PixXDir(pix&)
PixY(pix&) = PixY(pix&) - PixYDir(pix&)
Line (PixX(pix&), PixY(pix&))-Step(3, 3), PixClr&(pix&), BF
Next
_Limit 120
_Display
Next
End Sub
Sub ExplodeScreen (img&)
pixels& = _Width(img&) * _Height(img&)
Dim PixX(pixels&), PixY(pixels&)
Dim PixXDir(pixels&), PixYDir(pixels&)
Dim PixClr&(pixels&), PixGro(pixels&)
_Source img&
pix& = 0
For x2 = 0 To _Width(img&) - 1
For y2 = 0 To _Height(img&) - 1
PixClr&(pix&) = Point(x2, y2)
PixX(pix&) = x + x2
PixY(pix&) = y + y2
Do
PixXDir(pix&) = Rnd * 8 - Rnd * 8
PixYDir(pix&) = Rnd * 8 - Rnd * 8
If PixXDir(pix&) <> 0 And PixYDir(pix&) <> 0 Then Exit Do
Loop
If Int(Rnd * 200) = 2 Then
PixGro(pix&) = 2
Else
PixGro(pix&) = 1
End If
pix& = pix& + 1
Next
Next
_Source 0
For alpha = 0 To 225 Step .8
For pix& = 0 To pixels& - 1 Step 8
PixX(pix&) = PixX(pix&) + PixXDir(pix&)
PixY(pix&) = PixY(pix&) + PixYDir(pix&)
If PixX(pix&) > 0 And PixX(pix&) < _Width Then
If PixY(pix&) > 0 And PixY(pix&) < _Height Then
Line (PixX(pix&), PixY(pix&))-Step(PixGro(pix&), PixGro(pix&)), PixClr&(pix&), BF
End If
End If
If PixGro(pix&) > 1 Then
PixGro(pix&) = PixGro(pix&) + .05
If PixGro(pix&) > 10 Then PixGro(pix&) = 10
End If
Next
Line (0, 0)-(_Width, _Height), _RGBA(0, 0, 0, alpha), BF
_Limit 30
_Display
Next
End Sub
Sub PPRINT (x, y, size, clr&, trans&, text$)
orig& = _Dest
bit = 32: If _PixelSize(0) = 1 Then bit = 256
For t = 0 To Len(text$) - 1
pprintimg& = _NewImage(16, 16, bit)
_Dest pprintimg&
Cls , trans&: Color clr&
Print Mid$(text$, t + 1, 1);
_ClearColor _RGB(0, 0, 0), pprintimg&
_Dest orig&
x1 = x + (t * size): x2 = x1 + size
y1 = y: y2 = y + size
_PutImage (x1 - (size / 2), y1)-(x2, y2 + (size / 3)), pprintimg&
_FreeImage pprintimg&
Next
End Sub