|
-
Dec 5th, 2000, 05:08 AM
#1
Thread Starter
PowerPoster
Here's my little present for you!
1. Open a new project in your VB
2. Open the code window and remove then default Form_Load sub
3. Paste the code below
4. Press F5 and enjoy!
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
Hope you'll like it 
Bat Fox, Bat Scout Trooper
-
Dec 5th, 2000, 11:23 AM
#2
New Member
Bat-O-Rama!
Bat-O-Rama!
Bat-O-Rama!
-
Dec 5th, 2000, 01:35 PM
#3
Thread Starter
PowerPoster
That's really nice, too!
I like the colored lines though!
-
Dec 5th, 2000, 03:41 PM
#4
Frenzied Member
WOW  Nice coloring effect fox!
Batman...you really back? (please say yes!)
Bat-O-Rama!
-
Dec 5th, 2000, 04:18 PM
#5
 You boys really do have way too much time on your hands
....Nice effect though Fox. Maybe next time you could use your power for the benefit of mankind.
-
Dec 5th, 2000, 04:30 PM
#6
Thread Starter
PowerPoster
Well... 1 hour of coding isn't that much as I think.
-
Dec 6th, 2000, 12:50 AM
#7
Thread Starter
PowerPoster
Hm, maybe I should use the Matrix part for a screensaver 
-
Dec 6th, 2000, 01:14 PM
#8
transcendental analytic
Hehe, i think there's a matrix screensaver out there already
Use  
writing software in C++ is like driving rivets into steel beam with a toothpick.
writing haskell makes your life easier:
reverse (p (6*9)) where p x|x==0=""|True=chr (48+z): p y where (y,z)=divMod x 13
To throw away OOP for low level languages is myopia, to keep OOP is hyperopia. To throw away OOP for a high level language is insight.
-
Dec 6th, 2000, 03:27 PM
#9
Frenzied Member
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|
Reply With Quote