form1.frm

对于压缩机产业中经常需要的试验数据转换

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