End Sub
Private Sub GGrid1_KeyPress(KeyAscii As Integer) '網格1鍵盤事件處理
Select Case KeyAscii
Case 8
'處理退格鍵
If Len(GGrid1.Text) = 0 Then Exit Sub
GGrid1.Text = Left$(GGrid1.Text, Len(GGrid1.Text) - 1)
Exit Sub
Case 46
'處理小數點
GGrid1.Text = GGrid1.Text + "."
Exit Sub
Case 45
'處理負號
GGrid1.Text = GGrid1.Text + "-"
Exit Sub
Case 43
'處理正號
GGrid1.Text = GGrid1.Text + "+"
Exit Sub
Case 13
GGrid1.Col = GGrid1.Col + 1
GGrid1.Text = ""
GGrid1.SetFocus
End Select
If (KeyAscii < 48 And KeyAscii <> 13 Or KeyAscii > 58 And KeyAscii <> 13) Then
'處理非數字
 MsgBox "輸入數據中含有非法字符", vbCritical, "請重新輸入"
 GGrid1.Text = ""
 Exit Sub
ElseIf KeyAscii = 13 Then
GGrid1.Text = ""
Else
GGrid1.Text = GGrid1.Text + Right(str(KeyAscii - 48), 1)
End If
End Sub
Private Sub Command1_Click()
For i = 2 To 9
If GGrid1.TextMatrix(2, i) = "" Then
MsgBox "請先輸入參數", vbCritical, "錯誤"
Exit Sub
End If
Next i
Np = GGrid1.TextMatrix(2, 1)
Ns = GGrid1.TextMatrix(2, 2)
b2 = GGrid1.TextMatrix(2, 3)
beta2 = GGrid1.TextMatrix(2, 4) * 0.001
D2 = GGrid1.TextMatrix(2, 5) * 0.001
D1 = GGrid1.TextMatrix(2, 6) * 0.001
U2 = GGrid1.TextMatrix(2, 7)
Zi = GGrid1.TextMatrix(2, 8)
Zshort = Val(GGrid1.TextMatrix(2, 9))
End Sub
Private Sub GGrid1_DblClick()
  GGrid1.Text = ""
End Sub
Private Sub Command2_Click()
N = Val(Text3.Text)
Pin = Val(Text4.Text)
tin = Val(Text5.Text)
Codenum = Val(Text6.Text)
 ReDim Faim(1 To N), Pstot(1 To N), Eftot(1 To N), Psst(1 To N), Efst(1 To N), Anoise(1 To N), QQx(1 To N), Pd(1 To N)
 ReDim Ptot(1 To N), Pst(1 To N)
 GGrid3.Rows = N + 1
 strC3 = ";工況點數|"
 For i = 1 To N
  strC3 = strC3 & i & "|"
 Next i
 strR3 = "|^流量(m3/s)|^全壓升(Pa)|^全壓效率|^靜壓升(Pa)|^靜壓效率|^噪聲(db)"
 strA3 = strR3 & strC3
 GGrid3.FormatString = strA3
 On Error GoTo Hand
Open App.Path & "\" & "Lastest.dat" For Output As #1
      Print #1, GGrid1.TextMatrix(2, 1); Tab(8); GGrid1.TextMatrix(2, 2); Tab(8 * 2); _
        GGrid1.TextMatrix(2, 3); Tab(8 * 3); GGrid1.TextMatrix(2, 4); Tab(8 * 4); _
        GGrid1.TextMatrix(2, 5); Tab(8 * 5); GGrid1.TextMatrix(2, 6); Tab(8 * 6); _
        GGrid1.TextMatrix(2, 7); Tab(8 * 7); GGrid1.TextMatrix(2, 8); Tab(8 * 8); GGrid1.TextMatrix(2, 9), Tab(8 * 9); Text6.Text, Tab(8 * 10)
Hand:   Exit Sub
End Sub
Private Sub GGrid3_DblClick()
GGrid3.Text = ""
End Sub
Private Sub GGrid3_KeyPress(KeyAscii As Integer) '網格3鍵盤事件處理
Select Case KeyAscii
Case 8
'處理退格鍵
If Len(GGrid3.Text) = 0 Then Exit Sub
GGrid3.Text = Left$(GGrid3.Text, Len(GGrid3.Text) - 1)
Exit Sub
Case 46
'處理小數點
GGrid3.Text = GGrid3.Text + "."
Exit Sub
Case 45
'處理負號
GGrid3.Text = GGrid3.Text + "-"
Exit Sub
Case 43
'處理正號
GGrid3.Text = GGrid3.Text + "+"
Exit Sub
Case 13
GGrid3.Col = GGrid3.Col + 1
GGrid3.Text = ""
GGrid3.SetFocus
End Select
If (KeyAscii < 48 And KeyAscii <> 13 Or KeyAscii > 58 And KeyAscii <> 13) Then
    MsgBox "輸入數據中含有非法字符", vbCritical, "請重新輸入"
    GGrid3.Text = ""
    Exit Sub
    ElseIf KeyAscii = 13 Then
    GGrid3.Text = ""
    Else
    GGrid3.Text = GGrid3.Text + Right(str(KeyAscii - 48), 1)
End If
End Sub
Private Sub Command3_Click()
Dim logical As Boolean
Dim i As Integer
Dim Rou As Single
Dim Temp0 As Single
For i = 1 To N
  If GGrid3.TextMatrix(i, 1) = "" Or GGrid3.TextMatrix(i, 2) = "" Or GGrid3.TextMatrix(i, 3) = "" Then
    logical = True
  End If
Next i
If logical = True Then
 MsgBox "尚未完整輸入流量、全壓升及全壓效率", vbCritical, "警告"
 Exit Sub
End If
With GGrid3
    For i = 1 To N
      QQx(i) = Val(.TextMatrix(i, 1))
      Ptot(i) = Val(.TextMatrix(i, 2))
      Eftot(i) = Val(.TextMatrix(i, 3))
      Pst(i) = Val(.TextMatrix(i, 4))
      Efst(i) = Val(.TextMatrix(i, 5))
      Anoise(i) = Val(.TextMatrix(i, 6))
    Next i
End With
For i = 1 To N
  Print #1, QQx(i); Tab(8); Ptot(i); Tab(8 * 2); _
        Eftot(i); Tab(8 * 3); Pst(i); Tab(8 * 4); _
        Efst(i); Tab(8 * 5); Anoise(i), Tab(8 * 6)
  Next i
Close #1
Call Calculate
End Sub
Private Sub Command4_Click()
Dim Rou As Single
Dim Temp0 As Single
Dim i  As Integer, j As Integer
Dim output(1 To 6) As String
If N = 0 Or Codenum = 0 Then
    Np = GGrid1.TextMatrix(2, 1)
    Ns = GGrid1.TextMatrix(2, 2)
    b2 = GGrid1.TextMatrix(2, 3)
    beta2 = GGrid1.TextMatrix(2, 4) * 0.001
    D2 = GGrid1.TextMatrix(2, 5) * 0.001
    D1 = GGrid1.TextMatrix(2, 6) * 0.001
    U2 = GGrid1.TextMatrix(2, 7)
    Zi = GGrid1.TextMatrix(2, 8)
    Zshort = Val(GGrid1.TextMatrix(2, 9))
    Codenum = Val(Text6.Text)
    N = Val(Text3.Text)
    Pin = Val(Text4.Text)
    tin = Val(Text5.Text)
    D2 = GGrid1.TextMatrix(2, 5) * 0.001
    U2 = GGrid1.TextMatrix(2, 7)
    ReDim Faim(1 To N), Pstot(1 To N), Eftot(1 To N), Psst(1 To N), Efst(1 To N), Anoise(1 To N), QQx(1 To N), Pd(1 To N)
    ReDim Ptot(1 To N), Pst(1 To N)
    Call Calculate
    Call Printresult
Else
    Call Printresult
End If
 End Sub
 Private Sub Calculate()
 pi = 3.141592653
 With GGrid3
        For i = 1 To N
          QQx(i) = Val(.TextMatrix(i, 1))
          Ptot(i) = Val(.TextMatrix(i, 2))
          Eftot(i) = Val(.TextMatrix(i, 3))
          Pst(i) = Val(.TextMatrix(i, 4))
          Efst(i) = Val(.TextMatrix(i, 5))
          Anoise(i) = Val(.TextMatrix(i, 6))
        Next i
    End With
         Rou = Pin / (287 * (273.15 + tin))
         
    For i = 1 To N
       Faim(i) = Format(QQx(i) / (pi * 0.25 * D2 * D2 * U2), "0.000")
       Pstot(i) = Format(Ptot(i) / (Rou * U2 * U2), "0.000")
    Next i
    
    If GGrid3.TextMatrix(1, 4) <> "" Then
        For i = 1 To N
          Psst(i) = Format(Pst(i) / (Rou * U2 * U2), "0.000")
        Next i
    Else
       ssout = Val(InputBox("請輸入蝸殼出口面積,（單位：平方米）,并單擊確定。否則計算機取默認值：出口速度＝30m/s，并單擊取消", "詢問"))
       If ssout = 0 Then
          ssout = QQx(Codenum) / 30
       End If
        Temp0 = (QQx(Codenum) / ssout) * (QQx(Codenum) / ssout)
       For i = 1 To N
        Psst(i) = Format((Ptot(i) - Temp0 * 0.5 * Rou) / (Rou * U2 * U2), "0.000")
        Efst(i) = Format(Eftot(i) * (1 - Temp0 * 0.5 * Rou / Ptot(i)), "0.000")
       Next i
    End If
    If GGrid3.TextMatrix(1, 6) = "" Then
      For i = 1 To N
        Anoise(i) = Format(25 + 10 * Log(QQx(Codenum) * Ptot(i) * Ptot(i)) / Log(10) - 19.8, "0.0")
      Next i
    End If
End Sub
Private Sub Printresult()
Dim i  As Integer
Dim output(1 To 6) As String
  MsgBox "結果輸出為：數據轉換輸出.dat", vbOKOnly, "結果輸出"
  Open App.Path & "\" & "數據轉換輸出.dat" For Output As #2
       Print #2, "模型編號：" & Text1.Text & "："; Text2.Text
       Print #2, Np; Ns; b2; beta2; D2; D1; U2; Zi; Zshort
       Print #2, Text3.Text; Faim(Codenum); Pstot(Codenum); Eftot(Codenum); _
        Psst(Codenum); Efst(Codenum); Anoise(Codenum)
       For i = 1 To N
          output(1) = output(1) & "  " & Faim(i)
          output(2) = output(2) & "  " & Pstot(i)
          output(3) = output(3) & "  " & Format(Eftot(i), ".000")
          output(4) = output(4) & "  " & Format(Psst(i), ".000")
          output(5) = output(5) & "  " & Format(Efst(i), ".000")
          output(6) = output(6) & "  " & Anoise(i)
       Next i
       For i = 1 To 6
        Print #2, LTrim(output(i))
       Next i
     Print #2, "該試驗數據轉換輸出文件：數據轉換輸出.dat 可直接復制到模型級數據文件model.dat的前九行"
     Close #2
End Sub
Private Sub Command5_Click()
Dim blnOpen As Boolean, strF As String, intN As Integer
blnOpen = SelectDateFile(CommonDialog1, strF)
ReDim Faim(1 To N), Pstot(1 To N), Pd(1 To N), Psst(1 To N)
Call Calculate
End Sub
Function SelectDateFile(dlgC As CommonDialog, strF As String) As Boolean
      Dim intN As Integer
      Dim strText As String
      On Error GoTo 100
      dlgC.Filter = "所有文件|*.*|*.DAT"
      dlgC.FilterIndex = 2
      dlgC.DefaultExt = "DAT"
      dlgC.Flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist Or cdlOFNNoReadOnlyReturn
      dlgC.DialogTitle = "選擇數據輸入文件"
      dlgC.CancelError = True
      dlgC.ShowOpen
      strF = dlgC.FileName
      intN = FreeFile()
      Open strF For Input As #intN
      Line Input #intN, strText
      Input #intN, Np, Ns, b2, beta2, D2, D1, U2, Zi, Zshort
      Line Input #intN, strText
      Input #intN, N, Pin, tin, Codenum
      Close #intN
      ReDim Last3(1 To N, 1 To 7), QQx(1 To N), Ptot(1 To N), Eftot(1 To N), Pst(1 To N), Efst(1 To N), Anoise(1 To N)
      Open strF For Input As #intN
      Line Input #intN, strText
      Line Input #intN, strText
      Line Input #intN, strText
      Line Input #intN, strText
      Line Input #intN, strText
      For i = 1 To N
           For j = 1 To 7
           Input #1, Last2(i, j)
        Next j
    Next i
     For i = 1 To N
          For j = 1 To 6
           GGrid3.TextMatrix(i, j) = Last2(i, j)
            If GGrid3.TextMatrix(i, j) = 0 Then
              GGrid3.TextMatrix(i, j) = ""
            End If
          Next j
         Next i
     Close #intN
    b2 = b2 * 0.001
    D2 = D2 * 0.001
    D1 = D1 * 0.001
    GGrid1.TextMatrix(2, 1) = Np
    GGrid1.TextMatrix(2, 2) = Ns
    GGrid1.TextMatrix(2, 3) = b2 * 1000
    GGrid1.TextMatrix(2, 4) = beta2
    GGrid1.TextMatrix(2, 5) = D2 * 1000
    GGrid1.TextMatrix(2, 6) = D1 * 1000
    GGrid1.TextMatrix(2, 7) = U2
    GGrid1.TextMatrix(2, 8) = Zi
    GGrid1.TextMatrix(2, 9) = Zshort
    Text3.Text = N
    Text4.Text = Pin
    Text5.Text = tin
    Codenum = Val(Text6.Text)
'    With GGrid3
'      For i = 1 To N
'          QQx(i) = Val(.TextMatrix(i, 1))
'          Ptot(i) = Val(.TextMatrix(i, 2))
'          Eftot(i) = Val(.TextMatrix(i, 3))
'          Pst(i) = Val(.TextMatrix(i, 4))
'          Efst(i) = Val(.TextMatrix(i, 5))
'          Anoise(i) = Val(.TextMatrix(i, 6))
'      Next i
'    End With
100:
    Exit Function
End Function