cviewpan.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 = "CviewPan"
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 dz As Double, dx As Double
  Dim pGElement As CGElement
  Dim pLine As New CLine
  intmStep = intmStep + 1
  Select Case intmStep
    Case 1
      '设置绘图环境的绘图模式为6
      DrawMain.picDraw.DrawMode = 6
      Set ptLineBegin = pPos
      Set ptLineEnd = pPos
      Set pBasePos = pPos
      Set pDesPos = pPos
      '请输入平移画面的目标点：
      
    Case 2
      '
      Set ptLineEnd = pPos
      With pLine
        Set .pLineBegin = ptLineBegin
        Set .pLineEnd = ptLineEnd
      End With
      Set pGElement = pLine
      pGElement.Draw (edmNormal)
      DrawMain.picDraw.DrawMode = 13
      Call ReDraw(edmDelete)
      Set pDesPos = pPos
      dz = pBasePos.z - pDesPos.z
      dx = pBasePos.x - pDesPos.x
      '重新设置视口大小
      sLeft = sLeft + dz
      sRight = sRight + dz
      sTopic = sTopic + dx
      sBottom = sBottom + dx
      Call Coordinate
      
      DrawMain.picDraw.DrawMode = 6
      intmStep = 0
  End Select
End Sub

Private Sub CCommand_MouseMove(pPos As Position)
  Dim prepos As New Position, curpos As New Position
  Dim pGElement As CGElement
  Dim pTempLine1 As CLine
  Dim pTempLine2 As CLine
  Select Case intmStep
    Case 1
      '请输入移动目标点：
      Set prepos = ptLineEnd
      Set curpos = pPos
      '删除上一个橡皮线
      Set pTempLine1 = New CLine
      Set pTempLine2 = New CLine
      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)
  intmStep = 0
End Sub