?? libfigmoredates.bas
字號:
Attribute VB_Name = "LibFigMoreDates"
Option Explicit
Rem 懸點實測示功圖與泵轉化示功圖
Sub Fig_DynyMoreDates(jcal As Integer, Pr() As Single, prl() As Single, XPump() As Single, llpump() As Single)
Dim Xzb As Integer, Yzb As Integer
Dim spr As Single, Pmax As Single
Dim i As Integer, j As Integer
Dim i_ As Double
spr = 0
Pmax = 0
For j = 0 To jcal
If Pr(j) > spr Then spr = Pr(j)
If prl(j) > Pmax Then Pmax = prl(j)
Next j
Xzb = Int(spr + 1)
Yzb = Int(Pmax / 10000) + 1
Yzb = Yzb * 10
If Pmax <= 1 Then
Yzb = 1
Xzb = 1
End If
MoreDatesSimulator.PictRodPump.ForeColor = vbBlue
MoreDatesSimulator.PictRodPump.Cls
If Pmax <= 1 Then
MoreDatesSimulator.PictRodPump.Scale (-0.2 * Xzb, Yzb)-(Xzb, 0)
MoreDatesSimulator.PictRodPump.Line (-0.2 * Xzb, (1 - 0.002) * Yzb)-(1.2 * Xzb, 0.002), , BF
For i = 1 To 4
MoreDatesSimulator.PictRodPump.Line (0.25 * i, 0)-(0.25 * i, 0.03 * Yzb)
Next i
For i = 1 To 4
MoreDatesSimulator.PictRodPump.Line (0, i * Yzb / 4)-(0.02, i * Yzb / 4): DoEvents
Next i
MoreDatesSimulator.PictRodPump.CurrentX = 0.6 * Xzb
MoreDatesSimulator.PictRodPump.CurrentY = -0.08 * Yzb * 1000
MoreDatesSimulator.PictRodPump.Print "光桿位移(m)"
MoreDatesSimulator.PictRodPump.CurrentY = 0.95 * Yzb * 1000
MoreDatesSimulator.PictRodPump.CurrentX = -0.15 * Xzb
MoreDatesSimulator.PictRodPump.Print "載" & vbCrLf
MoreDatesSimulator.PictRodPump.CurrentX = -0.15 * Xzb
MoreDatesSimulator.PictRodPump.Print "荷"
MoreDatesSimulator.PictRodPump.CurrentX = -0.18 * Xzb
MoreDatesSimulator.PictRodPump.Print "(kN)"
Else
MoreDatesSimulator.PictRodPump.Scale (-0.2 * Xzb, 1.2 * Yzb * 1000#)-(1.2 * Xzb, -1.2 * Yzb * 1000# / 4)
MoreDatesSimulator.PictRodPump.Line (-0.2 * Xzb, 1.2 * Yzb * 1000#)-((1 - 0.002) * 1.2 * Xzb, -(1 - 0.02) * 1.2 * Yzb * 1000# / 4), vbWhite, BF
MoreDatesSimulator.PictRodPump.CurrentX = 0.6 * Xzb
MoreDatesSimulator.PictRodPump.CurrentY = -0.08 * Yzb * 1000
MoreDatesSimulator.PictRodPump.Print "光桿位移(m)"
MoreDatesSimulator.PictRodPump.CurrentY = 0.95 * Yzb * 1000
MoreDatesSimulator.PictRodPump.CurrentX = -0.15 * Xzb
MoreDatesSimulator.PictRodPump.Print "載" & vbCrLf
MoreDatesSimulator.PictRodPump.CurrentX = -0.15 * Xzb
MoreDatesSimulator.PictRodPump.Print "荷"
MoreDatesSimulator.PictRodPump.CurrentX = -0.18 * Xzb
MoreDatesSimulator.PictRodPump.Print "(kN)"
'載荷
MoreDatesSimulator.PictRodPump.Line (0, -1.2 * Yzb * 1000# / 4)-(0, 1.15 * Yzb * 1000#)
For i = 0 To 5
MoreDatesSimulator.PictRodPump.Line (0, -Yzb * 1000# / 4 + i * Yzb * 1000# / 4)-(0.08, -Yzb * 1000# / 4 + i * Yzb * 1000# / 4)
If i Mod 2 = 1 Or i = 0 Then
MoreDatesSimulator.PictRodPump.CurrentY = -Yzb * 1000# / 4 + i * Yzb * 1000# / 4 + Yzb * 50
If i = 1 Then
MoreDatesSimulator.PictRodPump.CurrentX = -0.06 * Xzb
MoreDatesSimulator.PictRodPump.Print "0"
Else
If i = 0 Then
MoreDatesSimulator.PictRodPump.CurrentX = -0.14 * Xzb
Else
MoreDatesSimulator.PictRodPump.CurrentX = -0.1 * Xzb
End If
MoreDatesSimulator.PictRodPump.Print Format((i - 1) * Yzb / 4, "##0")
End If
End If
Next i
For i_ = -0.01 * Xzb To 0.015 * Xzb Step 0.0006 * Xzb
MoreDatesSimulator.PictRodPump.Line (i_, 1.02 * Yzb * 1000#)-(0, 1.16 * Yzb * 1000#)
Next
'光桿位移坐標
MoreDatesSimulator.PictRodPump.Line (0, 0)-(1.15 * Xzb, 0)
For i = 0 To 2 * Xzb
MoreDatesSimulator.PictRodPump.Line (0.5 * i, 0)-(0.5 * i, 0.03 * Yzb * 1000#)
If i = 0 Or i = Xzb Or i = 2 * Xzb Then
MoreDatesSimulator.PictRodPump.CurrentY = -0.1 * Yzb * 1000# / 4
If i = 0 Then
MoreDatesSimulator.PictRodPump.CurrentX = 0.5 * i + 0.01 * Xzb
MoreDatesSimulator.PictRodPump.Print "0"
Else
MoreDatesSimulator.PictRodPump.CurrentX = 0.5 * i - 0.06 * Xzb
MoreDatesSimulator.PictRodPump.Print Format(0.5 * i, "## 0.0")
End If
End If
Next i
For i_ = -20 * Yzb To 20 * Yzb Step Yzb
MoreDatesSimulator.PictRodPump.Line (1.05 * Xzb, i_)-(1.15 * Xzb, 0)
DoEvents
Next
End If
MoreDatesSimulator.PictRodPump.DrawWidth = 1
For j = 1 To jcal - 1
MoreDatesSimulator.PictRodPump.Line (XPump(j), llpump(j))-(XPump(j + 1), llpump(j + 1))
Next j
For j = 1 To jcal - 1
MoreDatesSimulator.PictRodPump.Line (Pr(j), prl(j))-(Pr(j + 1), prl(j + 1))
Next j
End Sub
Rem 繪產量、泵效與漏失系數曲線
Sub Fig_Xvatf(Ncal As Integer, QDiagnose() As Single, AlfaDiagnose() As Single, LeakCoef() As Single)
Dim i As Integer
Dim YMax As Single
Rem 產量曲線
YMax = 0
For i = 1 To Ncal
If QDiagnose(i) > YMax Then YMax = QDiagnose(i)
Next i
YMax = (Int(YMax / 10) + 1) * 10
MoreDatesSimulator.Lyzb1(1) = str$(YMax / 2)
MoreDatesSimulator.Lyzb1(2) = str$(YMax)
MoreDatesSimulator.Pict11.Scale (1, YMax)-(Ncal, 0)
MoreDatesSimulator.Pict11.Cls
MoreDatesSimulator.Pict11.ForeColor = vbBlue
MoreDatesSimulator.Pict11.BackColor = vbWhite
MoreDatesSimulator.Pict11.DrawWidth = 1
MoreDatesSimulator.Pict11.Line (0, (1 - 0.001) * YMax)-((1 - 0.002) * Ncal, 0.002 * YMax), , B
For i = 1 To Ncal
MoreDatesSimulator.Pict11.Line (Ncal / (Ncal - 1) * (i - 1), 0)-(Ncal / (Ncal - 1) * (i - 1), 0.03 * YMax)
Next i
For i = 1 To 3
MoreDatesSimulator.Pict11.Line (0, YMax / 4 * i)-(0.005 * Ncal, YMax / 4 * i)
Next i
MoreDatesSimulator.Pict11.DrawWidth = 2
For i = 1 To Ncal - 1
MoreDatesSimulator.Pict11.Line (i, QDiagnose(i))-((i + 1), QDiagnose(i + 1))
Next i
Rem 泵效曲線
YMax = 100
MoreDatesSimulator.Pict12.Scale (1, YMax)-(Ncal, 0)
MoreDatesSimulator.Pict12.Cls
MoreDatesSimulator.Pict12.ForeColor = vbBlue
MoreDatesSimulator.Pict12.BackColor = vbWhite
MoreDatesSimulator.Pict12.DrawWidth = 1
MoreDatesSimulator.Pict12.Line (0, (1 - 0.001) * YMax)-((1 - 0.002) * Ncal, 0.002 * YMax), , B
For i = 1 To Ncal
MoreDatesSimulator.Pict12.Line (Ncal / (Ncal - 1) * (i - 1), 0)-(Ncal / (Ncal - 1) * (i - 1), 0.03 * YMax)
Next i
For i = 1 To 3
MoreDatesSimulator.Pict12.Line (0, YMax / 4 * i)-(0.005 * Ncal, YMax / 4 * i)
Next i
MoreDatesSimulator.Pict12.DrawWidth = 2
MoreDatesSimulator.Pict12.ForeColor = vbBlue
For i = 1 To Ncal - 1
MoreDatesSimulator.Pict12.Line (i, AlfaDiagnose(i))-((i + 1), AlfaDiagnose(i + 1))
Next i
MoreDatesSimulator.Pict12.ForeColor = vbRed
For i = 1 To Ncal - 1
MoreDatesSimulator.Pict12.Line (i, LeakCoef(i))-((i + 1), LeakCoef(i + 1))
Next i
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -