form1.frm

实现画图

     SelectRec.mvarPoint2.Y), SelectRec.color, B
  Me.Refresh
End If

'================================draw circle=============================================
If nMouseDownCount = 1 And nOperType = 4 Then
       Me.DrawWidth = nSize
       Me.FillColor = nFillColor
       Me.FillStyle = nFillStyle
       Me.DrawStyle = nLineStyle
        Me.DrawMode = 10
       Me.Circle (LX1, LY1), Sqr((LX1 - tempX) ^ 2 + (LY1 - tempY) ^ 2), nColor
       Me.Circle (LX1, LY1), Sqr((LX1 - X) ^ 2 + (LY1 - Y) ^ 2), nColor
       tempX = X
       tempY = Y
End If
       

'
'-------------------------------move circle-----------------------------------------

    If nOperType = 401 And Button = 1 And nselectidc > 0 Then
         Set selectCircle = CircleArray(nselectidc)
       Me.MousePointer = 5
       Me.DrawWidth = nSize
       Me.FillColor = nFillColor
       Me.FillStyle = nFillStyle
       Me.DrawStyle = nLineStyle
        Me.DrawMode = 10

       
       Circle (selectCircle.CenterPoint.X, selectCircle.CenterPoint.Y), selectCircle.CR, Me.BackColor
        
   
     selectCircle.CenterPoint.X = X
      selectCircle.CenterPoint.Y = Y
      selectCircle.cp.X = X + selectCircle.CR
      selectCircle.cp.Y = Y + selectCircle.CR
       Me.DrawMode = 10
       Circle (X, Y), selectCircle.CR, nColor
    ' Circle (X, Y), selectCircle.CR, nColor
       Me.Refresh

End If
'--------------------------edit circle-----------------------------------------
  If nOperType = 402 And Button = 1 And nselectidc > 0 Then
       Set selectCircle = CircleArray(nselectidc)
   Me.DrawWidth = nSize
       Me.FillColor = nFillColor
       Me.FillStyle = nFillStyle
       Me.DrawStyle = nLineStyle
        Me.DrawMode = 10
      Circle (selectCircle.CenterPoint.X, selectCircle.CenterPoint.Y), Sqr((selectCircle.CenterPoint.X - selectCircle.cp.X) ^ 2 + _
       (selectCircle.CenterPoint.Y - selectCircle.cp.Y) ^ 2), Me.BackColor
       selectCircle.CenterPoint.X = X
       selectCircle.CenterPoint.Y = Y
       selectCircle.cp.X = tempX
       selectCircle.cp.Y = tempY
       Circle (selectCircle.CenterPoint.X, selectCircle.CenterPoint.Y), Sqr((selectCircle.CenterPoint.X - selectCircle.cp.X) ^ 2 + _
       (selectCircle.CenterPoint.Y - selectCircle.cp.Y) ^ 2), nColor
     Me.Refresh
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If nOperType = 10 Or nOperType = 20 Or nOperType = 100 Or nOperType = 201 Or nOperType = 200 Or nOperType = 202 _
Or nOperType = 30 Or nOperType = 300 Or nOperType = 301 Or nOperType = 302 Or nOperType = 40 Or nOperType = 400 _
Or nOperType = 401 Or nOperType = 402 Then
     If nMouseDownCount = 1 Then
        nMouseDownCount = 0
        Me.MousePointer = 1
       ' Me.DrawMode = 13
    End If
End If
If nOperType = 2 And nMouseDownCount = 2 Then
    nMouseDownCount = 0
    Me.DrawMode = 13
    Me.Refresh
End If
If nOperType = 3 And nMouseDownCount = 2 Then
    nMouseDownCount = 0
     Me.DrawMode = 13
    Me.Refresh
End If
If nOperType = 4 And nMouseDownCount = 2 Then
    nMouseDownCount = 0
     Me.DrawMode = 13
    Me.Refresh
End If
End Sub


Private Sub Form_Paint()
 Me.Scale (lx, ly)-(rx, ry)
Dim i As Integer
i = 0

'===============================Point=============================

Dim p As CPoint
For i = 1 To PntArray.Count
    Set p = PntArray.Item(i)
    Me.DrawWidth = p.size
    Me.PSet (p.X, p.Y), p.color
Next

Set p = Nothing

'=============================Line=====================================
     
Dim l As CLine
 For i = 1 To LineArray.Count
        Set l = LineArray.Item(i)
        Me.DrawWidth = l.size
        Me.DrawStyle = l.nStyle
        Me.Line (l.startPoint.X, l.startPoint.Y)-(l.endPoint.X, l.endPoint.Y), l.color
Next
Set l = Nothing

'================================Rec============================================

Dim r As CRec
 For i = 1 To RecArray.Count
        Set r = RecArray.Item(i)
        Me.DrawWidth = r.size
        Me.DrawStyle = r.nStyle
        Me.FillColor = nFillColor
        Me.FillStyle = r.nFillStyle
        Me.Line (r.mvarPoint1.X, r.mvarPoint1.Y)-(r.mvarPoint2.X, r.mvarPoint2.Y _
        ), r.color, B
Next
Set r = Nothing

'===============================Circle=======================================

Dim c As CCircle
 For i = 1 To CircleArray.Count
     Set c = CircleArray.Item(i)
       Me.DrawWidth = c.size
       Me.DrawStyle = c.nStyle
       Me.FillStyle = c.nFillStyle
      ' Me.FillColor = nFillColor
       Me.Circle (c.CenterPoint.X, c.CenterPoint.Y), Sqr((c.CenterPoint.X - c.cp.X) ^ 2 _
       + (c.CenterPoint.Y - c.cp.Y) ^ 2), c.color
       
    Next
Set c = Nothing
End Sub



Private Sub Form_Resize()
Me.Refresh
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Form2
Unload Form3
Unload FormLogin
Unload frmLine
Unload frmRec
Unload frmCircle
Unload Form7
Unload addUser
Unload Upkey
Unload Del_User
Unload Me
End Sub

Private Sub mnu_addc_Click()
nOperType = 4
Me.MousePointer = 2

End Sub

Private Sub mnu_addj_Click()
nOperType = 3
Me.MousePointer = 2
End Sub

Private Sub mnu_addl_Click()
nOperType = 2
Me.MousePointer = 2
End Sub

Private Sub mnu_addp_Click()
nOperType = 1
Me.MousePointer = 2
End Sub



Private Sub mnu_big_Click()
  dxy = 100
  lx = lx + dxy
   ly = ly - dxy
   rx = rx - dxy
   ry = ry + dxy
   Me.Scale (lx, ly)-(rx, ry)
   Me.Refresh
End Sub



Private Sub mnu_cp_Click()
Form3.Show 0, Me

End Sub

Private Sub mnu_cshow_Click()
'CommonDialog1.Filter = "Access 文件(*.mdb)|*.mdb"
'Me.CommonDialog1.ShowOpen
'If Me.CommonDialog1.FileName = "" Then Exit Sub '---------
'Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source =" & Me.CommonDialog1.FileName & ";Persist Security Info=False"

Me.DataGrid1.Refresh
Adodc1.RecordSource = "select * from CircleTable"
Me.DataGrid1.Visible = True
Me.DataGrid1.Caption = "数据表名为:圆形表"
Adodc1.Refresh
Me.DataGrid1.Refresh
Me.DataGrid1.Enabled = False
End Sub

Private Sub mnu_dataapdate_Click()
nOperType = 500    '修改数据库数据
Me.DataGrid1.Enabled = True
End Sub

Private Sub mnu_datadelete_Click()
nOperType = 600
Me.DataGrid1.Enabled = True
End Sub

Private Sub mnu_deletec_Click()
nOperType = 400   '圆删除
End Sub

Private Sub mnu_deletej_Click()
nOperType = 300 '矩形删除
End Sub

Private Sub mnu_deletel_Click()
nOperType = 202
End Sub

Private Sub mnu_deletep_Click()
nOperType = 101
End Sub

Private Sub mnu_deletey_Click()
Del_User.Show 0, Me
End Sub

Private Sub mnu_editc_Click()
                            
  nOperType = 402         '圆编辑
End Sub

Private Sub mnu_editj_Click()
nOperType = 301  '矩形编辑
End Sub

Private Sub mnu_editl_Click()
nOperType = 200
End Sub

Private Sub mnu_editpoint_Click()
nOperType = 10

End Sub

Private Sub mnu_edpa_Click()
Upkey.Show
End Sub

Private Sub mnu_jshow_Click()
'CommonDialog1.Filter = "Access 文件(*.mdb)|*.mdb"
'Me.CommonDialog1.ShowOpen
'If Me.CommonDialog1.FileName = "" Then Exit Sub '---------
'Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source =" & Me.CommonDialog1.FileName & ";Persist Security Info=False"
'
Me.DataGrid1.Refresh
Adodc1.RecordSource = "select * from RecTable"
Me.DataGrid1.Visible = True
Me.DataGrid1.Caption = "数据表名为:矩形表"
Adodc1.Refresh
Me.DataGrid1.Refresh
Me.DataGrid1.Enabled = False
End Sub

Private Sub mnu_lshow_Click()
'CommonDialog1.Filter = "Access 文件(*.mdb)|*.mdb"
'Me.CommonDialog1.ShowOpen
'If Me.CommonDialog1.FileName = "" Then Exit Sub '---------
'Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source =" & Me.CommonDialog1.FileName & ";Persist Security Info=False"
'
Me.DataGrid1.Refresh
Adodc1.RecordSource = "select * from LineTable"
Me.DataGrid1.Visible = True
Me.DataGrid1.Caption = "数据表名为:线表"
Adodc1.Refresh
Me.DataGrid1.Refresh
Me.DataGrid1.Enabled = False
End Sub

Private Sub mnu_newp_Click()
addUser.Show 0, Me
End Sub

Private Sub mnu_opendao_Click()
Dim mydatabase As Database
Me.CommonDialog1.Filter = "Access 文件(*.mdb)|*.mdb"
Me.CommonDialog1.ShowOpen
If Me.CommonDialog1.FileName = "" Then Exit Sub '---------

Set mydatabase = Workspaces(0).OpenDatabase(CommonDialog1.FileName)
If mydatabase Is Nothing Then
  MsgBox "该数据库不存在"
  Exit Sub
End If
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source =" & Me.CommonDialog1.FileName & ";Persist Security Info=False"
'================================point======================================
Me.Adodc1.RecordSource = "select * from PointTable"
Me.Adodc1.Refresh
 
 Do While Not Adodc1.Recordset.EOF()
    If Adodc1.Recordset.Fields("ID").Value = Null Then
    Adodc1.Recordset.MoveNext
      Else
           Dim p As New CPoint
          p.ID = Adodc1.Recordset.Fields("ID").Value
         p.X = Adodc1.Recordset.Fields("X").Value
         p.Y = Adodc1.Recordset.Fields("Y").Value
        p.size = Adodc1.Recordset.Fields("Size").Value
         p.color = Adodc1.Recordset.Fields("Color").Value
         PntArray.Add p
         Set p = Nothing
         Adodc1.Recordset.MoveNext
         Me.Refresh
        End If
  Loop
  
  
 
 '===========================Line============================================
 Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source =" & Me.CommonDialog1.FileName & ";Persist Security Info=False"
 Me.Adodc1.RecordSource = "select * from LineTable"
 Me.Adodc1.Refresh
  Do While Not Adodc1.Recordset.EOF()
 
   If Adodc1.Recordset.Fields("ID").Value = Null Then
   Adodc1.Recordset.MoveNext
   Else
     Dim l As New CLine
    l.ID = Adodc1.Recordset.Fields("ID").Value
    l.startPoint.X = Adodc1.Recordset.Fields("X1").Value
   l.startPoint.Y = Adodc1.Recordset.Fields("Y1").Value
    l.endPoint.X = Adodc1.Recordset.Fields("X2").Value
   l.endPoint.Y = Adodc1.Recordset.Fields("Y2").Value
   l.size = Adodc1.Recordset.Fields("Size").Value
   l.color = Adodc1.Recordset.Fields("Color").Value
   LineArray.Add l
   Set l = Nothing
 Adodc1.Recordset.MoveNext
   Me.Refresh
  End If
  Loop



 '==============================Rec=========================================
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source =" & Me.CommonDialog1.FileName & ";Persist Security Info=False"
 Me.Adodc1.RecordSource = "select * from RecTable"
 Me.Adodc1.Refresh
  Do While Not Adodc1.Recordset.EOF()
  
    If Adodc1.Recordset.Fields("ID").Value = Null Then
    Adodc1.Recordset.MoveNext
    Else
     Dim r As New CRec
     r.ID = Adodc1.Recordset.Fields("ID").Value
    r.mvarPoint1.X = Adodc1.Recordset.Fields("X1").Value
    r.mvarPoint1.Y = Adodc1.Recordset.Fields("Y1").Value
    r.mvarPoint2.X = Adodc1.Recordset.Fields("X2").Value
    r.mvarPoint2.Y = Adodc1.Recordset.Fields("Y2").Value
    r.size = Adodc1.Recordset.Fields("Size").Value
     r.color = Adodc1.Recordset.Fie