Search Tools Links Login

Titlebar Animation Module


Visual Basic 6, or VB Classic

Have you ever wanted to make use of the animations Windows uses when you minimize and maximize open windows? Now you can, and it's eaiser than you think! Use this simple module to make all of your forms open and close with animations. Works on any Win32 system. The animation is drawn with the caption of the opening window in it, and uses your system colors (and gradients, if your system supports them) to create the titlebar animations. Enjoy! I don't care about the votes.

Original Author: Doctor Evil

Code

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
Private Declare Function DrawAnimatedRects Lib "user32" (ByVal hwnd As Long, ByVal idAni As Long, lprcFrom As RECT, lprcTo As RECT) As Long
Private Const IDANI_CAPTION = &H3
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Type POINTAPI
    X As Long
    Y As Long
End Type
'ShowWindow
'Opens your from with animation from an object to the window to show.
' From_Object_hWnd: the hWnd of the object to start the animation from. This is usually the button that is clicked on to open a form.
'ToWindow: The form to open.
'ShowModal: Show the the from as a modal form? (similar to the [Modal] parameter of Form.Show)
'OwnerOfNewWindow: The owner of a form. (similar to the [OwnerForm] parameter of Form.Show)
'CenterWindow: Center the window on the screen? This is important, as if you only set the StartUpPosition property of a form to CenterScreen, the animation will run before the form is centered and will look funny. The form will be centered over the owner.
Public Sub ShowWindow(From_Object_hWnd As Long, ToWindow As Form, Optional ShowModal As Integer = vbModeless, Optional OwnerOfNewWindow As Form, Optional CenterWindow As Boolean)
If ShowModal <> 0 And ShowModal <> 1 Then
Err.Raise 15448, "ShowWindowAnimation", "Animated Window Show: ShowModal must be a value of 0 or 1. Requested value was " & ShowModal & ". Window will not be opened."
Exit Sub
End If
On Error Resume Next
Load ToWindow
If CenterWindow Then
CenterChild OwnerOfNewWindow, ToWindow
End If
  Dim FromRect As RECT, ToRect As RECT
  
  GetWindowRect From_Object_hWnd, FromRect
  GetWindowRect ToWindow.hwnd, ToRect
  
  DrawAnimatedRects ToWindow.hwnd, IDANI_CAPTION, FromRect, ToRect
ToWindow.Show ShowModal, OwnerOfNewWindow
End Sub
'UnloadWindow
'Use this to make an animation from a window to an object when a window is closing. You could put this in the Form_Unload event:
' UnloadWindow Me, PreviousWindow.Command1.hWnd
Public Sub UnloadWindow(WindowToClose As Form, Close_To_Object_hWnd As Long)
On Error Resume Next
  Dim FromRect As RECT, ToRect As RECT
  
  GetWindowRect WindowToClose.hwnd, FromRect
  GetWindowRect Close_To_Object_hWnd, ToRect
  
  DrawAnimatedRects WindowToClose.hwnd, IDANI_CAPTION, FromRect, ToRect
Unload WindowToClose
End Sub
'Centers a child window over a parent window.
Public Sub CenterChild(Parent As Form, Child As Form)
  On Local Error Resume Next

  If Parent.WindowState = 1 Then
    Exit Sub
  Else
    Child.Left = (Parent.Left + (Parent.Width / 2)) - (Child.Width / 2)
    Child.Top = (Parent.Top + (Parent.Height / 2)) - (Child.Height / 2)
  End If
End Sub
'ShowWindowFromMouse
'Somewhat like ShowWindow, but instead of starting the animation from an object, it starts the animation from the position of the mouse on the screen. This is useful for menus.
Public Sub ShowWindowFromMouse(ToWindow As Form, Optional ShowModal As Integer = vbModeless, Optional OwnerOfNewWindow As Form)
If ShowModal <> 0 And ShowModal <> 1 Then
Err.Raise 15448, "ShowWindowAnimation", "Animated Window Show: ShowModal must be a value of 0 or 1. Requested value was " & ShowModal & ". Window will not be opened."
Exit Sub
End If
On Error Resume Next
Load ToWindow
  Dim FromRect As RECT, ToRect As RECT, Mouse As POINTAPI
  GetCursorPos Mouse
  FromRect.Top = Mouse.Y
  FromRect.Left = Mouse.X
  FromRect.Bottom = Mouse.Y + 32
  FromRect.Right = Mouse.X + 32
  GetWindowRect ToWindow.hwnd, ToRect
  
  DrawAnimatedRects ToWindow.hwnd, IDANI_CAPTION, FromRect, ToRect
ToWindow.Show ShowModal, OwnerOfNewWindow
End Sub
'Makes an animation from the hWnd of an object to the position of the mouse.
Public Sub MouseTohWnd(AnimateTo As Long)
On Error Resume Next
  Dim FromRect As RECT, ToRect As RECT, Mouse As POINTAPI
  GetCursorPos Mouse
  FromRect.Top = Mouse.Y
  FromRect.Left = Mouse.X
  FromRect.Bottom = Mouse.Y + 32
  FromRect.Right = Mouse.X + 32
  GetWindowRect AnimateTo, ToRect
  
  DrawAnimatedRects AnimateTo, IDANI_CAPTION, FromRect, ToRect
End Sub

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 106 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.