ccreatecirce.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 = "CCreateCirce"
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 pTempCircle As CCircle
  Dim pNewCircle As New CCircle
  Set pTempLine = New CLine
  Set pTempCircle = New CCircle
  Dim pGElement As New CGElement
  Dim center As New Position
  
  '将绘图模式设置为6
  DrawMain.picDraw.DrawMode = 6
  'intmStep变量记录鼠标左键的单击次数
  intmStep = intmStep + 1
  
  Select Case intmStep
    Case 1
      Set ptCircleCenter = pPos
      Set ptCircleR = pPos
      '“请输入圆周上的任意点：”
      
    Case 2
      Set center = ptCircleCenter
      
      '擦除拖动时显示的橡皮线
      Set ptLineBegin = ptCircleCenter
      Set ptLineEnd = pPos
      With pTempLine
        Set .pLineBegin = ptLineBegin
        Set .pLineEnd = ptLineEnd
      End With
      Set pGElement = pTempLine
      pGElement.Draw (edmNormal)
      Set pTempLine = Nothing
      
      '清除拖动时显示的橡皮圆
      Set ptCircleR = pPos
      With pTempCircle
        Set .pCenter = ptCircleCenter
        Set .pCircleR = ptCircleR
      End With
      Set pGElement = pTempCircle
      pGElement.Draw (edmNormal)
      Set pTempCircle = Nothing
      
      '绘当前位置上的圆
      Set ptCircleCenter = center
      Set ptCircleR = pPos
      With pNewCircle
        Set .pCenter = ptCircleCenter
        Set .pCircleR = ptCircleR
      End With
      Set pGElement = pNewCircle
      pGElement.Draw (edmNormal)
      
      '图元个数加1，并作为当前创建的圆的ID号
      geNum = geNum + 1
      Dim ID As Integer
      ID = geNum
      '将当前创建的圆添加到GElements集合类和circles集合类
      Call GElements.Add(ID)
      Call circles.Add(1, vbSolid, 0, ptCircleR, ptCircleCenter, ID, Str(ID))
      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 = ptCircleR
      Set curpos = pPos
      
      '设置绘图环境的绘图模式为6
      DrawMain.picDraw.DrawMode = 6
      
      Dim pTempLine1 As CLine
      Dim pTempLine2 As CLine
      Dim pTempCircle1 As CCircle
      Dim pTempCircle2 As CCircle
      Set pTempLine1 = New CLine
      Set pTempLine2 = New CLine
      Set pTempCircle1 = New CCircle
      Set pTempCircle2 = New CCircle
      Dim pGElement As New CGElement
      
       '重画并擦除上一条橡皮线
      Set ptLineBegin = ptCircleCenter
      Set ptLineEnd = prepos
      With pTempLine1
        Set .pLineBegin = ptLineBegin
        Set .pLineEnd = ptLineEnd
      End With
      Set pGElement = pTempLine1
      pGElement.Draw (edmNormal)
      Set pTempLine1 = Nothing
      
      '重画并擦除上一个橡皮圆
      Set ptCircleR = prepos
      With pTempCircle1
        Set .pCenter = ptCircleCenter
        Set .pCircleR = ptCircleR
      End With
      Set pGElement = pTempCircle1
      pGElement.Draw (edmNormal)
      Set pTempCircle1 = Nothing
      
      '绘当前位置的橡皮线
      Set ptLineBegin = ptCircleCenter
      Set ptLineEnd = curpos
      With pTempLine2
        Set .pLineBegin = ptLineBegin
        Set .pLineEnd = ptLineEnd
      End With
      Set pGElement = pTempLine2
      pGElement.Draw (edmNormal)
      Set pTempLine2 = Nothing
      
      '绘当前位置的橡皮圆
      Set ptCircleR = curpos
      With pTempCircle2
        Set .pCenter = ptCircleCenter
        Set .pCircleR = ptCircleR
      End With
      Set pGElement = pTempCircle2
      pGElement.Draw (edmNormal)
      Set pTempCircle2 = Nothing
      
    End Select
End Sub

'单击鼠标右键时的绘图行为
Private Sub CCommand_RButtonDown(pPos As Position)
  Dim prepos As New Position
  Dim pTempLine As CLine
  Dim pTempCircle As CCircle
  Set pTempLine = New CLine
  Set pTempCircle = New CCircle
  Dim pGElement As New CGElement
  
  '若单击鼠标左键的次数为1，重绘并擦除上次鼠标移动时绘的橡皮线和橡皮圆
  If intmStep = 1 Then
    Set prepos = pPos
    Set ptLineBegin = ptCircleCenter
    Set ptLineEnd = prepos
    Set ptCircleR = prepos
    With pTempLine
      Set .pLineBegin = ptLineBegin
      Set .pLineEnd = ptLineEnd
    End With
    Set pGElement = pTempLine
    pGElement.Draw (edmNormal)
    Set pTempLine = Nothing
    
    With pTempCircle
      Set .pCenter = ptCircleCenter
      Set .pCircleR = ptCircleR
    End With
    Set pGElement = pTempCircle
    pGElement.Draw (edmNormal)
    Set pTempCircle = Nothing
  End If
  intmStep = 0    '将鼠标左键的单击次数置0
  '请输入圆心位置：
  
End Sub