mdataoperate.bas

地面测试仪

'* 函数描述:保存数据
'* 参数列表:SData地面仪数据, strFile文件名
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
Dim filenum As Integer, i As Integer

filenum = FreeFile
   
Open strFile For Output As #filenum
'写文件头
Print #filenum, Space(20) & "地面测试仪数据记录" & IIf(SData.HaveDym, "", "(无高低频)")
Print #filenum, Space(15) & "=========================="
Print #filenum, Space(15) & "井    号:" & SData.dmyHead(1)
Print #filenum, Space(15) & "日    期:" & SData.dmyHead(2)
Print #filenum, Space(15) & "时    间:" & SData.dmyHead(3)
Print #filenum, Space(15) & "关井时间:" & SData.dmyHead(4)
Print #filenum, Space(15) & "液 面 深:" & Format(SData.dmyHead(5), "0.0")
Print #filenum, Space(15) & "套    压:" & SData.dmyHead(6)
Print #filenum, Space(15) & "声    速:" & SData.dmyHead(7)
Print #filenum, Space(15) & "数据点数:" & SData.dmyHead(8)
Print #filenum, Space(15) & "回归间隔:" & SData.dmyHead(9)
Print #filenum, Space(15) & "回归点数:" & SData.dmyHead(10)
Print #filenum, Space(15) & "文 件 名:" & strFile
Print #filenum, " "

'写液面套压数据
Print #filenum, Space(10) & "液面套压数据"
Print #filenum, " "
Print #filenum, "序号" & Space(6) & "累计时间(s)" & Space(6) _
              & "套压" & Space(6) & "液面数据"
Print #filenum, " "
  
For i = 1 To CInt(SData.dmyHead(10))
    Print #filenum, strFormat(CStr(i), Chr(32), 9, False) & _
                    strFormat(SData.dmyYT(i, 1), Chr(32), 10) & _
                    strFormat(Format(SData.dmyYT(i, 3), "0.000"), Chr(32), 10) & _
                    strFormat(Format(SData.dmyYT(i, 2), "0.00"), Chr(32), 10)
Next

'写液面高低频数据
If SData.HaveDym Then
    Print #filenum, Space(10) & "液面高低频数据"
    Print #filenum, " "
    Print #filenum, Space(5) & "序号" & Space(10) & "高频数据" & Space(10) & "低频数据"
    Print #filenum, " "
    For i = 1 To CInt(SData.dmyHead(8))
        Print #filenum, Space(5) & strFormat(CStr(i), Chr(32), 9, False) & _
                        strFormat(SData.dmyHL(i, 1), Chr(32), 10) & _
                        strFormat(SData.dmyHL(i, 2), Chr(32), 10)
    Next
End If
Close #filenum

End Function

'打开数据
Function openFile(strFile As String) As dmyData
On Error GoTo errlab
'**********************************************************************
'* 函数名称:openFile
'* 函数描述:从文件读取数据
'* 参数列表:strFile文件名
'* 返    回:地面仪数据
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
Dim filenum As Integer, i As Integer
Dim strTemp As String, strTitle As String
Dim tempData As dmyData
Dim dataCount As Long   '数据长度
Dim rCount As Long      '回归数据长度
filenum = FreeFile()
Open strFile For Input As filenum
    Line Input #filenum, strTemp
    strTitle = Trim(strTemp)
    Line Input #filenum, strTemp
    '3-13表头
    For i = 1 To 11
        Line Input #filenum, strTemp
        tempData.dmyHead(i) = GetStr(Trim(strTemp), ":")
    Next
    dataCount = CLng(tempData.dmyHead(8))
    rCount = CLng(tempData.dmyHead(10))
'    Line Input #fileNum, Trim()
    
    '4行表头
    For i = 1 To 5
         Line Input #filenum, strTemp
    Next
    '液面套压数据
    ReDim tempData.dmyYT(rCount, 5) '1时间2液面3套压4x轴坐标5静压
    
    For i = 1 To rCount
        Line Input #filenum, strTemp
        
'        tempData.dmyYT(i, 1) = i
        tempData.dmyYT(i, 2) = CSng(Trim(Mid(strTemp, 32))) '液面
        tempData.dmyYT(i, 3) = CSng(Trim(Mid(strTemp, 21, 11))) '套压
        tempData.dmyYT(i, 1) = CSng(Trim(Mid(strTemp, 11, 11))) '时间
        
        If tempData.YNoodlesMax < tempData.dmyYT(i, 2) Then tempData.YNoodlesMax = tempData.dmyYT(i, 2)
        If tempData.TPressMax < tempData.dmyYT(i, 3) Then tempData.TPressMax = tempData.dmyYT(i, 3)
    Next
    tempData.YNoodlesMax = IIf(tempData.YNoodlesMax > 0, tempData.YNoodlesMax * 1.1, 1.5)
    
    tempData.TPressMax = IIf(tempData.TPressMax > 0, (tempData.TPressMax \ 2 + 1) * 2, 2)
    
    tempData.TimeMax = IIf(tempData.dmyYT(rCount, 1) > 0, tempData.dmyYT(rCount, 1), IIf(tempData.dmyHead(9) > 0, tempData.dmyHead(9), 15))
    
    
    If Trim(strTitle) <> strDataYTTitle Then
        
        tempData.HaveDym = True
        Line Input #filenum, strTemp
   
    '4行表头
        For i = 1 To 3
             Line Input #filenum, strTemp
        Next
        '液面高低频数据
        ReDim tempData.dmyHL(dataCount, 3)
        For i = 1 To dataCount
            Line Input #filenum, strTemp
            
    '        tempData.dmyHL(i, 1) = i
            tempData.dmyHL(i, 1) = CSng(Trim(Mid(strTemp, 10, 15))) '高频
            tempData.dmyHL(i, 2) = CSng(Trim(Mid(strTemp, 25)))     '低频
            
            If tempData.HFrequencyMax < tempData.dmyHL(i, 1) Then tempData.HFrequencyMax = tempData.dmyHL(i, 1)
            If tempData.LFrequencyMax < tempData.dmyHL(i, 2) Then tempData.LFrequencyMax = tempData.dmyHL(i, 2)
        Next
        
        tempData.HLRowPiont = CLng(dataCount / HLRowCount / 10) * 10
        
    End If
Close filenum

getOp tempData.hanshui, tempData.zhongshen, strFile

If havaRep(strFile) Then
   
    ReadRep strFile, tempData.dmyRep
Else
    tempData.dmyRep(3) = tempData.dmyHead(1)
    tempData.dmyRep(7) = ""
    tempData.dmyRep(8) = ""
    tempData.dmyRep(9) = tempData.dmyHead(3)
    tempData.dmyRep(11) = tempData.dmyHead(4)
    tempData.dmyRep(19) = tempData.dmyHead(6)
End If
'结束
tempData.fileName = strFile
tempData.ReadSuc = True
openFile = tempData
Exit Function

errlab:
    '文件格式不对
Close filenum
tempData.ReadSuc = False
openFile = tempData
End Function

'合并数据
Function MergeData(FirstFile As String, SecondFile As String, dFile As String)
'**********************************************************************
'* 函数名称:MergeData
'* 函数描述:合并数据
'* 参数列表:FirstFile第一个文件,SecondFile第二个文件,dFile目标文件
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************

'文件头用第一个文件的头，点数需要加

On Error GoTo errlab
Dim t1 As dmyData
Dim t2 As dmyData
Dim t3() As String
Dim rowCount As Integer, i  As Integer, j As Integer, k As Integer
Dim jg As Long, temptime As Long
t1 = openFile(FirstFile)
t2 = openFile(SecondFile)
jg = t1.dmyHead(9)
If t1.ReadSuc And t2.ReadSuc Then

    j = CInt(t1.dmyHead(10))
    k = CInt(t2.dmyHead(10))
    rowCount = j + k
    t3 = t1.dmyYT
    ReDim t1.dmyYT(rowCount, 5)
    
    For i = 1 To j
        t1.dmyYT(i, 1) = t2.dmyYT(i, 1)
        t1.dmyYT(i, 2) = t2.dmyYT(i, 2)
        t1.dmyYT(i, 3) = t2.dmyYT(i, 3)
    Next
    temptime = t1.dmyYT(j, 1)
    
    For i = 1 To k
        t1.dmyYT(i + j, 1) = CStr(temptime + jg * i)
        t1.dmyYT(i + j, 2) = t2.dmyYT(i, 2)
        t1.dmyYT(i + j, 3) = t2.dmyYT(i, 3)
'        t1.dmyYT(i + j, 4) = t2.dmyYT(i, 4)
'        t1.dmyYT(i + j, 5) = t2.dmyYT(i, 5)
    Next
    Erase t1.dmyHL
    
    t1.dmyHead(10) = rowCount
    
    saveFile t1, dFile
    MsgBox "文件合并完成"
Else
    MsgBox "失败：检查文件格式"
End If
Exit Function
errlab:
    MsgBox "失败：检查文件格式"
    

End Function

Function JianDing()
'**********************************************************************
'* 函数名称:JianDing
'* 函数描述:打开检定报表（打开Excel）
'* 参数列表:
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
'Dim xlApp As Excel.Application
'Dim xlBook As Excel.Workbook
'Dim xlsheet As Excel.Worksheet '定义工作表类
'
'If Dir(App.Path & "\jdbb.~") = "" Then
'    Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象
'    xlApp.Visible = True '设置EXCEL对象可见（或不可见）
'    Set xlBook = xlApp.Workbooks.Open(App.Path & "\jdbb.xls")  '打开已经存在的EXCEL工件簿文件
'    DoEvents
'    Set xlsheet = xlBook.Worksheets(1) '打开EXCEL工作表
'    xlsheet.Activate '激活工作表
'Else
'
'    MsgBox "检定报表已经打开！！！"
'End If
'
'Set xlApp = Nothing
'Set xlBook = Nothing
'Set xlsheet = Nothing

FrmJianDing.Show 1

End Function

'获得静压
Function GetJpress(zDeep As Integer, hWater As Integer)
'**********************************************************************
'* 函数名称:GetJpress
'* 函数描述:获得静压
'* 参数列表:zDeep 油层中深, hWater含水
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
 '液面及套压计算静压的公式P=P'+(H"-H')*[H"'*R'+(1-H"')*R"]
 'P为静压，p'为套压，H"为油层中深，H'液面深度，H"'为含水，R'为水密度，R"为油密度
Dim i As Integer
Dim sngTemp As Single

With TempDmyData
    .JPressMax = 0
    For i = 1 To UBound(TempDmyData.dmyYT())
        sngTemp = .dmyYT(i, 3) + (zDeep - .dmyYT(i, 2)) * (hWater / 100 * 1 + (1 - hWater / 100) * 0.82) * 0.00980665
        
        If .JPressMax < sngTemp Then .JPressMax = sngTemp
         .dmyYT(i, 5) = Format(IIf(sngTemp < 0, 0, sngTemp), "#.00")
    Next
    .JPressMax = Int(.JPressMax) + 1
End With
End Function


'获得时间数组
Function getTimeArr(Interval As Integer, arrCount As Integer, isXianxing As Boolean) As Long()
'**********************************************************************
'* 函数名称:getTimeArr
'* 函数描述:获得时间数组
'* 参数列表:Interval时间间隔, arrCount 数组长度, isXianxing 是否线性
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
Dim timerArr() As Long
ReDim timerArr(arrCount)
Dim i As Integer, j As Integer, k As Long 'k为累计时间
'T  2T  4T  8T  16T 32T
'8  8   8   8   16  结尾
'0  1   2   3   4-5 6-end

timerArr(1) = 0
For i = 2 To arrCount
    If Not isXianxing Then '时间非线性
        j = ((i - 1) \ 8) '0到8
        Select Case True
        Case j <= 3 'j=1 到3
            k = Interval * 2 ^ j '累计时间=时间间隔×2的j次方（1次，2次，3次）
        Case j > 3 And j <= 5 'i=5到6
            k = Interval * 2 ^ 4 '累计时间=时间间隔×16
        Case Else
            k = Interval * 2 ^ 5 '剩下，累计时间=时间间隔×32
        End Select
        timerArr(i) = timerArr(i - 1) + k '上一次时间+累计时间
    Else '时间线性增加
        timerArr(i) = Interval * (i - 1)
    End If
'    Debug.Print timerArr(i)
Next
getTimeArr = timerArr
End Function


Public Sub FSaveFile(SData As dmyData)
'**********************************************************************
'* 函数名称:FSaveFile
'* 函数描述:保存文件
'* 参数列表:SData 地面仪数据
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
    Dim fileName As String
    mDialog.DialogTitle = "保存数据文件"
    mDialog.Filter = "文件 (*.dmy)|*.dmy"
    mDialog.Flags = cdlOFNFileMustExist
    mDialog.fileName = SData.dmyHead(1)
    mDialog.DefaultExt = "dmy"
    mDialog.InitDir = App.Path 'getdefaultpath_load
    mDialog.ShowSave
    fileName = Trim(mDialog.fileName)
    If fileName <> "" Then
        saveFile SData, fileName
    End If
    
End Sub