form1.frm

实现画图

'------------------------------Select Rec--------------------------------------------------------------
'-
If nOperType = 30 Or nOperType = 300 Or nOperType = 301 Or nOperType = 302 And Button = 1 Then
nMouseDownCount = nMouseDownCount + 1
 Dim p2 As New CPoint
 p2.X = X
 p2.Y = Y
 rex = p2.X
 rey = p2.Y
 dxy = 5
 
 Dim reccurrent As Long
   reccurrent = 0
        nselectidr = 0
        Me.Refresh
        Dim m  As Long
        m = 0
        frmRec.Hide
      For m = 1 To RecArray.Count
      Set r = RecArray.Item(m)
       
          
     If (r.mvarPoint1.X - p2.X) * (r.mvarPoint1.X - p2.X) + (r.mvarPoint2.Y - p2.Y) * (r.mvarPoint2.Y - p2.Y) < max * max Then
        ' 指向左上点
         reccurrent = 1
         nselectidr = m
         Set SelectRec = RecArray(m)
            Me.Circle (SelectRec.mvarPoint1.X, SelectRec.mvarPoint1.Y), dxy, vbBlue
            Me.Circle (SelectRec.mvarPoint1.X, SelectRec.mvarPoint2.Y), dxy, vbBlue
            Me.Circle (SelectRec.mvarPoint2.X, SelectRec.mvarPoint1.Y), dxy, vbBlue
            Me.Circle (SelectRec.mvarPoint2.X, SelectRec.mvarPoint2.Y), dxy, vbBlue
            If isShowRecInfo = True Then
                   frmRec.Text1 = SelectRec.ID
                    frmRec.Text2 = SelectRec.mvarPoint1.X
                    frmRec.Text3 = SelectRec.mvarPoint1.Y
                    frmRec.Text4 = SelectRec.mvarPoint2.X
                    frmRec.Text5 = SelectRec.mvarPoint2.Y
                     frmRec.Text6 = SelectRec.size
                    frmRec.Text7.BackColor = SelectRec.color
                    frmRec.Text8 = SelectRec.nFillStyle
                   frmRec.Show 0, Me
                    isShowRecInfo = False
                End If
            Exit For
        
    ElseIf (r.mvarPoint2.X - p2.X) * (r.mvarPoint2.X - p2.X) + (r.mvarPoint2.Y - p2.Y) * (r.mvarPoint2.Y - p2.Y) < max * max Then
        '指向右上点
        reccurrent = 2
         nselectidr = m
         Set SelectRec = RecArray(m)
            Me.Circle (SelectRec.mvarPoint1.X, SelectRec.mvarPoint1.Y), dxy, vbBlue
            Me.Circle (SelectRec.mvarPoint1.X, SelectRec.mvarPoint2.Y), dxy, vbBlue
            Me.Circle (SelectRec.mvarPoint2.X, SelectRec.mvarPoint1.Y), dxy, vbBlue
            Me.Circle (SelectRec.mvarPoint2.X, SelectRec.mvarPoint2.Y), dxy, vbBlue
            If isShowRecInfo = True Then
                   frmRec.Text1 = SelectRec.ID
                     frmRec.Text2 = SelectRec.mvarPoint1.X
                    frmRec.Text3 = SelectRec.mvarPoint1.Y
                    frmRec.Text4 = SelectRec.mvarPoint2.X
                    frmRec.Text5 = SelectRec.mvarPoint2.Y
                     frmRec.Text6 = SelectRec.size
                    frmRec.Text7.BackColor = SelectRec.color
                    frmRec.Text8 = SelectRec.nFillStyle
                   frmRec.Show 0, Me
                    isShowRecInfo = False
                End If
              
            Exit For
   ElseIf (r.mvarPoint1.X - p2.X) * (r.mvarPoint1.X - p2.X) + (r.mvarPoint2.Y - p2.Y) * (r.mvarPoint2.Y - p2.Y) < max * max Then
         '指向左下点
         reccurrent = 3
         nselectidr = m
          Set SelectRec = RecArray(m)
            Me.Circle (SelectRec.mvarPoint1.X, SelectRec.mvarPoint1.Y), dxy, vbBlue
            Me.Circle (SelectRec.mvarPoint1.X, SelectRec.mvarPoint2.Y), dxy, vbBlue
            Me.Circle (SelectRec.mvarPoint2.X, SelectRec.mvarPoint1.Y), dxy, vbBlue
            Me.Circle (SelectRec.mvarPoint2.X, SelectRec.mvarPoint2.Y), dxy, vbBlue
            Exit For
    ElseIf (r.mvarPoint2.X - p2.X) * (r.mvarPoint2.X - p2.X) + (r.mvarPoint2.Y - p2.Y) * (r.mvarPoint2.Y - p2.Y) < max * max Then
      '指向右下点
      reccurrent = 4
      nselectidr = m
       Set SelectRec = RecArray(m)
            Me.Circle (SelectRec.mvarPoint1.X, SelectRec.mvarPoint1.Y), dxy, vbBlue
            Me.Circle (SelectRec.mvarPoint1.X, SelectRec.mvarPoint2.Y), dxy, vbBlue
            Me.Circle (SelectRec.mvarPoint2.X, SelectRec.mvarPoint1.Y), dxy, vbBlue
              Me.Circle (SelectRec.mvarPoint2.X, SelectRec.mvarPoint2.Y), dxy, vbBlue
              If isShowRecInfo = True Then
                   frmRec.Text1 = SelectRec.ID
                     frmRec.Text2 = SelectRec.mvarPoint1.X
                    frmRec.Text3 = SelectRec.mvarPoint1.Y
                    frmRec.Text4 = SelectRec.mvarPoint2.X
                    frmRec.Text5 = SelectRec.mvarPoint2.Y
                     frmRec.Text6 = SelectRec.size
                    frmRec.Text7.BackColor = SelectRec.color
                    frmRec.Text8 = SelectRec.nFillStyle
                   frmRec.Show 0, Me
                   isShowRecInfo = False
                End If
          Exit For
    ElseIf OnReg(p2, r) Then
    '指向矩形本身
     reccurrent = 5
     nselectidr = m
     Set SelectRec = RecArray(m)
            Me.Circle (SelectRec.mvarPoint1.X, SelectRec.mvarPoint1.Y), dxy, vbBlue
            Me.Circle (SelectRec.mvarPoint1.X, SelectRec.mvarPoint2.Y), dxy, vbBlue
            Me.Circle (SelectRec.mvarPoint2.X, SelectRec.mvarPoint1.Y), dxy, vbBlue
            Me.Circle (SelectRec.mvarPoint2.X, SelectRec.mvarPoint2.Y), dxy, vbBlue
            If isShowRecInfo = True Then
                   frmRec.Text1 = SelectRec.ID
                     frmRec.Text2 = SelectRec.mvarPoint1.X
                    frmRec.Text3 = SelectRec.mvarPoint1.Y
                    frmRec.Text4 = SelectRec.mvarPoint2.X
                    frmRec.Text5 = SelectRec.mvarPoint2.Y
                     frmRec.Text6 = SelectRec.size
                    frmRec.Text7.BackColor = SelectRec.color
                    frmRec.Text8 = SelectRec.nFillStyle
                   frmRec.Show 0, Me
                    isShowRecInfo = False
                End If
       
       Exit For

   End If
 Next
End If


'------------------------------Delete Rec----------------------------------------------
'--------
If nOperType = 300 Then
        For m = 1 To RecArray.Count
        Set r = RecArray.Item(m)
        RecArray.Remove (nselectidr)
        Me.Refresh
        Set r = Nothing
        Exit For

Next
Set r = Nothing
End If


'====================================Draw Circle========================================================
If nOperType = 4 And Button = 1 Then
  nMouseDownCount = nMouseDownCount + 1
  If nMouseDownCount = 1 Then
     LX1 = X
     LY1 = Y
     tempX = X
     tempY = Y
  End If
  If nMouseDownCount = 2 Then
      CID = CID + 1
      Dim c As New CCircle
      c.color = nColor
      c.CenterPoint.X = LX1
      c.CenterPoint.Y = LY1
      c.cp.X = X
      c.cp.Y = Y
      c.CR = Sqr((LX1 - X) ^ 2 + (LY1 - Y) ^ 2)
      c.nType = 4
      c.ID = CID
      c.size = nSize
      c.nFillStyle = nFillStyle
      
      c.nStyle = nLineStyle
      Me.DrawStyle = nLineStyle
      Me.FillColor = nFillColor
      Me.DrawWidth = nSize
      Me.Circle (c.CenterPoint.X, c.CenterPoint.Y), c.CR, c.color
      CircleArray.Add c
       Me.StatusBar1.Panels(2).Text = "圆的信息："
       Me.StatusBar1.Panels(3).Text = "圆的ID号："
      Me.StatusBar1.Panels(4).Text = c.ID
      Set c = Nothing
      End If
End If



'-------------------------------Select Circle-------------------------------------------
'

If nOperType = 40 Or nOperType = 400 Or nOperType = 401 Or nOperType = 402 And Button = 1 Then

    nMouseDownCount = nMouseDownCount + 1
    frmCircle.Hide
    Dim p3 As New CPoint
    p3.X = X
    p3.Y = Y
    nselectidc = 0
    Dim n As Long
    Dim ccurrent As Long
    n = 0
    For n = 1 To CircleArray.Count
    Set c = CircleArray.Item(n)
    '假设指定点不在圆上
    ccurrent = 0
      If OnCircle(p3, c) Then
      ccurrent = 1
      nselectidc = n
      Me.Timer1.Enabled = True
       Set selectCircle = CircleArray(n)
       Me.DrawWidth = selectCircle.size
       Me.Circle (selectCircle.CenterPoint.X, selectCircle.CenterPoint.Y), selectCircle.CR, vbGreen
       If isShowCircleInfo = True Then
                   frmCircle.Text1 = selectCircle.ID
                    frmCircle.Text2 = selectCircle.CenterPoint.X
                     frmCircle.Text3 = selectCircle.CenterPoint.Y
                      frmCircle.Text4 = selectCircle.cp.X
                       frmCircle.Text5 = selectCircle.cp.Y
                        frmCircle.Text6 = selectCircle.size
                         frmCircle.Text7.BackColor = selectCircle.color
                          frmCircle.Text8 = selectCircle.nFillStyle
                           frmCircle.Show 0, Me
                           isShowCircleInfo = False
                End If
            Exit For
      
      Exit For
      End If
      Next
End If


'----------------------------------Delete Circle----------------------------------------
'
If nOperType = 400 Then
        For n = 1 To CircleArray.Count
        Set c = CircleArray.Item(n)
        CircleArray.Remove (nselectidc)
        Me.Refresh
        Set c = Nothing
        Exit For

Next
Set c = Nothing
End If



End Sub



Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.StatusBar1.Panels(1).Text = "x=" & Str(X) & " y=" & Str(Y)

 Me.Scale (lx, ly)-(rx, ry)
'==================================move point===============================================
If nMouseDownCount = 1 And Button = 1 Then
    If nOperType = 100 And nselectid > 0 Then
    
        Me.DrawMode = 13
     Me.MousePointer = 5
     Set SelectPoint = PntArray(nselectid)
       Me.DrawWidth = SelectPoint.size + 10
       PSet (SelectPoint.X, SelectPoint.Y), Me.BackColor
       
       SelectPoint.X = X
       SelectPoint.Y = Y
       Me.DrawWidth = SelectPoint.size + 10
       PSet (SelectPoint.X, SelectPoint.Y), SelectPoint.color
    End If
End If
'==================================draw line============================================
'
If nMouseDownCount = 1 And nOperType = 2 Then

        Me.DrawWidth = nSize
        Me.DrawStyle = nLineStyle
        Me.FillStyle = nFillStyle
        Me.FillColor = nFillColor
        Me.DrawMode = 10
        Me.Line (LX1, LY1)-(tempX, tempY), nColor
        Me.Line (LX1, LY1)-(X, Y), nColor
        tempX = X
        tempY = Y
       ' Me.DrawMode = 10
        
        End If
        
'

'-------------------------------move line-----------------------------------------


    If nOperType = 201 And Button = 1 And nselectidl > 0 Then
       Me.MousePointer = 5
       Set SelectLine = LineArray.Item(nselectidl)
       Me.DrawWidth = SelectLine.size
        Me.DrawStyle = nLineStyle
        Me.FillStyle = nFillStyle
        Me.FillColor = nFillColor
 
       Me.Line (SelectLine.startPoint.X, SelectLine.startPoint.Y)-( _
       SelectLine.endPoint.X, SelectLine.endPoint.Y), Me.BackColor
       Me.FillColor = Me.BackColor
        Me.Circle (SelectLine.startPoint.X, SelectLine.startPoint.Y), dxy, Me.BackColor
            Me.Circle (SelectLine.endPoint.X, SelectLine.endPoint.Y), dxy, Me.BackColor
        Dim dxl, dyl As Single
        dxl = X - mx
        dyl = Y - my
    
        SelectLine.startPoint.X = SelectLine.startPoint.X + dxl
        SelectLine.endPoint.X = SelectLine.endPoint.X + dxl
        SelectLine.startPoint.Y = SelectLine.startPoint.Y + dyl
        SelectLine.endPoint.Y = SelectLine.endPoint.Y + dyl
         Me.DrawMode = 13
      Me.Line (SelectLine.startPoint.X, SelectLine.startPoint.Y)-( _
     SelectLine.endPoint.X, SelectLine.endPoint.Y), SelectLine.color
     
              mx = X
              my = Y
   Me.Line (SelectLine.startPoint.X, SelectLine.startPoint.Y)-( _
     SelectLine.endPoint.X, SelectLine.endPoint.Y), SelectLine.color
          End If


'-------------------------------------------edit line-------------------------------------
'


   If nOperType = 200 And Button = 1 And nselectidl > 0 Then
       Me.MousePointer = 5
       Set SelectLine = LineArray(nselectidl)
       Me.DrawWidth = SelectLine.size
        Me.DrawStyle = nLineStyle
        Me.FillStyle = nFillStyle
        Me.FillColor = nFillColor
        Me.DrawMode = 10
      Me.Line (SelectLine.startPoint.X, SelectLine.startPoint.Y)-( _
      SelectLine.endPoint.X, SelectLine.endPoint.Y), Me.BackColor
       SelectLine.startPoint.X = tempX
       SelectLine.startPoint.Y = tempY
      SelectLine.endPoint.X = X
       SelectLine.endPoint.Y = Y
     Me.Line (SelectLine.startPoint.X, SelectLine.startPoint.Y)-( _
     SelectLine.endPoint.X, SelectLine.endPoint.Y), SelectLine.color
    Me.Line (SelectLine.startPoint.X, SelectLine.startPoint.Y)-( _
     SelectLine.endPoint.X, SelectLine.endPoint.Y), SelectLine.color
     Me.Refresh
     End If



      
        
'================================draw rec=======================================
   If nMouseDownCount = 1 And nOperType = 3 Then

        Me.DrawWidth = nSize
        Me.DrawStyle = nLineStyle
        Me.FillStyle = nFillStyle
        Me.FillColor = nFillColor
        Me.DrawMode = 10
        Me.Line (LX1, LY1)-(tempX, tempY), nColor, B
        Me.Line (LX1, LY1)-(X, Y), nColor, B
        tempX = X
        tempY = Y
   End If
   
 
'
'-------------------------------edit rec-----------------------------------------------------

       If nOperType = 301 And Button = 1 And nselectidr > 0 Then
       Me.MousePointer = 5
       Set SelectRec = RecArray(nselectidr)
       Me.DrawWidth = SelectRec.size
        Me.DrawStyle = nLineStyle
        Me.FillStyle = nFillStyle
        Me.FillColor = nFillColor
        Me.DrawMode = 10
       
       Me.Line (SelectRec.mvarPoint1.X, SelectRec.mvarPoint1.Y)-(SelectRec.mvarPoint2.X, SelectRec.mvarPoint2.Y), Me.BackColor, B
       SelectRec.mvarPoint1.X = tempX
       SelectRec.mvarPoint1.Y = tempY
       SelectRec.mvarPoint2.X = X
       SelectRec.mvarPoint1.Y = Y

      
       Me.Line (SelectRec.mvarPoint1.X, SelectRec.mvarPoint1.Y)-(SelectRec.mvarPoint2.X, _
       SelectRec.mvarPoint2.Y), SelectRec.color, B
      Me.Line (SelectRec.mvarPoint1.X, SelectRec.mvarPoint1.Y)-(SelectRec.mvarPoint2.X, _