home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1997 March / VPR9703A.ISO / MS_DEV / VBCCE / SAMPLES / AXClock / AXClock.EXE / RCDATA / CABINET / Clock.ctl < prev    next >
Text File  |  1996-10-25  |  16KB  |  497 lines
  1. VERSION 5.00
  2. Begin VB.UserControl Clock 
  3.    AutoRedraw      =   -1  'True
  4.    ClientHeight    =   3600
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   3540
  8.    BeginProperty Font 
  9.       Name            =   "Tahoma"
  10.       Size            =   8.25
  11.       Charset         =   0
  12.       Weight          =   400
  13.       Underline       =   0   'False
  14.       Italic          =   0   'False
  15.       Strikethrough   =   0   'False
  16.    EndProperty
  17.    PropertyPages   =   "Clock.ctx":0000
  18.    ScaleHeight     =   3600
  19.    ScaleWidth      =   3540
  20.    ToolboxBitmap   =   "Clock.ctx":0004
  21.    Begin VB.Timer Timer1 
  22.       Enabled         =   0   'False
  23.       Interval        =   499
  24.       Left            =   2880
  25.       Top             =   360
  26.    End
  27.    Begin VB.Label lblNumber 
  28.       Alignment       =   2  'Center
  29.       BackStyle       =   0  'Transparent
  30.       Caption         =   "9"
  31.       BeginProperty Font 
  32.          Name            =   "Tahoma"
  33.          Size            =   12
  34.          Charset         =   0
  35.          Weight          =   400
  36.          Underline       =   0   'False
  37.          Italic          =   0   'False
  38.          Strikethrough   =   0   'False
  39.       EndProperty
  40.       Height          =   375
  41.       Index           =   3
  42.       Left            =   3000
  43.       TabIndex        =   3
  44.       Top             =   3120
  45.       Visible         =   0   'False
  46.       Width           =   495
  47.    End
  48.    Begin VB.Label lblNumber 
  49.       Alignment       =   2  'Center
  50.       BackStyle       =   0  'Transparent
  51.       Caption         =   "6"
  52.       BeginProperty Font 
  53.          Name            =   "Tahoma"
  54.          Size            =   12
  55.          Charset         =   0
  56.          Weight          =   400
  57.          Underline       =   0   'False
  58.          Italic          =   0   'False
  59.          Strikethrough   =   0   'False
  60.       EndProperty
  61.       Height          =   375
  62.       Index           =   2
  63.       Left            =   2640
  64.       TabIndex        =   2
  65.       Top             =   3120
  66.       Visible         =   0   'False
  67.       Width           =   495
  68.    End
  69.    Begin VB.Label lblNumber 
  70.       Alignment       =   2  'Center
  71.       BackStyle       =   0  'Transparent
  72.       Caption         =   "3"
  73.       BeginProperty Font 
  74.          Name            =   "Tahoma"
  75.          Size            =   12
  76.          Charset         =   0
  77.          Weight          =   400
  78.          Underline       =   0   'False
  79.          Italic          =   0   'False
  80.          Strikethrough   =   0   'False
  81.       EndProperty
  82.       Height          =   375
  83.       Index           =   1
  84.       Left            =   2280
  85.       TabIndex        =   1
  86.       Top             =   3120
  87.       Visible         =   0   'False
  88.       Width           =   495
  89.    End
  90.    Begin VB.Label lblNumber 
  91.       Alignment       =   2  'Center
  92.       BackStyle       =   0  'Transparent
  93.       Caption         =   "12"
  94.       BeginProperty Font 
  95.          Name            =   "Tahoma"
  96.          Size            =   12
  97.          Charset         =   0
  98.          Weight          =   400
  99.          Underline       =   0   'False
  100.          Italic          =   0   'False
  101.          Strikethrough   =   0   'False
  102.       EndProperty
  103.       Height          =   375
  104.       Index           =   0
  105.       Left            =   1920
  106.       TabIndex        =   0
  107.       Top             =   3120
  108.       Visible         =   0   'False
  109.       Width           =   495
  110.    End
  111.    Begin VB.Line lSecond 
  112.       BorderWidth     =   2
  113.       X1              =   1560
  114.       X2              =   600
  115.       Y1              =   1560
  116.       Y2              =   2400
  117.    End
  118.    Begin VB.Line lMinute 
  119.       BorderWidth     =   4
  120.       X1              =   1560
  121.       X2              =   1560
  122.       Y1              =   240
  123.       Y2              =   1560
  124.    End
  125.    Begin VB.Line lHour 
  126.       BorderWidth     =   5
  127.       X1              =   1560
  128.       X2              =   2160
  129.       Y1              =   1560
  130.       Y2              =   2160
  131.    End
  132.    Begin VB.Shape ClockFace 
  133.       BorderWidth     =   5
  134.       Height          =   2895
  135.       Left            =   120
  136.       Shape           =   2  'Oval
  137.       Top             =   120
  138.       Width           =   2895
  139.    End
  140. End
  141. Attribute VB_Name = "Clock"
  142. Attribute VB_GlobalNameSpace = False
  143. Attribute VB_Creatable = True
  144. Attribute VB_PredeclaredId = False
  145. Attribute VB_Exposed = True
  146. Attribute VB_Description = "Analog Clock Object Browser"
  147. Option Explicit
  148.  
  149. 'Generic Constants
  150. Const PI                As Double = 3.14159265358979
  151. Const TwoPI             As Double = 2 * PI
  152. Const HourRatio         As Single = 0.55            ' Size of hour hand
  153. Const MinuteRatio       As Single = 0.85            ' Size of minute hand
  154. Const SecondRatio       As Single = 0.85            ' Size of second hand
  155.  
  156. 'Property Constants
  157. Const m_def_Enabled     As Boolean = False          ' Default with clock not enabled
  158. Const m_def_ShowNumbers As Boolean = False          ' Default with numbers not visible
  159. Const m_def_ShowBorder  As Boolean = True           ' Default with clock border visible
  160. Const m_def_ShowSeconds As Boolean = True           ' Default with second hand visible
  161. Const m_def_ColorBorder As Long = &H0               ' Default with color black
  162. Const m_def_ColorFace   As Long = &HFFFFFF          ' Default with color white
  163.  
  164. 'Private Property Variables
  165. Private m_Enabled       As Boolean                  ' Clock enabled?
  166. Private m_ShowNumbers   As Boolean                  ' Numbers visible?
  167. Private m_ShowBorder    As Boolean                  ' Clock border visible?
  168. Private m_ShowSeconds   As Boolean                  ' Second hand visible?
  169. Private m_ColorBorder   As OLE_COLOR                ' Clock border color
  170. Private m_ColorFace     As OLE_COLOR                ' Clock face color
  171. Private m_Picture       As StdPicture               ' Clock picture
  172. Private m_URLPicture    As String                   ' URL address
  173.  
  174. 'Private Generic Variables
  175. Private HalfX           As Long                     ' X-direction center of control
  176. Private HalfY           As Long                     ' Y-direction center of control
  177. Private CurrentTime     As String                   ' Current time
  178. Private OldTime         As String                   ' Old time holder
  179.  
  180. 'Initialize Properties for User Control
  181. Private Sub UserControl_InitProperties()
  182.     m_ShowNumbers = m_def_ShowNumbers
  183.     m_ShowBorder = m_def_ShowBorder
  184.     m_ShowSeconds = m_def_ShowSeconds
  185.     m_ColorBorder = m_def_ColorBorder
  186.     m_ColorFace = m_def_ColorFace
  187.     
  188.     OldTime = Format(Now, "hhmmss")
  189. End Sub
  190.  
  191. Private Sub Timer1_Timer()
  192.     CurrentTime = Format(Now, "hhmmss")
  193.         
  194. '   If the time hasn't changed, don't need to update clock
  195.     If CurrentTime = OldTime Then
  196.         Exit Sub
  197.     Else
  198.         DrawHands (CurrentTime)
  199.         OldTime = CurrentTime
  200.     End If
  201. End Sub
  202.  
  203. Private Sub UserControl_Resize()
  204.     Timer1.Enabled = False
  205.  
  206.     ClockFace.Move ScaleWidth * 0.01, ScaleHeight * 0.01, ScaleWidth * 0.98, ScaleHeight * 0.98
  207.     
  208.     HalfX = ScaleWidth / 2
  209.     HalfY = ScaleHeight / 2
  210.  
  211.     CurrentTime = Format(Now, "hhmmss")
  212.     
  213.     DrawHands (CurrentTime)
  214.     
  215.     If m_ShowNumbers Then PlaceNumbers
  216.     
  217. '   Repaint picture, if needed
  218.     UserControl_Paint
  219.     
  220.     Timer1.Enabled = m_Enabled
  221. End Sub
  222.  
  223. Private Sub UserControl_Paint()
  224. '   Don't need to draw if picture is invalid
  225.     If (m_Picture Is Nothing) Then Exit Sub
  226.     
  227.     With UserControl
  228.         .PaintPicture m_Picture, _
  229.                       .ScaleX(2, vbTwips, vbHimetric), _
  230.                       .ScaleY(2, vbTwips, vbHimetric), _
  231.                       .ScaleX(.Width - 4, vbTwips, vbHimetric), _
  232.                       .ScaleY(.Height - 4, vbTwips, vbHimetric), _
  233.                       0, _
  234.                       0, _
  235.                       m_Picture.Width, _
  236.                       m_Picture.Height
  237.     End With
  238. End Sub
  239.  
  240. Private Sub DrawHands(MyTime As String)
  241.     Dim cHour As Integer
  242.     Dim cMinute As Integer
  243.     Dim cSecond As Integer
  244.     
  245.     cHour = CInt(Mid(MyTime, 1, 2))
  246.     cMinute = CInt(Mid(MyTime, 3, 2))
  247.     cSecond = CInt(Mid(MyTime, 5, 2))
  248.     
  249. '   Draw Hour Hand
  250.     With lHour
  251.         .X1 = HalfX
  252.         .Y1 = HalfY
  253.         .X2 = HalfX + GiveX((cHour Mod 12) * 5 + (Int(cMinute / 12)), HalfX, HourRatio)
  254.         .Y2 = HalfY - GiveY((cHour Mod 12) * 5 + (Int(cMinute / 12)), HalfY, HourRatio)
  255.     End With
  256.  
  257. '   Draw Minute Hand
  258.     With lMinute
  259.         .X1 = HalfX
  260.         .Y1 = HalfY
  261.         .X2 = HalfX + GiveX(cMinute, HalfX, MinuteRatio)
  262.         .Y2 = HalfY - GiveY(cMinute, HalfY, MinuteRatio)
  263.     End With
  264.     
  265. '   Draw Second Hand
  266.     With lSecond
  267.         .X1 = HalfX
  268.         .Y1 = HalfY
  269.         .X2 = HalfX + GiveX(cSecond, HalfX, SecondRatio)
  270.         .Y2 = HalfY - GiveY(cSecond, HalfY, SecondRatio)
  271.     End With
  272. End Sub
  273.  
  274. Private Function GiveX(ByVal Angle As Integer, ByVal MaxX As Integer, ByVal Ratio As Single) As Integer
  275.     GiveX = MaxX * Ratio * Sin((Angle / 60) * TwoPI)
  276. End Function
  277.  
  278. Private Function GiveY(ByVal Angle As Integer, ByVal MaxY As Integer, ByVal Ratio As Single) As Integer
  279.     GiveY = MaxY * Ratio * Cos((Angle / 60) * TwoPI)
  280. End Function
  281.  
  282. Private Sub PlaceNumbers()
  283.     Dim tHeight As Integer
  284.     Dim tWidth As Integer
  285.     Dim WBorder As Integer
  286.     Dim HBorder As Integer
  287.     
  288. '   Get largest font size that will fit in display label
  289.     tHeight = ScaleHeight * 0.1
  290.     WBorder = ScaleWidth * 0.035
  291.     HBorder = ScaleHeight * 0.02
  292.     
  293.     FontSize = 1
  294.     
  295.     While TextHeight("3") < tHeight
  296.         FontSize = FontSize + 1
  297.     Wend
  298.     
  299. '   Since went to > tHeight, need to subtract 1
  300.     FontSize = FontSize - 1
  301.     
  302.     With lblNumber(0)
  303.         .FontSize = FontSize
  304.         .Width = TextWidth("12")
  305.         .Height = TextHeight("12")
  306.         .Move HalfX - (.Width / 2), HBorder
  307.     End With
  308.     With lblNumber(1)
  309.         .FontSize = FontSize
  310.         .Width = TextWidth("3")
  311.         .Height = TextHeight("3")
  312.         .Move ScaleWidth - .Width - WBorder, HalfY - (.Height / 2)
  313.     End With
  314.     With lblNumber(2)
  315.         .FontSize = FontSize
  316.         .Width = TextWidth("6")
  317.         .Height = TextHeight("6")
  318.         .Move HalfX - (.Width / 2), ScaleHeight - .Height - HBorder
  319.     End With
  320.     With lblNumber(3)
  321.         .FontSize = FontSize
  322.         .Width = TextWidth("9")
  323.         .Height = TextHeight("9")
  324.         .Move WBorder, HalfY - (.Height / 2)
  325.     End With
  326. End Sub
  327.  
  328. Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
  329.     If (AsyncProp.PropertyName = "URLPicture") Then Set Picture = AsyncProp.Value
  330. End Sub
  331.  
  332. Public Property Get Enabled() As Boolean
  333.     Enabled = m_Enabled
  334. End Property
  335.  
  336. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  337.     m_Enabled = New_Enabled
  338.     Timer1.Enabled = New_Enabled
  339. End Property
  340.  
  341. Public Property Get ShowNumbers() As Boolean
  342.     ShowNumbers = m_ShowNumbers
  343. End Property
  344.  
  345. Public Property Let ShowNumbers(ByVal New_ShowNumbers As Boolean)
  346.     m_ShowNumbers = New_ShowNumbers
  347.     
  348.     lblNumber(0).Visible = New_ShowNumbers
  349.     lblNumber(1).Visible = New_ShowNumbers
  350.     lblNumber(2).Visible = New_ShowNumbers
  351.     lblNumber(3).Visible = New_ShowNumbers
  352.     
  353.     UserControl_Resize
  354.     
  355.     PropertyChanged "ShowNumbers"
  356. End Property
  357.  
  358. Public Property Get ShowBorder() As Boolean
  359.     ShowBorder = m_ShowBorder
  360. End Property
  361.  
  362. Public Property Let ShowBorder(ByVal New_ShowBorder As Boolean)
  363.     m_ShowBorder = New_ShowBorder
  364.     
  365.     ClockFace.Visible = New_ShowBorder
  366.     
  367. '   Have to repaint, since picture needs to be redrawn based on new border
  368.     If Not m_Picture Is Nothing Then
  369.         UserControl_Paint
  370.     End If
  371.     
  372.     PropertyChanged "ShowBorder"
  373. End Property
  374.  
  375. Public Property Get ShowSeconds() As Boolean
  376.     ShowSeconds = m_ShowSeconds
  377. End Property
  378.  
  379. Public Property Let ShowSeconds(ByVal New_ShowSeconds As Boolean)
  380.     m_ShowSeconds = New_ShowSeconds
  381.     
  382.     lSecond.Visible = New_ShowSeconds
  383.    
  384.     PropertyChanged "ShowSeconds"
  385. End Property
  386.  
  387. Public Property Get ColorBorder() As OLE_COLOR
  388.     ColorBorder = m_ColorBorder
  389. End Property
  390.  
  391. Public Property Let ColorBorder(ByVal New_ColorBorder As OLE_COLOR)
  392.     m_ColorBorder = New_ColorBorder
  393.     
  394.     ClockFace.BorderColor = New_ColorBorder
  395.     lHour.BorderColor = New_ColorBorder
  396.     lMinute.BorderColor = New_ColorBorder
  397.     lSecond.BorderColor = New_ColorBorder
  398.     lblNumber(0).ForeColor = New_ColorBorder
  399.     lblNumber(1).ForeColor = New_ColorBorder
  400.     lblNumber(2).ForeColor = New_ColorBorder
  401.     lblNumber(3).ForeColor = New_ColorBorder
  402.     
  403.     PropertyChanged "ColorBorder"
  404. End Property
  405.  
  406. Public Property Get ColorFace() As OLE_COLOR
  407.     ColorFace = m_ColorFace
  408. End Property
  409.  
  410. Public Property Let ColorFace(ByVal New_ColorFace As OLE_COLOR)
  411.     m_ColorFace = New_ColorFace
  412.     
  413.     With ClockFace
  414.         .FillColor = New_ColorFace
  415.         .FillStyle = 0
  416.         .Refresh
  417.     End With
  418.  
  419.     PropertyChanged "ColorFace"
  420. End Property
  421.  
  422. Public Property Get Picture() As StdPicture
  423.     Set Picture = m_Picture
  424. End Property
  425.  
  426. Public Property Set Picture(New_Picture As StdPicture)
  427.     Set m_Picture = New_Picture
  428.     
  429.     ColorBorder = m_def_ColorBorder
  430.     ColorFace = m_def_ColorFace
  431.     
  432.     With ClockFace
  433.         .FillColor = 0
  434.         .FillStyle = 1
  435.         .Refresh
  436.     End With
  437.     
  438.     UserControl.Picture = m_Picture
  439.     
  440.     UserControl_Resize
  441.     
  442.     PropertyChanged "Picture"
  443. End Property
  444.  
  445. Public Property Let URLPicture(Url As String)
  446.     If (m_URLPicture <> Url) Then
  447.         m_URLPicture = Url
  448.         PropertyChanged "URLPicture"
  449.         
  450.         On Error Resume Next
  451.         
  452.         UserControl.AsyncRead Url, vbAsyncTypePicture, "URLPicture"
  453.     End If
  454. End Property
  455.  
  456. Public Property Get URLPicture() As String
  457.     URLPicture = m_URLPicture
  458. End Property
  459.  
  460. 'Load property values from storage
  461. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  462.     Dim Pic As StdPicture
  463.     Dim Url As String
  464.     
  465.     With PropBag
  466.         m_Enabled = .ReadProperty("Enabled", m_def_Enabled)
  467.         m_ShowNumbers = .ReadProperty("ShowNumbers", m_def_ShowNumbers)
  468.         m_ShowBorder = .ReadProperty("ShowBorder", m_def_ShowBorder)
  469.         m_ShowSeconds = .ReadProperty("ShowSeconds", m_def_ShowSeconds)
  470.         m_ColorBorder = .ReadProperty("ColorBorder", m_def_ColorBorder)
  471.         m_ColorFace = .ReadProperty("ColorFace", m_def_ColorFace)
  472.         
  473.         Set Pic = .ReadProperty("Picture", Nothing)
  474.         Url = .ReadProperty("URLPicture", "")
  475.         
  476.         If (Url <> "") Then
  477.             URLPicture = Url
  478.         ElseIf Not (Pic Is Nothing) Then
  479.             Set Picture = Pic
  480.         End If
  481.     End With
  482. End Sub
  483.  
  484. 'Write property values to storage
  485. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  486.     With PropBag
  487.         .WriteProperty "Enabled", m_Enabled, m_def_Enabled
  488.         .WriteProperty "ShowNumbers", m_ShowNumbers, m_def_ShowNumbers
  489.         .WriteProperty "ShowBorder", m_ShowBorder, m_def_ShowBorder
  490.         .WriteProperty "ShowSeconds", m_ShowSeconds, m_def_ShowSeconds
  491.         .WriteProperty "ColorBorder", m_ColorBorder, m_def_ColorBorder
  492.         .WriteProperty "ColorFace", m_ColorFace, m_def_ColorFace
  493.         .WriteProperty "Picture", m_Picture
  494.         .WriteProperty "URLPicture", m_URLPicture
  495.     End With
  496. End Sub
  497.