form1.frm

实现画图

      Begin VB.Menu mnu_openF 
         Caption         =   "打开"
      End
      Begin VB.Menu mnu_saveF 
         Caption         =   "保存"
      End
   End
   Begin VB.Menu mnu_data 
      Caption         =   "数据库"
      Begin VB.Menu mnu_opendata 
         Caption         =   "打开数据库文件（Data)"
      End
      Begin VB.Menu mnu_savedata 
         Caption         =   "保存数据库文件（Data)"
      End
      Begin VB.Menu mnu_d 
         Caption         =   "-"
      End
      Begin VB.Menu mnu_opendao 
         Caption         =   "打开数据库文件(ADO)"
      End
      Begin VB.Menu mnu_savedao 
         Caption         =   "保存数据库文件(ADO)"
      End
   End
   Begin VB.Menu mnu_view 
      Caption         =   "视图"
      Begin VB.Menu mnu_big 
         Caption         =   "放大"
      End
      Begin VB.Menu mnu_small 
         Caption         =   "缩小"
      End
      Begin VB.Menu mnu_py 
         Caption         =   "平移"
      End
   End
   Begin VB.Menu mnu_picture 
      Caption         =   "绘图(&D)"
      Begin VB.Menu mnu_point 
         Caption         =   "点类"
         Begin VB.Menu mnu_addp 
            Caption         =   "添加点"
         End
         Begin VB.Menu mnu_deletep 
            Caption         =   "删除点"
         End
         Begin VB.Menu mnu_editpoint 
            Caption         =   "点编辑"
         End
      End
      Begin VB.Menu mnu_line 
         Caption         =   "直线"
         Begin VB.Menu mnu_addl 
            Caption         =   "添加线"
         End
         Begin VB.Menu mnu_pyl 
            Caption         =   "线移动"
         End
         Begin VB.Menu mnu_editl 
            Caption         =   "线节点编辑器"
         End
         Begin VB.Menu mnu_deletel 
            Caption         =   "线删除"
         End
      End
      Begin VB.Menu mnu_ju 
         Caption         =   "矩形"
         Begin VB.Menu mnu_addj 
            Caption         =   "添加矩形"
         End
         Begin VB.Menu mnu_editj 
            Caption         =   "矩形编辑器"
         End
         Begin VB.Menu mnu_deletej 
            Caption         =   "矩形删除"
         End
      End
      Begin VB.Menu mnu_circle 
         Caption         =   "圆"
         Begin VB.Menu mnu_addc 
            Caption         =   "添加圆"
         End
         Begin VB.Menu mnu_zonrc 
            Caption         =   "圆移动"
         End
         Begin VB.Menu mnu_editc 
            Caption         =   "圆编辑"
         End
         Begin VB.Menu mnu_deletec 
            Caption         =   "圆删除"
         End
      End
   End
   Begin VB.Menu mnu_select 
      Caption         =   "拾取"
      Begin VB.Menu mnu_selectp 
         Caption         =   "点拾取"
      End
      Begin VB.Menu mnu_selectl 
         Caption         =   "线拾取"
      End
      Begin VB.Menu mnu_selectj 
         Caption         =   "矩形拾取"
      End
      Begin VB.Menu mnu_selectc 
         Caption         =   "圆拾取"
      End
   End
   Begin VB.Menu mnu_find 
      Caption         =   "查询"
      Begin VB.Menu mnu_pc 
         Caption         =   "图形到属性"
         Begin VB.Menu mnu_sp 
            Caption         =   "点属性"
         End
         Begin VB.Menu mnu_sl 
            Caption         =   "线属性"
         End
         Begin VB.Menu mnu_sr 
            Caption         =   "矩形属性"
         End
         Begin VB.Menu mnu_sec 
            Caption         =   "圆属性"
         End
      End
      Begin VB.Menu mnu_cp 
         Caption         =   "属性到图形"
      End
   End
   Begin VB.Menu mnu_pdata 
      Caption         =   "图形数据操作"
      Begin VB.Menu mnu_showdata 
         Caption         =   "数据统计"
      End
      Begin VB.Menu mnu_datashow 
         Caption         =   "数据显示"
         Begin VB.Menu mnu_pshow 
            Caption         =   "显示点数据"
         End
         Begin VB.Menu mnu_lshow 
            Caption         =   "显示线数据"
         End
         Begin VB.Menu mnu_jshow 
            Caption         =   "显示矩形数据"
         End
         Begin VB.Menu mnu_cshow 
            Caption         =   "显示圆数据"
         End
      End
      Begin VB.Menu mnu_datadelete 
         Caption         =   "数据删除"
      End
      Begin VB.Menu mnu_dataapdate 
         Caption         =   "修改数据"
      End
   End
   Begin VB.Menu mnu_man 
      Caption         =   "用户管理"
      Begin VB.Menu mnu_newp 
         Caption         =   "新建用户"
      End
      Begin VB.Menu mnu_edpa 
         Caption         =   "修改密码"
      End
      Begin VB.Menu mnu_deletey 
         Caption         =   "删除用户"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim nOperType As Integer '操作类型
Dim nColor As Long       '颜色参数
Dim PID As Long       '点ID号
Dim LID As Long  '线ID号
Dim RID As Long '矩形ID号
Dim CID As Long  '圆ID号
Dim nSize As Integer     '宽度
Dim nLineStyle As Integer     '线宽度
Dim nFillStyle As Integer     '填充风格
Dim nFillColor As Long     '填充颜色
Dim nSelectCount As Integer '显示选中点--时钟控件实现
Dim nselectcount2 As Integer  '显示选中圆--时钟控件实现
'Dim nselectid As Long        ' 记录选中点ID
'Dim nselectidl As Long          ' 记录选中线ID
'Dim nselectidr As Long           ' 记录选中矩形ID
'Dim nselectidc As Long           ' 记录选中圆ID
Dim isShowPointInfo As Boolean '是否显示选中点信息
Dim isShowLineInfo As Boolean
Dim isShowCircleInfo As Boolean
Dim isShowRecInfo As Boolean
Dim nMouseDownCount As Integer
Dim SelectPoint As CPoint
Dim SelectLine As CLine
Dim SelectRec As CRec
Dim selectCircle As CCircle
Dim LX1 As Long
Dim LY1 As Long
Dim tempX As Long
Dim tempY As Long
Dim mx, my, cx, cy, rex, rey As Long
Dim W, H, lx, ly, rx, ry, dxy As Long
Dim max As Long
Public ok As Boolean
Dim miCount As Integer


'============================计算点是否在线段上=====================================================
'

Private Function OnLine(p As CPoint, X1 As Single, Y1 As Single, X2 As Single, Y2 As Single) As Boolean
Dim A As Single
Dim B As Single
Dim c As Single
If X1 = X2 Then          '该线段为垂线
   If (p.Y - Y1) * (p.Y - Y2) < 0 And Abs(p.X - X1) < max Then
      OnLine = True
      Exit Function
   End If

  ElseIf (p.X - X1) * (p.X - X2) < 0 Then
   A = (Y2 - Y1) / (X2 - X1)
   B = -1
   c = Y1 - A * X1
        If (A * p.X + B * p.Y + c) * (A * p.X + B * p.Y + c) / (A * A + B * B) < max * max Then
          OnLine = True
          Exit Function
        End If
    End If
    OnLine = False
   
End Function


'================================判断点是否在矩形上===============================================
Private Function OnReg(p As CPoint, r As CRec) As Boolean
If ((p.Y - r.mvarPoint1.Y) * (p.Y - r.mvarPoint2.Y) < 0 And (Abs(p.X - r.mvarPoint1.X) < max _
Or Abs(p.X - r.mvarPoint2.X) < max)) Or ((p.X - r.mvarPoint1.X) * (p.X - r.mvarPoint2.X) < 0 And _
(Abs(p.Y - r.mvarPoint1.Y) < max Or Abs(p.Y - r.mvarPoint2.Y) < max)) Or ((p.X - r.mvarPoint1.X) * _
(p.X - r.mvarPoint2.X) < 0 And (p.Y - r.mvarPoint1.Y) * (p.Y - r.mvarPoint2.Y) < 0) Then

   OnReg = True
Else
  OnReg = False
End If

End Function


'==================================判断点是否在圆上====================================================
Private Function OnCircle(p As CPoint, c As CCircle) As Boolean

  If ((p.X - c.CenterPoint.X) ^ 2 + (p.Y - c.CenterPoint.Y) ^ 2) < Abs((c.CenterPoint.X - c.cp.X) ^ 2 + (c.CenterPoint.Y - c.cp.Y) ^ 2 + max) Then

   OnCircle = True
  Else
    OnCircle = False
  End If
End Function





Private Sub Combo1_Click()
nSize = Val(Me.Combo1.Text)
End Sub



Private Sub Combo2_Click()
nLineStyle = Combo2.ListIndex
End Sub

Private Sub Combo3_Click()
nFillStyle = Combo3.ListIndex
End Sub



Private Sub DataGrid1_AfterColEdit(ByVal ColIndex As Integer)
Dim i As Long
If nOperType = 500 Then
  If Me.DataGrid1.Caption = "数据表名为:点表" Then
   Adodc1.Recordset.Fields("X").Value = Me.DataGrid1.Columns(1)
   Adodc1.Recordset.Fields("Y").Value = Me.DataGrid1.Columns(2)
   Adodc1.Recordset.Fields("Size").Value = Me.DataGrid1.Columns(3)
   Adodc1.Recordset.Fields("Color").Value = Me.DataGrid1.Columns(4)
     Do While Not Adodc1.Recordset.EOF
          Dim p As New CPoint
             p.ID = Adodc1.Recordset.Fields("ID").Value
             PntArray.Remove p.ID
             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
       Loop
          Set p = Nothing
          Me.Refresh
     End If
     
      If Me.DataGrid1.Caption = "数据表名为:线表" Then
   'Adodc1.Recordset.Fields("ID").Value = Me.DataGrid1.Columns(0)
   Adodc1.Recordset.Fields("X1").Value = Me.DataGrid1.Columns(1)
   Adodc1.Recordset.Fields("Y1").Value = Me.DataGrid1.Columns(2)
   Adodc1.Recordset.Fields("X2").Value = Me.DataGrid1.Columns(3)
   Adodc1.Recordset.Fields("Y2").Value = Me.DataGrid1.Columns(4)
   Adodc1.Recordset.Fields("Size").Value = Me.DataGrid1.Columns(5)
   Adodc1.Recordset.Fields("Color").Value = Me.DataGrid1.Columns(6)
        
     Do While Not Adodc1.Recordset.EOF()
               Dim l As New CLine
               
                l.ID = Adodc1.Recordset.Fields("ID").Value
                 LineArray.Remove l.ID
                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
            
              Loop
            Set l = Nothing
          Me.Refresh
     End If
      If Me.DataGrid1.Caption = "数据表名为:矩形表" Then
   'Adodc1.Recordset.Fields("ID").Value = Me.DataGrid1.Columns(0)
    Adodc1.Recordset.Fields("X1").Value = Me.DataGrid1.Columns(1)
   Adodc1.Recordset.Fields("Y1").Value = Me.DataGrid1.Columns(2)
   Adodc1.Recordset.Fields("X2").Value = Me.DataGrid1.Columns(3)
   Adodc1.Recordset.Fields("Y2").Value = Me.DataGrid1.Columns(4)
   Adodc1.Recordset.Fields("Size").Value = Me.DataGrid1.Columns(5)
   Adodc1.Recordset.Fields("Color").Value = Me.DataGrid1.Columns(6)
      Do While Not Adodc1.Recordset.EOF()
                Dim r As New CRec
                
                  r.ID = Adodc1.Recordset.Fields("ID").Value
                  RecArray.Remove (r.ID)
                 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.Fields("Color").Value
                 RecArray.Add r
                 Set r = Nothing
                Adodc1.Recordset.MoveNext
                  Me.Refresh

     Loop
        Set r = Nothing
          Me.Refresh
    End If
      If Me.DataGrid1.Caption = "数据表名为:圆形表" Then
   'Adodc1.Recordset.Fields("ID").Value = Me.DataGrid1.Columns(0)
        Adodc1.Recordset.Fields("X1").Value = Me.DataGrid1.Columns(1)
        Adodc1.Recordset.Fields("Y1").Value = Me.DataGrid1.Columns(2)
        Adodc1.Recordset.Fields("X2").Value = Me.DataGrid1.Columns(3)
        Adodc1.Recordset.Fields("Y2").Value = Me.DataGrid1.Columns(4)
        Adodc1.Recordset.Fields("Size").Value = Me.DataGrid1.Columns(5)
        Adodc1.Recordset.Fields("Color").Value = Me.DataGrid1.Columns(6)
        
     Do While Not Adodc1.Recordset.EOF()
         Dim c As New CCircle
          c.ID = Adodc1.Recordset.Fields("ID").Value
          CircleArray.Remove (c.ID)
         c.CenterPoint.X = Adodc1.Recordset.Fields("X1").Value
         c.CenterPoint.Y = Adodc1.Recordset.Fields("Y1").Value
         c.cp.X = Adodc1.Recordset.Fields("X2").Value
        c.cp.Y = Adodc1.Recordset.Fields("Y2").Value
        c.size = Adodc1.Recordset.Fields("Size").Value
         c.color = Adodc1.Recordset.Fields("Color").Value
         CircleArray.Add c
         Set c = Nothing
        Adodc1.Recordset.MoveNext