home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Yet_anothe2099551282008.psc / frmClock.frm < prev    next >
Text File  |  2008-01-28  |  8KB  |  280 lines
  1. VERSION 5.00
  2. Begin VB.Form frmClock 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00000000&
  5.    BorderStyle     =   1  'Fest Einfach
  6.    ClientHeight    =   360
  7.    ClientLeft      =   15
  8.    ClientTop       =   15
  9.    ClientWidth     =   1395
  10.    ControlBox      =   0   'False
  11.    FillColor       =   &H00C0FFC0&
  12.    ForeColor       =   &H00C0FFC0&
  13.    Icon            =   "frmClock.frx":0000
  14.    LinkTopic       =   "Form1"
  15.    LockControls    =   -1  'True
  16.    MaxButton       =   0   'False
  17.    MinButton       =   0   'False
  18.    ScaleHeight     =   360
  19.    ScaleWidth      =   1395
  20.    Begin VB.Timer tmrTick 
  21.       Interval        =   40
  22.       Left            =   0
  23.       Top             =   300
  24.    End
  25.    Begin prjClock.Counter cntTime 
  26.       Height          =   390
  27.       Index           =   0
  28.       Left            =   1005
  29.       TabIndex        =   0
  30.       ToolTipText     =   "Seconds"
  31.       Top             =   -15
  32.       Width           =   405
  33.       _ExtentX        =   714
  34.       _ExtentY        =   688
  35.       ForeColor       =   16777215
  36.       CharacterExtraX =   0
  37.       CharacterExtraY =   4
  38.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  39.          Name            =   "Arial"
  40.          Size            =   14.25
  41.          Charset         =   0
  42.          Weight          =   700
  43.          Underline       =   0   'False
  44.          Italic          =   0   'False
  45.          Strikethrough   =   0   'False
  46.       EndProperty
  47.       Digits          =   2
  48.    End
  49.    Begin prjClock.Counter cntTime 
  50.       Height          =   390
  51.       Index           =   1
  52.       Left            =   495
  53.       TabIndex        =   1
  54.       ToolTipText     =   "Minutes"
  55.       Top             =   -15
  56.       Width           =   405
  57.       _ExtentX        =   714
  58.       _ExtentY        =   688
  59.       ForeColor       =   16777215
  60.       CharacterExtraX =   0
  61.       CharacterExtraY =   4
  62.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  63.          Name            =   "Arial"
  64.          Size            =   14.25
  65.          Charset         =   0
  66.          Weight          =   700
  67.          Underline       =   0   'False
  68.          Italic          =   0   'False
  69.          Strikethrough   =   0   'False
  70.       EndProperty
  71.       Digits          =   2
  72.    End
  73.    Begin prjClock.Counter cntTime 
  74.       Height          =   390
  75.       Index           =   2
  76.       Left            =   -15
  77.       TabIndex        =   2
  78.       ToolTipText     =   "Hours"
  79.       Top             =   -15
  80.       Width           =   405
  81.       _ExtentX        =   714
  82.       _ExtentY        =   688
  83.       ForeColor       =   16777215
  84.       CharacterExtraX =   0
  85.       CharacterExtraY =   4
  86.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  87.          Name            =   "Arial"
  88.          Size            =   14.25
  89.          Charset         =   0
  90.          Weight          =   700
  91.          Underline       =   0   'False
  92.          Italic          =   0   'False
  93.          Strikethrough   =   0   'False
  94.       EndProperty
  95.       Digits          =   2
  96.    End
  97.    Begin VB.Label lbl 
  98.       Appearance      =   0  '2D
  99.       AutoSize        =   -1  'True
  100.       BackColor       =   &H00004000&
  101.       BackStyle       =   0  'Transparent
  102.       BorderStyle     =   1  'Fest Einfach
  103.       Caption         =   ":"
  104.       BeginProperty Font 
  105.          Name            =   "Arial"
  106.          Size            =   14.25
  107.          Charset         =   0
  108.          Weight          =   700
  109.          Underline       =   0   'False
  110.          Italic          =   0   'False
  111.          Strikethrough   =   0   'False
  112.       EndProperty
  113.       ForeColor       =   &H00004000&
  114.       Height          =   360
  115.       Index           =   1
  116.       Left            =   885
  117.       TabIndex        =   4
  118.       Top             =   0
  119.       Width           =   135
  120.    End
  121.    Begin VB.Label lbl 
  122.       Appearance      =   0  '2D
  123.       AutoSize        =   -1  'True
  124.       BackColor       =   &H00004000&
  125.       BackStyle       =   0  'Transparent
  126.       BorderStyle     =   1  'Fest Einfach
  127.       Caption         =   ":"
  128.       BeginProperty Font 
  129.          Name            =   "Arial"
  130.          Size            =   14.25
  131.          Charset         =   0
  132.          Weight          =   700
  133.          Underline       =   0   'False
  134.          Italic          =   0   'False
  135.          Strikethrough   =   0   'False
  136.       EndProperty
  137.       ForeColor       =   &H00004000&
  138.       Height          =   360
  139.       Index           =   0
  140.       Left            =   375
  141.       TabIndex        =   3
  142.       Top             =   0
  143.       Width           =   135
  144.    End
  145. End
  146. Attribute VB_Name = "frmClock"
  147. Attribute VB_GlobalNameSpace = False
  148. Attribute VB_Creatable = False
  149. Attribute VB_PredeclaredId = True
  150. Attribute VB_Exposed = False
  151. Option Explicit
  152.  
  153. Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  154. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  155. Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  156. Private Type RECT
  157.     Left        As Long
  158.     Top         As Long
  159.     Right       As Long
  160.     Bottom      As Long
  161. End Type
  162.  
  163. Private WinRect             As RECT
  164.  
  165. Private WithEvents Systray  As clsSystray
  166. Attribute Systray.VB_VarHelpID = -1
  167.  
  168. Private ShowAgain           As Single
  169. Private SitsOnTop           As Boolean
  170.  
  171. Private Sub cntTime_MouseMove(Index As Integer)
  172.  
  173.     If SitsOnTop Then
  174.         Hide
  175.         ShowAgain = (Timer + 5) Mod 68400 'after 5 seconds
  176.     End If
  177.  
  178. End Sub
  179.  
  180. Private Sub Form_Load()
  181.  
  182.   Dim i     As Long
  183.   Dim Delay As Single
  184.  
  185.     If App.PrevInstance Then
  186.         Unload Me
  187.       Else 'APP.PREVINSTANCE = FALSE/0
  188.         For i = 0 To 2
  189.             cntTime(i).BackColor = BackColor
  190.             cntTime(i).ForeColor = ForeColor
  191.         Next i
  192.         lbl(0).ForeColor = ForeColor
  193.         lbl(1).ForeColor = ForeColor
  194.         Set Systray = New clsSystray
  195.         With Systray
  196.             .SetOwner Me
  197.             .AddIconToTray Icon.Handle, , True
  198.             .Tooltip = vbCrLf & App.ProductName & vbCrLf & vbCrLf & "   Click to unload" & vbCrLf
  199.             .ShowBalloon "        Click me to terminate", "System Tray Clock", InfoIcon
  200.             i = FindWindow("Shell_TrayWnd", vbNullString) 'find tray
  201.             GetWindowRect i, WinRect
  202.             If Not InIDE Then
  203.                 SetParent hwnd, i 'tray is gonna be my parent
  204.             End If
  205.             If WinRect.Bottom - WinRect.Top < 64 Then
  206.                 Move 0, 30 'on top of start button
  207.                 SitsOnTop = True
  208.               Else 'NOT WINRECT.BOTTOM...
  209.                 Move 0, 480 'below start button
  210.             End If
  211.  
  212.             Delay = Timer + 3
  213.             Do
  214.                 DoEvents
  215.             Loop Until Timer > Delay
  216.             .HideBalloon
  217.         End With 'SYSTRAY
  218.     End If
  219.  
  220. End Sub
  221.  
  222. Private Function InIDE(Optional c As Boolean = False) As Boolean
  223.  
  224.   Static b  As Boolean
  225.  
  226.     b = c
  227.     If b = False Then
  228.         Debug.Assert InIDE(True)
  229.     End If
  230.     InIDE = b
  231.  
  232. End Function
  233.  
  234. Private Sub lbl_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
  235.  
  236.     cntTime_MouseMove 0
  237.  
  238. End Sub
  239.  
  240. Private Sub Systray_MouseDown(Button As Integer)
  241.  
  242.     Unload Me
  243.  
  244. End Sub
  245.  
  246. Private Sub tmrTick_Timer()
  247.  
  248.   Dim Tim       As Single
  249.   Dim Frac      As Single
  250.   Dim Hour      As Single
  251.   Dim Minute    As Single
  252.   Dim Second    As Single
  253.  
  254.     Hour = Timer
  255.     If Hour > ShowAgain Then
  256.         Show
  257.         If Not SitsOnTop Then
  258.             ShowAgain = 99999
  259.         End If
  260.     End If
  261.     Tim = Int(Hour)
  262.     Frac = Hour - Tim
  263.     Second = Tim Mod 60 + Frac
  264.     Minute = (Tim \ 60) Mod 60
  265.     Hour = Tim \ 3600
  266.     If Second > 59 Then
  267.         Minute = Minute + Frac
  268.         If Minute > 59 Then
  269.             Hour = Hour + Frac
  270.         End If
  271.     End If
  272.     cntTime(0) = Second
  273.     cntTime(1) = Minute
  274.     cntTime(2) = Hour
  275.  
  276. End Sub
  277.  
  278. ':) Ulli's VB Code Formatter V2.23.17 (2008-Jan-28 11:28)  Decl: 18  Code: 107  Total: 125 Lines
  279. ':) CommentOnly: 2 (1,6%)  Commented: 8 (6,4%)  Empty: 27 (21,6%)  Max Logic Depth: 4
  280.