frmdynamictj.frm

水质模糊综合评价系统 水质模糊综合评价系统 水质模糊综合评价系统

VERSION 5.00
Object = "{65E121D4-0C60-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCHRT20.OCX"
Begin VB.Form FrmDynamicTj 
   Caption         =   "五级别水模型数据统计 "
   ClientHeight    =   8115
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   11100
   LinkTopic       =   "Form2"
   ScaleHeight     =   8115
   ScaleWidth      =   11100
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox Pic1 
      Height          =   495
      Left            =   2400
      ScaleHeight     =   435
      ScaleWidth      =   675
      TabIndex        =   12
      Top             =   7320
      Width           =   735
   End
   Begin VB.Frame Frame1 
      Caption         =   "统计项目的类型"
      Height          =   1935
      Left            =   360
      TabIndex        =   9
      Top             =   240
      Width           =   2055
      Begin VB.OptionButton Option2 
         Caption         =   "采样地点"
         Height          =   255
         Left            =   480
         TabIndex        =   11
         Top             =   1080
         Width           =   1095
      End
      Begin VB.OptionButton Option1 
         Caption         =   "采样日期"
         Height          =   375
         Left            =   480
         TabIndex        =   10
         Top             =   360
         Width           =   1335
      End
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   4920
      MaxLength       =   50
      TabIndex        =   8
      Top             =   720
      Width           =   2895
   End
   Begin VB.ComboBox Combo3 
      Height          =   300
      ItemData        =   "FrmDynamicTj.frx":0000
      Left            =   4920
      List            =   "FrmDynamicTj.frx":000D
      TabIndex        =   4
      Top             =   1560
      Width           =   2895
   End
   Begin VB.HScrollBar Hscroll1 
      Height          =   375
      Left            =   840
      TabIndex        =   3
      Top             =   2520
      Width           =   9495
   End
   Begin VB.TextBox Text9 
      Height          =   375
      Left            =   4920
      MaxLength       =   50
      TabIndex        =   2
      Top             =   120
      Width           =   2895
   End
   Begin VB.CommandButton Command12 
      Caption         =   "查看统计图 "
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   8160
      TabIndex        =   1
      Top             =   600
      Width           =   2175
   End
   Begin MSChart20Lib.MSChart MSChart1 
      Height          =   3855
      Left            =   1440
      OleObjectBlob   =   "FrmDynamicTj.frx":0027
      TabIndex        =   0
      Top             =   3120
      Width           =   8295
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "输入统计的项目："
      Height          =   375
      Left            =   2880
      TabIndex        =   7
      Top             =   720
      Width           =   1575
   End
   Begin VB.Label Label10 
      BackStyle       =   0  'Transparent
      Caption         =   "输入要统计的表名称 ："
      Height          =   375
      Left            =   2760
      TabIndex        =   6
      Top             =   240
      Width           =   2295
   End
   Begin VB.Label Label11 
      BackStyle       =   0  'Transparent
      Caption         =   "横向比"
      Height          =   255
      Left            =   3120
      TabIndex        =   5
      Top             =   1560
      Width           =   975
   End
End
Attribute VB_Name = "FrmDynamicTj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim WithEvents rs As Recordset
Attribute rs.VB_VarHelpID = -1
Dim intb1 As Integer
Dim tablename As String, tname As String
Dim i As Integer
Dim k As Integer
Private Sub Command12_Click()
Dim db As Connection
Set db = New Connection
db.CursorLocation = adUseClient
db.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "\db1.mdb;" & "Persist Security Info=False;"
 Set rs = New Recordset
 If Text1 = "" Then
  Call statisticchart1
  Else
  Call statisticchart2
  End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
 On Error Resume Next
 rs.Close
 Set rs = Nothing
 Set frmdt = Nothing
End Sub
Private Sub statisticchart1()

     '此过程用于产生汇总图
tablename = Text9.Text
tname = Text1.Text
Dim db As Connection
Set db = New Connection
db.CursorLocation = adUseClient
db.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "\db1.mdb;" & "Persist Security Info=False;"
 Set rs = New Recordset
 rs.Open " select * from " & tablename & " ", db, adOpenStatic, adLockOptimistic
Dim varrecords()
Dim rows As Integer, cols As Integer, col As Integer, row As Integer
Dim rstp As ADODB.Recordset
Set rstp = rs.Clone
cols = 7
rows = rstp.RecordCount
If rows = 0 Then
MSChart1.ColumnCount = 0
MSChart1.RowCount = 0
Exit Sub
End If
ReDim varrecords(0 To cols, 0 To rows)
   '把记录集中数据转到动态数组
For col = 0 To cols
    varrecords(col, 0) = rstp(col).Name
  Next col
   rstp.MoveFirst
   row = 1
   Do Until rstp.EOF
     For col = 0 To cols
       varrecords(col, row) = rstp(col)
       Next col
       row = row + 1
       rstp.MoveNext
    Loop
  rstp.Close
MSChart1.ChartData = varrecords '将数组中的数据传入汇总图

End Sub
Private Sub statisticchart2()

     '此过程用于产生汇总图
tablename = Text9.Text

Dim db As Connection
Set db = New Connection
db.CursorLocation = adUseClient
db.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "\db1.mdb;" & "Persist Security Info=False;"
 Set rs = New Recordset
  If Option1.Value = True Then
  rs.Open " select * from " & tablename & " where  采样日期='" & Text1 & "' ", db, adOpenStatic, adLockOptimistic

    ElseIf Option2.Value = True Then
rs.Open " select * from " & tablename & " where  采样地点='" & Text1 & "' ", db, adOpenStatic, adLockOptimistic
End If

  If (rs.EOF And rs.BOF) Then
  MsgBox "此项目不存在,请重新输入!", vbInformation
  Text1.Text = ""
  Exit Sub
Else
Dim varrecords()
Dim rows As Integer, cols As Integer, col As Integer, row As Integer
Dim rstp As ADODB.Recordset
Set rstp = rs.Clone
cols = 7
rows = rstp.RecordCount
If rows = 0 Then
MSChart1.ColumnCount = 0
MSChart1.RowCount = 0
Exit Sub
End If
ReDim varrecords(0 To cols, 0 To rows)
   '把记录集中数据转到动态数组
For col = 0 To cols
    varrecords(col, 0) = rstp(col).Name
  Next col
   rstp.MoveFirst
   row = 1
   Do Until rstp.EOF
     For col = 0 To cols
       varrecords(col, row) = rstp(col)
       Next col
       row = row + 1
       rstp.MoveNext
    Loop
  rstp.Close
MSChart1.ChartData = varrecords '将数组中的数据传入汇总图
End If

End Sub
Private Sub HScroll1_Change()
 MSChart1.Left = -HScroll1.Value
End Sub
Private Sub Combo3_Click()
intb1 = Combo3.ListIndex + 1
rechartsize
End Sub
Private Sub rechartsize()
If intb1 = 1 Then
 HScroll1.Visible = False
 MSChart1.Move 500, 3120, Width * intb1, Height - 600
 Else
 HScroll1.Visible = True
  MSChart1.Move 500, 3120, Width * intb1, Height - 600
  End If
  If MSChart1.Width - HScroll1.Width <= 32737 Then
  HScroll1.Max = MSChart1.Width - HScroll1.Width
  Else
  HScroll1.Max = (MSChart1.Width - HScroll1.Width) / 4
  End If
End Sub
Private Sub Form_resize()
BackG Me, Pic1
End Sub
Private Sub Form_Load()
Command12.Enabled = False
Me.AutoRedraw = True
Pic1.Visible = False
Pic1.BorderStyle = 0
Pic1.AutoSize = True
Pic1.Picture = LoadPicture(App.Path + "\02.gif")
BackG Me, Pic1
End Sub
Private Sub BackG(f As Form, pic As PictureBox)
For i = 0 To (f.ScaleWidth \ pic.Width)
   For j = 0 To (f.ScaleHeight \ pic.Height)
      PaintPicture pic.Picture, i * pic.Width, j * pic.Height
       Next
    Next
End Sub

Private Sub Text9_Change()
Dim db As Connection
Set db = New Connection
db.CursorLocation = adUseClient
db.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "\db1.mdb;" & "Persist Security Info=False;"
Set rs = New Recordset
  rs.Open "select * from  标准名称表 where   评价结果表1='" & Text9 & "'", db, adOpenStatic, adLockOptimistic
            If Not (rs.EOF And rs.BOF) Then
             Command12.Enabled = True
             Else
              Command12.Enabled = False
             
                  Exit Sub
                 End If
End Sub