home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 25: Programming / pc_actual_25.iso / Delphi / PolarDraw / data1.cab / Samples / Visual_Basic / Clock / FormClock.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-08-31  |  7.0 KB  |  242 lines
  1. VERSION 5.00
  2. Object = "{52DE3A21-0A3F-11D4-B9D2-008048FD54E6}#2.0#0"; "POLARDraw20.ocx"
  3. Begin VB.Form FormClock 
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "Clock"
  6.    ClientHeight    =   3240
  7.    ClientLeft      =   45
  8.    ClientTop       =   330
  9.    ClientWidth     =   4845
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   3240
  14.    ScaleWidth      =   4845
  15.    ShowInTaskbar   =   0   'False
  16.    StartUpPosition =   3  'Windows Default
  17.    Begin POLARDRAW20Lib.POLARDraw POLARDraw1 
  18.       Height          =   3015
  19.       Left            =   120
  20.       TabIndex        =   3
  21.       Top             =   120
  22.       Width           =   3375
  23.       _Version        =   131072
  24.       _ExtentX        =   5953
  25.       _ExtentY        =   5318
  26.       _StockProps     =   224
  27.       Appearance      =   1
  28.       PaperShadowColor=   0
  29.       PaperOutlinecolor=   22899756
  30.       EditMode        =   6
  31.       DrawPaper       =   0   'False
  32.       DrawPaperOutline=   -1  'True
  33.       DrawPaperShadow =   -1  'True
  34.       PaperShadowOffset=   0
  35.       ViewportOriginX =   22899756
  36.       ViewportOriginY =   22873116
  37.       PageOriginX     =   1
  38.       PageOriginY     =   97719525
  39.       HorizontalGrid  =   567
  40.       VerticalGrid    =   567
  41.       ShowVerticalScrollBar=   0   'False
  42.       ShowHorizontalScrollBar=   0   'False
  43.       ShowVerticalRuler=   0   'False
  44.       ShowHorizontalRuler=   0   'False
  45.       SelectionCount  =   22740992
  46.       ShapeCount      =   22742704
  47.       MeasurementUnits=   8
  48.       CanvasWidth     =   536873485
  49.       CanvasHeight    =   0
  50.       AllowSelect     =   0   'False
  51.       AllowRotate     =   0   'False
  52.       AllowDelete     =   0   'False
  53.       AllowResize     =   0   'False
  54.       AllowMove       =   0   'False
  55.       AllowEditPoints =   0   'False
  56.       AllowDragSelect =   0   'False
  57.    End
  58.    Begin VB.Timer Timer 
  59.       Interval        =   1000
  60.       Left            =   3720
  61.       Top             =   1320
  62.    End
  63.    Begin VB.CheckBox CheckTicking 
  64.       Caption         =   "Ticking"
  65.       Height          =   375
  66.       Left            =   3600
  67.       TabIndex        =   2
  68.       Top             =   2760
  69.       Width           =   1095
  70.    End
  71.    Begin VB.CheckBox CheckBorder 
  72.       Caption         =   "Border"
  73.       Height          =   255
  74.       Left            =   3600
  75.       TabIndex        =   1
  76.       Top             =   2520
  77.       Value           =   1  'Checked
  78.       Width           =   1095
  79.    End
  80.    Begin VB.CommandButton Close 
  81.       Caption         =   "Close"
  82.       Height          =   375
  83.       Left            =   3600
  84.       TabIndex        =   0
  85.       Top             =   120
  86.       Width           =   1095
  87.    End
  88. Attribute VB_Name = "FormClock"
  89. Attribute VB_GlobalNameSpace = False
  90. Attribute VB_Creatable = False
  91. Attribute VB_PredeclaredId = True
  92. Attribute VB_Exposed = False
  93. Private Type POINT
  94.    x As Long
  95.    y As Long
  96. End Type
  97. Dim m_pdHour As POLARDRAW20Lib.Shape
  98. Dim m_pdMinute As POLARDRAW20Lib.Shape
  99. Dim m_pdSecond As POLARDRAW20Lib.Shape
  100. Dim m_fTicking As Boolean
  101. Dim m_fBorder As Boolean
  102. Dim ptCenter As POINT
  103. Dim m_pdPage As POLARDRAW20Lib.Page
  104. Private Sub Form_Load()
  105.    Dim lX As Long
  106.    Dim lY As Long
  107.    Dim l As Long
  108.    Dim lRad As Long
  109.    Dim Shape As POLARDRAW20Lib.Shape
  110.    Set m_pdPage = POLARDraw1.ActivePage
  111.    m_fTicking = False
  112.    m_fBorder = True
  113.    l = 0
  114.    lRad = 90
  115.    ptCenter.x = 0
  116.    ptCenter.y = 0
  117.    POLARDraw1.ActiveWindow.Environment.EditMode = polRotate
  118.    While (l < 12)
  119.       Dim lAngle As Double
  120.       
  121.       lAngle = l * 30 / (360 / (2 * 3.1416))
  122.       lX = ptCenter.x - Sin(lAngle) * lRad
  123.       lY = ptCenter.y - Cos(lAngle) * lRad
  124.       If (l * 30) Mod 90 = 0 Then
  125.          Set Shape = m_pdPage.Shapes.Add(5, lX - 10, lY - 10, lX + 10, lY + 10)
  126.       Else
  127.          Set Shape = m_pdPage.Shapes.Add(5, lX - 8, lY - 8, lX + 8, lY + 8)
  128.       End If
  129.       Shape.Rotate (l * 30)
  130.       Shape.Fill.Color = RGB(0, 0, 255)
  131.       l = l + 1
  132.    Wend
  133.    Set Shape = Nothing
  134.    lX = ptCenter.x
  135.    lY = ptCenter.y
  136.    'hour handle
  137.    Set m_pdHour = m_pdPage.Shapes.Add(66, lX - 40, lY - 30, lX + 40, lY + 30)
  138.    With m_pdHour
  139.       .Rotation = -90
  140.       .Move 0, -30
  141.    End With
  142.    'minute handle
  143.    Set m_pdMinute = m_pdPage.Shapes.Add(5, lX - 10, lY - 100, lX + 10, lY + 10)
  144.    m_pdMinute.Fill.Color = RGB(255, 0, 0)
  145.       
  146.    'seconds handle
  147.    Set m_pdSecond = m_pdPage.Shapes.Add(1, lX - 2, lY - 95, lX + 2, lY + 10)
  148.    m_pdSecond.Fill.Color = RGB(0, 0, 255)
  149.    m_pdPage.Shapes.SelectAll
  150.    POLARDraw1.ActiveWindow.FitTo polFitToSelection
  151.    m_pdPage.Selection.Clear
  152. End Sub
  153. Private Sub Form_Unload(Cancel As Integer)
  154.       Set m_pdPage = Nothing
  155.       Set m_pdHour = Nothing
  156.       Set m_pdMinute = Nothing
  157.       Set m_pdSecond = Nothing
  158.       
  159. End Sub
  160. Private Sub Timer_Timer()
  161.    Dim lHH As Long
  162.    Dim lMM As Long
  163.    Dim lSS As Long
  164.    Dim lX As Long
  165.    Dim lY As Long
  166.    Dim crVal As Long
  167.    ' get current time
  168.    lHH = Hour(Time)
  169.    lMM = Minute(Time)
  170.    lSS = Second(Time)
  171.    ' disable redrawing while we moving objects
  172.    POLARDraw1.EnableRendering = False
  173.    lX = ptCenter.x
  174.    lY = ptCenter.y
  175.    ' set shapes to initial position
  176.    With m_pdHour
  177.      .Left = lX - 40
  178.      .Top = lY - 30
  179.      .Right = lX + 40
  180.      .Bottom = lY + 30
  181.      .Rotation = -90
  182.      .Move 0, -30
  183.    End With
  184.    With m_pdMinute
  185.      .Left = lX - 10
  186.      .Top = lY - 100
  187.      .Right = lX + 10
  188.      .Bottom = lY + 10
  189.      .Fill.Color = RGB(255, 0, 0)
  190.      .Rotation = 0
  191.    End With
  192.    With m_pdSecond
  193.      .Left = lX - 2
  194.      .Top = lY - 95
  195.      .Right = lX + 2
  196.      .Bottom = lY + 10
  197.      .Rotation = 0
  198.    End With
  199.       
  200.    ' rotate them around center according to the current time
  201.    m_pdHour.RotateAroundPoint -(lHH + lMM / 60) * 30, ptCenter.x, ptCenter.y
  202.    m_pdMinute.RotateAroundPoint -lMM * 6, ptCenter.x, ptCenter.y
  203.    m_pdSecond.RotateAroundPoint -lSS * 6, ptCenter.x, ptCenter.y
  204.    crVal = 255 * ((lSS Mod 60) / 60#)
  205.    POLARDraw1.EnableRendering = True
  206.    m_pdHour.Fill.Color = RGB(crVal, 255, 0)
  207.    If m_fTicking Then
  208.       Beep
  209.    End If
  210. End Sub
  211. Private Sub CheckBorder_Click()
  212.    If CheckBorder.Value = Checked Then
  213.       m_fBorder = True
  214.    Else
  215.       m_fBorder = False
  216.    End If
  217.    If m_fBorder Then
  218.       POLARDraw1.Appearance = cc3D
  219.       POLARDraw1.BorderStyle = 1
  220.    Else
  221.       POLARDraw1.Appearance = ccFlat
  222.       POLARDraw1.BorderStyle = 0
  223.    End If
  224.    ' stretch the canvas to fit the window
  225.    POLARDraw1.EnableRendering = False
  226.    m_pdPage.Shapes.SelectAll
  227.    POLARDraw1.ActiveWindow.FitTo polFitToSelection
  228.       
  229.    ' this call will re-render canvas
  230.    m_pdPage.Selection.Clear
  231. End Sub
  232. Private Sub CheckTicking_Click()
  233.    If CheckTicking.Value = Checked Then
  234.       m_fTicking = True
  235.    Else
  236.       m_fTicking = False
  237.    End If
  238. End Sub
  239. Private Sub Close_Click()
  240.    End
  241. End Sub
  242.