home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 May / CHIPCD5_98.iso / offline / ActiveX / zegar / zrodla / Zegarek.ctl < prev    next >
Text File  |  1998-03-26  |  2KB  |  70 lines
  1. VERSION 5.00
  2. Begin VB.UserControl Zegarek 
  3.    ClientHeight    =   3600
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   4800
  7.    FillColor       =   &H80000004&
  8.    FillStyle       =   5  'Downward Diagonal
  9.    ScaleHeight     =   3600
  10.    ScaleWidth      =   4800
  11.    Begin VB.Timer Timer1 
  12.       Interval        =   1000
  13.       Left            =   240
  14.       Top             =   2880
  15.    End
  16.    Begin VB.Shape Shape1 
  17.       BorderStyle     =   6  'Inside Solid
  18.       Height          =   3015
  19.       Left            =   600
  20.       Shape           =   3  'Circle
  21.       Top             =   240
  22.       Width           =   3255
  23.    End
  24. End
  25. Attribute VB_Name = "Zegarek"
  26. Attribute VB_GlobalNameSpace = False
  27. Attribute VB_Creatable = True
  28. Attribute VB_PredeclaredId = False
  29. Attribute VB_Exposed = True
  30. Const R = 1000
  31. Const Pi = 3.141
  32. Dim T As Integer
  33. Dim xp As Integer
  34. Dim yp As Integer
  35. Dim x As Integer
  36. Dim y As Integer
  37. Dim x1 As Integer
  38. Dim y1 As Integer
  39. Private Sub Timer1_Timer()
  40. ' To jest najwa┐niejsza procedura naszego zegarka,
  41. ' w│a£nie ona porusza wskaz≤wk╣
  42. ' ***********************************************
  43.  
  44. ' zmienna T okre£la k╣t pochylania wskaz≤wki
  45.     T = (T + 6) Mod 360
  46.     
  47. ' poprzednia pozycja wskazowki
  48.     x1 = x
  49.     y1 = y
  50. ' bie┐╣ca pozycja wskaz≤wki
  51.     x = xp + Cos((T - 90) * Pi / 180) * R
  52.     y = yp + Sin((T - 90) * Pi / 180) * R
  53.     
  54. ' rysuj szara wskazowke
  55.     Line (xp, yp)-(x1, y1), vbMenuBar
  56. ' rysuj niebieska wskazowke
  57.     Line (xp, yp)-(x, y), vbHighlight
  58. End Sub
  59. Private Sub UserControl_Initialize()
  60. ' Ta procedura ustawia pocz╣tkowe parametry kontrolki
  61. Dim a As Integer ' pomocnicza zmienna
  62.     x = 0
  63.     y = 0
  64.     a = IIf(Shape1.Height < Shape1.Width, Shape1.Height, Shape1.Width)
  65.     Shape1.Move 5, 5, a - 50, a - 50
  66.     Shape1.Refresh
  67.     xp = (a - 10) / 2
  68.     yp = (a - 10) / 2
  69. End Sub
  70.