home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch12 / 2dCircle.cls next >
Encoding:
Visual Basic class definition  |  1999-06-17  |  4.3 KB  |  140 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 = "TwoDCircle"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. ' Two-dimensional circle object.
  16.  
  17. Implements TwoDObject
  18.  
  19. ' Coordinates of the center.
  20. Public X As Single
  21. Public Y As Single
  22.  
  23. ' Radius.
  24. Public Radius As Single
  25.  
  26. ' Drawing properties.
  27. Private m_DrawWidth As Integer
  28. Private m_DrawStyle As DrawStyleConstants
  29. Private m_ForeColor As OLE_COLOR
  30. Private m_FillColor As OLE_COLOR
  31. Private m_FillStyle As FillStyleConstants
  32.  
  33. Private Declare Function Arc Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
  34. ' Draw the object in a metafile.
  35. Private Sub TwoDObject_DrawInMetafile(ByVal mf_dc As Long)
  36.     SetMetafileDrawingParameters Me, mf_dc
  37.     Arc mf_dc, _
  38.         X - Radius, Y - Radius, _
  39.         X + Radius, Y + Radius, _
  40.         X + Radius, Y, _
  41.         X + Radius, Y
  42.     RestoreMetafileDrawingParameters mf_dc
  43. End Sub
  44.  
  45. ' Return the object's DrawWidth.
  46. Public Property Get TwoDObject_DrawWidth() As Integer
  47.     TwoDObject_DrawWidth = m_DrawWidth
  48. End Property
  49. ' Set the object's DrawWidth.
  50. Public Property Let TwoDObject_DrawWidth(ByVal new_value As Integer)
  51.     m_DrawWidth = new_value
  52. End Property
  53.  
  54. ' Return the object's DrawStyle.
  55. Public Property Get TwoDObject_DrawStyle() As DrawStyleConstants
  56.     TwoDObject_DrawStyle = m_DrawStyle
  57. End Property
  58. ' Set the object's DrawStyle.
  59. Public Property Let TwoDObject_DrawStyle(ByVal new_value As DrawStyleConstants)
  60.     m_DrawStyle = new_value
  61. End Property
  62.  
  63. ' Return the object's ForeColor.
  64. Public Property Get TwoDObject_ForeColor() As OLE_COLOR
  65.     TwoDObject_ForeColor = m_ForeColor
  66. End Property
  67. ' Set the object's ForeColor.
  68. Public Property Let TwoDObject_ForeColor(ByVal new_value As OLE_COLOR)
  69.     m_ForeColor = new_value
  70. End Property
  71.  
  72. ' Return the object's FillColor.
  73. Public Property Get TwoDObject_FillColor() As OLE_COLOR
  74.     TwoDObject_FillColor = m_FillColor
  75. End Property
  76. ' Set the object's FillColor.
  77. Public Property Let TwoDObject_FillColor(ByVal new_value As OLE_COLOR)
  78.     m_FillColor = new_value
  79. End Property
  80.  
  81. ' Return the object's FillStyle.
  82. Public Property Get TwoDObject_FillStyle() As FillStyleConstants
  83.     TwoDObject_FillStyle = m_FillStyle
  84. End Property
  85. ' Set the object's FillStyle.
  86. Public Property Let TwoDObject_FillStyle(ByVal new_value As FillStyleConstants)
  87.     m_FillStyle = new_value
  88. End Property
  89.  
  90. ' Return this object's bounds.
  91. Public Sub TwoDObject_Bound(ByRef xmin As Single, ByRef xmax As Single, ByRef ymin As Single, ByRef ymax As Single)
  92.     xmin = X - Radius
  93.     xmax = X + Radius
  94.     ymin = Y - Radius
  95.     ymax = Y + Radius
  96. End Sub
  97. ' Draw the object on the canvas.
  98. Public Sub TwoDObject_Draw(ByVal canvas As Object)
  99.     SetCanvasDrawingParameters Me, canvas
  100.     canvas.Circle (X, Y), Radius
  101. End Sub
  102. ' Initialize the object using a serialization string.
  103. ' The serialization does not include the
  104. ' "TwoDRectangle(...)" part.
  105. Private Property Let TwoDObject_Serialization(ByVal RHS As String)
  106. Dim token_name As String
  107. Dim token_value As String
  108.  
  109.     InitializeDrawingProperties Me
  110.  
  111.     ' Read tokens until there are no more.
  112.     Do While Len(RHS) > 0
  113.         ' Read a token.
  114.         GetNamedToken RHS, token_name, token_value
  115.         Select Case token_name
  116.             Case "X"
  117.                 X = CSng(token_value)
  118.             Case "Y"
  119.                 Y = CSng(token_value)
  120.             Case "Radius"
  121.                 Radius = CSng(token_value)
  122.             Case Else
  123.                 ReadDrawingPropertySerialization Me, token_name, token_value
  124.         End Select
  125.     Loop
  126. End Property
  127.  
  128. ' Return a serialization string for the object.
  129. Public Property Get TwoDObject_Serialization() As String
  130. Dim txt As String
  131.  
  132.     txt = DrawingPropertySerialization(Me)
  133.     txt = txt & " X(" & Format$(X) & ")"
  134.     txt = txt & " Y(" & Format$(Y) & ")"
  135.     txt = txt & " Radius(" & Format$(Radius) & ")"
  136.     TwoDObject_Serialization = "TwoDCircle(" & txt & ")"
  137. End Property
  138.  
  139.  
  140.