ccreatearc.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 = "CCreateArc"
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)
  
  '绘新圆弧时认为没有发生镜像转换
  bolMirror = False
  '将绘图环境的绘图模式设置为6
  DrawMain.picDraw.DrawMode = 6
  'intmStep记录鼠标左键的单击次数
  intmStep = intmStep + 1
  Select Case intmStep
    Case 1
      Set ptArcCenter = pPos
      '请输入圆弧的起点：
      
    Case 2
      Set ptArcBegin = pPos
      Set ptArcEnd = pPos
      '请输入圆弧的终点
      
    Case 3
      Dim pTempLine1 As CLine
      Dim pTempLine2 As CLine
      Dim pTempArc As CArc
      Dim pNewArc As CArc
      Set pTempLine1 = New CLine
      Set pTempLine2 = New CLine
      Set pTempArc = New CArc
      Set pNewArc = New CArc
      Dim pGElement As New CGElement
      Dim center As New Position
      Dim begin As New Position
      
      Set center = ptArcCenter
      Set begin = ptArcBegin

      '重画并擦除在拖动状态时圆弧圆心到起点的橡皮线
      Set ptLineBegin = ptArcCenter
      Set ptLineEnd = ptArcBegin
      With pTempLine1
        Set .pLineBegin = ptLineBegin
        Set .pLineEnd = ptLineEnd
      End With
      Set pGElement = pTempLine1
      pGElement.Draw (edmNormal)
      Set pTempLine1 = Nothing
      
      '重画并擦除拖动时显示的圆弧圆心到终点的橡皮线
      Set ptLineBegin = ptArcCenter
      Set ptLineEnd = ptArcEnd
      With pTempLine2
        Set .pLineBegin = ptLineBegin
        Set .pLineEnd = ptLineEnd
      End With
      Set pGElement = pTempLine2
      pGElement.Draw (edmNormal)
      Set pTempLine2 = Nothing
      
      '将设备环境的绘图模式设置为13
      DrawMain.picDraw.DrawMode = 13
      
      '重绘并删除前一橡皮弧
      With pTempArc
        Set .pCenter = ptArcCenter
        Set .pBegin = ptArcBegin
        Set .pEnd = ptArcEnd
      End With
      Set pGElement = pTempArc
      pGElement.Draw (edmNormal)
      Set pTempArc = Nothing
      
      '绘当前位置的圆弧
      Set ptArcCenter = center
      Set ptArcBegin = begin
      Set ptArcEnd = pPos
      With pNewArc
        Set .pCenter = ptArcCenter
        Set .pBegin = ptArcBegin
        Set .pEnd = ptArcEnd
      End With
      Set pGElement = pNewArc
      pGElement.Draw (edmNormal)
     
      '图元个数加1，并作为当前创建的圆弧的ID号
      geNum = geNum + 1
      Dim ID As Integer
      ID = geNum
      '把当前创建的圆弧保存到GElements集合类和arcs集合类中
      Call GElements.Add(ID)
      Call arcs.Add(1, vbSolid, 0, ptArcCenter, ptArcBegin, ptArcEnd, ID, Str(ID))
      
      '将绘图环境的绘图模式设置为6
      DrawMain.picDraw.DrawMode = 6
      
      intmStep = 0     '将鼠标左键的单击次数置0
       '“请输入圆弧的中心点：”
       
   End Select
End Sub

'移动鼠标时的绘图行为
Private Sub CCommand_MouseMove(pPos As Position)

  Select Case intmStep
    Case 0
      '“请输入圆心位置：”
    Case 2
      
      '将绘图环境的绘图模式设置为6
      DrawMain.picDraw.DrawMode = 6
      
      Dim pTempLine1 As CLine
      Dim pTempLine2 As CLine
      Dim pTempArc1 As CArc
      Dim pTempArc2 As CArc
      Set pTempLine1 = New CLine
      Set pTempLine2 = New CLine
      Set pTempArc1 = New CArc
      Set pTempArc2 = New CArc
      Dim pGElement As New CGElement
      Dim prepos As New Position
      Dim curpos As New Position
      
      '记录当前的终点，作为下一次移动时擦除橡皮线用
      Set prepos = ptArcEnd
      Set curpos = pPos
      
      '重画并擦除上一条圆心到终点的橡皮线
      Set ptLineBegin = ptArcCenter
      Set ptLineEnd = prepos
      With pTempLine1
        Set .pLineBegin = ptLineBegin
        Set .pLineEnd = ptLineEnd
      End With
      Set pGElement = pTempLine1
      pGElement.Draw (edmNormal)
      Set pTempLine1 = Nothing
      
      '绘当前位置圆心到终点的橡皮线
      Set ptLineBegin = ptArcCenter
      Set ptLineEnd = curpos
      With pTempLine2
        Set .pLineBegin = ptLineBegin
        Set .pLineEnd = ptLineEnd
      End With
      Set pGElement = pTempLine2
      pGElement.Draw (edmNormal)
      Set pTempLine2 = Nothing
      
      '将绘图环境的绘图模式设置为13，
      '画笔颜色取为绘图环境的前景色
      DrawMain.picDraw.DrawMode = 13

      '用底色重画前一个橡皮弧，从屏幕上删除它
      Set ptArcEnd = prepos
      With pTempArc1
        Set .pCenter = ptArcCenter
        Set .pBegin = ptArcBegin
        Set .pEnd = ptArcEnd
      End With
      Set pGElement = pTempArc1
      pGElement.Draw (edmDelete)
      Set pTempArc1 = Nothing
      
      '画当前位置的橡皮弧
      Set ptArcEnd = curpos
      With pTempArc2
        Set .pCenter = ptArcCenter
        Set .pBegin = ptArcBegin
        Set .pEnd = ptArcEnd
      End With
      Set pGElement = pTempArc2
      pGElement.Draw (edmNormal)
      Set pTempArc2 = Nothing
      
      '设置绘图环境的绘图模式为6，画橡皮线时取当前点的反色
      DrawMain.picDraw.DrawMode = 6
    End Select
End Sub

'单击鼠标右键时的绘图行为
Private Sub CCommand_RButtonDown(pPos As Position)
  Dim prepos As New Position
  Dim beginPos As New Position
  Dim pTempLine1 As CLine
  Dim pTempLine2 As CLine
  Dim pTempArc1 As CArc
  Dim pTempArc2 As CArc
  Set pTempLine1 = New CLine
  Set pTempLine2 = New CLine
  Set pTempArc1 = New CArc
  Set pTempArc2 = New CArc
  Dim pGElement As New CGElement
  
  '若鼠标左键单击次数为2
  If intmStep = 2 Then
    '擦除上条圆心到起点的橡皮线
    Set prepos = ptArcEnd
    Set beginPos = ptArcBegin
    Set ptLineBegin = ptArcCenter
    Set ptLineEnd = ptArcBegin
    With pTempLine1
      Set .pLineBegin = ptLineBegin
      Set .pLineEnd = ptLineEnd
    End With
    Set pGElement = pTempLine1
    pGElement.Draw (edmNormal)
    Set pTempLine1 = Nothing
    
    '擦除上条圆心到终点的橡皮线
    Set ptLineEnd = prepos
    With pTempLine2
      Set .pLineBegin = ptLineBegin
      Set .pLineEnd = ptLineEnd
    End With
    Set pGElement = pTempLine2
    pGElement.Draw (edmNormal)
    Set pTempLine2 = Nothing
    
    '擦除上条橡皮弧
    Set ptArcEnd = prepos
    With pTempArc2
      Set .pCenter = ptArcCenter
      Set .pBegin = ptArcBegin
      Set .pEnd = ptArcEnd
    End With
    Set pGElement = pTempArc2
    pGElement.Draw (edmNormal)
    Set pTempArc2 = Nothing
  End If
  intmStep = 0     '将鼠标左键的单击次数置0
  '请输入圆心位置：
  
End Sub