Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win


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

Posted on 2004-09-12
Medium Priority
Last Modified: 2011-08-18
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?
Question by:RobK6364
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions

Expert Comment

ID: 12041782
maybe u can use a timer and adjust the left, top properties of the form?

Expert Comment

ID: 12044891
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.

Expert Comment

ID: 12045056
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.


Expert Comment

ID: 12045119
I forgot that in the FORM RESIZE EVENT:

 If Me.WindowState = vbMinimized Then Me.Hide

LVL 86

Accepted Solution

Mike Tomlinson earned 1000 total points
ID: 12046452
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

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Suggested Courses

636 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question