home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD56675102000.psc / CS.cls < prev    next >
Encoding:
Visual Basic class definition  |  2000-05-10  |  5.8 KB  |  170 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CS"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. '+-----------------------------------------------+
  15. '|         ***Source Code Information***         |
  16. '|                                               |
  17. '|Author:    InfraRed                            |
  18. '|                                               |
  19. '|E-Mail:    InfraRed@flashmail.com              |
  20. '|                                               |
  21. '|ICQ UIN:   17948286                            |
  22. '|                                               |
  23. '|Comments:  I hope you enjoy my source code.  I |
  24. '|worked very hard on this, and if you use       |
  25. '|anything from here, I would like to get credit |
  26. '|for it.  If it makes you feel any better, you  |
  27. '|can e-mail/ICQ me and ask permission to use my |
  28. '|source code...  BUT you don't have to!  If you |
  29. '|have any complaints, compliments, comments,    |
  30. '|threats, fan mail, junk mail, hate mail, or    |
  31. '|anything else you can think of, go ahead and   |
  32. '|send.                                          |
  33. '|                                               |
  34. '|              ***Enjoy my code!***             |
  35. '+-----------------------------------------------+
  36.  
  37. Dim DDI As Integer, Rad As Single, RotS As Integer, RotC As Integer, CentX As Single, CentY As Single, DotX(359) As Single, DotY(359) As Single, DotC As Long
  38. 'DDI = Dot Degree Interval
  39. 'Rad = Radius
  40. 'RotS = Rotation Speed
  41. 'RotC = Current Rotation (Speed)
  42. 'CentX = Center (X)
  43. 'CentY = Center (Y)
  44. 'DotX = Dot Location (X)
  45. 'DotY = Dot Location (Y)
  46. 'DotC = Dot Color
  47.  
  48. 'Here are all of the property lets and gets, self explanitory
  49. '----------------------------------------------------
  50. Property Let Dot_Degree_Interval(NewDDI As Integer)
  51. DDI = NewDDI
  52. End Property
  53.  
  54. Property Let Radius(NewRad As Single)
  55. Rad = NewRad
  56. End Property
  57.  
  58. Property Let Dot_Color(NewColor As Long)
  59. DotC = NewColor
  60. End Property
  61.  
  62. Property Let Rotation_Speed(Pixel_Amount As Integer)
  63. RotS = Pixel_Amount
  64. End Property
  65.  
  66. Property Get Dot_Degree_Interval() As Integer
  67. Dot_Degree_Interval = DDI
  68. End Property
  69.  
  70. Property Get Radius() As Single
  71. Radius = Rad
  72. End Property
  73.  
  74. Property Get Dot_Color() As Long
  75. DotColor = DotC
  76. End Property
  77.  
  78. Property Get Rotation_Speed() As Integer
  79. Rotation_Speed = RotS
  80. End Property
  81. '----------------------------------------------------
  82.  
  83. Public Sub Set_Center_Position(NewX As Single, NewY As Single) 'Sets the new center postion, self explanitory
  84. CentX = NewX
  85. CentY = NewY
  86. End Sub
  87.  
  88. Public Sub Draw_Circle(YI As Integer) 'This draws the circle
  89. Dim DegP(359) As Double, XP(359) As Single, YP(359) As Single, i As Integer
  90. 'DepP = Degree Position
  91. 'XP = X Position
  92. 'YP = Y Position
  93.  
  94.   If DC(YI) = True Then
  95.   Erase_All YI
  96.   Exit Sub
  97.   End If
  98. For i = 0 To (360 / DDI) - 1 'Loop through every dot
  99. EraseP DotX(i), DotY(i) 'Erase the old dot
  100. DegP(i) = ((360 / DDI) * i) + RotC 'Find the degree (in the circle) of the current dot and add rotation
  101. XP(i) = (Cos(DegP(i)) * Radius) + CentX 'Find the dot's true X position and center it
  102. YP(i) = (Sin(DegP(i)) * Radius) + CentY 'Find the dot's true Y position and center it
  103.   '--------------------------------------------------
  104.   'Now, I understand that some people may not know
  105.   'How to use Cosine and Sine to find the
  106.   'coordinates of dots on a circle, so I will explain
  107.   'it to the best of my ability.  Here is a quick
  108.   'explanation.  Now, you know that coordinates are
  109.   'shown in (X, Y), well, Cosine (Cos) finds the X
  110.   'and Sine (Sin) finds the Y.  So really, you could
  111.   'think of Sine and Cosine as (Cosine, Sine).  Don't
  112.   'get confused yet, lol, I will explain this further.
  113.   'Now, Cosine can be used to find the coordinates of
  114.   'a certain point by using the degrees of that point
  115.   'Here is a quick example:
  116.   'Cosine(Point_Degree) * Radius_Length = The X
  117.   'coordinate of that Point.  And:
  118.   'Sine(Point_Degree) * Radius_Length = The Y
  119.   'coordinate of that Point.  Here is an example of
  120.   'finding the (X, Y) of a point with the degree
  121.   'measurement of 100░, and the circle has a radius
  122.   'of 5.  To find the X:
  123.   'Cos(100) * 5
  124.   'To find the Y:
  125.   'Sin(100) * 5
  126.   'Simple enough, right?  Now you may notice the
  127.   'CentX and the CentY.  Those are used for me to
  128.   'put the circle at the point I want.  So I just
  129.   'add a certain amount to the X and Y like this:
  130.   '(X + CentX, Y + CentY) = New (X, Y)
  131.   'That is all that does, and if it confuses you,
  132.   'just ignore it for now.  I hope this little
  133.   'tutorial helps you understand the use of Sine
  134.   'and Cosine in finding the coordinates of a
  135.   'point on a circle.
  136.   '--------------------------------------------------
  137. DotX(i) = XP(i) 'Set the main dot position (X)
  138. DotY(i) = YP(i) 'Set the main dot position (Y)
  139.       If DC(YI) = False Then SetP XP(i), YP(i), DotC 'Draw dot
  140. DoEvents
  141. Next i 'Loop back
  142. 'Add to the rotation
  143. '-------------------------
  144. RotC = RotC + RotS
  145.   Do While RotC > DDI
  146.   RotC = RotC - DDI
  147.   Loop
  148.     If DC(YI) = True Then
  149.     Erase_All YI
  150.     Exit Sub
  151.     End If
  152. '-------------------------
  153. End Sub
  154.  
  155. Private Sub EraseP(X As Single, Y As Single) 'This erases a point, self explanitory
  156. MainFrm.PSet (X, Y), RGB(0, 0, 0)
  157. End Sub
  158.  
  159. Private Sub SetP(X As Single, Y As Single, Color As Long) 'This sets the color of a certain point on the screen, self explanitory
  160. MainFrm.PSet (X, Y), Color
  161. End Sub
  162.  
  163. Public Sub Erase_All(MI As Integer) 'This erases all the points of the circle, self explanitory
  164. Dim i As Integer
  165. For i = 0 To 359
  166. EraseP DotX(i), DotY(i)
  167. Next i
  168. DC(MI) = False
  169. End Sub
  170.