frmBounce




Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Dim What As RECT

Private Sub Form_Unload(Cancel As Integer)

If Me.WindowState <> 0 Then
Me.WindowState = 0
End If

Cancel = -1

Dim HeightOfStartMenu As Long
Dim Speed As Long
Dim StartAt As Long

For I = 1 To 999
z$ = Space$(128)
Y = GetClassName(I, z$, 128)
X = Left$(z$, Y)
If LCase(X) = "shell_traywnd" Then
Goto JumpOut:
End If
Next I

JumpOut:

GetWindowRect I, What

'// Get the top pos of the Start Menu

HeightOfStartMenu = What.Top * 15

If HeightOfStartMenu <= 0 Then
HeightOfStartMenu = Screen.Height
'// If some smart guy moves the start-menu, to say

'// the top, left or right bounce at the bottom of

'// the screen

End If

'// Turn the value into twips (more commonly used)

StartAt = HeightOfStartMenu - 4000

If StartAt < Me.Top Then
StartAt = Me.Top
'// This code prevents the form from bouncing

'// higher than itself (not logical, the start menu isn't made

'// of rubber you now)

End If

'// How many "bounces?"

Speed = 100
'// How fast should this go?

Me.Height = 0
Me.Width = 4000
GoAgain:


Do Until Me.Top >= HeightOfStartMenu
DoEvents
Me.Top = Me.Top + Speed
Me.Left = Me.Left + 15 '<--- Remove the " ' " to make the window bounce sideways!
Loop

Do Until Me.Top <= StartAt
DoEvents
Me.Top = Me.Top - Speed
Me.Left = Me.Left + 15 '<--- Remove the " ' " to make the window bounce sideways!
Loop

If StartAt >= 10000 And Me.Top >= HeightOfStartMenu Then
Do Until Me.Top >= HeightOfStartMenu + 15000
Me.Top = Me.Top + Speed
Loop
End
Exit Sub
End If

StartAt = StartAt + 1000
Speed = Speed - 5
'// Decrease speed with 5 after each "bounce",

'// You can change the value all ya want :)


If Speed <= 0 Then
Speed = 5
'// If the Speed value gets under zero i will

'// automatically turn into 5 (cause if it don't

'// It will stop or do something crazy

End If

Goto GoAgain:

End Sub










( frmbounce.html )- by Paolo Puglisi - Modifica del 17/12/2023