classdpaedata.cls

持续时间震级计算vb源码。利用地震波持续时间同地震震级的相关性来反映震源强度

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClassDPAEDATA"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Type T_RunMode
     No As Integer
     ModeStr As String * 10
     ParaStr As String * 1
     ModeCode As Byte
End Type
 
Private Type T_TrigMode
     No As Integer
     ModeStr As String * 9
     ParaStr As String * 4
     ModeCode As Byte
End Type


Private Type T_TrigLevel
  LevelPercentStr As String * 6  '+xx.x%
  ParaStr As String * 8   '8对应-100%, 248对应+1+100%, 128对应0
  LevelPercent As Single       '触发电压百分数，具体电压需要参考通道增益
End Type

Private Type T_Gain
     No As Integer
     GainStr As String * 10
     ParaStr As String * 8
     MaxInVol As Single                    '最高输入电压 单位：V
End Type

Private Type T_ADFrequency
    No As Integer
    FreStr As String * 6
    Para As Byte                           '硬件写入数据
    Fre As Single                          '采样频率，单位MHz
End Type

Private Type T_DelayAddr
    No As Integer
    DelayStr As String
    Para As Byte                          '硬件写入数据
    Addr As Integer                       '延迟地址数，单位：字
End Type



Private Type TADBoardParas
  DATAFileName As String * 80                  '数据文件名，保持原名，避免被ReName,以备检查。它应当与UnitNo有合成关系。
  UnitNo As Integer                            '数据采集单元编号，应当从磁盘名上获得，表示本数据文件来自哪个采样单元
  GroupSwitch(1 To 32) As Boolean              '采样组各个单元的状态开关，以便从一个文件查找其它文件
  
  CreateTime As Date
  Operator As String * 10
  Brief As String * 120

  RunMode As T_RunMode
  TrigMode As T_TrigMode
  Gain As T_Gain
  ADFre As T_ADFrequency
  TrigLevel As T_TrigLevel
  DelayNum As T_DelayAddr
  SampleLen As Integer
  
  
End Type


Private Type T_DATABlock
  EventNo As Long
  AbsDate As Date
  uSTimer As Currency
  nSTimer As Currency
  DataBuffer() As Integer
End Type

Private Type MT
   T() As Currency
   m() As Single
   
End Type

'硬件固定参数
Const ADBoardName As String = "DPAE—分布式并行控制声发射系统，USB接口50兆12位数据采集板"
Const DeveloperName As String = "数据采集板硬件设计制作：陆志梁；USB接口硬件设计制作及下位上位机通讯驱动软件开发：张智河。"

Const BuffSize As Integer = 4096    '采样长度
Const MaxSignal As Single = 1       '最高输入电压
Const MinSignal As Single = -1      '最低输入电压
Const SignalChNum As Integer = 1    '采样通道数 1， 即仅有第一通道


'硬件可调参数表
Dim RunModeTable(0 To 1) As T_RunMode
Dim TrigModeTable(0 To 6) As T_TrigMode
Dim GainTable(0 To 4) As T_Gain
Dim ADFreTable(0 To 7) As T_ADFrequency
Dim DelayTable(0 To 15) As T_DelayAddr




'********* 缺省参数 *************************************


Const DefaultDATAFileName As String = "No File"
Const DefaultParaFile As String = "C:\WINNT\SYSTEM\DPAE1.CNF"
Dim DPAEFileName As String


'********* 当前选定的设备参数表号 **************************
Dim CurrentRunNo As Integer
Dim CurrentTrigModeNo As Integer
Dim CurrentCh1GainNo As Integer
Dim CurrentCh2GainNo As Integer
Dim CurrentADFreNo As Integer
Dim CurrentTrigLevel As T_TrigLevel
Dim CurrentDelayNo As Integer
Dim CurrentSampleLen As Integer    '采样长度 通常取2的整数幂，512，1024，2048，4096
                                   '注意，在USB传送数据的情况下，采样长度与传输速度没有线性增加的关系，
                                   '一般来说，传送数据越多，平均传送时间越短。
                                   
Dim Paras As TADBoardParas
Dim DATABlock As T_DATABlock

 
Dim DATAFileNo As Integer
Dim SavedEventNum As Long

Dim EventNum As Long   '注意：这里的事件数是指波形数据段或记录块数，在有删节时并不等于每条记录的波形号。
Dim RecordBytes As Long
Dim HeadBytes As Long

Dim AEFileHead As New ClassFileHead   '文件头变量



























Public Sub SaveDTEventsAsNewFile(DT As Currency, EventNo1 As Long, EventNo2 As Long, OldFileName As String, NewFileName As String)
Dim FileFormatHeadBytes As Long
Dim OldFileNo As Integer
Dim NewFileNo As Integer
Dim LParas As TADBoardParas
Dim LP As Long
Dim LRecordBytes As Long, LHeadBytes As Long
Dim LEventNum As Long
Dim LDATABlock As T_DATABlock
Dim LAEFileHead As New ClassFileHead
Dim i As Long
Dim n1 As Long, n2 As Long
Dim t0 As Currency

    n1 = EventNo1
    n2 = EventNo2

    With LAEFileHead
      .ReadFileHead (OldFileName)
      FileFormatHeadBytes = .FileHeadByteNum
      '.WriteFileHead (NewFileName)
    End With
    
     OldFileNo = FreeFile
     Open OldFileName For Binary As #OldFileNo
       Seek #OldFileNo, FileFormatHeadBytes + 1
       Get #OldFileNo, , LParas
       LHeadBytes = Seek(OldFileNo) - 1
       ReDim LDATABlock.DataBuffer(0 To LParas.SampleLen + 512) As Integer
       Seek #OldFileNo, LHeadBytes + 1
       Get #OldFileNo, , LDATABlock
       LRecordBytes = Seek(OldFileNo) - 1 - LHeadBytes
       LEventNum = (LOF(OldFileNo) - LHeadBytes) \ LRecordBytes
       
       
       If n2 < n1 Then Call Swap(n1, n2)
       If n1 < 1 Then n1 = 1
       If n2 > LEventNum Then n2 = LEventNum
        
       If n2 = 0 Then GoTo NoEvents
       
       AEFileHead.WriteFileHead (NewFileName)
       
       NewFileNo = FreeFile
       Open NewFileName For Binary As #NewFileNo
       Seek #NewFileNo, LOF(NewFileNo) + 1
       Put #NewFileNo, , LParas
       
       
       For i = n1 To n2
         LP = (i - 1) * LRecordBytes + LHeadBytes + 1
         Seek #OldFileNo, LP
         Get #OldFileNo, , LDATABlock
         Put #NewFileNo, , LDATABlock
       Next i
       Close #NewFileNo
       
NoEvents:
      Close #OldFileNo
      


End Sub



Public Sub SaveEventsAsNewFile(EventNo1 As Long, EventNo2 As Long, OldFileName As String, NewFileName As String)
Dim FileFormatHeadBytes As Long
Dim OldFileNo As Integer
Dim NewFileNo As Integer
Dim LParas As TADBoardParas
Dim LP As Long
Dim LRecordBytes As Long, LHeadBytes As Long
Dim LEventNum As Long
Dim LDATABlock As T_DATABlock
Dim LAEFileHead As New ClassFileHead
Dim i As Long
Dim n1 As Long, n2 As Long
    n1 = EventNo1
    n2 = EventNo2

    With LAEFileHead
      .ReadFileHead (OldFileName)
      FileFormatHeadBytes = .FileHeadByteNum
      '.WriteFileHead (NewFileName)
    End With
    
     OldFileNo = FreeFile
     Open OldFileName For Binary As #OldFileNo
       Seek #OldFileNo, FileFormatHeadBytes + 1
       Get #OldFileNo, , LParas
       LHeadBytes = Seek(OldFileNo) - 1
       ReDim LDATABlock.DataBuffer(0 To LParas.SampleLen + 512) As Integer
       Seek #OldFileNo, LHeadBytes + 1
       Get #OldFileNo, , LDATABlock
       LRecordBytes = Seek(OldFileNo) - 1 - LHeadBytes
       LEventNum = (LOF(OldFileNo) - LHeadBytes) \ LRecordBytes
       
       
       If n2 < n1 Then Call Swap(n1, n2)
       If n1 < 1 Then n1 = 1
       If n2 > LEventNum Then n2 = LEventNum
        
       If n2 = 0 Then GoTo NoEvents
       
       AEFileHead.WriteFileHead (NewFileName)
       
       NewFileNo = FreeFile
       Open NewFileName For Binary As #NewFileNo
       Seek #NewFileNo, LOF(NewFileNo) + 1
       Put #NewFileNo, , LParas
       
       For i = n1 To n2
         LP = (i - 1) * LRecordBytes + LHeadBytes + 1
         Seek #OldFileNo, LP
         Get #OldFileNo, , LDATABlock
         Put #NewFileNo, , LDATABlock
       Next i
       Close #NewFileNo
       
NoEvents:
      Close #OldFileNo
      


End Sub






Public Sub LoadFileParas(DATAFile As String)
Dim DATABytes As Long
Dim FileFormatHeadBytes As Long


   DPAEFileName = DATAFile
   
    With AEFileHead
      .ReadFileHead (DATAFileName)
      FileFormatHeadBytes = .FileHeadByteNum
    End With



 
  
  DATAFileNo = FreeFile
  Open DPAEFileName For Binary As #DATAFileNo
       Seek #DATAFileNo, FileFormatHeadBytes + 1
       Get #DATAFileNo, , Paras
       HeadBytes = Seek(DATAFileNo) - 1
       ReDim DATABlock.DataBuffer(0 To Paras.SampleLen + 512) As Integer
       Seek #DATAFileNo, HeadBytes + 1
       Get #DATAFileNo, , DATABlock
       RecordBytes = Seek(DATAFileNo) - 1 - HeadBytes
  Close #DATAFileNo
  
  DATABytes = FileLen(DPAEFileName) - HeadBytes
  EventNum = DATABytes \ RecordBytes
End Sub

Private Function RecordPointer(RecordNo As Long) As Long
  RecordPointer = (RecordNo - 1) * RecordBytes + HeadBytes + 1
End Function

Public Sub GetWaveDATA(BlockNo As Long, Rec_nS As Currency, wavedata() As Single)
Dim i As Integer
Dim temp As Single
Dim temp0 As Single
   DATAFileNo = FreeFile
   Open DPAEFileName For Binary As #DATAFileNo
     Seek DATAFileNo, RecordPointer(BlockNo)
     Get #DATAFileNo, , DATABlock
   Close #DATAFileNo
   
    
   For i = 1 To Paras.SampleLen
      If DATABlock.DataBuffer(i + 512) >= 0 Then
         wavedata(i) = DATABlock.DataBuffer(i + 512) - 32768
      Else
         wavedata(i) = DATABlock.DataBuffer(i + 512) + 32767
      End If
   Next i
   
     For i = Paras.SampleLen - 5 To Paras.SampleLen
         wavedata(i) = wavedata(i - 5)
     Next i
     
     For i = 1 To 16
         wavedata(i) = wavedata(i + 16)
     Next i
   
   
   'For i = 16 To 1 Step -1
     'WaveDATA(i) = WaveDATA(i + 1)
   'Next i
   
   'temp0 = WaveDATA(32)
   'temp0 = temp0 - WaveDATA(17)

   'For i = 1 To 16
     'temp = WaveDATA(i + 16)
     'temp = temp - temp0
     'If temp > 32767 Then temp = 32767
     'If temp < -32768 Then temp = -32768
     
     'WaveDATA(i) = Int(temp)
   'Next i

   Rec_nS = DATABlock.nSTimer



End Sub




Public Sub GetRecordTime(ByVal BlockNo As Long, ByRef RecNo As Long, ByRef RecDate As Date, ByRef Rec_uS As Currency, ByRef Rec_nS As Currency)
   DATAFileNo = FreeFile
   Open DPAEFileName For Binary As #DATAFileNo
     Seek DATAFileNo, RecordPointer(BlockNo)
     Get #DATAFileNo, , DATABlock
   Close #DATAFileNo
   With DATABlock
     RecNo = .EventNo
     RecDate = .AbsDate
     Rec_uS = .uSTimer
     Rec_nS = .nSTimer
   End With
End Sub



Public Property Get RecordDate(ByRef RecordNo As Long) As Date
   DATAFileNo = FreeFile
   Open DPAEFileName For Binary As #DATAFileNo
     Seek DATAFileNo, RecordPointer(RecordNo)
     Get #DATAFileNo, , DATABlock
   Close #DATAFileNo
   RecordNo = DATABlock.EventNo
   RecordDate = DATABlock.AbsDate
End Property
Public Property Get RecorduS(ByRef RecordNo As Long) As Currency
   DATAFileNo = FreeFile