form1.frm

趋势系数计算源代码

VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4650
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5970
   LinkTopic       =   "Form1"
   ScaleHeight     =   4650
   ScaleWidth      =   5970
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "部分地区年平均"
      Height          =   495
      Left            =   2040
      TabIndex        =   1
      Top             =   960
      Width           =   1575
   End
   Begin VB.CommandButton Command1 
      Caption         =   "全省年平均"
      Height          =   495
      Left            =   2040
      TabIndex        =   0
      Top             =   360
      Width           =   1575
   End
   Begin MSAdodcLib.Adodc Adodc1 
      Height          =   375
      Left            =   360
      Top             =   240
      Width           =   1200
      _ExtentX        =   2117
      _ExtentY        =   661
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Adodc1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim zjPeiZhiLuJing As String
Dim cnnSUP As New ADODB.Connection
Sub CreateDSN(dbName As String, zjdbName As String)
    Dim Filname As String
    
    Filname = zjPeiZhiLuJing + zjdbName
    
    Open Filname For Output As #1
        Print #1, "[ODBC]"
        Print #1, "DRIVER=Microsoft Access Driver (*.mdb)"
        Print #1, "UID =admin"
        Print #1, "UserCommitSync=Yes"
        Print #1, "Threads=3"
        Print #1, "SafeTransactions=0"
        Print #1, "PageTimeout=5"
        Print #1, "MaxScanRows=80"
        Print #1, "MaxBufferSize=20480"
        Print #1, "FIL=MS Access"
        Print #1, "DriverId = 25"
        Print #1, "DefaultDir=" & zjPeiZhiLuJing
        Print #1, "DBQ=" & zjPeiZhiLuJing & Trim(dbName)
    Close #1
    
End Sub

Private Sub Command1_Click()
    Dim rstSQLZB As New ADODB.Recordset
    Dim x(100) As Integer
    dbPassWord = ""
    If cnnSUP.State = adStateOpen Then cnnSUP.Close
    zjPeiZhiLuJing = App.Path + "\"
    CreateDSN "气温统计(全省).mdb", "ZJDB.DSN" '创建数据源文件
    cnnSUP.Open "FILE NAME=" & zjPeiZhiLuJing & "ZJDB.dsn", "admin", dbPassWord   '打开连接
Open App.Path + "\zh.txt" For Input As #1
qsn0 = 1971
jsn0 = 1983
Open App.Path + "\" + CStr(qsn0) + "-" + CStr(jsn0) + ".txt" For Output As #2
Do While Not EOF(1)
    Line Input #1, zh
    sql = "select t,the_year from  年平均 where address=" + zh + " and the_year>=" + CStr(qsn0) + "and the_year<=" + CStr(jsn0)
    xm = 0
    ym = 0
    xy = 0
    X2 = 0
    Y2 = 0
    With rstSQLZB
        If .State = adStateOpen Then .Close
        .ActiveConnection = cnnSUP
        .CursorType = adOpenKeyset
        .LockType = adLockBatchOptimistic
        .Open sql
        If Not .EOF Then
        .MoveFirst
        qsn = !the_year
         rec = .RecordCount
         rray = .GetRows(rec)
         .MoveLast
        jsn = !the_year
         .Close
        Else
            .Close
            GoTo 100
        End If
    End With
    If qsn > qsn0 Then GoTo 100
    If jsn < jsn0 Then GoTo 100
For i = 0 To rec - 1
    x(i) = i + 1
    xm = xm + x(i)
    ym = ym + rray(0, i) / 10
    X2 = X2 + x(i) * x(i)
    Y2 = Y2 + rray(0, i) * rray(0, i) / 100
    xy = xy + x(i) * rray(0, i) / 10
Next i

b = (xy - (xm * ym) / rec) / (X2 - xm * xm / rec)
b0 = ym / rec - b * xm / rec
Print #2, zh, Format(b * 10 * 1000, "0")
100:
Loop
Close #1
Close #2
End Sub

Private Sub Command2_Click()
    '十年滑动趋势回归系数
    Dim rstSQLZB As New ADODB.Recordset
    Dim x(100) As Integer
    Dim arry10(100) As Single
    dbPassWord = ""
    If cnnSUP.State = adStateOpen Then cnnSUP.Close
    zjPeiZhiLuJing = App.Path + "\"
    CreateDSN "气温统计(全省).mdb", "ZJDB.DSN" '创建数据源文件
    cnnSUP.Open "FILE NAME=" & zjPeiZhiLuJing & "ZJDB.dsn", "admin", dbPassWord   '打开连接
Open App.Path + "\zh1.txt" For Input As #1
'qsn0 = 1971
'jsn0 = 1983
Open App.Path + "\计算结果.txt" For Output As #2
Do While Not EOF(1)
    Line Input #1, zh
    sql = "select tmax,the_year from  月最高 where address=" + zh + " and the_month=7"
    xm = 0
    ym = 0
    xy = 0
    X2 = 0
    Y2 = 0
    rec = 0
    With rstSQLZB
        If .State = adStateOpen Then .Close
        .ActiveConnection = cnnSUP
        .CursorType = adOpenKeyset
        .LockType = adLockBatchOptimistic
        .Open sql
        If Not .EOF Then
        .MoveFirst
        qsn = !the_year
         rec = .RecordCount
         rray = .GetRows(rec)
         .MoveLast
        jsn = !the_year
         .Close
        Else
            .Close
            GoTo 100
        End If
    End With
  If rec >= 10 Then
    For i = 0 To rec - 1 - 9
        For j = 0 To 9
            arry10(i) = arry10(i) + rray(0, i + j)
        Next j
        arry10(i) = arry10(i) / 10
    Next i
  End If
 '   If qsn > qsn0 Then GoTo 100
  '  If jsn < jsn0 Then GoTo 100
  rec1 = rec - 9
For i = 0 To rec1 - 1
    x(i) = i + 1
    xm = xm + x(i)
    ym = ym + arry10(i) / 10
    X2 = X2 + x(i) * x(i)
    Y2 = Y2 + arry10(i) * arry10(i) / 100
    xy = xy + x(i) * arry10(i) / 10
Next i
'回归系数b和截距b0
b = (xy - (xm * ym) / rec1) / (X2 - xm * xm / rec1)
b0 = ym / rec1 - b * xm / rec1
'相关系数rxy
rxy = Sqr((X2 - xm * xm / rec1) / (Y2 - ym * ym / rec1)) * b
'F检验
f = rxy * rxy / ((1 - rxy * rxy) / (rec1 - 2))
Print #2, zh, Format(b * 10, "0.00"), Format(rxy, "0.00"), Format(f, "0.00"), jsn - qsn + 1
100:
Loop
Close #1
Close #2

End Sub