form1.frm

实现画图

       Me.Refresh
    Loop
    Me.Refresh
    Set c = Nothing
   End If
End If


If nOperType = 600 Then
    If Me.DataGrid1.Caption = "数据表名为:点表" Then
        For i = 1 To PntArray.Count
          Set p = PntArray.Item(i)
             If (p.ID = Adodc1.Recordset.Fields("ID").Value) Then
              PntArray.Remove (i)
              Set p = Nothing
             Adodc1.Recordset.Delete
                Me.Refresh
             If Adodc1.Recordset.EOF() Then Exit For
             End If
        Next
          Me.Refresh
      End If
     
       If Me.DataGrid1.Caption = "数据表名为:线表" Then
        For i = 1 To LineArray.Count
          Set l = LineArray.Item(i)
            If (l.ID = Adodc1.Recordset.Fields("ID").Value) Then
             LineArray.Remove (i)
             Set l = Nothing
             Adodc1.Recordset.Delete
            '  Me.Adodc1.Recordset.MoveNext
             If Adodc1.Recordset.EOF() Then Exit For
             Me.Refresh
            End If
           Next
          Me.Refresh
     End If
     
       If Me.DataGrid1.Caption = "数据表名为:矩形表" Then
    
                  For i = 1 To RecArray.Count
                   Set r = RecArray.Item(i)
                   If (r.ID = Adodc1.Recordset.Fields("ID").Value) Then
                      RecArray.Remove (i)
                       Set r = Nothing
                        Me.Refresh
                     Adodc1.Recordset.Delete
                   '  Me.Adodc1.Recordset.MoveNext
                    If Adodc1.Recordset.EOF() Then Exit For
                  End If
             Next
             Me.Refresh
     End If
       If Me.DataGrid1.Caption = "数据表名为:圆形表" Then
               For i = 1 To CircleArray.Count
                Set c = CircleArray.Item(i)
               
                    
                   If (c.ID = Adodc1.Recordset.Fields("ID").Value) Then
                     
                    CircleArray.Remove (i)
                   
                    Set c = Nothing
                       Me.Refresh
                     Adodc1.Recordset.Delete
                     'Me.Adodc1.Recordset.MoveNext
                   If Adodc1.Recordset.EOF() Then Exit For
                    End If
              
              Next
               Me.Refresh
       End If
  End If
End Sub

 
         





Private Sub Form_Load()
'Me.AutoRedraw = False
 Me.StatusBar1.Panels(5).Text = Time
nMouseDownCount = 0
nOperType = 0
nSelectCount = 0
nselectcount2 = 0
nselectid = 0
nselectidl = 0
nselectidr = 0
nselectidc = 0
nColor = vbRed
nFillColor = RGB(0, 0, 0)
PID = 0
LID = 0
RID = 0
CID = 0
nSize = 1
max = 50
isShowPointInfo = False
isShowLineInfo = False
isShowRecInfo = False
isShowCircleInfo = False
ok = False
miCount = 0
Form7.Hide

nLineStyle = 0

   W = Me.ScaleHeight
    H = Me.ScaleWidth
    lx = -500 * H / W
    ly = 500
    rx = 500 * H / W
    ry = -500
    Me.Scale (lx, ly)-(rx, ry)
    dxy = 50

End Sub


Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Me.Scale (lx, ly)-(rx, ry)
'============================Draw Point=====================================
If nOperType = 1 And Button = 1 Then
        Dim p As New CPoint
        PID = PID + 1
        p.color = nColor
        p.X = X
        p.Y = Y
        p.size = nSize
        p.ID = PID
        p.nType = 1
        PntArray.Add p
        Me.DrawWidth = nSize
        Me.PSet (X, Y), nColor
         Me.StatusBar1.Panels(2).Text = "点的信息："
         Me.StatusBar1.Panels(3).Text = "点的ID号："
      Me.StatusBar1.Panels(4).Text = p.ID
        Set p = Nothing
        
    End If
    
    '----------------------------------Select Point----------------------------
    
    If nOperType = 10 Or nOperType = 100 Then
        nMouseDownCount = nMouseDownCount + 1
        nselectid = 1
        Me.Refresh
        Dim i As Long
        Dim d As Double
        i = 0
      
       
        Form2.Hide
        For i = 1 To PntArray.Count
           Set p = PntArray.Item(i)
           d = Sqr((X - p.X) ^ 2 + (Y - p.Y) ^ 2)
           If d <= 50 Then
                nselectid = i
                 Me.Timer1.Enabled = True
                Me.DrawWidth = p.size + 10
                Me.PSet (p.X, p.Y), p.color
                If isShowPointInfo = True Then
                   Form2.Text1 = p.ID
                   Form2.Text2 = p.X
                   Form2.Text3 = p.Y
                   Form2.Text4 = p.size
                   Form2.Text5.BackColor = p.color
                

                   Form2.Show 0, Me
                   isShowPointInfo = False
                End If
                Exit For
           End If
        Next
        Set p = Nothing

End If
    
    '-----------------------------------Delete Point-----------------------------

    If nOperType = 101 Then
    
     
        i = 0
       ' nselectid = 1
        For i = 1 To PntArray.Count
           Set p = PntArray.Item(i)
           d = Sqr((X - p.X) ^ 2 + (Y - p.Y) ^ 2)
           If d <= 50 Then
                PntArray.Remove i
                Me.Refresh
                Set p = Nothing
                Exit For
           End If
        Next
        Set p = Nothing

End If
    
    
'===============================Draw Line=======================================
If nOperType = 2 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
        LID = LID + 1
        Dim l As New CLine
        l.color = nColor
        l.startPoint.X = LX1
        l.startPoint.Y = LY1
        l.endPoint.X = X
        l.endPoint.Y = Y
        l.size = nSize
        l.ID = LID
        l.nType = 2
        l.nStyle = nLineStyle
        Me.FillColor = nColor
        Me.DrawWidth = nSize
        Me.DrawStyle = nLineStyle
        Me.Line (l.startPoint.X, l.startPoint.Y)-(l.endPoint.X, l.endPoint.Y), nColor
        LineArray.Add l
         Me.StatusBar1.Panels(2).Text = "线的信息"
         Me.StatusBar1.Panels(3).Text = "线的ID号："
      Me.StatusBar1.Panels(4).Text = l.ID
        Set l = Nothing
    End If
    
End If



'---------------------select line---------------------------------------------------------

If nOperType = 20 Or nOperType = 201 Or nOperType = 200 Or nOperType = 202 And Button = 1 Then
nMouseDownCount = nMouseDownCount + 1
 Dim p1 As New CPoint
 p1.X = X
 p1.Y = Y
 mx = p1.X
 my = p1.Y
 dxy = 5
 Dim iscurrent As Long
  iscurrent = 0
        nselectidl = 1
        Me.Refresh
        Dim j  As Long
        j = 0
        frmLine.Hide
      For j = 1 To LineArray.Count
      Set l = LineArray.Item(j)
   '假设指定点不在当前线段上
          If (l.startPoint.X - p1.X) * (l.startPoint.X - p1.X) + (l.startPoint.Y - p1.Y) * (l.startPoint.Y - p1.Y) < max * max Then
            '指向第一点
            iscurrent = 1
            nselectidl = j
            Set SelectLine = LineArray(j)
            Me.Circle (SelectLine.startPoint.X, SelectLine.startPoint.Y), dxy, vbGreen
            Me.Circle (SelectLine.endPoint.X, SelectLine.endPoint.Y), dxy, vbGreen
                If isShowLineInfo = True Then
                   frmLine.Text1 = SelectLine.ID
                    frmLine.Text2 = SelectLine.startPoint.X
                    frmLine.Text3 = SelectLine.startPoint.Y
                    frmLine.Text4 = SelectLine.endPoint.X
                    frmLine.Text5 = SelectLine.endPoint.Y
                     frmLine.Text6 = SelectLine.size
                    frmLine.Text7 = SelectLine.nStyle
                    frmLine.Text8.BackColor = SelectLine.color

                   frmLine.Show 0, Me
                   isShowLineInfo = False
                End If
               Exit For
        
            ElseIf (l.endPoint.X - p1.X) * (l.endPoint.X - p1.X) + (l.endPoint.Y - p1.Y) * (l.endPoint.Y - p1.Y) < max * max Then
           '指向第二点
            iscurrent = 2
            nselectidl = j
            Set SelectLine = LineArray(j)
            Me.Circle (SelectLine.startPoint.X, SelectLine.startPoint.Y), dxy, vbGreen
            Me.Circle (SelectLine.endPoint.X, SelectLine.endPoint.Y), dxy, vbGreen
               If isShowLineInfo = True Then
                   frmLine.Text1 = SelectLine.ID
                    frmLine.Text2 = SelectLine.startPoint.X
                    frmLine.Text3 = SelectLine.startPoint.Y
                    frmLine.Text4 = SelectLine.endPoint.X
                    frmLine.Text5 = SelectLine.endPoint.Y
                     frmLine.Text6 = SelectLine.size
                    frmLine.Text7 = SelectLine.nStyle
                    frmLine.Text8.BackColor = SelectLine.color
                    
                   frmLine.Show 0, Me
                   isShowLineInfo = False
                End If
               Exit For
            
        
            ElseIf OnLine(p1, l.startPoint.X, l.startPoint.Y, l.endPoint.X, l.endPoint.Y) Then
            '指向线段本身
            iscurrent = 3
            nselectidl = j
               Set SelectLine = LineArray(j)
            Me.Circle (SelectLine.startPoint.X, SelectLine.startPoint.Y), dxy, vbGreen
            Me.Circle (SelectLine.endPoint.X, SelectLine.endPoint.Y), dxy, vbGreen
              If isShowLineInfo = True Then
                   frmLine.Text1 = SelectLine.ID
                    frmLine.Text2 = SelectLine.startPoint.X
                    frmLine.Text3 = SelectLine.startPoint.Y
                    frmLine.Text4 = SelectLine.endPoint.X
                    frmLine.Text5 = SelectLine.endPoint.Y
                     frmLine.Text6 = SelectLine.size
                    frmLine.Text7 = SelectLine.nStyle
                    frmLine.Text8.BackColor = SelectLine.color
                   frmLine.Show 0, Me
                   isShowLineInfo = False
                End If
               Exit For
           
           End If
     Next

    
End If

'---------------------------Delete line----------------------------------------------------
'
If nOperType = 202 Then
        For j = 1 To LineArray.Count
        Set l = LineArray.Item(j)
        LineArray.Remove (nselectidl)
        Me.Refresh
        Set l = Nothing
        Exit For

Next
Set l = Nothing
End If






'======================================Draw Rec============================================
If nOperType = 3 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
        nMouseDownCount = 0
        RID = RID + 1
        Dim r As New CRec
        r.color = nColor
        r.mvarPoint1.X = LX1
        r.mvarPoint1.Y = LY1
        r.mvarPoint2.X = X
        r.mvarPoint2.Y = Y
        r.size = nSize
        r.ID = RID
        r.nType = 3
        r.nStyle = nLineStyle
        r.nFillStyle = nFillStyle
        Me.FillColor = nFillColor
       RecArray.Add r
        Me.DrawWidth = nSize
        Me.DrawStyle = nLineStyle
        Me.FillStyle = nFillStyle
        Me.Line (r.mvarPoint1.X, r.mvarPoint1.Y)-(r.mvarPoint2.X, r.mvarPoint2.Y), nColor, B
       Me.Refresh
         Me.StatusBar1.Panels(2).Text = "矩形的信息"
         Me.StatusBar1.Panels(3).Text = "矩形的ID号："
      Me.StatusBar1.Panels(4).Text = r.ID
        Set r = Nothing
    End If
    
End If