form1.frm

一个处理文本文件的程序

        End If
    Loop
    
    sCON = sTEMP

'将清理结果分段（100字符）保存'''''''''''''''''''''''''''''''''''''''''''''
    lCOUNTS = Len(sCON)
    
    sDSP = Str(lCOUNTS \ 100)
    
    Open Text2.Text For Output As #1
    
    Do While lJ * 100 < lCOUNTS
    
        If lCOUNTS > (lJ + 1) * 100 Then
           sCON1 = Mid(sCON, lJ * 100 + 1, 100)
           lCOUNTS1 = 100
        Else
           sCON1 = Mid(sCON, lJ * 100 + 1, lCOUNTS - lJ * 100)
           lcount1 = lCOUNTS - lJ * 100
        End If
        
        Print #1, sCON1
                    
        lJ = lJ + 1
            
        Label6.Caption = "Step2:" + Format(lJ * 100, "0,000") + "/" + sDSP + "00"
        Label6.Refresh
    Loop
    
    Close #1
    
    Command1.BackColor = RGB(97, 97, 97)

     MsgBox "共读到" + Format(Len(sCON), "#,###") + "字节有效数据，已存储为：" + Text2.Text
    
End Sub


Private Sub Command2_Click()

Dim ii As Integer, iJ As Integer, lCOUNT As Long, i As Long

Dim ch As String
Dim sTR1, sTR2, sTR3, sTRsTR
Dim dA As Double, dC As Double, dG As Double
Dim xishu As Double
    
    xishu = 0
    For i = -100 To 100
    xishu = xishu + Exp(-Abs(i) * Abs(i) / 800)
    Next
    xishu = xishu / 50.132565
    
    If Text6.Text = "" Then
       MsgBox "请输入文件名及路径！"
       Exit Sub
    End If
   
    If Dir(Text6.Text) = "" Then
       MsgBox "文件" + Text6.Text + "不存在！"
       Exit Sub
    End If

    Open Text6.Text For Input As #1
    Open Text5.Text For Output As #2
    
    Input #1, sTR1
    Input #1, sTR2
    Input #1, sTR3
    lCOUNT = 100
    
    Do While Not EOF(1)
       sTRsTR = sTR1 + sTR2 + sTR3
       For ii = 101 To 200
          lCOUNT = lCOUNT + 1
          dA = 0
          dG = 0
          dC = 0
          For iJ = ii - 100 To ii + 99
             ch = Mid(sTRsTR, iJ, 1)
             If ch = "a" Then dA = (dA + Exp(-Abs(iJ - ii) * Abs(iJ - ii) / 800) / 50.132565)
             If ch = "A" Then dA = (dA + Exp(-Abs(iJ - ii) * Abs(iJ - ii) / 800) / 50.132565)

             If ch = "c" Then dC = (dC + Exp(-Abs(iJ - ii) * Abs(iJ - ii) / 800) / 50.132565)
             If ch = "C" Then dC = (dC + Exp(-Abs(iJ - ii) * Abs(iJ - ii) / 800) / 50.132565)
             
             If ch = "g" Then dG = (dG + Exp(-Abs(iJ - ii) * Abs(iJ - ii) / 800) / 50.132565)
             If ch = "G" Then dG = (dG + Exp(-Abs(iJ - ii) * Abs(iJ - ii) / 800) / 50.132565)
             
          Next
          dA = dA / xishu
          dC = dC / xishu
          dG = dG / xishu
          
       If dA >= 0.25 Then
            dA = CInt(128 + 127 * (1 - ((16 * (dA - 0.5) * (dA - 0.5)))))
       Else
            dA = CInt(128 - 127 * (1 - 16 * dA * dA))
        End If
      
         
         If dG > 0.25 Then
              dG = CInt(128 + 127 * (1 - ((16 * (dG - 0.5) * (dG - 0.5)))))
         Else
              dG = CInt(128 - 127 * (1 - 16 * dG * dG))
      End If
        
         
         If dC > 0.25 Then
             dC = CInt(128 + 127 * (1 - ((16 * (dC - 0.5) * (dC - 0.5)))))
         Else
             dC = CInt(128 - 127 * (1 - 16 * dC * dC))
        End If
         
          Print #2, Str(lCOUNT) + "," + Str((dA)) + "," + Str((dC)) + "," + Str((dG))
       ' Print #2, Str(lCOUNT) + "," + Str(255 * (dA)) + "," + Str(255 * (dC)) + "," + Str(255 * (dG))

       Next
       
       sTR1 = sTR2
       sTR2 = sTR3
       Input #1, sTR3
       
       Label6.Caption = "处理记录数：" + Format(lCOUNT, "0,000")
       Label6.Refresh
    Loop
    
Close #2
Close #1

MsgBox "数据转换完成！"

End Sub

Private Sub Command3_Click()
    peano.Show
End Sub

Private Sub Command4_Click()

Dim lCOUNT As Long

Dim sTR1 As String

Open Text3.Text For Input As #1
   
Data1.DatabaseName = "peano1.mdb"
Data1.RecordSource = "peano"
Data1.Refresh

Do While Not EOF(1)
   Input #1, sTR1
   Data1.Recordset.AddNew
   Data1.Recordset.Fields("xh") = Val(sTR1)
   Input #1, sTR1
   Data1.Recordset.Fields("r") = Int(Val(sTR1))
   Input #1, sTR1
   Data1.Recordset.Fields("g") = Int(Val(sTR1))
   Input #1, sTR1
   Data1.Recordset.Fields("b") = Int(Val(sTR1))
   Data1.Recordset.Update
   lCOUNT = lCOUNT + 1
   If lCOUNT Mod 1000 = 0 Then
      Label6.Caption = "写数据记录数：" + Format(lCOUNT, "0,000")
      Label6.Refresh
   End If
Loop

Close #1

MsgBox "数据库处理完成！"

End Sub

Private Sub Command5_Click()

'清空数据库表'''''''''''''''''''''''''''''

If MsgBox("是否清空数据库？", vbYesNo, "提示信息") = vbNo Then Exit Sub

Data1.DatabaseName = "peano0.mdb"
Data1.RecordSource = "array"
Data1.Refresh

Data2.DatabaseName = "peano0.mdb"
Data2.RecordSource = "array"
Data2.Refresh

Data3.DatabaseName = "peano0.mdb"
Data3.RecordSource = "group"
Data3.Refresh

x = CopyFile("peano0.mdb", "peano1.mdb", False)
x = DeleteFile("peano1.ldb")

MsgBox "数据库清理完成"
'If Data1.Recordset.BOF Then
'   Exit Sub
'End If'

'Data1.Recordset.MoveFirst

'Do While Not Data1.Recordset.BOF
'   Data1.Recordset.Delete
'   Data1.Recordset.MoveNext
'Loop
''''''''''''''''''''''''''''''''''''''''''

End Sub

Private Sub Command7_Click()

Dim iR1 As Integer, iG1 As Integer, iB1 As Integer, lCOUNT As Long, i As Long
Dim iR2 As Integer, iG2 As Integer, iB2 As Integer
Dim ch As String
Dim sTR_r1, sTR_r2, sTR_g1, sTR_g2, sTR_b1, sTR_b2, sTR_xh1, sTR_xh2
Dim ai(3000) As Integer
Dim dSHang As Double, lE As Long
Dim dBianHuaLiang As Double, dBianHuaLiang_temp As Double

    If Text7.Text = "" Then
       MsgBox "请输入文件名及路径！"
       Exit Sub
    End If
   
    If Dir(Text7.Text) = "" Then
       MsgBox "文件" + Text6.Text + "不存在！"
       Exit Sub
    End If

    Open Text7.Text For Input As #1
    Open Text8.Text For Output As #2
    
    Input #1, sTR_xh1
    Input #1, sTR_r1
    Input #1, sTR_g1
    Input #1, sTR_b1
'    Input #1, sTR_xh2
'    Input #1, sTR_r2
'    Input #1, sTR_g2
'    Input #1, sTR_b2
    
    lE = 0
    
    Do While Not EOF(1)
       
       Input #1, sTR_xh2
       Input #1, sTR_r2
       Input #1, sTR_g2
       Input #1, sTR_b2
       
       dBianHuaLiang_temp = (Sqr((Val(sTR_r2) - Val(sTR_r1)) ^ 2 + (Val(sTR_g2) - Val(sTR_g1)) ^ 2 + (Val(sTR_b2) - Val(sTR_b1)) ^ 2))
       i = Int(dBianHuaLiang_temp * 100)
       
       dBianHuaLiang = dBianHuaLiang + dBianHuaLiang_temp
       
       Print #2, Str(sTR_xh2) + "," + Str(i)
       
       ai(i) = ai(i) + 1
       
       lE = lE + 1
       
       sTR_xh1 = sTR_xh2

       sTR_r1 = sTR_r2
       sTR_g1 = sTR_g2
       sTR_b1 = sTR_b2
           
       lCOUNT = lCOUNT + 1
       If lCOUNT Mod 100 = 0 Then
          Label6.Caption = "处理记录数：" + Format(lCOUNT, "0,000")
          Label6.Refresh
       End If
    Loop
            
Close #2
Close #1

Open Left(Text8.Text, Len(Text8.Text) - 4) + "x" + Right(Text8.Text, 4) For Output As #2

   For i = 0 To 2999
       If ai(i) > 0 Then
          Print #2, Str(i) + "," + Str(ai(i))
          dSHang = dSHang - ai(i) / lE * Log(ai(i) / lE)
       End If
   Next
   
Close #2

Label6.Caption = "熵=" + Str(dSHang) + "，变化量=" + Format(dBianHuaLiang, "0,000.#######")

MsgBox "熵计算完成！"

End Sub

Private Sub Command8_Click()

Dim lCOUNT As Long

Dim sTR1 As String

Dim dSHang As Double
Dim lE As Long

Command8.BackColor = RGB(125, 125, 125)
Command8.Refresh

Open Text9.Text For Input As #1
   
Data2.DatabaseName = "peano1.mdb"
Data2.RecordSource = "array"
Data2.Refresh

Data3.DatabaseName = "peano1.mdb"
Data3.RecordSource = "group"
Data3.Refresh

Do While Not EOF(1)
   Input #1, sTR1
   Data2.Recordset.AddNew
   Data2.Recordset.Fields("xh") = Val(sTR1)
   Input #1, sTR1
   Data2.Recordset.Fields("val") = Int(Val(sTR1))
   Data2.Recordset.Update
   lCOUNT = lCOUNT + 1
   If lCOUNT Mod 1000 = 0 Then
      Label6.Caption = "写数据记录数：" + Format(lCOUNT, "0,000")
      Label6.Refresh
   End If
Loop

Close #1

Open Left(Text9.Text, Len(Text9.Text) - 4) + "x" + Right(Text9.Text, 4) For Input As #1
   
lE = 0
Do While Not EOF(1)
   Input #1, sTR1
   Input #1, sTR1
   lE = lE + Val(sTR1)
Loop

Close #1

Open Left(Text9.Text, Len(Text9.Text) - 4) + "x" + Right(Text9.Text, 4) For Input As #1
   
lCOUNT = 0
dSHang = 0

Do While Not EOF(1)
   Input #1, sTR1
   Data3.Recordset.AddNew
   Data3.Recordset.Fields("group") = Val(sTR1)
   Input #1, sTR1
   Data3.Recordset.Fields("count") = Val(sTR1)
   
   dSHang = dSHang - Val(sTR1) / lE * Log(Val(sTR1) / lE)
   
   Data3.Recordset.Fields("shang") = dSHang
   
   Data3.Recordset.Update
   lCOUNT = lCOUNT + 1
   If lCOUNT Mod 10 = 0 Then
      Label6.Caption = "写数据记录数：" + Str(lCOUNT)
      Label6.Refresh
   End If
Loop

Close #1

Command8.BackColor = RGB(97, 97, 97)
Command8.Refresh

MsgBox "数据库处理完成！"

End Sub

Private Sub Command9_Click()
'清空数据库表'''''''''''''''''''''''''''''
If Data2.Recordset.BOF Then
   Exit Sub
End If

Data2.Recordset.MoveFirst

Do While Not Data2.Recordset.BOF
   Data2.Recordset.Delete
   Data2.Recordset.MoveNext
Loop
''''''''''''''''''''''''''''''''''''''''''

End Sub

Private Sub Text2_Change()
    Text6.Text = Text2.Text
    
End Sub

Private Sub Text5_Change()
    Text3.Text = Text5.Text
    Text7.Text = Text5.Text
    
End Sub

Private Sub Text8_Change()
   Text9.Text = Text8.Text
End Sub