ccircle.cls

数控自动编程系统

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CCircle"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
Implements CGElement

Private m_geColor As Double
Private m_geLineStyle As LineStyle
Private m_geLineWidth As Double
Private m_pCircleR As Position
Private m_pCenter As Position
Private m_ID_Circle As Integer

'写ID_Circle属性
Public Property Let ID_Circle(ByVal vData As Integer)
    m_ID_Circle = vData
End Property

'读ID_Circle属性
Public Property Get ID_Circle() As Integer
    ID_Circle = m_ID_Circle
End Property

'写pCenter属性
Public Property Set pCenter(ByVal vData As Position)
    Set m_pCenter = vData
End Property

'读pCenter属性
Public Property Get pCenter() As Position
    Set pCenter = m_pCenter
End Property

'写pCircleR属性
Public Property Set pCircleR(ByVal vData As Position)
    Set m_pCircleR = vData
End Property

'读pCircleR属性
Public Property Get pCircleR() As Position
    Set pCircleR = m_pCircleR
End Property

'根据指定的绘图模式绘圆
Private Sub CGElement_Draw(eDrawMode As GEDrawMode)
  Dim pen As Double
  Dim n As Integer
    
  '设置线宽
  m_geLineWidth = 1
  '根据绘图模式定义线型和颜色
  Select Case eDrawMode
    Case edmNormal
      m_geLineStyle = vbSolid
      m_geColor = RGB(0, 0, 0)     '正常模式下，黑色
    Case edmSelect
      m_geLineStyle = vbDash
      m_geColor = RGB(255, 0, 0)   '选择模式下，红色
    Case edmDelete                    '删除模式下，用绘图环境的底色重画
      m_geLineStyle = vbSolid
      m_geColor = GetBkColor(DrawMain.picDraw.hdc)
  End Select
    
  '设置绘图属性
  With DrawMain.picDraw
    .DrawStyle = m_geLineStyle
    .DrawWidth = m_geLineWidth
    .ForeColor = m_geColor
  End With
  
  Dim circleR As Double
  '求圆的半径
  circleR = distPtoP(m_pCenter, m_pCircleR)
  '利用Circle方法绘圆
  DrawMain.picDraw.Circle (m_pCenter.z, m_pCenter.x), circleR
End Sub

'写geColor属性
Public Property Let geColor(ByVal RHS As Double)
  m_geColor = RHS
End Property

'读geColor属性
Public Property Get geColor() As Double
  geColor = m_geColor
End Property

'写geLineStyle属性
Public Property Let geLineStyle(ByVal RHS As LineStyle)
  m_geLineStyle = RHS
End Property

'读geLineStyle属性
Public Property Get geLineStyle() As LineStyle
  geLineStyle = m_geLineStyle
End Property

'写geLineWidth属性
Public Property Let geLineWidth(ByVal RHS As Double)
  m_geLineWidth = RHS
End Property

'读geLineWidth属性
Public Property Get geLineWidth() As Double
  geLineWidth = m_geLineWidth
End Property

'获取圆的包围矩形
Private Sub CGElement_GetBox(pBox As Box)
  Dim circleR As Double
  '计算圆的半径
  circleR = distPtoP(m_pCenter, m_pCircleR)
  pBox.minZ = m_pCenter.z - circleR
  pBox.minX = m_pCenter.x - circleR
  pBox.maxZ = m_pCenter.z + circleR
  pBox.maxX = m_pCenter.x + circleR
End Sub

Private Property Let CGElement_ID(ByVal RHS As Integer)

End Property

Private Property Get CGElement_ID() As Integer

End Property

'圆的镜像变换
Private Sub CGElement_Mirror(Pos1 As Position, Pos2 As Position)
  Set m_pCenter = m_pCenter.pntMirror(Pos1, Pos2)
  Set m_pCircleR = m_pCircleR.pntMirror(Pos1, Pos2)
End Sub

'圆的平移变换
Private Sub CGElement_Move(basePos As Position, desPos As Position)
  Dim zz As Double, xx As Double
  zz = desPos.z - basePos.z
  xx = desPos.x - basePos.x
  Set m_pCenter = m_pCenter.pntMove(zz, xx)
  Set m_pCircleR = m_pCircleR.pntMove(zz, xx)
End Sub
Private Sub CGElement_Moveonly()
  Set m_pCenter = m_pCenter.pntMove(100, 0)
  Set m_pCircleR = m_pCircleR.pntMove(100, 0)
End Sub
'圆的拾取
Private Function CGElement_Pick(pos As Position, PickRadius As Double) As Boolean
  Dim i As Integer
  Dim lDistance As Double
  Dim sourceBox As New Box
  Dim cLineTemp As New CLine
  Dim circleR As Double
  
  '计算圆心
  circleR = distPtoP(m_pCenter, m_pCircleR)
  '获取圆的包围矩形
  Call CGElement_GetBox(sourceBox)
  '如果拾取点不在圆的包围矩形内，不被拾取
  If (Not InBox(sourceBox, pos)) Then
    CGElement_Pick = False
  '如果拾取点在圆的包围矩形内
  Else
    '计算拾取点到圆心的距离
    lDistance = distPtoP(pos, m_pCenter)
    '如果拾取点与圆心的距离与圆的半径接近，则该圆被拾取，
    '否则不被拾取
    If (lDistance > circleR - PickRadius * 200 / scale1 And lDistance < circleR + PickRadius * 200 / scale1) Then
      CGElement_Pick = True
    Else
      CGElement_Pick = False
    End If
  End If
End Function

'圆的旋转变换
Private Sub CGElement_Rotate(basePos As Position, Angle As Double)
  Set m_pCenter = m_pCenter.pntRotate(basePos, Angle)
  Set m_pCircleR = m_pCircleR.pntRotate(basePos, Angle)
End Sub

'圆的比例变换
Private Sub CGElement_ScaleTransform(scalez As Double, scalex As Double)
  Set m_pCenter = m_pCenter.pntScale(scalez, scalex)
  Set m_pCircleR = m_pCircleR.pntScale(scalez, scalex)
End Sub