home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD93018252000.psc / SysTray.ctl (.txt) < prev   
Encoding:
Visual Basic Form  |  2000-08-26  |  9.0 KB  |  212 lines
  1. VERSION 5.00
  2. Begin VB.UserControl SysTray 
  3.    ClientHeight    =   780
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   2565
  7.    InvisibleAtRuntime=   -1  'True
  8.    PropertyPages   =   "SysTray.ctx":0000
  9.    ScaleHeight     =   780
  10.    ScaleWidth      =   2565
  11.    Begin VB.PictureBox Picture2 
  12.       Height          =   495
  13.       Left            =   1920
  14.       ScaleHeight     =   435
  15.       ScaleWidth      =   435
  16.       TabIndex        =   1
  17.       Top             =   120
  18.       Width           =   495
  19.    End
  20.    Begin VB.Timer Timer1 
  21.       Left            =   1320
  22.       Top             =   120
  23.    End
  24.    Begin VB.PictureBox Picture1 
  25.       Height          =   615
  26.       Left            =   75
  27.       Picture         =   "SysTray.ctx":0014
  28.       ScaleHeight     =   555
  29.       ScaleWidth      =   555
  30.       TabIndex        =   0
  31.       Top             =   90
  32.       Width           =   615
  33.    End
  34. Attribute VB_Name = "SysTray"
  35. Attribute VB_GlobalNameSpace = False
  36. Attribute VB_Creatable = True
  37. Attribute VB_PredeclaredId = False
  38. Attribute VB_Exposed = True
  39. Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
  40. 'AUTHOR:    Peter Morgan    <firefly_nz24@yahoo.com>
  41. 'DATE:      25 August 2000
  42. 'Please feel free to use this code how you see fit
  43. 'Any comments or enhancements to the existing control would
  44. 'be great. If someone would like to double-team on a project,
  45. 'please drop me a line
  46. 'CREDITS:
  47. '   * Jonathan Morrison  <jonathanm@mindspring.com>
  48. '   * Pascal van de Wijdeven
  49. 'Thanks guys
  50. Option Explicit
  51. 'Property Variables:
  52. Public stSequence As New colSeq         'this object holds all frame and sequencing information
  53. Private m_Animate As Boolean            'enable animated sequence?
  54. Private m_CurrentSequence As Integer    'current sequence number
  55. Private m_InitialSequence As Integer    'starting sequence number
  56. Private m_InitialImage As Integer       'starting image number
  57. Private m_TipText As String             'text to be displayed on system tray icon
  58. Private intCurrent As Currency          'timer variable used with animation frame change
  59. Private intTotal As Integer             'number of seconds before next frame is displayed
  60. Private intPos As Integer               'position in sequence
  61. Private blnBegin As Boolean             'can we start yet? stops timer trigger in design mode
  62. Private blnRepeat As Boolean            'should animation repeat or stop at last frame?
  63. ' Default values
  64. Private Const def_InitialImage = 1
  65. Private Const def_InitialSequence = 1
  66. Private Const def_CurrentSequence = 1
  67. Private Const def_Animate = False
  68. Private Const def_TipText = ""
  69. ' PROPERTIES *************************************************
  70. Public Property Get Animate() As Boolean
  71. Attribute Animate.VB_ProcData.VB_Invoke_Property = "PropertyPage1"
  72.     Animate = m_Animate
  73. End Property
  74. Public Property Let Animate(ByVal New_Animate As Boolean)
  75.     m_Animate = New_Animate
  76.     PropertyChanged "Animate"
  77. End Property
  78. Public Property Get CurrentSequence() As Integer
  79. Attribute CurrentSequence.VB_ProcData.VB_Invoke_Property = "PropertyPage1"
  80.     CurrentSequence = m_CurrentSequence
  81. End Property
  82. Public Property Let CurrentSequence(ByVal New_CurrentSequence As Integer)
  83.     m_CurrentSequence = New_CurrentSequence
  84.     PropertyChanged "CurrentSequence"
  85. End Property
  86. Public Property Get InitialImage() As Integer
  87. Attribute InitialImage.VB_ProcData.VB_Invoke_Property = "PropertyPage1"
  88.     InitialImage = m_InitialImage
  89. End Property
  90. Public Property Let InitialImage(ByVal New_InitialImage As Integer)
  91.     m_InitialImage = New_InitialImage
  92.     PropertyChanged "InitialImage"
  93. End Property
  94. Public Property Get InitialSequence() As Integer
  95. Attribute InitialSequence.VB_ProcData.VB_Invoke_Property = "PropertyPage1"
  96.     InitialSequence = m_InitialSequence
  97. End Property
  98. Public Property Let InitialSequence(ByVal New_InitialSequence As Integer)
  99.     m_InitialSequence = New_InitialSequence
  100.     PropertyChanged "InitialSequence"
  101. End Property
  102. Public Property Get TipText() As String
  103. Attribute TipText.VB_ProcData.VB_Invoke_Property = "PropertyPage1"
  104.     TipText = m_TipText
  105. End Property
  106. Public Property Let TipText(ByVal New_TipText As String)
  107.     m_TipText = New_TipText
  108.     PropertyChanged "TipText"
  109. End Property
  110. Private Sub UserControl_InitProperties()
  111. 'Initialize Properties for User Control
  112.     m_InitialImage = def_InitialImage
  113.     m_InitialSequence = def_InitialSequence
  114.     m_CurrentSequence = def_CurrentSequence
  115.     m_Animate = def_Animate
  116.     m_TipText = def_TipText
  117. End Sub
  118. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  119. 'Load property values from storage
  120.     Set frm = Parent
  121.     m_InitialImage = PropBag.ReadProperty("InitialImage", def_InitialImage)
  122.     m_InitialSequence = PropBag.ReadProperty("InitialSequence", def_InitialSequence)
  123.     m_CurrentSequence = PropBag.ReadProperty("CurrentSequence", def_CurrentSequence)
  124.     m_Animate = PropBag.ReadProperty("Animate", def_Animate)
  125.     m_TipText = PropBag.ReadProperty("TipText", def_TipText)
  126. End Sub
  127. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  128. 'Write property values to storage
  129.     Call PropBag.WriteProperty("InitialImage", m_InitialImage, def_InitialImage)
  130.     Call PropBag.WriteProperty("InitialSequence", m_InitialSequence, def_InitialSequence)
  131.     Call PropBag.WriteProperty("CurrentSequence", m_CurrentSequence, def_CurrentSequence)
  132.     Call PropBag.WriteProperty("Animate", m_Animate, def_Animate)
  133.     Call PropBag.WriteProperty("TipText", m_TipText, def_TipText)
  134. End Sub
  135. Private Sub UserControl_Resize()
  136. 'Keep the control a specific height and width at design-time
  137.     UserControl.Height = 780
  138.     UserControl.Width = 780
  139. End Sub
  140. ' USER CONTROL FUNCTIONS **************************************
  141. Public Function SendToTray()
  142. 'Create effect where form minimizes into the tray
  143.     Dim lngRetVal As Long
  144.     ZoomForm ZOOM_TO_TRAY, frm.hwnd
  145.     frm.Visible = False 'hide the form from view
  146.     Picture2.Picture = frm.Icon 'store original icon from restoration on terminate
  147.     m_CurrentSequence = m_InitialSequence   'init sequence
  148.     'take the specified initial image
  149.     frm.Icon = frm.Controls(stSequence(m_InitialSequence).ImageList).ListImages(m_InitialImage).Picture
  150.     Set IconObject = frm.Icon
  151.     'create the new icon on the system tray
  152.     AddIcon frm, IconObject.Handle, IconObject, m_TipText
  153. End Function
  154. Public Function RestoreFromTray()
  155. 'Create the effect that original window is expanding from system tray
  156.     delIcon IconObject.Handle   'remove icon from tray
  157.     m_Animate = False           'stop animation
  158.     frm.Icon = Picture2.Picture 'restore original icon
  159.     ZoomForm ZOOM_FROM_TRAY, frm.hwnd
  160.     frm.Visible = True          'make original form visible
  161. End Function
  162. Private Sub Timer1_Timer()
  163. 'Main animation cycle
  164.     'The control must be allowed to animate
  165.     If m_Animate = True Then
  166.         'The icon needs to be on the tray before animation starts
  167.         If blnBegin = True Then
  168.             'change the animated frame if the duration has expired
  169.             If intCurrent >= intTotal Then
  170.                 intCurrent = 0
  171.                 intPos = intPos + 1
  172.                 'loop to beginning of frames in this sequence if end is reached
  173.                 If intPos > stSequence(m_CurrentSequence).colFrame.Count Then
  174.                     intPos = 1
  175.                     If blnRepeat = False Then
  176.                         'stop animation if this was a forward only animation
  177.                         m_Animate = False
  178.                         Exit Sub
  179.                     End If
  180.                 End If
  181.                 Call AnimateIcon    'sub to repaint the icon
  182.             End If
  183.             'intCurrent is a currency variable to allow for a
  184.             'floating point - dodgey, but it works
  185.             intCurrent = intCurrent + (Timer1.Interval / 1000)
  186.         End If
  187.     End If
  188. End Sub
  189. Private Sub AnimateIcon()
  190. 'Repaint new icon image to system tray
  191.     Dim intNextImage As Integer
  192.     'get the next frame from the sequence
  193.     intNextImage = stSequence(m_CurrentSequence).colFrame.Item(intPos).ImageNum
  194.     intTotal = stSequence(m_CurrentSequence).colFrame.Item(intPos).Interval
  195.     'set the form icon property to the next picture in the sequence
  196.     frm.Icon = frm.Controls(stSequence(m_CurrentSequence).ImageList).ListImages(intNextImage).Picture
  197.     intTotal = Me.stSequence(m_CurrentSequence).colFrame.Item(intPos).Interval
  198.     'paint the forms icon to the system tray
  199.     modIcon frm, IconObject.Handle, frm.Icon, m_TipText
  200. End Sub
  201. Public Sub PlayAnimation(ByVal Seq As Integer, ByVal Repeat As Boolean)
  202. '(re)initialise variables - ready for animation play
  203.     intPos = 1
  204.     intCurrent = 0
  205.     intTotal = 0
  206.     m_CurrentSequence = Seq
  207.     blnRepeat = Repeat
  208.     blnBegin = True
  209.     Timer1.Interval = 100   'frames can be changed every 1/10 second (I guess)
  210.     Call AnimateIcon    'sub to repaint the icon
  211. End Sub
  212.