home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Gradient_C2055663232007.psc / ClockOCX.ctl < prev    next >
Text File  |  2007-03-23  |  35KB  |  891 lines
  1. VERSION 5.00
  2. Begin VB.UserControl AnalogClock 
  3.    AutoRedraw      =   -1  'True
  4.    ClientHeight    =   375
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   360
  8.    ClipControls    =   0   'False
  9.    BeginProperty Font 
  10.       Name            =   "Tahoma"
  11.       Size            =   24
  12.       Charset         =   0
  13.       Weight          =   700
  14.       Underline       =   0   'False
  15.       Italic          =   0   'False
  16.       Strikethrough   =   0   'False
  17.    EndProperty
  18.    PaletteMode     =   2  'Custom
  19.    PropertyPages   =   "ClockOCX.ctx":0000
  20.    ScaleHeight     =   375
  21.    ScaleWidth      =   360
  22.    ToolboxBitmap   =   "ClockOCX.ctx":0014
  23.    Begin VB.Timer Timer1 
  24.       Interval        =   100
  25.       Left            =   2595
  26.       Top             =   2625
  27.    End
  28. End
  29. Attribute VB_Name = "AnalogClock"
  30. Attribute VB_GlobalNameSpace = False
  31. Attribute VB_Creatable = True
  32. Attribute VB_PredeclaredId = False
  33. Attribute VB_Exposed = False
  34. Option Explicit
  35.  
  36. Private Type POINTAPI
  37.    X As Long
  38.    Y As Long
  39. End Type
  40.  
  41. Private Const ALTERNATE As Long = 1
  42. Private Const Pi As Double = 3.14159265358979
  43. Private Const WINDING As Long = 2
  44.  
  45. Private Declare Function CreateEllipticRgn Lib "gdi32.dll" (ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
  46. Private Declare Function CreatePolygonRgn Lib "gdi32.dll" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
  47. Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
  48. Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
  49. Private Declare Function FillRgn Lib "gdi32.dll" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
  50. Private Declare Function FrameRgn Lib "gdi32.dll" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  51. Private Declare Function OffsetRgn Lib "gdi32.dll" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long
  52. Private Declare Function SetWindowRgn Lib "user32.dll" (ByVal hWd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  53.  
  54. Private Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  55. Private Declare Function SetPixelV Lib "gdi32.dll" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
  56.  
  57. Private m_DrawHourOutline As Boolean
  58. Private m_DrawMinuteOutline As Boolean
  59. Private m_DrawShadow As Boolean
  60. Private m_DrawBodyOutline As Boolean
  61. Private m_DrawSecond As Boolean
  62. Private m_ShowMinorPoint As Boolean
  63. Private m_ShowMajorPoint As Boolean
  64. Private m_MinuteOutline As OLE_COLOR
  65. Private m_HourOutline As OLE_COLOR
  66. Private m_MajorPoint As OLE_COLOR
  67. Private m_MinorPoint As OLE_COLOR
  68. Private m_SecondPointer As OLE_COLOR
  69. Private m_MinutePointer As OLE_COLOR
  70. Private m_HourPointer As OLE_COLOR
  71. Private m_CircleBorder As OLE_COLOR
  72. Private m_ClockBody As OLE_COLOR
  73. Private m_AntiAliasing As Boolean
  74.  
  75. Private m_button As Integer
  76.  
  77. Private CenterX As Long
  78. Private CenterY As Long
  79.  
  80. Public Event Click()
  81. Public Event DblClick()
  82. Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
  83.  
  84. Private Function Dec2Rad(ByVal dblDec As Double) As Double 'Convert Decimal To Radian, I don't know math that well, so I got it from some where
  85.    Dim dRad As Double
  86.  
  87.    dRad = Pi / 180
  88.    Dec2Rad = dblDec * dRad
  89. End Function
  90.  
  91. Private Sub ShowTime()
  92.    Dim dH As Long, dH1 As Long, dH2 As Long, iH As Integer 'Hour Variables
  93.    Dim dM As Long, dM1 As Long, dM2 As Long, iM As Integer 'Minute Variables
  94.    Dim dS As Long 'Second Variable
  95.    
  96.    Dim dHX As Double, dHX1 As Double, dHX2 As Double 'Hour Variables
  97.    Dim dHY As Double, dHY1 As Double, dHY2 As Double
  98.    
  99.    Dim dMX As Double, dMX1 As Double, dMX2 As Double 'Minute Variables
  100.    Dim dMY As Double, dMY1 As Double, dMY2 As Double
  101.    
  102.    Dim dSX As Double, dSY As Double 'Second Variables
  103.    
  104.    Dim pP(1 To 4) As POINTAPI 'The Polygons Points
  105.    Dim hRgn As Long, hBrush As Long 'Fill Color
  106.    
  107.    Dim fW As Long, fH As Long
  108.    Dim iCircle As Integer, r As Integer, g As Integer, B As Integer
  109.    
  110.    fW = UserControl.ScaleWidth
  111.    fH = UserControl.ScaleHeight
  112.    
  113.    iH = Hour(Time)                                    '| Get the Current Hour
  114.    If iH > 12 Then iH = iH - 12                       '| Make it 12 Hour Format
  115.    If iH = 0 Then iH = 12                             '|
  116.    dH = (iH * 30) + (Int(Minute(Time) / 12) * 6)      '| Hour Original
  117.    dH1 = dH - 40                                      '| Hour Outer
  118.    dH2 = dH + 40                                      '| Hour Inner
  119.    
  120.    iM = Minute(Time)                                  '| Get the Current Minute
  121.    If iM = 0 Then iM = 60                             '|
  122.    dM = iM * 6                                        '| Minute Original
  123.    dM1 = dM - 40                                      '| Minute Outer
  124.    dM2 = dM + 40                                      '| Minute Inner
  125.    
  126.    dS = Int(Timer) * 6                                '| Second Code
  127.  
  128.    dHX = Sin(Dec2Rad(dH))                             '| Hour Point.X
  129.    dHY = -Cos(Dec2Rad(dH))                            '| Hour Point.Y
  130.    dHX1 = Sin(Dec2Rad(dH1))                           '| Hour Left Point.X
  131.    dHY1 = -Cos(Dec2Rad(dH1))                          '| Hour Left Point.Y
  132.    dHX2 = Sin(Dec2Rad(dH2))                           '| Hour Right Point.X
  133.    dHY2 = -Cos(Dec2Rad(dH2))                          '| Hour Right Point.Y
  134.                                                             
  135.    dMX = Sin(Dec2Rad(dM))                             '| Minute Point.X
  136.    dMY = -Cos(Dec2Rad(dM))                            '| Minute Point.Y
  137.    dMX1 = Sin(Dec2Rad(dM1))                           '| Minute Left Point.X
  138.    dMY1 = -Cos(Dec2Rad(dM1))                          '| Minute Left Point.Y
  139.    dMX2 = Sin(Dec2Rad(dM2))                           '| Minute Right Point.X
  140.    dMY2 = -Cos(Dec2Rad(dM2))                          '| Minute Right Point.Y
  141.    
  142.    dSX = Sin(Dec2Rad(dS))                             '| The Second
  143.    dSY = -Cos(Dec2Rad(dS))                            '|
  144.    
  145.    UserControl.Cls                                    '| Clear the Form
  146.    UserControl.DrawStyle = 5                          '| Set to Transparent
  147.    UserControl.FillStyle = 0                          '| Set to Solid
  148.    
  149.    hRgn = CreateEllipticRgn(2, 2, CenterX + CenterX, CenterY + CenterY)   '| Clock's Region >>------\
  150.    hBrush = CreateSolidBrush(m_ClockBody)             '|                                            |
  151.    FillRgn UserControl.hdc, hRgn, hBrush              '| Fill the Clock, I think it's not necessary |
  152.    DeleteObject hBrush                                '|                                            |
  153.    Draw_GradientCircle m_ClockBody                    '| Draw circle gradient style                 |
  154.    UserControl.DrawStyle = 0                          '| Set Back to Solid                          |
  155.    UserControl.FillStyle = 1                          '| Set Back to Transparent                    |
  156.                                                       '|                                            |
  157.    hBrush = CreateSolidBrush(IIf(m_DrawBodyOutline, m_CircleBorder, m_ClockBody))                  '|
  158.    FrameRgn UserControl.hdc, hRgn, hBrush, 1, 1       '| Draw the Frame of the Region <<------------/
  159.    DeleteObject hBrush
  160.    DeleteObject hRgn
  161.       
  162.    '===========================================
  163.    '=== The Minute's Pointer Polygon Points ===
  164.    '===========================================
  165.    pP(1).X = (dMX * -Round(fW / 19)) + CenterX
  166.    pP(1).Y = (dMY * -Round(fH / 19)) + CenterY
  167.    pP(2).X = (dMX1 * Round(fW / 19)) + pP(1).X
  168.    pP(2).Y = (dMY1 * Round(fH / 19)) + pP(1).Y
  169.    pP(3).X = (dMX * Round(fW / 2.2)) + pP(1).X
  170.    pP(3).Y = (dMY * Round(fH / 2.2)) + pP(1).Y
  171.    pP(4).X = (dMX2 * Round(fW / 19)) + pP(1).X
  172.    pP(4).Y = (dMY2 * Round(fH / 19)) + pP(1).Y
  173.    '===========================================
  174.    
  175.    hRgn = CreatePolygonRgn(pP(1), 4, WINDING)         '| Create the Minute Region
  176.    
  177.    If m_DrawShadow Then
  178.       OffsetRgn hRgn, 2, 2                            '| Shadow First  <<---------------------------\
  179.       hBrush = CreateSolidBrush(RGB(127, 127, 127))   '| Create a Brush Handle with specified color |
  180.       FillRgn UserControl.hdc, hRgn, hBrush           '| Fill the Shadow                            |
  181.       OffsetRgn hRgn, -2, -2                          '| Then the Pointer  <<-----------------------/
  182.       DeleteObject hBrush                             '| RELEASE THE MEMORY HANDLE, TO AVOID GDI MEMORY LEAK *) That's what they always said! :p
  183.       
  184.       If m_AntiAliasing Then
  185.          AALINE pP(1).X + 2, pP(1).Y + 2, pP(2).X + 2, pP(2).Y + 2, RGB(127, 127, 127)
  186.          AALINE pP(2).X + 2, pP(2).Y + 2, pP(3).X + 2, pP(3).Y + 2, RGB(127, 127, 127)
  187.          AALINE pP(3).X + 2, pP(3).Y + 2, pP(4).X + 2, pP(4).Y + 2, RGB(127, 127, 127)
  188.          AALINE pP(4).X + 2, pP(4).Y + 2, pP(1).X + 2, pP(1).Y + 2, RGB(127, 127, 127)
  189.       End If
  190.    End If
  191.    
  192.    hBrush = CreateSolidBrush(m_MinutePointer)
  193.    FillRgn UserControl.hdc, hRgn, hBrush              '| Fill the Minute Region
  194.    DeleteObject hBrush
  195.    
  196.    If m_AntiAliasing Then
  197.       AALINE pP(1).X, pP(1).Y, pP(2).X, pP(2).Y, IIf(m_DrawMinuteOutline, m_MinuteOutline, m_MinutePointer)
  198.       AALINE pP(2).X, pP(2).Y, pP(3).X, pP(3).Y, IIf(m_DrawMinuteOutline, m_MinuteOutline, m_MinutePointer)
  199.       AALINE pP(3).X, pP(3).Y, pP(4).X, pP(4).Y, IIf(m_DrawMinuteOutline, m_MinuteOutline, m_MinutePointer)
  200.       AALINE pP(4).X, pP(4).Y, pP(1).X, pP(1).Y, IIf(m_DrawMinuteOutline, m_MinuteOutline, m_MinutePointer)
  201.    Else
  202.       If m_DrawMinuteOutline Then
  203.          hBrush = CreateSolidBrush(m_MinuteOutline)
  204.          FrameRgn UserControl.hdc, hRgn, hBrush, 1, 1    '| Draw the Frame of the Minute Region
  205.          DeleteObject hBrush
  206.       End If
  207.    End If
  208.    
  209.    DeleteObject hRgn
  210.    
  211.    '===========================================
  212.    '==== The Hour's Pointer Polygon Points ====
  213.    '===========================================
  214.    pP(1).X = (dHX * -Round(fW / 19)) + CenterX
  215.    pP(1).Y = (dHY * -Round(fH / 19)) + CenterY
  216.    pP(2).X = (dHX1 * Round(fW / 19)) + pP(1).X
  217.    pP(2).Y = (dHY1 * Round(fH / 19)) + pP(1).Y
  218.    pP(3).X = (dHX * Round(fW / 2.8)) + pP(1).X
  219.    pP(3).Y = (dHY * Round(fH / 2.8)) + pP(1).Y
  220.    pP(4).X = (dHX2 * Round(fW / 19)) + pP(1).X
  221.    pP(4).Y = (dHY2 * Round(fH / 19)) + pP(1).Y
  222.    '===========================================
  223.  
  224.    hRgn = CreatePolygonRgn(pP(1), 4, WINDING)          '| Create the Hour's Region
  225.    
  226.    If m_DrawShadow Then
  227.       OffsetRgn hRgn, 2, 2                             '| Shadow First  <<---------------------------\
  228.       hBrush = CreateSolidBrush(RGB(127, 127, 127))    '| Create a Brush Handle with specified color |
  229.       FillRgn UserControl.hdc, hRgn, hBrush            '| Fill the Shadow                            |
  230.       OffsetRgn hRgn, -2, -2                           '| Then the Pointer  <<-----------------------/
  231.       DeleteObject hBrush                              '| RELEASE THE MEMORY HANDLE, TO AVOID GDI MEMORY LEAK *) That's what they always said! :p
  232.       
  233.       If m_AntiAliasing Then
  234.          AALINE pP(1).X + 2, pP(1).Y + 2, pP(2).X + 2, pP(2).Y + 2, RGB(127, 127, 127)
  235.          AALINE pP(2).X + 2, pP(2).Y + 2, pP(3).X + 2, pP(3).Y + 2, RGB(127, 127, 127)
  236.          AALINE pP(3).X + 2, pP(3).Y + 2, pP(4).X + 2, pP(4).Y + 2, RGB(127, 127, 127)
  237.          AALINE pP(4).X + 2, pP(4).Y + 2, pP(1).X + 2, pP(1).Y + 2, RGB(127, 127, 127)
  238.       End If
  239.    End If
  240.    
  241.    hBrush = CreateSolidBrush(m_HourPointer)
  242.    FillRgn UserControl.hdc, hRgn, hBrush               '| Fill the Hour Region
  243.    DeleteObject hBrush
  244.    
  245.    If m_AntiAliasing Then
  246.       AALINE pP(1).X, pP(1).Y, pP(2).X, pP(2).Y, IIf(m_DrawHourOutline, m_HourOutline, m_HourPointer)
  247.       AALINE pP(2).X, pP(2).Y, pP(3).X, pP(3).Y, IIf(m_DrawHourOutline, m_HourOutline, m_HourPointer)
  248.       AALINE pP(3).X, pP(3).Y, pP(4).X, pP(4).Y, IIf(m_DrawHourOutline, m_HourOutline, m_HourPointer)
  249.       AALINE pP(4).X, pP(4).Y, pP(1).X, pP(1).Y, IIf(m_DrawHourOutline, m_HourOutline, m_HourPointer)
  250.    Else
  251.       If m_DrawHourOutline Then
  252.          hBrush = CreateSolidBrush(m_HourOutline)
  253.          FrameRgn UserControl.hdc, hRgn, hBrush, 1, 1  '| Draw the Frame of the Hour Region
  254.          DeleteObject hBrush
  255.       End If
  256.    End If
  257.    
  258.    DeleteObject hRgn
  259.    
  260.    If m_DrawSecond Then
  261.       If m_DrawShadow Then
  262.          If m_AntiAliasing Then
  263.             AALINE (dSX * -Round(fW / 10)) + CenterX + 2, (dSY * -Round(fH / 10)) + CenterY + 2, _
  264.                    (dSX * Round(fW / 2.5)) + CenterX + 2, (dSY * Round(fH / 2.5)) + CenterY + 2, _
  265.                    RGB(127, 127, 127)
  266.          Else
  267.             UserControl.Line ((dSX * -Round(fW / 10)) + CenterX + 2, (dSY * -Round(fH / 10)) + CenterY + 2)- _
  268.                              ((dSX * Round(fW / 2.5)) + CenterX + 2, (dSY * Round(fH / 2.5)) + CenterY + 2), _
  269.                              RGB(127, 127, 127)              '| Create a Shadow of the Second Pointer
  270.          End If
  271.       End If
  272.                              
  273.       If m_AntiAliasing Then
  274.          AALINE (dSX * -Round(fW / 10)) + CenterX, (dSY * -Round(fH / 10)) + CenterY, _
  275.                 (dSX * Round(fW / 2.5)) + CenterX, (dSY * Round(fH / 2.5)) + CenterY, _
  276.                 m_SecondPointer
  277.       Else
  278.          UserControl.Line ((dSX * -Round(fW / 10)) + CenterX, (dSY * -Round(fH / 10)) + CenterY)- _
  279.                           ((dSX * Round(fW / 2.5)) + CenterX, (dSY * Round(fH / 2.5)) + CenterY), _
  280.                           m_SecondPointer                    '| Now Create the Simple Second Pointer
  281.       End If
  282.    End If
  283.    
  284.    UserControl.Circle (CenterX, CenterY), 0, m_HourPointer   '| Draw the Pointers Axis
  285.    UserControl.Circle (CenterX, CenterY), 1, m_HourPointer   '| Draw the Pointers Axis, again...?
  286.    
  287.    For iCircle = 6 To 360 Step 6                             '| Draw the Points
  288.       dHX = Sin(Dec2Rad(iCircle))                            '| Zzz...Zzz...Zzz...
  289.       dHY = -(Cos(Dec2Rad(iCircle)))
  290.       dHX1 = Sin(Dec2Rad(iCircle - 0.25))
  291.       dHY1 = -(Cos(Dec2Rad(iCircle - 0.25)))
  292.       dHX2 = Sin(Dec2Rad(iCircle + 0.25))
  293.       dHY2 = -(Cos(Dec2Rad(iCircle + 0.25)))
  294.       
  295.       If m_ShowMajorPoint Then
  296.          If iCircle Mod 30 = 0 Then
  297.             If iCircle Mod 90 = 0 Then
  298.                If m_AntiAliasing Then
  299.                   AALINE (dHX1 * Round(fW / 2.1)) + CenterX, (dHY1 * Round(fH / 2.1)) + CenterY, _
  300.                          (dHX1 * Round(fW / 2.3)) + CenterX, (dHY1 * Round(fH / 2.3)) + CenterY, m_MajorPoint
  301.                Else
  302.                   UserControl.Line ((dHX1 * Round(fW / 2.1)) + CenterX, (dHY1 * Round(fH / 2.1)) + CenterY)- _
  303.                                    ((dHX1 * Round(fW / 2.3)) + CenterX, (dHY1 * Round(fH / 2.3)) + CenterY), m_MajorPoint
  304.                End If
  305.             Else
  306.                If m_AntiAliasing Then
  307.                   AALINE (dHX * Round(fW / 2.1)) + CenterX, (dHY * Round(fH / 2.1)) + CenterY, _
  308.                          (dHX * Round(fW / 2.3)) + CenterX, (dHY * Round(fH / 2.3)) + CenterY, m_MajorPoint
  309.                Else
  310.                   UserControl.Line ((dHX * Round(fW / 2.1)) + CenterX, (dHY * Round(fH / 2.1)) + CenterY)- _
  311.                                    ((dHX * Round(fW / 2.3)) + CenterX, (dHY * Round(fH / 2.3)) + CenterY), m_MajorPoint
  312.                End If
  313.             End If
  314.          Else
  315.             If m_ShowMinorPoint Then
  316.                UserControl.Circle ((dHX * Round(fW / 2.2)) + CenterX, (dHY * Round(fH / 2.2)) + CenterY), 0, m_MinorPoint
  317.             End If
  318.          End If
  319.       Else
  320.          If m_ShowMinorPoint Then
  321.             UserControl.Circle ((dHX * Round(fW / 2.2)) + CenterX, (dHY * Round(fH / 2.2)) + CenterY), 0, m_MinorPoint
  322.          End If
  323.       End If
  324.    Next iCircle
  325.    
  326.    If m_AntiAliasing Then
  327.       AAELLIPSE CenterX, CenterY, CenterX - 3, CenterY - 3, IIf(m_DrawBodyOutline, m_CircleBorder, m_ClockBody)
  328.    End If
  329. End Sub
  330.  
  331. Public Sub Refresh()
  332. Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  333.    UserControl.Refresh
  334. End Sub
  335.  
  336. Private Sub Timer1_Timer()
  337.    Static lngSecond As Long
  338.    
  339.    If lngSecond <> Second(Time) Then
  340.       ShowTime
  341.       lngSecond = Second(Time)
  342.    End If
  343. End Sub
  344.  
  345. Private Sub UserControl_Initialize()
  346.    UserControl.ScaleMode = vbPixels
  347.    UserControl.Refresh
  348.    ShowTime
  349. End Sub
  350.  
  351. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  352.    m_button = Button
  353. End Sub
  354.  
  355. Private Sub UserControl_Resize()
  356.    Dim hRgn As Long
  357.  
  358.    CenterX = UserControl.ScaleWidth / 2
  359.    CenterY = UserControl.ScaleHeight / 2
  360.    
  361.    hRgn = CreateEllipticRgn(2, 2, CenterX + CenterX, CenterY + CenterY)   'Clock's Face
  362.    SetWindowRgn UserControl.hwnd, hRgn, True                              'Set to a Circular Form (Not a Rectangle :)
  363.  
  364.    ShowTime
  365. End Sub
  366.  
  367. Private Sub UserControl_Show()
  368.    ShowTime
  369. End Sub
  370.  
  371. Private Sub UserControl_InitProperties()
  372.    Timer1.Enabled = Ambient.UserMode
  373.    m_ShowMajorPoint = True
  374.    m_MinuteOutline = vbWhite
  375.    m_HourOutline = vbWhite
  376.    m_MajorPoint = vbWhite
  377.    m_MinorPoint = vbWhite
  378.    m_SecondPointer = vbWhite
  379.    m_MinutePointer = vbBlack
  380.    m_HourPointer = vbBlack
  381.    m_CircleBorder = vbWhite
  382.    m_ClockBody = vbBlack
  383.    m_ShowMinorPoint = True
  384.    m_DrawHourOutline = True
  385.    m_DrawMinuteOutline = True
  386.    m_DrawShadow = True
  387.    m_DrawBodyOutline = True
  388.    m_DrawSecond = True
  389.    m_AntiAliasing = False
  390. End Sub
  391.  
  392. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  393.    Timer1.Enabled = Ambient.UserMode
  394.    m_ShowMajorPoint = PropBag.ReadProperty("ShowMajorPoint", True)
  395.    m_MinuteOutline = PropBag.ReadProperty("MinuteOutline", vbWhite)
  396.    m_HourOutline = PropBag.ReadProperty("HourOutline", vbWhite)
  397.    m_MajorPoint = PropBag.ReadProperty("MajorPoint", vbWhite)
  398.    m_MinorPoint = PropBag.ReadProperty("MinorPoint", vbWhite)
  399.    m_SecondPointer = PropBag.ReadProperty("SecondPointer", vbWhite)
  400.    m_MinutePointer = PropBag.ReadProperty("MinutePointer", vbBlack)
  401.    m_HourPointer = PropBag.ReadProperty("HourPointer", vbBlack)
  402.    m_CircleBorder = PropBag.ReadProperty("CircleBorder", vbWhite)
  403.    m_ClockBody = PropBag.ReadProperty("ClockBody", vbBlack)
  404.    m_ShowMinorPoint = PropBag.ReadProperty("ShowMinorPoint", True)
  405.    m_DrawHourOutline = PropBag.ReadProperty("DrawHourOutline", True)
  406.    m_DrawMinuteOutline = PropBag.ReadProperty("DrawMinuteOutline", True)
  407.    m_DrawShadow = PropBag.ReadProperty("DrawShadow", True)
  408.    m_DrawBodyOutline = PropBag.ReadProperty("DrawBodyOutline", True)
  409.    m_DrawSecond = PropBag.ReadProperty("DrawSecond", True)
  410.    m_AntiAliasing = PropBag.ReadProperty("AntiAliasing", False)
  411. End Sub
  412.  
  413. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  414.    With PropBag
  415.       .WriteProperty "ShowMajorPoint", m_ShowMajorPoint, True
  416.       .WriteProperty "MinuteOutline", m_MinuteOutline, vbWhite
  417.       .WriteProperty "HourOutline", m_HourOutline, vbWhite
  418.       .WriteProperty "MajorPoint", m_MajorPoint, vbWhite
  419.       .WriteProperty "MinorPoint", m_MinorPoint, vbWhite
  420.       .WriteProperty "SecondPointer", m_SecondPointer, vbWhite
  421.       .WriteProperty "MinutePointer", m_MinutePointer, vbBlack
  422.       .WriteProperty "HourPointer", m_HourPointer, vbBlack
  423.       .WriteProperty "CircleBorder", m_CircleBorder, vbWhite
  424.       .WriteProperty "ClockBody", m_ClockBody, vbBlack
  425.       .WriteProperty "ShowMinorPoint", m_ShowMinorPoint, True
  426.       .WriteProperty "DrawHourOutline", m_DrawHourOutline, True
  427.       .WriteProperty "DrawMinuteOutline", m_DrawMinuteOutline, True
  428.       .WriteProperty "DrawShadow", m_DrawShadow, True
  429.       .WriteProperty "DrawBodyOutline", m_DrawBodyOutline, True
  430.       .WriteProperty "DrawSecond", m_DrawSecond, True
  431.       .WriteProperty "AntiAliasing", m_AntiAliasing, False
  432.    End With
  433. End Sub
  434.  
  435. Public Property Get hwnd() As Long
  436. Attribute hwnd.VB_Description = "Returns a handle (from Microsoft Windows) to an object's window."
  437.    hwnd = UserControl.hwnd
  438. End Property
  439.  
  440. Public Property Get hdc() As Long
  441. Attribute hdc.VB_Description = "Returns a handle (from Microsoft Windows) to the object's device context."
  442.    hdc = UserControl.hdc
  443. End Property
  444.  
  445. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  446.    RaiseEvent MouseMove(Button, Shift, X, Y)
  447. End Sub
  448.  
  449. Private Sub UserControl_Click()
  450.    If m_button = vbLeftButton Then
  451.       RaiseEvent Click
  452.    End If
  453. End Sub
  454.  
  455. Private Sub UserControl_DblClick()
  456.    If m_button = vbLeftButton Then
  457.       RaiseEvent DblClick
  458.    End If
  459. End Sub
  460.  
  461. Public Property Get ShowMajorPoint() As Boolean
  462. Attribute ShowMajorPoint.VB_Description = "Returns/sets whether major points are drawn."
  463.    ShowMajorPoint = m_ShowMajorPoint
  464. End Property
  465.  
  466. Public Property Let ShowMajorPoint(ByVal New_ShowMajorPoint As Boolean)
  467.    m_ShowMajorPoint = New_ShowMajorPoint
  468.    PropertyChanged "ShowMajorPoint"
  469.    ShowTime
  470. End Property
  471.  
  472. Public Property Get ShowMinorPoint() As Boolean
  473. Attribute ShowMinorPoint.VB_Description = "Returns/sets whether minor points are drawn."
  474.    ShowMinorPoint = m_ShowMinorPoint
  475. End Property
  476.  
  477. Public Property Let ShowMinorPoint(ByVal New_ShowMinorPoint As Boolean)
  478.    m_ShowMinorPoint = New_ShowMinorPoint
  479.    PropertyChanged "ShowMinorPoint"
  480.    ShowTime
  481. End Property
  482.  
  483. Public Property Get MajorPoint() As OLE_COLOR
  484. Attribute MajorPoint.VB_Description = "Returns/sets the color of major points."
  485.    MajorPoint = m_MajorPoint
  486. End Property
  487.  
  488. Public Property Let MajorPoint(ByVal New_MajorPoint As OLE_COLOR)
  489.    m_MajorPoint = New_MajorPoint
  490.    PropertyChanged "MajorPoint"
  491.    ShowTime
  492. End Property
  493.  
  494. Public Property Get MinorPoint() As OLE_COLOR
  495. Attribute MinorPoint.VB_Description = "Returns/sets the color of minor points."
  496.    MinorPoint = m_MinorPoint
  497. End Property
  498.  
  499. Public Property Let MinorPoint(ByVal New_MinorPoint As OLE_COLOR)
  500.    m_MinorPoint = New_MinorPoint
  501.    PropertyChanged "MinorPoint"
  502.    ShowTime
  503. End Property
  504.  
  505. Public Property Get SecondPointer() As OLE_COLOR
  506.    SecondPointer = m_SecondPointer
  507. End Property
  508.  
  509. Public Property Let SecondPointer(ByVal New_SecondPointer As OLE_COLOR)
  510. Attribute SecondPointer.VB_Description = "Returns/sets whether major points are drawn."
  511.    m_SecondPointer = New_SecondPointer
  512.    PropertyChanged "SecondPointer"
  513.    ShowTime
  514. End Property
  515.  
  516. Public Property Get MinutePointer() As OLE_COLOR
  517. Attribute MinutePointer.VB_Description = "Returns/sets the minute pointer's color."
  518.    MinutePointer = m_MinutePointer
  519. End Property
  520.  
  521. Public Property Let MinutePointer(ByVal New_MinutePointer As OLE_COLOR)
  522.    m_MinutePointer = New_MinutePointer
  523.    PropertyChanged "MinutePointer"
  524.    ShowTime
  525. End Property
  526.  
  527. Public Property Get HourPointer() As OLE_COLOR
  528. Attribute HourPointer.VB_Description = "Returns/sets the hour pointer's color."
  529.    HourPointer = m_HourPointer
  530. End Property
  531.  
  532. Public Property Let HourPointer(ByVal New_HourPointer As OLE_COLOR)
  533.    m_HourPointer = New_HourPointer
  534.    PropertyChanged "HourPointer"
  535.    ShowTime
  536. End Property
  537.  
  538. Public Property Get CircleBorder() As OLE_COLOR
  539. Attribute CircleBorder.VB_Description = "Returns/sets the clock outline's color."
  540.    CircleBorder = m_CircleBorder
  541. End Property
  542.  
  543. Public Property Let CircleBorder(ByVal New_CircleBorder As OLE_COLOR)
  544.    m_CircleBorder = New_CircleBorder
  545.    PropertyChanged "CircleBorder"
  546.    ShowTime
  547. End Property
  548.  
  549. Public Property Get ClockBody() As OLE_COLOR
  550. Attribute ClockBody.VB_Description = "Returns/sets the clock body's color."
  551.    ClockBody = m_ClockBody
  552. End Property
  553.  
  554. Public Property Let ClockBody(ByVal New_ClockBody As OLE_COLOR)
  555.    m_ClockBody = New_ClockBody
  556.    PropertyChanged "ClockBody"
  557.    ShowTime
  558. End Property
  559.  
  560. Public Property Get HourOutline() As OLE_COLOR
  561. Attribute HourOutline.VB_Description = "Returns/sets hour pointer's outline color."
  562.    HourOutline = m_HourOutline
  563. End Property
  564.  
  565. Public Property Let HourOutline(ByVal New_HourOutline As OLE_COLOR)
  566.    m_HourOutline = New_HourOutline
  567.    PropertyChanged "HourOutline"
  568.    ShowTime
  569. End Property
  570.  
  571. Public Property Get MinuteOutline() As OLE_COLOR
  572. Attribute MinuteOutline.VB_Description = "Returns/sets minute pointer's outline color."
  573.    MinuteOutline = m_MinuteOutline
  574. End Property
  575.  
  576. Public Property Let MinuteOutline(ByVal New_MinuteOutline As OLE_COLOR)
  577.    m_MinuteOutline = New_MinuteOutline
  578.    PropertyChanged "MinuteOutline"
  579.    ShowTime
  580. End Property
  581.  
  582. Public Property Get DrawHourOutline() As Boolean
  583. Attribute DrawHourOutline.VB_Description = "Returns/sets whether outline on hour pointer is drawn."
  584.    DrawHourOutline = m_DrawHourOutline
  585. End Property
  586.  
  587. Public Property Let DrawHourOutline(ByVal New_DrawHourOutline As Boolean)
  588.    m_DrawHourOutline = New_DrawHourOutline
  589.    PropertyChanged "DrawHourOutline"
  590.    ShowTime
  591. End Property
  592.  
  593. Public Property Get DrawMinuteOutline() As Boolean
  594. Attribute DrawMinuteOutline.VB_Description = "Returns/sets whether outline on minute pointer is drawn."
  595.    DrawMinuteOutline = m_DrawMinuteOutline
  596. End Property
  597.  
  598. Public Property Let DrawMinuteOutline(ByVal New_DrawMinuteOutline As Boolean)
  599.    m_DrawMinuteOutline = New_DrawMinuteOutline
  600.    PropertyChanged "DrawMinuteOutline"
  601.    ShowTime
  602. End Property
  603.  
  604. Public Property Get DrawShadow() As Boolean
  605. Attribute DrawShadow.VB_Description = "Returns/sets whether the shadow of the pointers is drawn."
  606.    DrawShadow = m_DrawShadow
  607. End Property
  608.  
  609. Public Property Let DrawShadow(ByVal New_DrawShadow As Boolean)
  610.    m_DrawShadow = New_DrawShadow
  611.    PropertyChanged "DrawShadow"
  612.    ShowTime
  613. End Property
  614.  
  615. Public Property Get DrawBodyOutline() As Boolean
  616. Attribute DrawBodyOutline.VB_Description = "Returns/sets whether the clock's outline is drawn."
  617.    DrawBodyOutline = m_DrawBodyOutline
  618. End Property
  619.  
  620. Public Property Let DrawBodyOutline(ByVal New_DrawBodyOutline As Boolean)
  621.    m_DrawBodyOutline = New_DrawBodyOutline
  622.    PropertyChanged "DrawBodyOutline"
  623.    ShowTime
  624. End Property
  625.  
  626. Public Property Get DrawSecond() As Boolean
  627. Attribute DrawSecond.VB_Description = "Returns/sets whether the second pointer is drawn."
  628.    DrawSecond = m_DrawSecond
  629. End Property
  630.  
  631. Public Property Let DrawSecond(ByVal New_DrawSecond As Boolean)
  632.    m_DrawSecond = New_DrawSecond
  633.    PropertyChanged "DrawSecond"
  634.    ShowTime
  635. End Property
  636.  
  637. Public Property Get AntiAliasing() As Boolean
  638. Attribute AntiAliasing.VB_Description = "Returns/sets whether anti-aliasing is used to draw the clock. (Procedures by Robert Rayment on (RRPaint)"
  639.    AntiAliasing = m_AntiAliasing
  640. End Property
  641.  
  642. Public Property Let AntiAliasing(ByVal New_AntiAliasing As Boolean)
  643.    m_AntiAliasing = New_AntiAliasing
  644.    PropertyChanged "AntiAliasing"
  645.    ShowTime
  646. End Property
  647.  
  648. Public Sub About()
  649. Attribute About.VB_Description = "Show about window of this OCX."
  650. Attribute About.VB_UserMemId = -552
  651.    Dim frmX As Form
  652.  
  653.    For Each frmX In Forms
  654.       If frmX.Name = "frmAbout" Then Unload frmX
  655.    Next frmX
  656.    
  657.    frmAbout.Show vbModeless, UserControl.Parent
  658. End Sub
  659.  
  660. Private Sub Draw_GradientCircle(lngColor1 As Long, Optional lngColor2 As Long = &HFFFFFF)
  661.    Dim SQNum As Double
  662.    Dim tmpDir As Integer
  663.    
  664.    Dim eScale As ScaleModeConstants
  665.    Dim eDraw As DrawModeConstants
  666.    Dim lngDrawWidth As Long
  667.    
  668.    Dim lngX As Long
  669.    Dim lngY As Long
  670.    
  671.    Dim tmpR1 As Long
  672.    Dim tmpG1 As Long
  673.    Dim tmpB1 As Long
  674.    
  675.    Dim tmpR2 As Long
  676.    Dim tmpG2 As Long
  677.    Dim tmpB2 As Long
  678.    
  679.    Dim FinalR As Long
  680.    Dim FinalG As Long
  681.    Dim FinalB As Long
  682.    
  683.    Dim FinalRGB As Single
  684.    
  685.    Dim lngR
  686.    Dim lngG
  687.    Dim lngB
  688.    
  689.    Dim lngCounter As Integer
  690.    
  691.    eScale = UserControl.ScaleMode
  692.    UserControl.ScaleMode = vbPixels
  693.    
  694.    lngX = UserControl.ScaleWidth / 4
  695.    lngY = UserControl.ScaleHeight / 4
  696.    
  697.    If lngX > (UserControl.ScaleWidth / 2) Then
  698.       If lngY > (UserControl.ScaleHeight / 2) Then
  699.          SQNum = (lngX * lngX) + (lngY * lngY)
  700.          tmpDir = Sqr(SQNum)
  701.       Else
  702.          SQNum = (lngX * lngX) + ((UserControl.ScaleHeight - lngY) * (UserControl.ScaleHeight - lngY))
  703.          tmpDir = Sqr(SQNum)
  704.       End If
  705.    Else
  706.       If lngY > (UserControl.ScaleHeight / 2) Then
  707.          SQNum = ((UserControl.ScaleWidth - lngX) * (UserControl.ScaleWidth - lngX)) + (lngY * lngY)
  708.          tmpDir = Sqr(SQNum)
  709.       Else
  710.          SQNum = ((UserControl.ScaleWidth - lngX) * (UserControl.ScaleWidth - lngX)) + ((UserControl.ScaleHeight - lngY) * (UserControl.ScaleHeight - lngY))
  711.          tmpDir = Sqr(SQNum)
  712.       End If
  713.    End If
  714.    
  715.    tmpR1 = Get_RGB(lngColor2, 1)
  716.    tmpG1 = Get_RGB(lngColor2, 2)
  717.    tmpB1 = Get_RGB(lngColor2, 3)
  718.    tmpR2 = Get_RGB(lngColor1, 1)
  719.    tmpG2 = Get_RGB(lngColor1, 2)
  720.    tmpB2 = Get_RGB(lngColor1, 3)
  721.    
  722.    lngR = (tmpR2 - tmpR1) / tmpDir
  723.    lngG = (tmpG2 - tmpG1) / tmpDir
  724.    lngB = (tmpB2 - tmpB1) / tmpDir
  725.    
  726.    eDraw = UserControl.DrawMode
  727.    lngDrawWidth = UserControl.DrawWidth
  728.    
  729.    UserControl.DrawWidth = 2
  730.    UserControl.DrawMode = 13
  731.    
  732.    For lngCounter = tmpDir - 1 To 0 Step -1
  733.       FinalR = tmpR1 + (lngR * lngCounter)
  734.       FinalG = tmpG1 + (lngG * lngCounter)
  735.       FinalB = tmpB1 + (lngB * lngCounter)
  736.       
  737.       FinalRGB = RGB(FinalR, FinalG, FinalB)
  738.       
  739.       UserControl.FillColor = RGB(FinalR, FinalG, FinalB)
  740.       UserControl.Circle (lngX, lngY), lngCounter
  741.    Next lngCounter
  742.    
  743.    UserControl.ScaleMode = eScale
  744.    UserControl.DrawWidth = lngDrawWidth
  745.    UserControl.DrawMode = eDraw
  746. End Sub
  747.  
  748. Private Function Get_RGB(RGBValue As Long, val As Integer) As Long
  749.    If RGBValue > -1 And val > 0 And val < 4 Then
  750.       Select Case val
  751.          Case 1
  752.             Get_RGB = (RGBValue And &HFF&)
  753.          Case 2
  754.             Get_RGB = (RGBValue And &HFF00&) / &H100
  755.          Case 3
  756.             Get_RGB = (RGBValue And &HFF0000) / &H10000
  757.       End Select
  758.    End If
  759. End Function
  760.  
  761. '========================================================
  762. 'Anti-Aliasing Procedures By Robert Rayment on (RRPaint)
  763. 'http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=66991&lngWId=1
  764. '========================================================
  765.  
  766. Private Sub LngToRGB(LCul As Long, r As Byte, g As Byte, B As Byte)
  767.    r = LCul And &HFF&
  768.    g = (LCul And &HFF00&) \ &H100&
  769.    B = (LCul And &HFF0000) \ &H10000
  770. End Sub
  771.  
  772. Private Sub AALINE(ByVal ix1 As Integer, ByVal iy1 As Integer, ByVal ix2 As Integer, ByVal iy2 As Integer, Cul As Long)
  773.    Dim zm As Single, zc As Single
  774.    Dim Xs As Single, Ys As Single
  775.    Dim i As Integer
  776.    
  777.    If ix1 = ix2 Or iy1 = iy2 Then
  778.       UserControl.Line (ix1, iy1)-(ix2, iy2), Cul
  779.       Exit Sub
  780.    End If
  781.    
  782.    If Abs(ix2 - ix1) < Abs(iy2 - iy1) Then
  783.       If iy2 < iy1 Then
  784.          i = ix1
  785.          ix1 = ix2
  786.          ix2 = i
  787.          i = iy1
  788.          iy1 = iy2
  789.          iy2 = i
  790.       End If
  791.       
  792.       zm = (iy2 - iy1) / (ix2 - ix1)
  793.       zc = iy1 - zm * ix1
  794.       
  795.       For Ys = iy1 To iy2
  796.          Xs = (Ys - zc) / zm
  797.          CalcAA Xs, Ys, Cul
  798.       Next Ys
  799.    Else
  800.       If ix2 < ix1 Then
  801.          i = ix1
  802.          ix1 = ix2
  803.          ix2 = i
  804.          i = iy1
  805.          iy1 = iy2
  806.          iy2 = i
  807.       End If
  808.       
  809.       zm = (iy2 - iy1) / (ix2 - ix1)
  810.       zc = iy1 - zm * ix1
  811.       
  812.       For Xs = ix1 To ix2
  813.          Ys = zm * Xs + zc
  814.          CalcAA Xs, Ys, Cul
  815.       Next Xs
  816.    End If
  817. End Sub
  818.  
  819. 'Based on:-
  820. 'http://www.eclipzer.com/tutorials/subpixel/subpixel.html
  821. 'Web Ref frm Aleksander Ruzicic at PSC CodeId=66836
  822. Private Sub CalcAA(Xs As Single, Ys As Single, Cul As Long)
  823.    Dim ix As Single, iy As Single
  824.    Dim a1 As Single, a2 As Single, a3 As Single, a4 As Single
  825.    Dim r1 As Byte, g1 As Byte, b1 As Byte
  826.    Dim r2 As Byte, g2 As Byte, b2 As Byte
  827.    Dim r3 As Byte, g3 As Byte, b3 As Byte
  828.    Dim r4 As Byte, g4 As Byte, b4 As Byte
  829.    Dim rc As Byte, gc As Byte, bc As Byte
  830.    Dim cul1 As Long, cul2 As Long, cul3 As Long, cul4 As Long
  831.    
  832.    If Xs = Int(Xs) Then
  833.       Xs = Xs + 0.07
  834.    End If
  835.    
  836.    If Ys = Int(Ys) Then
  837.       Ys = Ys + 0.07
  838.    End If
  839.    
  840.    ix = Int(Xs)
  841.    iy = Int(Ys)
  842.    a1 = (ix + 1 - Xs) * (iy + 1 - Ys)
  843.    a2 = (Xs - ix) * (iy + 1 - Ys)
  844.    a3 = (ix + 1 - Xs) * (Ys - iy)
  845.    a4 = (Xs - ix) * (Ys - iy)
  846.    
  847.    LngToRGB GetPixel(UserControl.hdc, ix, iy), r1, b1, g1
  848.    LngToRGB GetPixel(UserControl.hdc, ix + 1, iy), r2, b2, g2
  849.    LngToRGB GetPixel(UserControl.hdc, ix, iy + 1), r3, b3, g3
  850.    LngToRGB GetPixel(UserControl.hdc, ix + 1, iy + 1), r4, b4, g4
  851.    LngToRGB Cul, rc, gc, bc
  852.    
  853.    cul1 = RGB(a1 * (1& * rc - r1) + r1, a1 * (1& * gc - g1) + g1, a1 * (1& * bc - b1) + b1)
  854.    cul2 = RGB(a2 * (1& * rc - r2) + r2, a2 * (1& * gc - g2) + g2, a2 * (1& * bc - b2) + b2)
  855.    cul3 = RGB(a3 * (1& * rc - r3) + r3, a3 * (1& * gc - g3) + g3, a3 * (1& * bc - b3) + b3)
  856.    cul4 = RGB(a4 * (1& * rc - r4) + r4, a4 * (1& * gc - g4) + g4, a4 * (1& * bc - b4) + b4)
  857.  
  858.    SetPixelV UserControl.hdc, ix, iy, cul1
  859.    SetPixelV UserControl.hdc, ix + 1, iy, cul2
  860.    SetPixelV UserControl.hdc, ix, iy + 1, cul3
  861.    SetPixelV UserControl.hdc, ix + 1, iy + 1, cul4
  862. End Sub
  863.  
  864. Private Sub AAELLIPSE(ByVal ix1 As Integer, ByVal iy1 As Integer, ByVal zradx As Single, ByVal zrady As Single, Cul As Long)
  865.    Dim TAlpha As Double
  866.    Dim zxc As Single, zyc As Single
  867.    Dim zStep As Double
  868.    
  869.    If zradx = 0 Then zradx = 0.001
  870.    If zrady = 0 Then zrady = 0.001
  871.    
  872.    zStep = 2 / zradx
  873.    
  874.    If zrady > zradx Then zStep = 2 / zrady
  875.    
  876.    For TAlpha = 0 To 2 * Pi Step zStep
  877.       zxc = ix1 + zradx * Cos(TAlpha)
  878.       zyc = iy1 + zrady * Sin(TAlpha)
  879.       CalcAA zxc, zyc, Cul
  880.    Next TAlpha
  881.    
  882.    For TAlpha = 0 To 2 * Pi Step zStep
  883.       zxc = ix1 + zradx * Cos(TAlpha)
  884.       zyc = iy1 + zrady * Sin(TAlpha)
  885.       SetPixelV UserControl.hdc, zxc, zyc, Cul
  886.    Next TAlpha
  887. End Sub
  888.  
  889. '========================================================
  890.  
  891.