ccreateline.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 = "CCreateLine"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Description = "创建直线"
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
  Dim point1 As New Position
  Dim point2 As New Position
  Dim prepos As New Position
    
  '设置绘图环境的绘图模式为6
  DrawMain.picDraw.DrawMode = 6
  '记录鼠标左键的单击次数
  intmStep = intmStep + 1
  Select Case intmStep
    Case 1            '第一次单击鼠标左键
      Set ptLineBegin = pPos
      Set ptLineEnd = pPos
      '在状态栏中显示"请输入直线的末端点:"
    Case 2            '第二次单击鼠标左键
        '重绘并删除前一位置的直线段
        Set prepos = ptLineBegin
        With pTempLine
          Set .pLineBegin = ptLineBegin
          Set .pLineEnd = ptLineEnd
        End With
        Set pGElement = pTempLine
        pGElement.Draw (edmNormal)
        Set pTempLine = Nothing
        '绘当前位置的直线段
        Set ptLineBegin = prepos
        Set ptLineEnd = pPos
        With pNewLine
          Set .pLineBegin = ptLineBegin
          Set .pLineEnd = ptLineEnd
        End With
        Set pGElement = pNewLine
        pGElement.Draw (edmNormal)
        '图元个数加1，作为当前直线段的ID号
        geNum = geNum + 1
        Set point1 = ptLineBegin
        Set point2 = ptLineEnd
        '将当前创建的直线段添加到GElements集合类和lines集合类
        Call GElements.Add(geNum)
        Call lines.Add(1, vbSolid, 0, geNum, point1, point2, Str(geNum))
        intmStep = 0      '将鼠标左键单击次数置0

        '"请输入直线的起点:"
  End Select
End Sub

'移动鼠标时的绘图行为
Private Sub CCommand_MouseMove(pPos As Position)
  
  Select Case intmStep
    Case 0
      '“请输入直线的起点：”
    Case 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
      Dim pGElement As CGElement
      Set pTempLine1 = New CLine
      Set pTempLine2 = New CLine
      Set pGElement = 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 pTempLine As CLine
  Dim pGElement As CGElement
  Set pTempLine = New CLine
  Set pGElement = New CGElement
  '若左键单击次数为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
  intmStep = 0        '将左键单击次数置0
  '"请输入直线的起点："
End Sub