minimize to systray... but toward the clock...

hello experts,

i've got my program setup to cancel on QueryUnload and minimize instead, at which point i hide the form and show my systray icon.  then on systray icon double-click, the form becomes visible again and restores itself... everything works fine.

but here's what i want to do, when i minimize it shows the form shrink down to the TASKBAR, then it disappears from the taskbar and the icon appears in the SYSTRAY.  but i would like to make my program appear to be minimizing directly toward the clock.. ZoneAlarm can do this, and i'm sure many other programs... i know ZA wasn't written in VB, but i'm wondering if anyone knows how i can create a similiar effect?
Who is Participating?
Mike TomlinsonConnect With a Mentor Middle School Assistant TeacherCommented:
Create a new project and add a module.  Add a PictureBox and a Timer to the form.  Set the Picture property of the picturebox to the icon you want to appear in the tray.  Optional: Set the ShowInTaskBar property of the form to false (I think it looks better this way).

All the math shenanigans are to make the form move at a linear speed.  I set it up so that the windows will travel across the whole screen in approximately 1/4 second (250 milliseconds).  Microsoft "recommends" that window animations should take no longer than 300 milliseconds.

The code also demonstrates how to subclass the form to trap the minimize event BEFORE the form is minimized.  This allows us to cancel it and instead animate the window minimizing to the tray.  If you don't like my window moving algorithm then at least can take the subclassing part out for your use.



' ------------------------------------------------------------
' Form1
' ------------------------------------------------------------
Option Explicit

Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Sub Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA)

Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_RBUTTONDOWN = &H204

Private inTray As Boolean

Private movementInterval As Single
Private pixelsPerSec As Single

Private rc As Rect

Private AxStep As Single
Private AyStep As Single
Private AxStart As Single
Private AyStart As Single
Private AxCurrent As Single
Private AyCurrent As Single
Private AxTarget As Single
Private AyTarget As Single
Private AtargetDistance As Single
Private BxStep As Single
Private ByStep As Single
Private BxStart As Single
Private ByStart As Single
Private BxCurrent As Single
Private ByCurrent As Single
Private BxTarget As Single
Private ByTarget As Single

Private Sub Form_Load()
    Timer1.Enabled = False
    Me.ScaleMode = vbPixels
    Picture1.Visible = False
    ' in one second we can move this distance in pixels
    ' this particular setting means we can travel across the screen
    ' in about 250 milliseconds
    pixelsPerSec = Screen.Width / Screen.TwipsPerPixelX * 4
    ' will move on screen every movementInterval milliseconds
    movementInterval = 10
    Timer1.interval = movementInterval
    HookWindow Me.hwnd
End Sub

Public Sub AnimateToTray()
    Dim interval As Single
    Dim a As Single
    Dim b As Single
    GetWindowRect Me.hwnd, rc
    AxCurrent = rc.Left
    AyCurrent = rc.Top
    BxCurrent = rc.Right
    ByCurrent = rc.Bottom
    AxTarget = (Screen.Width / Screen.TwipsPerPixelX - 10)
    AyTarget = (Screen.Height / Screen.TwipsPerPixelY - 10)
    a = AxTarget - rc.Left
    b = AyTarget - rc.Top
    AtargetDistance = Math.Sqr((a * a) + (b * b))
    BxTarget = (Screen.Width / Screen.TwipsPerPixelX)
    ByTarget = (Screen.Height / Screen.TwipsPerPixelY)
    interval = AtargetDistance / pixelsPerSec * 1000#
    AxStep = (AxTarget - rc.Left) / (interval / movementInterval)
    AyStep = (AyTarget - rc.Top) / (interval / movementInterval)
    BxStep = (BxTarget - rc.Right) / (interval / movementInterval)
    ByStep = (ByTarget - rc.Bottom) / (interval / movementInterval)

    Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
    AxCurrent = AxCurrent + AxStep
    AyCurrent = AyCurrent + AyStep
    BxCurrent = BxCurrent + BxStep
    ByCurrent = ByCurrent + ByStep
    If Math.Sqr((AxCurrent - rc.Left) * (AxCurrent - rc.Left) + (AyCurrent - rc.Top) * (AyCurrent - rc.Top)) >= AtargetDistance Then
        Timer1.Enabled = False
        SetWindowPos Me.hwnd, 0, AxTarget, AyTarget, BxTarget - AxTarget, ByTarget - AyTarget, 0
        Me.Visible = False
        SetWindowPos Me.hwnd, 0, AxCurrent, AyCurrent, BxCurrent - AxCurrent, ByCurrent - AyCurrent, 0
    End If
End Sub

Private Sub dropToTray()
    tic.cbSize = Len(tic)
    tic.hwnd = Picture1.hwnd ' Callback Control
    tic.uID = 1&
    tic.uFlags = NIF_DOALL
    tic.uCallbackMessage = WM_MOUSEMOVE
    tic.hIcon = Picture1.Picture
    tic.szTip = "My Application" & Chr$(0)

    Shell_NotifyIcon NIM_ADD, tic
    inTray = True
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    X = X / Screen.TwipsPerPixelX
    Select Case X
            Shell_NotifyIcon NIM_DELETE, tic
            SetWindowPos Me.hwnd, 0, rc.Left, rc.Top, rc.Right - rc.Left, rc.Bottom - rc.Top, 0
            Me.Visible = True
            inTray = False
    End Select
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Select Case UnloadMode
        Case vbAppTaskManager, vbAppWindows
            HookWindow Me.hwnd
            If inTray Then
                Shell_NotifyIcon NIM_DELETE, tic
            End If

        Case Else
            Cancel = True
    End Select
End Sub

' ------------------------------------------------------------
' Module1
' ------------------------------------------------------------
Option Explicit

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const WM_SYSCOMMAND = &H112
Private Const SC_MINIMIZE = &HF020&

Private Const GWL_WNDPROC As Long = (-4)

Private lPrevProc As Long

Public Sub HookWindow(ByVal lHandle As Long)
    If lPrevProc = 0 Then
        lPrevProc = SetWindowLong(lHandle, GWL_WNDPROC, AddressOf HookProc)
        Call SetWindowLong(lHandle, GWL_WNDPROC, lPrevProc)
    End If
End Sub

Public Function HookProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If uMsg = WM_SYSCOMMAND And wParam = SC_MINIMIZE Then
        HookProc = CallWindowProc(lPrevProc, hwnd, uMsg, wParam, lParam)
    End If
End Function
maybe u can use a timer and adjust the left, top properties of the form?
As 'agj' mentioned you could use a timer, for exmaple create a new form, add a timer and add this code:

<-- CODE START -->

Public Sub Shrink(fPercent As Single)
    Form1.Width = Form1.Width - ((Form1.Width / 100) * fPercent)
    Form1.Height = Form1.Height - ((Form1.Height / 100) * fPercent)
End Sub

Private Sub Form_Load()
    Timer1.Enabled = True
    Timer1.Interval = 10
End Sub

Private Sub Timer1_Timer()
    Shrink 5
    Interval = 10
End Sub

<-- CODE END -->

The above code will shrink the form. However you will need to modify it so that it shrinks towards the clock, which shouldnt be too hard.  For exmaple if you want to shirnk the form but keep the bottom rioght corner in the same position then you could replace the above Shirnk function with the following code:

<-- CODE START -->

Public Sub Shrink(fPercent As Single)

    ' this is a hack and should be rewrote
    If Form1.Width < 1800 Then Exit Sub
    If Form1.Height < 1800 Then Exit Sub

    Dim iSubX, iSubY As Integer

    iSubX = ((Form1.Width / 100) * fPercent)
    iSubY = ((Form1.Height / 100) * fPercent)

    Form1.Width = Form1.Width - iSubX
    Form1.Height = Form1.Height - iSubY
    Form1.Left = Form1.Left + iSubX
    Form1.Top = Form1.Top + iSubY
End Sub

<-- CODE END -->

The main problem with the above code isthat forms have a min width, if you reach this width then the form will not get any smaller but with the shrink function it will keep moving - comment out the hack at the top to see what i mean.
Here's the code I use to minimize to the system tray.  When I minimize to the system tray it looks like it is going directly to the clock without having the form minimize first to the task bar:


Option Explicit

'user defined type required by Shell_NotifyIcon API call
      Public Type NOTIFYICONDATA
       cbSize As Long
       hwnd As Long
       uId As Long
       uFlags As Long
       uCallBackMessage As Long
       hIcon As Long
       szTip As String * 64
      End Type

      'constants required by Shell_NotifyIcon API call:
      Public Const NIM_ADD = &H0
      Public Const NIM_MODIFY = &H1
      Public Const NIM_DELETE = &H2
      Public Const NIF_MESSAGE = &H1
      Public Const NIF_ICON = &H2
      Public Const NIF_TIP = &H4
      Public Const WM_MOUSEMOVE = &H200
      Public Const WM_LBUTTONDOWN = &H201     'Button down
      Public Const WM_LBUTTONUP = &H202       'Button up
      Public Const WM_LBUTTONDBLCLK = &H203   'Double-click
      Public Const WM_RBUTTONDOWN = &H204     'Button down
      Public Const WM_RBUTTONUP = &H205       'Button up
      Public Const WM_RBUTTONDBLCLK = &H206   'Double-click

      Public Declare Function SetForegroundWindow Lib "user32" _
      (ByVal hwnd As Long) As Long
      Public Declare Function Shell_NotifyIcon Lib "shell32" _
      Alias "Shell_NotifyIconA" _
      (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

      Public nid As NOTIFYICONDATA


With nid
    .cbSize = Len(nid)
    .hwnd = Me.hwnd
    .uId = vbNull
    .uCallBackMessage = WM_MOUSEMOVE
    .hIcon = Me.Icon
    .szTip = "MOHAA Query - v" & App.Major & "." & App.Minor & "." & App.Revision & vbNullChar
End With
Shell_NotifyIcon NIM_ADD, nid


'this procedure receives the callbacks from the System Tray icon.
      Dim Result As Long
      Dim msg As Long
       'the value of X will vary depending upon the scalemode setting
       If Me.ScaleMode = vbPixels Then
        msg = X
        msg = X / Screen.TwipsPerPixelX
       End If
       Select Case msg
        Case WM_LBUTTONUP        '514 restore form window
         Me.WindowState = vbNormal
         Result = SetForegroundWindow(Me.hwnd)
        Case WM_LBUTTONDBLCLK    '515 restore form window
         Me.WindowState = vbNormal
         Result = SetForegroundWindow(Me.hwnd)
        Case WM_RBUTTONUP        '517 display popup menu
         Result = SetForegroundWindow(Me.hwnd)
       End Select


'this removes the icon from the system tray
       Shell_NotifyIcon NIM_DELETE, nid

I hope this helps.

I forgot that in the FORM RESIZE EVENT:

 If Me.WindowState = vbMinimized Then Me.Hide

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.