VB 读文件，将原信息是相对值，转为绝对值的方式
Option Explicit
' 定义坐标结构体类型
Private Type Coordinate
X As Single
Y As Single
End Type
Dim dict As Collection
Private Sub Command1_Click()
' 显示文件选择对话框
CommonDialog1.InitDir = App.Path
CommonDialog1.DialogTitle = "选择要打开的文件"
CommonDialog1.Filter = "文本文件 (*.DMX)|*.DMX"
CommonDialog1.FilterIndex = 1
CommonDialog1.FileName = ""
CommonDialog1.ShowOpen
' 如果用户点击了“打开”按钮，则处理选定的文件
If CommonDialog1.FileName <> "" Then
' 在这里处理选中文件的逻辑
Command1.Caption = CommonDialog1.FileName
If Command2.Caption <> "单击选择文件" Then Command3.Enabled = True
Else
Command1.Caption = "单击选择文件"
MsgBox "您取消了文件选择"
End If
End Sub
Private Sub Command2_Click()
' 显示文件选择对话框
CommonDialog1.InitDir = App.Path
CommonDialog1.DialogTitle = "选择要打开的文件"
CommonDialog1.Filter = "文本文件 (*.HDM)|*.HDM"
CommonDialog1.FilterIndex = 1
CommonDialog1.FileName = ""
CommonDialog1.ShowOpen
' 如果用户点击了“打开”按钮，则处理选定的文件
If CommonDialog1.FileName <> "" Then
' 在这里处理选中文件的逻辑
Command2.Caption = CommonDialog1.FileName
If Command1.Caption <> "单击选择文件" Then Command3.Enabled = True
Else
Command2.Caption = "单击选择文件"
MsgBox "您取消了文件选择"
End If
End Sub
Private Sub ReadDMX()
Dim filePath As String
Dim fileNum As Integer
Dim line As String
Dim lineNumber As Integer
Dim parts() As String
' 文件路径
filePath = Command1.Caption
' 打开文件
fileNum = FreeFile
Open filePath For Input As #fileNum
' 跳过第一行
Line Input #fileNum, line
' 从第二行开始逐行处理
lineNumber = 2
Do Until EOF(fileNum)
Line Input #fileNum, line
line = Trim(line)
parts = Split(line, vbTab)
dict.Add parts(1), parts(0)
'Debug.Print UBound(parts) & " " & line
'Debug.Print parts(0) & "_" & parts(1)
'Debug.Print "Line " & lineNumber & ": " & line
' 可以在这里进行其他操作，如解析数据等
lineNumber = lineNumber + 1
Loop
' 关闭文件
Close #fileNum
End Sub
Private Sub ReadHDM()
Dim filePath As String
Dim filePath1 As String
Dim fileNum As Integer
Dim fileNum1 As Integer
Dim line As String
Dim lineNumber As Integer
Dim parts() As String
Dim first As String
Dim left_ As String
Dim right_ As String
' 文件路径
filePath = Command2.Caption
' 设置文件路径
filePath1 = App.Path & "\res.csv"
' 打开文件以写模式写入
fileNum1 = FreeFile
Open filePath1 For Output As #fileNum1
' 打开文件
fileNum = FreeFile
Open filePath For Input As #fileNum
' 跳过第一行
Line Input #fileNum, line
' 从第二行开始逐行处理
lineNumber = 2
Do Until EOF(fileNum)
Line Input #fileNum, line
first = Trim(line)
parts = Split(first, " ")
If UBound(parts) = -1 Then Exit Do '最后一行没信息了，直接结束循环
Line Input #fileNum, line
left_ = Trim(line)
left_ = ReplaceMultipleSpaces(left_)
Line Input #fileNum, line
right_ = Trim(line)
right_ = ReplaceMultipleSpaces(right_)
Call Calculate(first, left_, right_, fileNum1) '计算并入文件内
Line Input #fileNum, line '跳一个空行
lineNumber = lineNumber + 1 '累计多少组数据
Loop
' 关闭文件
Close #fileNum
Close #fileNum1
End Sub
Private Sub Calculate(first As String, left_ As String, right_ As String, fileNum As Integer)
Dim parts() As String
Dim i As Integer
Dim j As Integer
Call AppendToCSVFile(first, fileNum) '索引值先入表
'处理左边
parts = Split(left_, " ")
Dim previous As Coordinate
Dim temp As Coordinate
Dim arr() As Coordinate
ReDim arr(Val(parts(0)))
Dim s As String
s = "0.000"
j = 0
previous.X = Format(0 + Val(Text1.Text), s)
previous.Y = Format(dict.Item(first), s)
For i = 1 To UBound(parts) Step 2
'i为x信息
arr(j).X = Format(previous.X - Val(parts(i)), s)
'i+1为y信息
arr(j).Y = Format(previous.Y + Val(parts(i + 1)), s)
previous = arr(j)
j = j + 1
Next
' 获取数组的最大索引
Dim lastIndex As Integer
lastIndex = UBound(arr)
' 将数组倒序排列
For i = 0 To lastIndex \ 2
' 交换 arr(i) 和 arr(lastIndex - i)
temp = arr(i)
arr(i) = arr(lastIndex - i)
arr(lastIndex - i) = temp
Next i
For i = 1 To UBound(arr)
Call AppendToCSVFile("," & arr(i).X & "," & arr(i).Y, fileNum)
Next
'处理右边
parts = Split(right_, " ")
ReDim arr(Val(parts(0)))
j = 0
previous.X = Format(0 + Val(Text1.Text), s)
previous.Y = Format(dict.Item(first), s)
For i = 1 To UBound(parts) Step 2
'i为x信息
arr(j).X = Format(previous.X + Val(parts(i)), s)
'i+1为y信息
arr(j).Y = Format(previous.Y + Val(parts(i + 1)), s)
previous = arr(j)
Call AppendToCSVFile("," & arr(j).X & "," & arr(j).Y, fileNum)
j = j + 1
Next
End Sub
Private Sub Command3_Click()
If Not IsNumericVB6(Text1.Text) Then
MsgBox "B的值必须是数值型"
Exit Sub
End If
Me.Hide
Dim filePath As String
filePath = App.Path & "\res.csv"
Call ClearFile(filePath)
Call ReadDMX
Call ReadHDM
Me.Show
MsgBox "计算完毕"
End
End Sub
Function IsNumericVB6(inputStr As String) As Boolean
Dim numericValue As Double
numericValue = Val(inputStr)
' 如果 Val 返回 0 并且输入字符串不为 "0"，则不是数值
If numericValue = 0 And inputStr <> "0" Then
IsNumericVB6 = False
Else
IsNumericVB6 = True
End If
End Function
Private Sub Form_Load()
Set dict = New Collection
End Sub
Function ReplaceMultipleSpaces(inputStr As String) As String
Dim i As Integer
Dim result As String
Dim isPreviousSpace As Boolean
result = ""
isPreviousSpace = False
For i = 1 To Len(inputStr)
If Mid(inputStr, i, 1) = " " Then
If Not isPreviousSpace Then
result = result & " "
End If
isPreviousSpace = True
Else
result = result & Mid(inputStr, i, 1)
isPreviousSpace = False
End If
Next i
ReplaceMultipleSpaces = result
End Function
Sub AppendToCSVFile(dataString As String, fileNum As Integer)
Print #fileNum, dataString
End Sub
Sub ClearFile(filePath As String)
Dim fileNum As Integer
' 打开文件以写入模式（清空文件）
fileNum = FreeFile
Open filePath For Output As #fileNum
' 关闭文件
Close #fileNum
End Sub
