by Unknown (2 Submissions)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 12th August 2005
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Holiday Greeting for those of you bouncing off the walls...
API Declarations
'put a Shape1 on the form
'put a Label1 on the form
'put a Timer1 on the form
'put a Timer2 on the form
'IMPORTANT after all the above are done, Right Click on Label1 and select "Bring to Front"
'Don't worry about sizes or shapes or locations
'the code will set everything else up correctly
'Declarations
Option Explicit
Dim DeltaX, DeltaY As Integer ' Declare variables.
Dim DisplayStr As String
Dim tmp
Dim i
VBcoders
DeltaX = 100 ' Initialize variables.
DeltaY = 100
'Form1 Properties
DisplayStr = String(20, " ") + "Holiday Greetings!" + String(20, " ") + "Holiday Greetings!" + String(20, " ") + "Holiday Greetings!"
With Form1
.BackColor = vbWhite
.BorderStyle = 1 'Fixed Single - for some reason NOT recognized!
.Caption = DisplayStr
.Height = 6555
.Width = 10785
'.StartUpPosition = 1 'Center Owned
'#Cannot use above in runtime - set manually if this option is desirable to you
End With 'Form1 Properties
'Shape Properties
With Shape1
.FillColor = vbRed
.FillStyle = 0 'Solid
.Shape = 3 'Circle
.Height = 1335
.Width = 1815
.Left = 3600
.Top = 1920
End With 'Shape1 Properties
'Label1 Properties
With Label1
.Alignment = 2 'Center
.BackStyle = 0 'Transparent
.Caption = "HAPPY NEW YEAR"
.Height = 735
.Left = 4080
.Top = 2280
.Width = 855
End With 'Label1 Properties
'Timer1 Properties
With Timer1
.Interval = 50 ' Set Interval.
'.Enabled = False ' Disable here to use a command button to start animation
End With 'Timer1 Properties ' You must add the command button and the
' Timer1.Enabled = True code in it for this option
' Timer2.Enabled = True code in it for this option
'Timer2 Properties
With Timer2
.Interval = 100
'.Enabled = False ' See above for info
End With 'Timer2 Properties
End Sub
Private Sub Timer1_Timer()
'-----------------------------------------------------------------------------------
'Movement of Form1 Caption
'DisplayStr = Mid(DisplayStr, 2) & Left(DisplayStr, 1) 'UnREM to use only Timer1
'Form1.Caption = DisplayStr 'UnREM to use only Timer1
' 'REM out Timer2 in Form Load
'-----------------------------------------------------------------------------------
'Movement of Balloon and Color changes Control
Shape1.Move Shape1.Left + DeltaX, Shape1.Top + DeltaY
Label1.Left = Shape1.Left + 480: Label1.Top = Shape1.Top + 360
If Shape1.Left < ScaleLeft Then DeltaX = 100: Call changeAll 'the color Function
If Shape1.Left + Shape1.Width > ScaleWidth + ScaleLeft Then
DeltaX = -100
Call changeAll 'the Function that changes the colors
End If
If Shape1.Top < ScaleTop Then DeltaY = 100: Call changeAll 'the color Function
If Shape1.Top + Shape1.Height > ScaleHeight + ScaleTop Then
DeltaY = -100
Call changeAll 'the Function that changes the colors
End If
End Sub
Public Function changeAll()
'Form1.BackColor Change
'Shape1 FillColor Change
'Label1 ForeColor Change
'Information Only - Not needed --------------------------------------------------
'= RGB(0, 0, 0) 'Black absence of all colors in 'spectrum' = vbBlack
'= RGB(0, 0, 255) 'Blue presence of ONLY blue = vbBlue
'= RGB(0, 255, 0) 'Green presence of ONLY green = vbGreen
'= RGB(0, 255, 255) 'Cyan presence of green and black - NO red = vbCyan
'= RGB(255, 0, 0) 'Red presence of ONLY red = vbRed
'= RGB(255, 0, 255) 'Magenta presence of red and black - NO green = vbMagenta
'= RGB(255, 255, 0) 'Yellow presence of red and green - NO black = vbYellow
'= RGB(255, 255, 255) 'White presence of all colors in 'spectrum' = vb White
'--------------------------------------------------------------------------------
Dim MyValue
StartHere:
Randomize
MyValue = Int((8 * Rnd) + 1) ' Generate random value between 1 and 8.
If MyValue = tmp Then ' Check to see if number is the same as last time
GoTo StartHere ' If same number came up last time - start over
End If
Select Case MyValue
Case Is = 1
Form1.BackColor = vbWhite 'White / could be RGB(255, 255, 255)
Shape1.FillColor = RGB(0, 0, 0) 'Black / could be vbBlack
Label1.ForeColor = vbWhite 'White / could be RGB(255, 255, 255)
Case Is = 2
Form1.BackColor = vbYellow
Shape1.FillColor = RGB(0, 0, 255) 'Blue
Label1.ForeColor = vbWhite
Case Is = 3
Form1.BackColor = vbRed
Shape1.FillColor = RGB(0, 255, 0) 'Green
Label1.ForeColor = vbBlack
Case Is = 4
Form1.BackColor = vbYellow
Shape1.FillColor = RGB(0, 255, 255) 'Cyan
Label1.ForeColor = vbBlack
Case Is = 5
Form1.BackColor = vbGreen
Shape1.FillColor = RGB(255, 0, 0) 'Red
Label1.ForeColor = vbWhite
Case Is = 6
Form1.BackColor = vbWhite
Shape1.FillColor = RGB(255, 0, 255) 'Magenta
Label1.ForeColor = vbWhite
Case Is = 7
Form1.BackColor = vbGreen
Shape1.FillColor = RGB(255, 255, 0) 'Yellow
Label1.ForeColor = vbBlack
Case Is = 8
Form1.BackColor = vbBlue 'Blue / could be RGB((0, 0, 255)
Shape1.FillColor = RGB(255, 255, 255) 'White / could be vbWhite
Label1.ForeColor = vbRed 'Red / could be RGB(255, 0, 0)
End Select 'MyValue
tmp = MyValue ' Set tmp to the value of last random number generated
End Function
Private Sub Timer2_Timer()
'Movement of Form1 Caption
DisplayStr = Mid(DisplayStr, 2) & Left(DisplayStr, 1)
Form1.Caption = DisplayStr
End Sub