Tuesday 1 October 2013

A usercontrol example to build an Analog clock in Visual Basic 6.0

Download Source Code

Option Explicit
Private Type POINTAPI
    x As Double
    y As Double
End Type
Private oHrCenter As POINTAPI, oHrEnd As POINTAPI
Private oMinCenter As POINTAPI, oMinEnd As POINTAPI
Private oSecCenter As POINTAPI, oSecEnd As POINTAPI
Private m_Hour As Integer
Private m_Minute As Integer
Private m_Second As Integer
Private m_Radius As Double
Private Const PIE = 3.14159265358979

Private Sub Timer1_Timer()
    Call UserControl_Resize
End Sub

Private Sub UserControl_Initialize()
    UserControl.ScaleMode = vbPixels
End Sub

Private Sub DrawClock()
    UserControl.Cls
    m_Hour = VBA.hour(VBA.Now)
    m_Minute = VBA.Minute(VBA.Now)
    m_Second = VBA.second(VBA.Now)
    Call SetHour((m_Hour Mod 12))
    Call SetMinute(m_Minute)
    Call SetSecond(m_Second)
    Debug.Print (m_Second) & " : " & GetAngle(m_Second * 6)
    UserControl.Circle (oHrCenter.x, oHrCenter.y), m_Radius, RGB(255, 255, 255)
    UserControl.DrawWidth = 2    UserControl.Line (oHrCenter.x, oHrCenter.y)-(oHrEnd.x, oHrEnd.y)
    UserControl.DrawWidth = 1
    UserControl.Line (oMinCenter.x, oMinCenter.y)-(oMinEnd.x, oMinEnd.y)
    UserControl.Line (oSecCenter.x, oSecCenter.y)-(oSecEnd.x, oSecEnd.y)
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    If UserControl.Ambient.UserMode = True Then
        Timer1.Enabled = True
        Timer1.Interval = 1000
    End If
End Sub

Private Sub UserControl_Resize()
    UserControl.Height = UserControl.Width
    m_Radius = UserControl.ScaleWidth / 2 - 1
    DrawClock
End Sub

Public Sub SetHour(hour As Integer)
    oHrCenter.x = UserControl.ScaleWidth / 2
    oHrCenter.y = UserControl.ScaleHeight / 2
    oHrEnd.x = (m_Radius - 10) * XValue(hour * 30) + oHrCenter.x
    oHrEnd.y = (m_Radius - 10) * YValue(hour * 30) + oHrCenter.y
End Sub

Public Sub SetMinute(min As Integer)
    oMinCenter.x = UserControl.ScaleWidth / 2
    oMinCenter.y = UserControl.ScaleHeight / 2
    oMinEnd.x = (m_Radius - 5) * XValue(min * 6) + oMinCenter.x
    oMinEnd.y = (m_Radius - 5) * YValue(min * 6) + oMinCenter.y
End Sub

Public Sub SetSecond(second As Integer)
    oSecCenter.x = UserControl.ScaleWidth / 2
    oSecCenter.y = UserControl.ScaleHeight / 2
    oSecEnd.x = (m_Radius) * XValue(second * 6) + oSecCenter.x
    oSecEnd.y = (m_Radius) * YValue(second * 6) + oSecCenter.y
 '   Debug.Print (second * 6)

End Sub

Private Function GetAngle(ang As Double) As Double
'    If ang > 0 And ang <= 90 Then
'      GetAngle = 90 - ang
'    Else
        GetAngle = (450 - ang)
'    End If
End Function

Private Function YValue(ByVal angle As Double) As Double
  Select Case angle
    Case 0 To 90, 360 To 450
      YValue = -Math.Sin(GetAngle(angle) * 2 * PIE / 360)
    Case 90 To 180
      YValue = -Math.Sin(GetAngle(angle) * 2 * PIE / 360)
    Case 180 To 270
      YValue = -Math.Sin(GetAngle(angle) * 2 * PIE / 360)
    Case 270 To 360
      YValue = -Math.Sin(GetAngle(angle) * 2 * PIE / 360)
  End Select
End Function

Private Function XValue(ByVal angle As Double) As Double
  Select Case (angle)
    Case 0 To 90, 360 To 450
      XValue = Math.Cos(GetAngle(angle) * 2 * PIE / 360)
    Case 90 To 180
      XValue = Math.Cos(GetAngle(angle) * 2 * PIE / 360)
    Case 180 To 270
      XValue = Math.Cos(GetAngle(angle) * 2 * PIE / 360)
    Case 270 To 360
      XValue = Math.Cos(GetAngle(angle) * 2 * PIE / 360)
  End Select
End Function

No comments: