Code:
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Const ABC = " ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!?&<>\/()*+-$^~., "
Private Type tText
Active As Boolean
ActiveTime As Long
Text As String
Effect As Long
Mode As Long
X As Long
Y As Long
R As Single
G As Single
B As Single
DstR As Byte
DstG As Byte
DstB As Byte
SpeedR As Single
SpeedG As Single
SpeedB As Single
End Type
Dim TextCount As Long
Dim Text() As tText
Dim Window As Form
Dim BackDC As Long
Dim CanContinue As Boolean
Function Add(iText As String, iX As Long, iY As Long, iMode As Long, Optional iStartTime As Long = 0) As Long
TextCount = TextCount + 1
With Text(TextCount)
.Text = iText
.X = iX
.Y = iY
.ActiveTime = GetTickCount + iStartTime
End With
SetMode TextCount, iMode
Add = TextCount
End Function
Sub AddText(iText As String, iX As Long, iY As Long, iMode As Long, iStartTime As Long, iDelay As Long)
Dim A As Long
Dim Temp As Long
Dim Timer As Long
Timer = GetTickCount
For A = 0 To Len(iText) - 1
Temp = Add(Mid(iText, A + 1, 1), iX + A * 8, iY, iMode)
Text(Temp).ActiveTime = Timer + iStartTime + A * iDelay
Next
End Sub
Sub Draw()
Dim A As Long
Window.ForeColor = Window.BackColor
For A = 0 To TextCount
With Text(A)
TextOut BackDC, .X, .Y, .Text, Len(.Text)
End With
Next
For A = 0 To TextCount
With Text(A)
If .Active Then
Window.ForeColor = RGB(.R, .G, .B)
TextOut BackDC, .X, .Y, .Text, Len(.Text)
End If
End With
Next
Window.Refresh
End Sub
Sub Animate()
Dim A As Long
Dim Temp As Byte
Dim Timer As Long
Timer = GetTickCount
For A = 0 To TextCount
With Text(A)
If .ActiveTime < Timer Then
.Active = True
Temp = True
If .R > .DstR Then
.R = .R - .SpeedR
If .R < .DstR Then: .R = .DstR
Temp = False
ElseIf .R < .DstR Then
.R = .R + .SpeedR
If .R > .DstR Then: .R = .DstR
Temp = False
End If
If .G > .DstG Then
.G = .G - .SpeedG
If .G < .DstG Then: .G = .DstG
Temp = False
ElseIf .G < .DstG Then
.G = .G + .SpeedG
If .G > .DstG Then: .G = .DstG
Temp = False
End If
If .B > .DstB Then
.B = .B - .SpeedB
If .B < .DstB Then: .B = .DstB
Temp = False
ElseIf .B < .DstB Then
.B = .B + .SpeedB
If .B > .DstB Then: .B = .DstB
Temp = False
End If
If Temp Then: SetMode A, .Mode + 1
End If
End With
Next
End Sub
Sub Main()
Dim NextTick As Long
While DoEvents
If NextTick < GetTickCount Then
NextTick = GetTickCount + 25
Draw
Animate
End If
Wend
End Sub
Sub RemoveText(iText As Long)
Window.ForeColor = Window.BackColor
With Text(iText)
TextOut BackDC, .X, .Y, .Text, Len(.Text)
End With
Text(iText) = Text(TextCount)
TextCount = TextCount - 1
End Sub
Sub SetColor(iText As Long, iR As Byte, iG As Byte, iB As Byte, iFrames As Long)
With Text(iText)
.DstR = iR
.DstG = iG
.DstB = iB
.SpeedR = (.DstR - .R) / iFrames * IIf((.DstR - .R) > 0, 1, -1)
.SpeedG = (.DstG - .G) / iFrames * IIf((.DstG - .G) > 0, 1, -1)
.SpeedB = (.DstB - .B) / iFrames * IIf((.DstB - .B) > 0, 1, -1)
End With
End Sub
Sub SetMode(iText As Long, iMode As Long)
With Text(iText)
.Mode = iMode
Select Case iMode
Case 0
SetColor iText, 0, 0, 0, 1
Case 1
SetColor iText, 255, 255, 255, 5
Case 2
SetColor iText, 0, 255, 0, 10
Case 3
.Mode = 2
Case 4
SetColor iText, 255, 255, 255, 5
Case 5
SetColor iText, 63, 63, 255, 10
Case 6
.Mode = 5
Case 7
SetColor iText, 255, 255, 255, 5
Case 8
SetColor iText, 255, 0, 0, 10
Case 9
Text(iText).ActiveTime = GetTickCount + 1000
SetColor iText, 0, 0, 0, 1
Case 10
Text(iText).ActiveTime = GetTickCount + 500
SetColor iText, 255, 0, 0, 1
Case 11
Text(iText).ActiveTime = GetTickCount + 1000
SetColor iText, 0, 0, 0, 1
Case 12
Text(iText).ActiveTime = GetTickCount + 500
SetColor iText, 255, 0, 0, 1
Case 13
Text(iText).ActiveTime = GetTickCount + 1000
SetColor iText, 0, 0, 0, 1
Case 14
Text(iText).ActiveTime = GetTickCount + 500
SetColor iText, 255, 0, 0, 1
Case 17
SetColor iText, 255, 255, 255, 5
Case 18
SetColor iText, 63, 63, 255, 10
Case 19
Text(iText).ActiveTime = GetTickCount + 2000
Case 20
SetTexts
Case 21
SetColor iText, 255, 255, 255, 10
Case 22
SetColor iText, 63, 63, 255, 10
Case 23
SetColor iText, 255, 255, 255, 10
Case 24
.Mode = 21
Case 30
SetColor iText, 255 * Rnd, 0, 0, 10
.Mode = 29
Case 32
SetColor iText, 255, 255, 255, 10
Case 33
SetColor iText, 128, 0, 255, 10
Case 34
.Mode = 31
Case 40
SetColor iText, 255, 255, 255, 40
Case 41
SetColor iText, 128, 0, 255, 40
Case 42
SetColor iText, 0, 128, 255, 40
Case 43
.Mode = 40
Case 99
If 100 * Rnd < 20 Then: SetNewText iText, Mid(ABC, (Len(ABC) - 1) * Rnd + 1, 1)
SetColor iText, 255, 255, 255, 4
Case 100
If 100 * Rnd < 20 Then: SetNewText iText, Mid(ABC, (Len(ABC) - 1) * Rnd + 1, 1)
SetColor iText, 0, 255, 0, 20
Case 101
If 100 * Rnd < 20 Then: SetNewText iText, Mid(ABC, (Len(ABC) - 1) * Rnd + 1, 1)
SetColor iText, 0, 0, 0, 50 + 20 * Rnd
Case 102
.Text = Mid(ABC, (Len(ABC) - 1) * Rnd + 1, 1)
.ActiveTime = GetTickCount + 5000 + 5000 * Rnd
.Active = False
.Mode = 98
Case Else
RemoveText iText
End Select
End With
End Sub
Sub SetNewText(iText As Long, iNewText As String)
With Text(iText)
Window.ForeColor = Window.BackColor
TextOut BackDC, .X, .Y, .Text, Len(.Text)
.Text = iNewText
End With
End Sub
Sub SetTexts()
Dim A As Long
For A = 0 To TextCount
With Text(A)
.R = 0
.G = 0
.B = 0
End With
Next
TextCount = -1
With Window
.Cls
.Caption = "WELCOME BACK !!!"
BackDC = .hdc
End With
AddText " | |", 300, 285 + 1, 40, 4500, 200
AddText "Batman", 40 + 14 * 8, 40, 21, 100 + 40 * 14, 40
AddText " / \ A / \", 300, 252 + 10, 40, 4500, 200
AddText "BAT-O-RAMA !!!", 40, 240, 30, 2700, 40
AddText " A A", 300, 250, 40, 4500, 200
AddText " | ___ |", 300, 309 + 1, 40, 4500, 200
AddText " V V", 300, 345, 40, 4500, 200
AddText "Welcome back, !", 40, 40, 1, 100, 40
AddText "You are the best!", 40, 180, 1, 1400, 40
AddText " / \/ \/ \", 300, 274, 40, 4500, 200
AddText "I hope you dont leave us again!!!", 40, 120, 1, 1000, 40
AddText "BAT-O-RAMA !!!", 40, 220, 30, 2500, 40
AddText " \ / \ /", 300, 330, 40, 4500, 200
AddText "BAT-O-RAMA !!!", 40, 260, 30, 2900, 40
AddText "Bat Fox", 348, 300, 32, 4500, 700
AddText "We LOVE you!", 40, 140, 1, 1100, 40
AddText "We NEED you!", 40, 160, 1, 1200, 40
AddText " ( )", 300, 298, 40, 4500, 200
Add "Press [Enter] to continue", 50, Me.ScaleHeight - 40, 32, 11000
CanContinue = True
End Sub
Sub SetMatrix()
Dim A As Long
Dim B As Long
For A = 0 To TextCount
With Text(A)
.R = 0
.G = 0
.B = 0
End With
Next
TextCount = -1
Me.Cls
Me.Caption = "You can now exit if you want"
BackDC = Window.hdc
For A = 0 To Me.ScaleHeight / 12
For B = 0 To Window.ScaleWidth / 8
Add Mid(ABC, (Len(ABC) - 1) * Rnd + 1, 1), B * 8, A * 12, 99, 40000 * Rnd
Next
Next
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If CanContinue Then
SetMatrix
End If
End If
End Sub
Private Sub Form_Load()
Set Window = Me
Randomize
TextCount = -1
ReDim Text(10000)
With Window
.Width = 500 * Screen.TwipsPerPixelX
.Height = 400 * Screen.TwipsPerPixelY
.Move (Screen.Width - .Width) / 2, (Screen.Height - .Height) / 2
.AutoRedraw = True
.ScaleMode = 3
.Show
.Font = "Fixedsys"
.BackColor = 0
BackDC = .hdc
.Caption = "Database"
End With
Add "[Initializing ]", 40, 30, 1, 1000
Add "Missed", 180, 140, 7, 13000
AddText "!!!", 180 + 5 * 8, 140, 17, 20500, 300
AddText "...", 40 + 13 * 8, 30, 1, 1100, 300
Add "[Connecting ]", 40, 50, 1, 2700
AddText "Ready", 180, 140, 4, 19000, 30
Add "[Done]", 40, 70, 4, 5000
AddText "> Subject :", 40, 100, 1, 6000, 20
AddText "Batman", 180, 100, 1, 7000, 20
AddText "Dark Knight of Gotham City", 180, 120, 1, 9500, 20
AddText "> Status :", 40, 140, 1, 11000, 20
AddText "...", 40 + 11 * 8, 50, 1, 2900, 300
AddText "> Description :", 40, 120, 1, 8500, 20
Main
End Sub
Private Sub Form_Unload(Cancel As Integer)
Erase Text
Unload Window
Set Window = Nothing
End
End Sub
Reply With Quote