Solved

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

Posted on 2004-09-12
5
357 Views
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?
0
Comment
Question by:RobK6364
5 Comments
 
LVL 7

Expert Comment

by:_agj_
ID: 12041782
maybe u can use a timer and adjust the left, top properties of the form?
0
 
LVL 4

Expert Comment

by:KarlPurkhardt
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.
0
 
LVL 4

Expert Comment

by:RichW
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:

IN A MODULE:

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


IN THE FORM LOAD EVENT:

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

IN  THE FORM MOUSE_MOVE EVENT:

'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
       Else
        msg = X / Screen.TwipsPerPixelX
       End If
       Select Case msg
        Case WM_LBUTTONUP        '514 restore form window
         Me.WindowState = vbNormal
         Result = SetForegroundWindow(Me.hwnd)
         Me.Show
        Case WM_LBUTTONDBLCLK    '515 restore form window
         Me.WindowState = vbNormal
         Result = SetForegroundWindow(Me.hwnd)
         Me.Show
        Case WM_RBUTTONUP        '517 display popup menu
         Result = SetForegroundWindow(Me.hwnd)
       End Select

IN THE FORM UNLOAD EVENT:

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



I hope this helps.

RichW
0
 
LVL 4

Expert Comment

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

 If Me.WindowState = vbMinimized Then Me.Hide

0
 
LVL 85

Accepted Solution

by:
Mike Tomlinson earned 250 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.

Regards,

Idle_Mind

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

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

Private 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

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 NIF_DOALL = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_RBUTTONDOWN = &H204

Private tic As NOTIFYICONDATA
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
        dropToTray
    Else
        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
        Case WM_LBUTTONDBLCLK
            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
            AnimateToTray
    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)
    Else
        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
        Form1.AnimateToTray
    Else
        HookProc = CallWindowProc(lPrevProc, hwnd, uMsg, wParam, lParam)
    End If
End Function
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

760 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now