plotgra.bas

用于三次采油技术的经济评价

Attribute VB_Name = "PLOTGRA"
Dim X(), Y() As Single

Sub bbox(bx1, by1, bx2, by2, bx3, by3, object1 As Object)
   object1.Line (bx1, by1)-(bx2, by2), QBColor(8), BF
   object1.Line (bx1 - 10, by1 - 8)-(bx2 - 10, by2 - 8), QBColor(7), BF
   object1.Line (bx2, by2)-(bx2 - 10, by2 - 8), QBColor(0)
   object1.Line (bx1 - 7, by1 - 5)-(bx2 - 13, by2 - 11), QBColor(0), B
   object1.Line (bx1 - 10, by1 - 8)-(bx2 - 10, by2 - 8), QBColor(0), B
   object1.Line (bx1, by2)-(bx2, by2), QBColor(0)
   object1.Line (bx2, by1)-(bx2, by2), QBColor(0)
   object1.Line (bx1 - 5, by1 - 3)-(bx2 - bx3, by1 + by3), QBColor(3), BF
   object1.Line (bx1 - 5, by1 - 3)-(bx2 - bx3, by1 + by3), QBColor(0), B
   x1 = bx2 - 10: y1 = by1 - 8: x2 = bx2: y2 = by1: cor1 = 0: cor2 = QBColor(8)
   Call trigle1(x1, y1, x2, y2, cor1, cor2, object1)
   x1 = bx1 - 10: y1 = by2 - 9: x2 = bx1: y2 = by2: cor1 = 0: cor2 = QBColor(8)
   Call trigle2(x1, y1, x2, y2, cor1, cor2, object1)
End Sub

Sub bhx(X(), x0, x1, n)
   Call maxmin(X(), n, xmax, xmin)
   bx = (x1 - x0) / (xmax - xmin)
   For i = 1 To n
    X(i) = x0 + (X(i) - xmin) * bx
   Next i
End Sub

Sub drawb(object1 As Object)
   object1.FontName = "Arial": object1.FontSize = axis_fontsize * formbl_x
   If TRborder_visible = -1 Then
    object1.Line (px1, py1)-(px2, py1), QBColor(0)
    object1.Line (px2, py1)-(px2, py2), QBColor(0)
   End If
   
   If xaxis_visible = -1 Then
    object1.Line (px1, py2)-(px2, py2), QBColor(0)
    BIG_LINEX = Int((py2 - py1) / 48#): SMALL_LINEX = Int((py2 - py1) / 70#)
    If xaxis_type = 1 Then
     xm1 = (xaxis_max - xaxis_min) / xaxis_interval
     xn1 = Int(xm1): xn2 = 5
     dx = (px2 - px1) / xm1 * xn1: ddx = dx / xn1
     For i = 1 To xn1
      object1.Line (px1 + dx / xn1 * i, py2)-(px1 + dx / xn1 * i, py2 - BIG_LINEX), QBColor(0)
     Next i
     For i = 0 To xn1 - 1
      For j = 1 To xn2 - 1
       object1.Line (px1 + dx / xn1 * i + ddx / xn2 * j, py2)-(px1 + dx / xn1 * i + ddx / xn2 * j, py2 - SMALL_LINEX), QBColor(0)
      Next j
     Next i
     For i = 0 To xn1
      T$ = Format$(xaxis_min + xaxis_interval * i, xaxis_format$)
      object1.CurrentX = Int(px1 + dx / xn1 * i - object1.TextWidth(T$) / 2#)
      object1.CurrentY = py2 + BIG_LINEX
      object1.ForeColor = QBColor(0)
      object1.Print T$
     Next i
    Else
     DXcxn1 = (px2 - px1) / xaxis_max
     For i = 1 To xaxis_max
      object1.Line (px1 + DXcxn1 * i, py2)-(px1 + DXcxn1 * i, py2 - BIG_LINEX), QBColor(0)
     Next i
     startzi = Int((xaxis_max - Int(xaxis_max / Int(xaxis_interval)) * Int(xaxis_interval)) / 2#) + 1
     For i = startzi To xaxis_max Step Int(xaxis_interval)
      T$ = Trim$(grdatx_str$(i))
      object1.CurrentX = Int(px1 + DXcxn1 * (i - 0.5) - object1.TextWidth(T$) / 2#)
      object1.CurrentY = py2 + BIG_LINEX
      object1.ForeColor = QBColor(0)
      object1.Print T$
     Next i
    End If
   End If
   For i = 1 To yaxis_num
    Select Case i
     Case 1: startx = px1: bbz = 1
     Case 2: startx = px2: bbz = -1
     Case Is > 2: startx = px1 - twoyaxis_interval * (i - 2): bbz = 1
    End Select
    BIG_LINEY = bbz * Int((px2 - px1) / 48#): SMALL_LINEY = bbz * Int((px2 - px1) / 70#)
    ym1 = (yaxis_max(i) - yaxis_min(i)) / yaxis_interval(i)
    If yaxis_type(i) = 1 Then yn2 = 5: yn1 = Int(ym1 + 0.5) Else yn2 = 10: yn1 = Int(ym1)
    dy = (py2 - py1) / ym1 * yn1: ddy = dy / yn1
    For j = 1 To yn1
     object1.Line (startx, py2 - dy / yn1 * j)-(startx + BIG_LINEY, py2 - dy / yn1 * j), QBColor(0)
    Next j
    For j = 0 To yn1 - 1
     For k = 1 To yn2 - 1
      If yaxis_type(i) = 1 Then ynmid = k / yn2 Else ynmid = Log(k) / Log(10)
      object1.Line (startx, py2 - dy / yn1 * j - ddy * ynmid)-(startx + SMALL_LINEY, py2 - dy / yn1 * j - ddy * ynmid), QBColor(0)
     Next k
    Next j
    object1.Line (startx, py1)-(startx, py2), QBColor(0)
    object1.Line (startx, py2)-(startx + BIG_LINEY, py2), QBColor(0)
    For j = 0 To yn1
     If yaxis_type(i) = 1 Then ynmid = yaxis_min(i) + yaxis_interval(i) * j Else ynmid = 10 ^ (yaxis_min(i) + yaxis_interval(i) * j)
     T$ = Format$(ynmid, yaxis_format$(i))
     object1.CurrentX = Int(startx - (bbz + 1) / 2 * object1.TextWidth(T$) - (1 + (1 - bbz) / 2) * BIG_LINEY / 2#)
     object1.CurrentY = Int(py2 - dy / yn1 * j - object1.TextHeight(T$) / 2#)
     object1.ForeColor = QBColor(0)
     object1.Print T$
    Next j
    object1.ForeColor = QBColor(0)
   Next i
End Sub

Sub drawg(object1 As Object)
  DXcsdx = (px2 - px1) / (xaxis_max - xaxis_min): dy = py2 - py1
  grnum = 0
  For i = 1 To yaxis_num
   DYcsdy = dy / (yaxis_max(i) - yaxis_min(i))
   For j = 1 To yaxis_grnum(i)
    grnum = grnum + 1
    Select Case gr_type(grnum)
     Case 1:
      object1.DrawStyle = Lstyle(grnum)
      object1.DrawWidth = Lwidth(grnum)
      If grpoint(grnum) > 0 Then
       If Abs(grdaty(grnum, 1) + 999) < 0.0001 Then
        gdraw_bz = 0
       Else
        gdraw_bz = 1
        If xaxis_type = 1 Then AX = px1 + (grdatx(grnum, 1) - xaxis_min) * DXcsdx Else AX = px1 + 0.5 * DXcsdx
        If yaxis_type(i) = 1 Then ynmid = grdaty(grnum, 1) Else ynmid = Log(grdaty(grnum, 1)) / Log(10)
        AY = py2 - (ynmid - yaxis_min(i)) * DYcsdy
        object1.PSet (AX, AY), Lcolor(grnum)
       End If
      End If
      For k = 2 To grpoint(grnum)
       If Abs(grdaty(grnum, k) + 999) < 0.0001 Then
        gdraw_bz = 0
       Else
        If xaxis_type = 1 Then AX = px1 + (grdatx(grnum, k) - xaxis_min) * DXcsdx Else AX = px1 + (k - 0.5) * DXcsdx
        If yaxis_type(i) = 1 Then ynmid = grdaty(grnum, k) Else ynmid = Log(grdaty(grnum, k)) / Log(10)
        AY = py2 - (ynmid - yaxis_min(i)) * DYcsdy
        If gdraw_bz = 1 Then object1.Line -(AX, AY), Lcolor(grnum) Else object1.PSet (AX, AY), Lcolor(grnum)
        gdraw_bz = 1
       End If
      Next k
      object1.DrawStyle = 0
      object1.DrawWidth = 1
      For k = 1 To grpoint(grnum)
       If Abs(grdaty(grnum, k) + 999) > 0.0001 Then
        If xaxis_type = 1 Then AX = px1 + (grdatx(grnum, k) - xaxis_min) * DXcsdx Else AX = px1 + (k - 0.5) * DXcsdx
        If yaxis_type(i) = 1 Then ynmid = grdaty(grnum, k) Else ynmid = Log(grdaty(grnum, k)) / Log(10)
        AY = py2 - (ynmid - yaxis_min(i)) * DYcsdy
        Call post(AX, AY, Pwidth(grnum), Pcolor(grnum), Pstyle(grnum), object1)
       End If
      Next k
     Case 2:
      object1.FillColor = Lcolor(grnum)
      For k = 1 To grpoint(grnum)
       If Abs(grdaty(grnum, k) + 999) > 0.0001 Then
        If k / 2 = Int(k / 2) Then object1.FillStyle = 4 Else object1.FillStyle = 5
        ax1 = px1 + (k - 1) * DXcsdx
        ax2 = px1 + k * DXcsdx
        ay1 = py2
        ay2 = py2 - (grdaty(grnum, k) - yaxis_min(i)) * DYcsdy
        object1.Line (ax1, ay1)-(ax2, ay2), , B
       End If
      Next k
      object1.FillStyle = 1
      object1.FillColor = QBColor(0)
     Case 3:
      object1.DrawStyle = Lstyle(grnum)
      object1.DrawWidth = Lwidth(grnum)
      For k = 1 To grpoint(grnum)
       If Abs(grdaty(grnum, k) + 999) > 0.0001 Then
        ax1 = px1 + (k - 1) * DXcsdx
        ax2 = px1 + k * DXcsdx
        AY = py2 - (grdaty(grnum, k) - yaxis_min(i)) * DYcsdy
        object1.Line (ax1, AY)-(ax2, AY), Lcolor(grnum)
       End If
      Next k
      For k = 2 To grpoint(grnum)
       If Abs(grdaty(grnum, k) + 999) > 0.0001 And Abs(grdaty(grnum, k - 1) + 999) > 0.0001 Then
        AX = px1 + (k - 1) * DXcsdx
        ay1 = py2 - (grdaty(grnum, k - 1) - yaxis_min(i)) * DYcsdy
        ay2 = py2 - (grdaty(grnum, k) - yaxis_min(i)) * DYcsdy
        object1.Line (AX, ay1)-(AX, ay2), Lcolor(grnum)
       End If
      Next k
      object1.DrawStyle = 0
      object1.DrawWidth = 1
    End Select
   
    If grnote_visible(grnum) = -1 Then
     grpoint2 = grpoint(grnum) / 2
     If Int(grpoint2) = grpoint2 Then
      If Abs(grdaty(grnum, grpoint2) + 999) > 0.0001 And Abs(grdaty(grnum, grpoint2 + 1) + 999) > 0.0001 Then
       If xaxis_type = 1 Then
        ax1 = px1 + (grdatx(grnum, grpoint2) - xaxis_min) * DXcsdx
        ax2 = px1 + (grdatx(grnum, grpoint2 + 1) - xaxis_min) * DXcsdx
       Else
        ax1 = px1 + (grpoint2 - 0.5) * DXcsdx
        ax2 = px1 + (grpoint2 + 0.5) * DXcsdx
       End If
       If yaxis_type(i) = 1 Then ynmid = grdaty(grnum, grpoint2) Else ynmid = Log(grdaty(grnum, grpoint2)) / Log(10)
       ay1 = py2 - (ynmid - yaxis_min(i)) * DYcsdy
       If yaxis_type(i) = 1 Then ynmid = grdaty(grnum, grpoint2 + 1) Else ynmid = Log(grdaty(grnum, grpoint2 + 1)) / Log(10)
       ay2 = py2 - (ynmid - yaxis_min(i)) * DYcsdy
       AX = (ax1 + ax2) / 2#: AY = (ay1 + ay2) / 2#
      Else
       For k = grpoint(grnum) To 1 Step -1
        If Abs(grdaty(grnum, k) + 999) > 0.0001 Then
         If xaxis_type = 1 Then AX = px1 + (grdatx(grnum, k) - xaxis_min) * DXcsdx Else AX = px1 + (k - 0.5) * DXcsdx
         If yaxis_type(i) = 1 Then ynmid = grdaty(grnum, k) Else ynmid = Log(grdaty(grnum, k)) / Log(10)
         AY = py2 - (ynmid - yaxis_min(i)) * DYcsdy
         Exit For
        End If
       Next k
      End If
     Else
      If Abs(grdaty(grnum, (grpoint(grnum) + 1) / 2) + 999) > 0.0001 Then
       If xaxis_type = 1 Then
        AX = px1 + (grdatx(grnum, (grpoint(grnum) + 1) / 2) - xaxis_min) * DXcsdx
       Else
        AX = px1 + ((grpoint(grnum) + 1) / 2 - 0.5) * DXcsdx
       End If
       If yaxis_type(i) = 1 Then ynmid = grdaty(grnum, (grpoint(grnum) + 1) / 2) Else ynmid = Log(grdaty(grnum, (grpoint(grnum) + 1) / 2)) / Log(10)
       AY = py2 - (ynmid - yaxis_min(i)) * DYcsdy
      Else
       For k = grpoint(grnum) To 1 Step -1
        If Abs(grdaty(grnum, k) + 999) > 0.0001 Then
         If xaxis_type = 1 Then AX = px1 + (grdatx(grnum, k) - xaxis_min) * DXcsdx Else AX = px1 + (k - 0.5) * DXcsdx
         If yaxis_type(i) = 1 Then ynmid = grdaty(grnum, k) Else ynmid = Log(grdaty(grnum, k)) / Log(10)
         AY = py2 - (ynmid - yaxis_min(i)) * DYcsdy
         Exit For
        End If
       Next k
      End If
     End If
     object1.FontName = "Arial": object1.FontSize = grnote_fontsize * formbl_x
     If gr_type(grnum) = 1 Then
      object1.CurrentX = AX + (grnote_LR(grnum) - 1) / 2 * object1.TextWidth(grnote_name$(grnum)) + grnote_LR(grnum) * 70
      object1.CurrentY = AY - object1.TextHeight(grnote_name$(grnum)) / 2
     Else
      object1.CurrentX = AX - object1.TextWidth(grnote_name$(grnum)) / 2
      object1.CurrentY = AY - object1.TextHeight(grnote_name$(grnum))
     End If
     object1.ForeColor = QBColor(1)
     object1.Print grnote_name$(grnum)
    End If
   Next j
  Next i
  
   'If a$ = "ecom_t1" Then
   ' yz = y2 - (0# - ymin) * DY / sdy
   ' object1.DrawStyle = 2
   ' object1.Picture1.Line (x1, yz)-(x2, yz), QBColor(8)
   ' object1.DrawStyle = 0
   'End If
End Sub

Sub LK(xx, aa, FB)
   Bit = Int(Log(Abs(xx)) / Log(10))
   FB = 10 ^ Bit: m = Abs(xx) / FB
   If m = Int(m) Then
    aa = xx
   Else
    If m * 100 - Int(m) * 100 > 50 Then aa = (Int(m) + 1) * FB Else aa = Int(m) * FB + 10 ^ (Bit - 1) * 5
    If xx < 0 Then aa = -1 * aa
   End If
End Sub

Sub maxmin(A(), n, max, min)
   max = -99999: min = 999999
   For i = 1 To n
    If A(i) >= max Then max = A(i)
    If A(i) <= min Then min = A(i)