classmedata.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 = "ClassDPMEData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit


Private Type T_Platform
  CurrentFileNo As Long          '当前文件号
  ns As Currency                 '当前记录纳秒表产生的记录时刻,单位微秒
  Date As String                 '当前记录的日期
  FileName() As String
  UnitNo As Integer              '子台号
  ADdT As Currency               'AD转换间隔,单位微秒
  SampleNum As Integer           '采样点数
  'TimeScope(1 To 2) As Currency  '记录时间范围，单位：微秒。
                                 '1:为第一条之启动时刻，2：为最后一条记录启动时刻的纳秒时钟加上该记录的时间窗宽度。
  WaveNum As Long                '矿震记录总数
  ColorNo As Long                '子台颜色
  ZoomPara As Single
  
  LinkChNo As Integer            '连接于比本通道更低一级增益的信号通道编号（注意：是单元号）
                                 '等于零时表示无低增益通道被同时使用
                                 
End Type



Dim MEFileName As String
Dim FileName() As String
Dim DATAFileNo As String
Dim FileHead As String
Dim FileHead1 As String
Dim EventNo As Integer
Dim Rec_nS As Currency
Dim GDate As String
Dim ADFreNo, SampleNum, GainNo(4), DelayNo, TrigLevelNo As Integer
Dim Platform As T_Platform

Dim WaveNum As Long
Dim DATADirection As Integer
Dim wavedata() As Long

Public Property Get TotalRecordNum() As Long

Dim tempFile As String
Dim n As Long
Dim WaveNum As Long
On Error GoTo ErrTrap
'用Dir$计算文件数
  tempFile = Dir("D:\data\*.dat")
     n = 0
  If tempFile = "" Then GoTo NoFile
     n = 1
     Do
       ReDim Preserve FileName(1 To n) As String
       FileName(n) = tempFile
       tempFile = Dir$
       'Debug.Print FileName(n)
       n = n + 1
     Loop
  'End If
     
NoFile:
   
   WaveNum = n
   
   TotalRecordNum = WaveNum
   
   Exit Property
   
ErrTrap:
   If Err = 5 Then
      GoTo NoFile
   Else
      TotalRecordNum = -1
   End If
End Property
Public Property Get TotalRecordNum2() As Long

Dim tempFile As String
Dim n As Long
Dim WaveNum As Long
On Error GoTo ErrTrap
'用Dir$计算文件数
  tempFile = Dir("D:\data2\*.dat")
     n = 0
  If tempFile = "" Then GoTo NoFile
     n = 1
     Do
       ReDim Preserve FileName(1 To n) As String
       FileName(n) = tempFile
       tempFile = Dir$
       'Debug.Print FileName(n)
       n = n + 1
     Loop
  'End If
     
NoFile:
   
   WaveNum = n
   
   TotalRecordNum2 = WaveNum
   
   Exit Property
   
ErrTrap:
   If Err = 5 Then
      GoTo NoFile
   Else
      TotalRecordNum2 = -1
   End If
End Property
Public Property Get TotalRecordNum3() As Long

Dim tempFile As String
Dim n As Long
Dim WaveNum As Long
On Error GoTo ErrTrap
'用Dir$计算文件数
  tempFile = Dir("D:\data3\*.dat")
     n = 0
  If tempFile = "" Then GoTo NoFile
     n = 1
     Do
       ReDim Preserve FileName(1 To n) As String
       FileName(n) = tempFile
       tempFile = Dir$
       'Debug.Print FileName(n)
       n = n + 1
     Loop
  'End If
     
NoFile:
   
   WaveNum = n
   
   TotalRecordNum3 = WaveNum
   
   Exit Property
   
ErrTrap:
   If Err = 5 Then
      GoTo NoFile
   Else
      TotalRecordNum3 = -1
   End If
End Property
Public Property Get TotalRecordNum4() As Long

Dim tempFile As String
Dim n As Long
Dim WaveNum As Long
On Error GoTo ErrTrap
'用Dir$计算文件数
  tempFile = Dir("D:\data4\*.dat")
     n = 0
  If tempFile = "" Then GoTo NoFile
     n = 1
     Do
       ReDim Preserve FileName(1 To n) As String
       FileName(n) = tempFile
       tempFile = Dir$
       'Debug.Print FileName(n)
       n = n + 1
     Loop
  'End If
     
NoFile:
   
   WaveNum = n
   
   TotalRecordNum4 = WaveNum
   
   Exit Property
   
ErrTrap:
   If Err = 5 Then
      GoTo NoFile
   Else
      TotalRecordNum4 = -1
   End If
End Property




Public Property Let DirectionDATA(Direct As Integer)
'Direct=1 代表X方向
'Direct=2 代表Y方向
'Direct=3 代表Z方向

   DATADirection = Direct
End Property
Public Sub GetWaveDATA(Direction As Integer, Rec_nS As Currency, wavedata() As Long)
Dim i As Long
Dim Counter As Long
Dim Point As Long
Dim j As Long
Dim WDATA() As Long

DATAFileNo = FreeFile
   Open MEFileName For Input As #DATAFileNo
   Input #DATAFileNo, EventNo, Rec_nS, GDate
   
   Line Input #DATAFileNo, FileHead
   ADFreNo = Val(Mid$(FileHead, 2, 1))
   SampleNum = Val(Mid$(FileHead, 16, 3))
   GainNo(1) = Val(Mid$(FileHead, 30, 1))
   GainNo(2) = Val(Mid$(FileHead, 44, 1))
   GainNo(3) = Val(Mid$(FileHead, 58, 1))
   GainNo(4) = Val(Mid$(FileHead, 72, 1))
   DelayNo = Val(Mid$(FileHead, 86, 1))

   TrigLevelNo = Val(Mid$(FileHead, 100, 1))
 
   Counter = 0
   Do While Not EOF(DATAFileNo)
     Counter = Counter + 1
     ReDim Preserve WDATA(4, 1 To Counter) As Long
     
     Input #DATAFileNo, Point, WDATA(1, Counter), WDATA(2, Counter), WDATA(3, Counter), WDATA(4, Counter)
   Loop
  
   ReDim Preserve wavedata(1 To Counter) As Long
    For i = 1 To Counter
      wavedata(i) = WDATA(Direction, i)
    Next i
    
  Close #DATAFileNo

End Sub

Public Sub LoadFileParas(DATAFile As String)

Dim Counter As Long
Dim i As Long
Dim Point As Long
Dim j As Long
Dim WDATA() As Long
Dim EventNum As Long

  MEFileName = DATAFile
  DATAFileNo = FreeFile
  
   Open MEFileName For Input As #DATAFileNo
   Input #DATAFileNo, EventNo, Rec_nS, GDate
   
   Line Input #DATAFileNo, FileHead
   ADFreNo = Val(Mid$(FileHead, 2, 1))

   SampleNum = Val(Mid$(FileHead, 16, 3))
 
   DelayNo = Val(Mid$(FileHead, 86, 1))

   TrigLevelNo = Val(Mid$(FileHead, 100, 1))
 
   Counter = 0
   Do While Not EOF(DATAFileNo)
     Counter = Counter + 1
     ReDim Preserve WDATA(4, 1 To Counter) As Long
     
     Input #DATAFileNo, Point, WDATA(1, Counter), WDATA(2, Counter), WDATA(3, Counter), WDATA(4, Counter)
     
   Loop
  
   ReDim Preserve wavedata(1 To Counter) As Long
    For i = 1 To Counter
      wavedata(i) = WDATA(DATADirection, i)
    Next i
    
Close #DATAFileNo
 
End Sub
Public Property Get RecordDate() As String
   DATAFileNo = FreeFile
   Open MEFileName For Input As #DATAFileNo
   Input #DATAFileNo, EventNo, Rec_nS, GDate
    
    RecordDate = GDate
   
   Close #DATAFileNo
End Property
Public Property Get CurrentEventNo() As Integer
  DATAFileNo = FreeFile
  Open MEFileName For Input As #DATAFileNo
  Input #DATAFileNo, EventNo, Rec_nS, GDate
  
  CurrentEventNo = EventNo
  Close #DATAFileNo
  
End Property
Public Property Get UnitNo() As Integer
  UnitNo = Platform.UnitNo
End Property
Public Property Get RecorduS() As Currency
   DATAFileNo = FreeFile
   Open MEFileName For Input As #DATAFileNo
   Input #DATAFileNo, EventNo, Rec_nS, GDate
   RecorduS = Rec_nS
   Close #DATAFileNo
   
End Property
Public Property Get CurrentADFreNo() As Integer
   DATAFileNo = FreeFile
   Open MEFileName For Input As #DATAFileNo
   Input #DATAFileNo, EventNo, Rec_nS, GDate
   Line Input #DATAFileNo, FileHead
   ADFreNo = Val(Mid$(FileHead, 2, 1))
   CurrentADFreNo = ADFreNo
   Close #DATAFileNo
End Property
Public Property Get SampleLength() As Long
   DATAFileNo = FreeFile
   Open MEFileName For Input As #DATAFileNo
   Input #DATAFileNo, EventNo, Rec_nS, GDate
   Line Input #DATAFileNo, FileHead
   SampleNum = Val(Mid$(FileHead, 16, 3))
   SampleLength = SampleNum * 1024
   Close #DATAFileNo
End Property
Public Property Get CurrentTrigNo() As Integer
   DATAFileNo = FreeFile
   Open MEFileName For Input As #DATAFileNo
   Input #DATAFileNo, EventNo, Rec_nS, GDate
   Line Input #DATAFileNo, FileHead
   TrigLevelNo = Val(Mid$(FileHead, 100, 1))
   CurrentTrigNo = TrigLevelNo
   Close #DATAFileNo
End Property
Public Property Get CurrentDelayNo() As Integer
   DATAFileNo = FreeFile
   Open MEFileName For Input As #DATAFileNo
   Input #DATAFileNo, EventNo, Rec_nS, GDate
   Line Input #DATAFileNo, FileHead
   DelayNo = Val(Mid$(FileHead, 86, 1))
   CurrentDelayNo = DelayNo
   Close #DATAFileNo
End Property
Public Property Get CurrentGain1() As Integer
   DATAFileNo = FreeFile
   Open MEFileName For Input As #DATAFileNo
   Input #DATAFileNo, EventNo, Rec_nS, GDate
   Line Input #DATAFileNo, FileHead
   GainNo(1) = Val(Mid$(FileHead, 30, 1))
   CurrentGain1 = GainNo(1)
   Close #DATAFileNo
End Property
Public Property Get CurrentGain2() As Integer
   DATAFileNo = FreeFile
   Open MEFileName For Input As #DATAFileNo
   Input #DATAFileNo, EventNo, Rec_nS, GDate
   Line Input #DATAFileNo, FileHead
   GainNo(2) = Val(Mid$(FileHead, 44, 1))
   CurrentGain2 = GainNo(2)
   Close #DATAFileNo
End Property

Public Property Get CurrentGain3() As Integer
   DATAFileNo = FreeFile
   Open MEFileName For Input As #DATAFileNo
   Input #DATAFileNo, EventNo, Rec_nS, GDate
   Line Input #DATAFileNo, FileHead
   GainNo(3) = Val(Mid$(FileHead, 58, 1))
   CurrentGain3 = GainNo(3)
   Close #DATAFileNo
End Property
Public Property Get CurrentGain4() As Integer
   DATAFileNo = FreeFile
   Open MEFileName For Input As #DATAFileNo
   Input #DATAFileNo, EventNo, Rec_nS, GDate
   Line Input #DATAFileNo, FileHead
   GainNo(4) = Val(Mid$(FileHead, 72, 1))
   CurrentGain4 = GainNo(4)
   Close #DATAFileNo
End Property