home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch12 / 2dEllip.cls < prev    next >
Encoding:
Visual Basic class definition  |  1999-06-17  |  4.9 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 = "TwoDEllipse"
  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 ellipse object.
  16.  
  17. Implements TwoDObject
  18.  
  19. ' Bounding box.
  20. Public X1 As Single
  21. Public Y1 As Single
  22. Public X2 As Single
  23. Public Y2 As Single
  24.  
  25. ' Drawing properties.
  26. Private m_DrawWidth As Integer
  27. Private m_DrawStyle As DrawStyleConstants
  28. Private m_ForeColor As OLE_COLOR
  29. Private m_FillColor As OLE_COLOR
  30. Private m_FillStyle As FillStyleConstants
  31.  
  32. 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
  33.  
  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.         X1, Y1, _
  39.         X2, Y2, _
  40.         X2, Y1, _
  41.         X2, Y1
  42.     RestoreMetafileDrawingParameters mf_dc
  43. End Sub
  44. ' Return the object's DrawWidth.
  45. Public Property Get TwoDObject_DrawWidth() As Integer
  46.     TwoDObject_DrawWidth = m_DrawWidth
  47. End Property
  48. ' Set the object's DrawWidth.
  49. Public Property Let TwoDObject_DrawWidth(ByVal new_value As Integer)
  50.     m_DrawWidth = new_value
  51. End Property
  52.  
  53. ' Return the object's DrawStyle.
  54. Public Property Get TwoDObject_DrawStyle() As DrawStyleConstants
  55.     TwoDObject_DrawStyle = m_DrawStyle
  56. End Property
  57. ' Set the object's DrawStyle.
  58. Public Property Let TwoDObject_DrawStyle(ByVal new_value As DrawStyleConstants)
  59.     m_DrawStyle = new_value
  60. End Property
  61.  
  62. ' Return the object's ForeColor.
  63. Public Property Get TwoDObject_ForeColor() As OLE_COLOR
  64.     TwoDObject_ForeColor = m_ForeColor
  65. End Property
  66. ' Set the object's ForeColor.
  67. Public Property Let TwoDObject_ForeColor(ByVal new_value As OLE_COLOR)
  68.     m_ForeColor = new_value
  69. End Property
  70.  
  71. ' Return the object's FillColor.
  72. Public Property Get TwoDObject_FillColor() As OLE_COLOR
  73.     TwoDObject_FillColor = m_FillColor
  74. End Property
  75. ' Set the object's FillColor.
  76. Public Property Let TwoDObject_FillColor(ByVal new_value As OLE_COLOR)
  77.     m_FillColor = new_value
  78. End Property
  79.  
  80. ' Return the object's FillStyle.
  81. Public Property Get TwoDObject_FillStyle() As FillStyleConstants
  82.     TwoDObject_FillStyle = m_FillStyle
  83. End Property
  84. ' Set the object's FillStyle.
  85. Public Property Let TwoDObject_FillStyle(ByVal new_value As FillStyleConstants)
  86.     m_FillStyle = new_value
  87. End Property
  88.  
  89. ' Return this object's bounds.
  90. Public Sub TwoDObject_Bound(ByRef xmin As Single, ByRef xmax As Single, ByRef ymin As Single, ByRef ymax As Single)
  91.     If X1 < X2 Then
  92.         xmin = X1
  93.         xmax = X2
  94.     Else
  95.         xmin = X2
  96.         xmax = X1
  97.     End If
  98.     If Y1 < Y2 Then
  99.         ymin = Y1
  100.         ymax = Y2
  101.     Else
  102.         ymin = Y2
  103.         ymax = Y1
  104.     End If
  105. End Sub
  106. ' Draw the object on the canvas.
  107. Public Sub TwoDObject_Draw(ByVal canvas As Object)
  108. Dim xmid As Single
  109. Dim ymid As Single
  110. Dim wid As Single
  111. Dim hgt As Single
  112.  
  113.     SetCanvasDrawingParameters Me, canvas
  114.  
  115.     ' Get the basic geometry.
  116.     xmid = (X1 + X2) / 2
  117.     ymid = (Y1 + Y2) / 2
  118.     wid = Abs(X1 - X2)
  119.     hgt = Abs(Y1 - Y2)
  120.  
  121.     If wid > 0.01 Then
  122.         If wid > hgt Then
  123.             canvas.Circle (xmid, ymid), wid / 2, , , , hgt / wid
  124.         Else
  125.             canvas.Circle (xmid, ymid), hgt / 2, , , , hgt / wid
  126.         End If
  127.     End If
  128. End Sub
  129. ' Initialize the object using a serialization string.
  130. ' The serialization does not include the
  131. ' ObjectType(...) part.
  132. Private Property Let TwoDObject_Serialization(ByVal RHS As String)
  133. Dim token_name As String
  134. Dim token_value As String
  135.  
  136.     InitializeDrawingProperties Me
  137.  
  138.     ' Read tokens until there are no more.
  139.     Do While Len(RHS) > 0
  140.         ' Read a token.
  141.         GetNamedToken RHS, token_name, token_value
  142.         Select Case token_name
  143.             Case "X1"
  144.                 X1 = CSng(token_value)
  145.             Case "Y1"
  146.                 Y1 = CSng(token_value)
  147.             Case "X2"
  148.                 X2 = CSng(token_value)
  149.             Case "Y2"
  150.                 Y2 = CSng(token_value)
  151.             Case Else
  152.                 ReadDrawingPropertySerialization Me, token_name, token_value
  153.         End Select
  154.     Loop
  155. End Property
  156.  
  157. ' Return a serialization string for the object.
  158. Public Property Get TwoDObject_Serialization() As String
  159. Dim txt As String
  160.  
  161.     txt = DrawingPropertySerialization(Me)
  162.     txt = txt & " X1(" & Format$(X1) & ")"
  163.     txt = txt & " Y1(" & Format$(Y1) & ")"
  164.     txt = txt & " X2(" & Format$(X2) & ")"
  165.     txt = txt & " Y2(" & Format$(Y2) & ")"
  166.     TwoDObject_Serialization = "TwoDEllipse(" & txt & ")"
  167. End Property
  168.  
  169.  
  170.