ccreatepolyline.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 = "CCreatePolyLine"
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)
  Dim pTempLine As CLine
  Dim pNewLine As CLine
  Dim pGElement As CGElement
  Set pTempLine = New CLine
  Set pNewLine = New CLine
  Set pGElement = New CGElement
  
  '设置绘图环境的绘图模式为6
  DrawMain.picDraw.DrawMode = 6
  '记录鼠标左键单击次数
  intmStep = intmStep + 1
  
  '如果鼠标单击次数为1，将当前位置作为起点，
  '并把起点添加到PLPoints集合类中进行保存
  If intmStep = 1 Then
    Set ptLineBegin = pPos
    Set PLPoints(geNum + 1, intmStep) = ptLineBegin
    Set ptLineEnd = ptLineBegin
    '在状态栏中显示"请输入下一顶点:"
    
  '如果鼠标左键单击次数大于1，
  ElseIf intmStep > 1 Then
    '重绘并清除前一位置的直线段
    Set ptLineBegin = ptLineEnd
    With pTempLine
      Set .pLineBegin = ptLineBegin
      Set .pLineEnd = ptLineEnd
    End With
    Set pGElement = pTempLine
    pGElement.Draw (edmNormal)
    Set pTempLine = Nothing
    '绘当前位置的直线段
    Set ptLineEnd = pPos
    With pNewLine
      Set .pLineBegin = ptLineBegin
      Set .pLineEnd = ptLineEnd
    End With
    Set pGElement = pNewLine
    pGElement.Draw (edmNormal)
    '将当前点的坐标添加到PLPoints集合类中，作为多义线的顶点
    Set PLPoints(geNum + 1, intmStep) = ptLineBegin
  End If
End Sub

'鼠标移动时的绘图行为
Private Sub CCommand_MouseMove(pPos As Position)
  
  Select Case intmStep
    Case 0
      '“请输入直线的起点：”
    Case Else    '如果鼠标左键的单击次数大于1
      Dim prepos As New Position
      Dim curpos As New Position
      Set prepos = ptLineEnd
      Set curpos = pPos
      Dim pTempLine1 As CLine
      Dim pTempLine2 As CLine
      Set pTempLine1 = New CLine
      Set pTempLine2 = New CLine
      Dim pGElement As New CGElement
      '重绘并清除前一位置的橡皮线
      Set ptLineEnd = prepos
      With pTempLine1
        Set .pLineBegin = ptLineBegin
        Set .pLineEnd = ptLineEnd
      End With
      Set pGElement = pTempLine1
      pGElement.Draw (edmNormal)
      Set pTempLine1 = Nothing
      '绘当前位置的橡皮线
      Set ptLineEnd = curpos
      With pTempLine2
        Set .pLineBegin = ptLineBegin
        Set .pLineEnd = ptLineEnd
      End With
      Set pGElement = pTempLine2
      pGElement.Draw (edmNormal)
      Set pTempLine2 = Nothing
    End Select
    
End Sub

'单击鼠标右键时的绘图行为
Private Sub CCommand_RButtonDown(pPos As Position)
  Dim prepos As New Position
  Dim pPLinePt As New Position
  Dim pTempLine As CLine
  Set pTempLine = New CLine
  Dim pGElement As New CGElement
  Dim NewPos As New Position
  
  '若鼠标左键单击次数为1，重画并清除当前位置的橡皮线
  If intmStep >= 1 Then
    With pTempLine
      Set .pLineBegin = ptLineBegin
      Set .pLineEnd = ptLineEnd
    End With
    Set pGElement = pTempLine
    pGElement.Draw (edmNormal)
    Set pTempLine = Nothing
  End If
  '图元个数加1，作为本次创建的多义线的ID号
  geNum = geNum + 1
  Dim ID As Integer
  ID = geNum
  '将多义线保存到GElements集合类和polylines集合类中
  Call GElements.Add(ID)
  Call polylines.Add(intmStep, PLPoints(), 1, vbSolid, 0, ID, Str(ID))
  
  intmStep = 0    '将鼠标左键单击次数置0
  '"请输入直线的起点："

End Sub