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