cpick.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 = "CPick"
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 CCommand

Private Sub CCommand_LButtonDown(pPos As Position)

End Sub

'移动鼠标时发生
Private Sub CCommand_MouseMove(pPos As Position)
  Dim i As Integer
  Dim j As Integer
  Dim jj As Integer
  Dim pGElement As CGElement
  Dim pEntity2 As CGElement
  Dim intEntityNum As Integer
  Dim pLine As CLine
  Dim pPLine As CPolyLine
  Dim pCircle As CCircle
  Dim pArc As CArc
  Dim pText As CText
  'someonePicked变量用于确定是否有图元被选择
  Dim someonePicked As Boolean
  
  someonePicked = False
    
        For j = 1 To lines.Count
          Set pLine = lines.Item(j)
            Set ptLineBegin = pLine.pLineBegin
            Set ptLineEnd = pLine.pLineEnd
          Set pGElement = pLine
          If pGElement.Pick(pPos, PickRadius) = True Then
            someonePicked = True
            pLine.Draw (1)
          End If
        Next j

     If someonePicked = False Then
        For j = 1 To polylines.Count
          Set pPLine = polylines.Item(j)
          With pPLine
            intPLPointNum = .intPLinePointNum
            Set ptPLPoints = .pPLinePoints
          End With
          Set pGElement = pPLine
          If pGElement.Pick(pPos, PickRadius) = True Then
            someonePicked = True
            pPLine.Draw (edmprompt)
          End If
        Next PLindex
      End If
      
      If someonePicked = False Then
        For j = 1 To circles.Count
          Set pCircle = circles.Item(j)
            Set ptCircleCenter = pCircle.pCenter
            Set ptCircleR = pCircle.pCircleR
          Set pGElement = pCircle
          If pGElement.Pick(pPos, PickRadius) = True Then
            someonePicked = True
            pCircle.Draw (edmprompt)
          End If
        Next j
      End If
      
      If someonePicked = False Then
        For j = 1 To arcs.Count
          Set pArc = arcs.Item(j)
            Set ptArcCenter = pArc.pCenter
            Set ptArcBegin = pArc.pBegin
            Set ptArcEnd = pArc.pEnd
            Set pGElement = pArc
            If pGElement.Pick(pPos, PickRadius) = True Then
              someonePicked = True
              pArc.Draw (edmprompt)
            End If
        Next j
    End If
    
    If someonePicked = False Then
        For j = 1 To texts.Count
          Set pText = texts.Item(j)
          Set pGElement = pText
            If pGElement.Pick(pPos, PickRadius) = True Then
              pText.Draw (edmprompt)
            End If
        Next j
        
    End If
End Sub

Private Sub CCommand_RButtonDown(pPos As Position)

End Sub