|
|
| |
Windows API/Global Declarations: Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
|
'**************************************
'Windows API/Global Declarations for :Fo
' rm bouncing against the Start Menu at ex
' it! 2.0
'**************************************
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
|
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
Terms of Agreement:
By using this code, you agree to the following terms...
1) You may use
this code in your own programs (and may compile it into a program and distribute it in compiled format for languages that allow it) freely and with no charge.
2) You MAY NOT redistribute this code (for example to a web site) without written permission from the original author. Failure to do so is a violation of copyright laws.
3) You may link to this code from another website, but ONLY if it is not wrapped in a frame.
4) You will abide by any additional copyright restrictions which the author may have placed in the code or code's description. |
'**************************************
' Name: Form bouncing against the Start
' Menu at exit! 2.0
' Description:This code is a must have!
' It's cooler than the "Cool Form Close" c
' ode , cooler than the "Implode and Explo
' de" code! So what does it do? When you c
' lose you program a really cool effect wi
' ll appear. Your form will shrink so just
' the Titlebar is being showned, then the
' titlebar accelerates and bounces againt
' the start menu, goes up in the air, boun
' ces a couple of more times and then disa
' ppears behind the Start Menu! Way Cool!
' This code is a very advanced one but it'
' s really easy to use, try it!!! Includes
' functions for getting the top position o
' f your start menu and offcourse the boun
' ce code! New for ver. 2 is that the form
' now can bounce sideways if you edit the
' code just a little tiny bit, now also su
' pports maximized windows!!!
' By: Johan Otterud
'
' Inputs:None really, you might wanna ch
' ange the speed property in the code if y
' ou can find it.
'
' Returns:A really cool 'bouncy' effect.
' I use it always in my progs!
'
' Assumes:Paste the 'main code' into the
' form_unload section. The declare the var
' iables (IMPORTANT!)
'
' Side Effects:None, but their might be
' bugs..
'
'This code is copyrighted and has' limited warranties.Please see http://w
' ww.Planet-Source-Code.com/vb/scripts/Sho
' wCode.asp?txtCodeId=1920&lngWId;=1'for details.'**************************************
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 '// The start menu never uses a HWND higher than 1000
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-me
' nu, to say
'// the top, left or right bounce at the
' bottom of
'// the screen
End If
'// Turn the value into twips (more comm
' only used)
StartAt = HeightOfStartMenu - 4000
If StartAt < Me.Top Then
StartAt = Me.Top
'// This code prevents the form from bou
' ncing
'// 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 "bo
' unce",
'// 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
| |
Other 5 submission(s) by this author
|
|
| |
| Report Bad Submission |
|
| |
| Your Vote! |
|
See Voting Log |
| |
| Other User Comments |
5/30/1999 8:01:00 AM:renegade
I would add this code to it because it
wont work if the window is maximized or
minimized, this resets the
window.
(place it in form1.unload
before the for-next)
If
Form1.WindowState <> 0
Then
Form1.WindowState = 0
End If
|
5/30/1999 12:48:00 PM:Johan Otterud
Geeh, I'm sorry... :-)
|
5/30/1999 11:26:00 PM:ctnap
way cool dude
|
5/31/1999 8:15:00 PM:Patrick K. Bigley
I am hard to convince when it comes to
VB coding, but this bouncing code is
really fun. I will use it on one of my
future projects! Thanks.
|
6/2/1999 10:04:00 AM:nachjager
Hey, dude, you really did it cool!!!
Added to a test app and one of the test
users thought he wacked the program!!!
Still LOL!! ;-)
|
6/8/1999 7:20:00 AM:dragyn
nice but you might wanna list the
declares and such for ppl
|
6/8/1999 7:20:00 AM:dragyn
ignore that the top window didnt load
the first time i came here! ;)
|
6/8/1999 7:49:00 AM:VB
I surf the net almost 8 hours per day
and this is one of the best codes that
I have found yet.
Way to go!!!!
|
6/9/1999 7:51:00 PM:Mike
Way cool.
I'll have to find a use
for this.
|
6/10/1999 4:36:00 AM:Michael T. Monaghan
Nice effect !
You can add these two
lines in the first two do loops to make
the caption shrink and bounce to the
right and go off screen.
Me.Left =
Me.Left + Speed / 2
Me.Width =
Me.Width - 6
Place them right after
you calculate the form's TOP position.
|
6/12/1999 5:48:00 AM:Graeme
Great stuff lads, and thanks to the
person who added to resize the window
before closing, Great Stuff!
Thanks
Again!
|
6/18/1999 9:19:00 PM:David Blewitt
This is a very cool prog!!
|
6/19/1999 10:47:00 AM:Abhijit
Gotta try this. Hey ppl, cant you post
zip files to d/l the code?
|
6/22/1999 1:59:00 PM:Siraris
I get a type mismatch for this line of
code: x = Left$(z$, y) Anyone have
any ideas?
|
6/23/1999 5:18:00 PM:Tiggermcat
Hey this is a good code i have to say
and Im going to put it in a new program
i have comming out on 8/10 maybe If you
let me i will put your name on it Just
e-mail if i can!!
|
6/23/1999 8:53:00 PM:Jim Sines
I have to say, by far, this code is
the
Absolute BEST unload code (hey, it
ryhmes)
I have ever seen. I also want
to use it
in One of my Freeware
Programs (WinOp 5).
Email Me if i can
or i'll include your
name in the
ABOUT box.
|
6/25/1999 1:50:00 AM:DSN
Thanks man, We here at DSN are very
happy with this Program , do you mind
sending me your e-Mail and we will ask
for you to join us here at DSN which
the Url will be posted to you after you
give me your e-mail address and you
send me a letter about Joining us
(DSN)
We are going to use your Code
for all of our programs from Now on!
|
6/26/1999 4:48:00 AM:Johan Otterud
Hi Everyone!
I'm really glad you like
this code! I see many people want to
use my code in their program(s). Well
send me an email at
johan_otterud@hotmail.com. Thanx
everyone!!!
|
6/27/1999 9:17:00 AM:Neila
Please use Option Explicit and Declare
all variables. Cute, don't know where
it would be useful in a serious
application .
|
7/11/1999 11:31:00 AM:Vichu, India.
this is a coolest code.
|
7/11/1999 2:54:00 PM:dine
I like it, but its a little over-rated
i think
|
7/11/1999 2:58:00 PM:UAE WONDER
It's a GREAT little program ..!
|
7/12/1999 2:12:00 PM:Mohammed Hasan
Neat piece of code....
Thanks Johan
|
7/13/1999 5:14:00 AM:Bill Gates
What a bunch of dorks! I think this
guy posted all these comments to his
own code! Oh... Please.... join my
company too. We will use all of your
code to do everything in the world!
You can be our leader. Please let us
hire you and pay you ONE MILLION
DOLLARS! Scratch that!... ONE HUNDRED
BILLION DOLLARS!
|
7/14/1999 8:51:00 AM:bigboy
I agree with Bill. Any company worth
their salt will not waste their time
with this nonsense. I want clean fast
code on any professional project, not
tricks.
|
7/17/1999 5:59:00 PM:DirtyBird
Well at least it works
|
7/19/1999 10:18:00 PM:none
style="font-family: Courier New;
font-size: 20pt"fontface = "Courier
New" size="7" color=blue Cool Code
|
7/26/1999 6:52:00 AM:Johan Otterud
Hi BigBoy and Bill Gates!
I just wan't
to ask you a question? Did I enter this
code 4000 times + ???
I could have
but only a dork would think so... And
no one has to use the code that's why
VB world is here. You have the freedom
of choosing here...
But maybe the
main question is: Why did they look
this code up, why did they try it! They
must be right I am the Leader! Well
anyway thanx everyone (else)
End If
|
7/28/1999 5:18:00 PM:Flash
Hi, I have a problem runing this
code...
I put me an " error compiling,
variable not defined " effor in the
first I of :
For I = 1 To 999
'// The start menu never uses a HWND
higher than 1000
z$ =
Space$(128)
Y =
GetClassName(I, z$, 128)
X =
Left$(z$, Y)
Please help me, thanks
you
|
8/8/1999 10:47:00 PM:DoG
i got the same problem
|
8/13/1999 1:56:00 PM:Johan Otterud
Make sure there's no Option Explicit on
(or make sure you declare all
variables, cause I most have forgotten
some) AND make sure the API
declarations has been declared in the
General section...
|
8/18/1999 6:43:00 AM:Michel Rutten
It's fun! I imagine one could play a
BOING!!! kinda sound at the same time,
making this even more hilarious.
|
8/19/1999 11:20:00 AM:Hey
I imagine this could would be nice, but
I'm getting an error saying 'ByRef Type
Mis-match' highlithing the below
code
JumpOut:
GetWindowRect
i, What
Any Ideas?
|
8/29/1999 12:19:00 AM:faun
I have some problem.???
my program
show "sub or function not defined" at
Y = GetClassName(I, z$, 128)
Please
help me
|
9/23/1999 7:12:00 AM:Theo
This code is really cool! I am going to
use it in my future projects. Thanx!
|
9/23/1999 1:09:00 PM:Thomas Spink
Being a 13 Year-Old VB Programmer, this
is the best code i have seen so far!
|
1/9/2000 5:52:39 PM:DarkAttack
Hi, I'm a the lead programmer at
SoftTech International Software.
"http://www.stsoftware.com". I'm just
writing to say nice work on the code!!!
If you would like to add more effact to
this insert the following code below
the line
"Dim StartAt As Long"
'
Copy Here
Dim HSt As Long
Dim WSt As Long
HSt =
Val(Me.Height / 70)
WSt =
Val(Val(Me.Width - 4000) / 70)
For
i = 0 To 70
Me.Height = Me.Height
- HSt
Me.Width = Me.Width - WSt
Next i
' End Copy Here
That code
above will srink the current window
down to size, then run the cool effact.
Some people may want to use it to ad to
the effact, change the number 70 (in 3
spots) to a lower number to go faster,
or higher to go slow.
|
8/28/2000 11:12:33 PM:|Lone_star
If you are having problem with it it
becuz you did put the code in the right
place like that first code you gotta
put it in the General-declarations
|
8/28/2000 11:16:04 PM:|Lone_star
that did=didn't
|
1/31/2002 10:27:23 PM:MAS84
hey, i had the same problem w/ variable
not defined...I just inserted a
Dim
i
Dim z$
Dim Y
Dim X
after doing
that, it worked perfectly
|
|
| Add Your Feedback! |
Note:Not only will your feedback be posted, but an email will be sent to the code's author in your name.
NOTICE: The author of this code has been kind enough to share it with you. If you have a criticism, please state it politely or it will be deleted.
For feedback not related to this particular code, please click here.
|
|
