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 / Form1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2000-08-26  |  7.0 KB  |  212 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Object = "*\A..\SYSTEM~1\projSysTray.vbp"
  4. Begin VB.Form Form1 
  5.    Caption         =   "System Tray ... test scenario"
  6.    ClientHeight    =   4395
  7.    ClientLeft      =   165
  8.    ClientTop       =   750
  9.    ClientWidth     =   4815
  10.    Icon            =   "Form1.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   4395
  13.    ScaleWidth      =   4815
  14.    StartUpPosition =   3  'Windows Default
  15.    Begin projSysTray.SysTray SysTray1 
  16.       Left            =   0
  17.       Top             =   3600
  18.       _ExtentX        =   1376
  19.       _ExtentY        =   1376
  20.    End
  21.    Begin VB.Timer Timer1 
  22.       Interval        =   1000
  23.       Left            =   1560
  24.       Top             =   3720
  25.    End
  26.    Begin VB.Frame Frame2 
  27.       Caption         =   "Waiting time before result:"
  28.       Height          =   1215
  29.       Left            =   720
  30.       TabIndex        =   3
  31.       Top             =   2280
  32.       Width           =   3375
  33.       Begin VB.TextBox txtDelay 
  34.          Height          =   285
  35.          Left            =   1680
  36.          TabIndex        =   5
  37.          Top             =   480
  38.          Width           =   855
  39.       End
  40.       Begin VB.Label Label1 
  41.          Caption         =   "Seconds"
  42.          Height          =   255
  43.          Left            =   840
  44.          TabIndex        =   4
  45.          Top             =   480
  46.          Width           =   855
  47.       End
  48.    End
  49.    Begin VB.Frame Frame1 
  50.       Caption         =   "By default, test will:"
  51.       Height          =   1575
  52.       Left            =   720
  53.       TabIndex        =   0
  54.       Top             =   480
  55.       Width           =   3375
  56.       Begin VB.OptionButton Option2 
  57.          Caption         =   "Fail"
  58.          Height          =   255
  59.          Left            =   720
  60.          TabIndex        =   2
  61.          Top             =   960
  62.          Width           =   1695
  63.       End
  64.       Begin VB.OptionButton Option1 
  65.          Caption         =   "Succeed"
  66.          Height          =   255
  67.          Left            =   720
  68.          TabIndex        =   1
  69.          Top             =   480
  70.          Width           =   1695
  71.       End
  72.    End
  73.    Begin MSComctlLib.ImageList ImageList1 
  74.       Left            =   840
  75.       Top             =   3720
  76.       _ExtentX        =   1005
  77.       _ExtentY        =   1005
  78.       BackColor       =   -2147483643
  79.       MaskColor       =   12632256
  80.       _Version        =   393216
  81.    End
  82.    Begin VB.Menu mnuPopUp 
  83.       Caption         =   "Tray Menu"
  84.       Begin VB.Menu mnuSend1 
  85.          Caption         =   "Attempt test connection"
  86.       End
  87.       Begin VB.Menu mnuRestore 
  88.          Caption         =   "Restore"
  89.          Enabled         =   0   'False
  90.       End
  91.    End
  92. Attribute VB_Name = "Form1"
  93. Attribute VB_GlobalNameSpace = False
  94. Attribute VB_Creatable = False
  95. Attribute VB_PredeclaredId = True
  96. Attribute VB_Exposed = False
  97. Option Explicit
  98. 'Constants used with mouse click on the system tray icon
  99. Const WM_RBUTTONUP = &H205
  100. Const WM_LBUTTONDBLCLK = &H203
  101. Dim start As Boolean
  102. Private Sub Form_Load()
  103. ' ... How can I get the adding of frames to be more like the
  104. 'adding of buttons to a toolbar control? (i.e. and save the
  105. 'results in the property bag)
  106.     Dim stFrames As New colFrame
  107.     'Set form default values
  108.     txtDelay = 10
  109.     'Load test graphics into imagelists (must be icons)
  110.     ' ... these could come from a resource file in the exe
  111.     ImageList1.ListImages.Add 1, , LoadPicture(App.Path & "\graphics\Chip0.ico")
  112.     ImageList1.ListImages.Add 2, , LoadPicture(App.Path & "\graphics\Chip1.ico")
  113.     ImageList1.ListImages.Add 3, , LoadPicture(App.Path & "\graphics\Chip2.ico")
  114.     ImageList1.ListImages.Add 4, , LoadPicture(App.Path & "\graphics\Chip3.ico")
  115.     ImageList1.ListImages.Add 5, , LoadPicture(App.Path & "\graphics\Chip4.ico")
  116.     ImageList1.ListImages.Add 6, , LoadPicture(App.Path & "\graphics\Chip5.ico")
  117.     ImageList1.ListImages.Add 7, , LoadPicture(App.Path & "\graphics\Chip6.ico")
  118.     'Animation Sequence #1 - "connecting phase"
  119.     'add individual frames to the frames collection
  120.     'format = key, image_index_number, delay_in_seconds
  121.     stFrames.Add 1, 1, 0.5
  122.     stFrames.Add 2, 2, 0.5
  123.     stFrames.Add 3, 3, 0.5
  124.     stFrames.Add 4, 4, 0.5
  125.     stFrames.Add 5, 5, 0.5
  126.     stFrames.Add 6, 1, 0.5
  127.     stFrames.Add 5, 5, 0.5
  128.     stFrames.Add 4, 4, 0.5
  129.     stFrames.Add 3, 3, 0.5
  130.     stFrames.Add 2, 2, 0.5
  131.     'assign these frames to sequence #1
  132.     'specify that images will come from ImageList1
  133.     SysTray1.stSequence.Add 1, "ImageList1", stFrames
  134.     Set stFrames = Nothing
  135.     'Sequence #2 - "connected"
  136.     Set stFrames = New colFrame
  137.     stFrames.Add 1, 1, 1
  138.     stFrames.Add 2, 6, 0.5
  139.     stFrames.Add 3, 1, 0.5
  140.     stFrames.Add 4, 6, 0.5
  141.     stFrames.Add 5, 1, 0.5
  142.     stFrames.Add 6, 6, 1
  143.     SysTray1.stSequence.Add 2, "ImageList1", stFrames
  144.     Set stFrames = Nothing
  145.     'Sequence #3 - "no connection"
  146.     Set stFrames = New colFrame
  147.     stFrames.Add 1, 1, 1
  148.     stFrames.Add 2, 7, 0.5
  149.     stFrames.Add 3, 1, 0.5
  150.     stFrames.Add 4, 7, 0.5
  151.     stFrames.Add 5, 1, 0.5
  152.     stFrames.Add 6, 7, 0.5
  153.     SysTray1.stSequence.Add 3, "ImageList1", stFrames
  154.     Set stFrames = Nothing
  155. End Sub
  156. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  157. ' Enable the popup menu for the system tray icon
  158. ' ... is there a better way to do this ???
  159.     Static Message As Long
  160.     Message = x / Screen.TwipsPerPixelX
  161.     Select Case Message
  162.         Case WM_LBUTTONDBLCLK
  163.             Call mnuRestore_Click
  164.         Case WM_RBUTTONUP:
  165.             Me.PopupMenu mnuPopUp
  166.     End Select
  167. End Sub
  168. Private Sub mnuSend1_Click()
  169.     start = True
  170.     Timer1.Interval = 1000
  171.     ToggleMenu True
  172.     SysTray1.Animate = True
  173.     SysTray1.InitialSequence = 1
  174.     SysTray1.InitialImage = 1
  175.     SysTray1.TipText = "Attempting Connection ..."
  176.     SysTray1.SendToTray
  177.     SysTray1.PlayAnimation 1, True
  178. End Sub
  179. Private Sub mnuRestore_Click()
  180.     ToggleMenu False
  181.     SysTray1.RestoreFromTray
  182. End Sub
  183. Private Sub ToggleMenu(ByVal blnSendToTray As Boolean)
  184.     If blnSendToTray = True Then
  185.         mnuSend1.Enabled = False
  186.         mnuRestore.Enabled = True
  187.     Else
  188.         mnuSend1.Enabled = True
  189.         mnuRestore.Enabled = False
  190.     End If
  191. End Sub
  192. Private Sub Timer1_Timer()
  193.     Static x As Integer
  194.     If start = True Then
  195.         x = x + 1
  196.         If x >= txtDelay.Text Then
  197.             Timer1.Interval = 0
  198.             x = 0
  199.             If Option1.Value = True Then
  200.                 'display success
  201.                 SysTray1.TipText = "Success"
  202.                 SysTray1.PlayAnimation 2, False
  203.             End If
  204.             If Option2.Value = True Then
  205.                 'display failure
  206.                 SysTray1.TipText = "Failure"
  207.                 SysTray1.PlayAnimation 3, False
  208.             End If
  209.         End If
  210.     End If
  211. End Sub
  212.