VERSION 5.00 Begin VB.Form frmWaveSelect BorderStyle = 3 '固定ダイアログ Caption = "地震波ファイル選択" ClientHeight = 4110 ClientLeft = 45 ClientTop = 330 ClientWidth = 5205 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 4110 ScaleWidth = 5205 ShowInTaskbar = 0 'False StartUpPosition = 3 'Windows の既定値 Begin VB.CommandButton cmdYes Caption = "選択する(&Y)" Default = -1 'True Height = 375 Left = 120 TabIndex = 5 Top = 3600 Width = 1335 End Begin VB.FileListBox File1 Height = 2970 Left = 2640 TabIndex = 4 Top = 480 Width = 2415 End Begin VB.DirListBox Dir1 Height = 2610 Left = 120 TabIndex = 3 Top = 840 Width = 2415 End Begin VB.DriveListBox Drive1 Height = 300 Left = 120 TabIndex = 2 Top = 480 Width = 2415 End Begin VB.TextBox txtFileName Height = 270 Left = 2640 TabIndex = 1 Top = 120 Width = 2415 End Begin VB.Label lblFileName Alignment = 1 '右揃え Caption = "ファイル名(&N):" Height = 255 Left = 120 TabIndex = 0 Top = 120 Width = 2415 End End Attribute VB_Name = "frmWaveSelect" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit '変数の宣言 Dim ans As String Dim OpenFile As String Dim FileNum As Integer Dim I As Integer Dim Dat(50000) As Double '入力加速度データ群(cm/s^2) Private Sub cmdYes_Click() '読み込みファイルの取得 With frmWaveSelect If Right(.Dir1.Path, 1) = "\" Then OpenFile = .Dir1.Path & .txtFileName.Text Else OpenFile = .Dir1.Path & "\" & .txtFileName.Text End If 'ファイル名が指定されていない場合の処理 If .txtFileName.Text = "" Then ans = MsgBox("地震波ファイルが選択されていません。", vbInformation, "解析不能") Exit Sub End If End With 'データの読み取り I = 0 FileNum = FreeFile Open OpenFile For Input As #FileNum Do While Not EOF(FileNum) Input #FileNum, Dat(I) I = I + 1 Loop Close #FileNum frmAnalysis.txtTs.Text = Val(Dat(0)) frmAnalysis.txtTl.Text = Val(Dat(0)) * (I - 1) '画面表示ウィンドウの切り替え frmWaveSelect.Hide frmAnalysis.Show 'メッセージの表示 ans = MsgBox("分割時間を変更しないで下さい。", vbInformation, "分割時間変更禁止") ans = MsgBox("解析時間を " & Val(Dat(0)) * (I - 1) & " 秒に設定しました。", vbInformation, "解析時間の設定") End Sub Private Sub Dir1_Change() 'カレントバスの取得 File1.Path = Dir1.Path End Sub Private Sub Drive1_Change() 'カレントドライブの取得 On Error GoTo errhandler Dir1.Path = Drive1.Drive Exit Sub errhandler: If Err.Number = 68 Or Err.Number = 71 Then ans = MsgBox("フロッピーディスクをセットして下さい。", vbExclamation, "フロッピー未搬入") Else ans = MsgBox("予期しないエラーが発生しました。強制終了します。", vbCritical, "強制終了") End End If End Sub Private Sub File1_Click() '選択したファイル名の取得 txtFileName.Text = File1.FileName End Sub