⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 plotgra.bas

📁 用于三次采油技术的经济评价
💻 BAS
📖 第 1 页 / 共 3 页
字号:
   Next i
End Sub

Sub pat(x0, x1, y0, y1, ik, yymax, object1 As Object)
   Static ox(4), oy(4), px(2), py(2), mp(4)
   If ik < 0 Or ik > 7 Then ik = 0
   If ik = 0 Then Exit Sub
   dh = 50
   If ik = 1 Or ik = 7 Then ak = 45#
   If ik = 2 Then ak = -45#
   If ik <= 2 Or ik = 7 Then
    nnnn = 0
    ak = ak * 3.1415926 / 180#
1   dh = dh / Sin(3.1415926 / 2# - ak)
    hstr = -1000000#
    If (y1 - ak * x0) >= hstr Then hstr = y1 - ak * x0
    If (y1 - ak * x1) >= hstr Then hstr = y1 - ak * x1
    If 200 >= hstr Then hstr = 200
    hend = 1000000#
    If (y0 - ak * x1) <= hend Then hend = y0 - ak * x1
    If (y0 - ak * x0) <= hend Then hend = y0 - ak * x0
    If -200 <= hend Then hend = -200
    For hi = hstr To hend Step -dh
     ox(1) = x0
     oy(1) = ak * x0 + hi
     ox(2) = (y1 - hi) / ak
     oy(2) = y1
     ox(3) = x1
     oy(3) = ak * x1 + hi
     ox(4) = (y0 - hi) / ak
     oy(4) = y0
     For k = 1 To 4
      mp(k) = 0#
     Next k
     If (y0 <= oy(1)) And (oy(1) <= y1) And Abs(ox(1) - x0) < 0.01 Then mp(1) = 1
     If (y0 <= oy(3)) And (oy(3) <= y1) And Abs(ox(3) - x1) < 0.01 Then mp(3) = 1
     If (x0 <= ox(2)) And (ox(2) <= x1) And Abs(oy(2) - y1) < 0.01 Then mp(2) = 1
     If (x0 <= ox(4)) And (ox(4) <= x1) And Abs(oy(4) - y0) < 0.01 Then mp(4) = 1
     nn = 0
     For k = 1 To 4
      If Abs(mp(k)) <= 0.000001 Then GoTo 10
      nn = nn + 1
      px(nn) = ox(k)
      py(nn) = oy(k)
10   Next k
     If nn >= 2 Then
      object1.Line (px(1), yymax - py(1))-(px(2), yymax - py(2))
     End If
    Next hi
    If ik = 7 Then
     nnnn = nnnn + 1
     ak = -ak
     If nnnn = 1 Then GoTo 1
    End If
   End If
   If ik = 3 Then
    For xi = x0 + dh To x1 Step dh
     object1.Line (xi, yymax - y0)-(xi, yymax - y1)
    Next xi
   End If
   If ik = 4 Then
    For yi = y1 - dh To y0 Step -dh
     object1.Line (x0, yymax - yi)-(x1, yymax - yi)
    Next yi
   End If
   If ik = 5 Then
    For xi = x0 + dh To x1 Step dh
     object1.Line (xi, yymax - y0)-(xi, yymax - y1)
    Next xi
    For yi = y1 - dh To y0 Step -dh
     object1.Line (x0, yymax - yi)-(x1, yymax - yi)
    Next yi
   End If
   If ik = 6 Then
    dh = 0.02
    For xi = x0 + dh To x1 - dh Step dh
     object1.Line (xi, yymax - y0)-(xi, yymax - y1)
    Next xi
   End If
End Sub

Sub PLOT(x1, x2, a1, a2, DA1)
   Rem GET VAXIS
   If x1 = 0 Then a1 = 0: Call LK(x2, a2, FB)
   If x2 = 0 Then a2 = 0: Call LK(x1, a1, FB)
   If Sgn(x1) = Sgn(x2) Then
    If (x2 / x1) ^ Sgn(x1) >= 10 Then
     If Sgn(x1) = 1 Then a1 = 0: Call LK(x2, a2, FB) Else a2 = 0: Call LK(x1, a1, FB)
    Else
     If Sgn(x1) = 1 Then
      Call LK(x2, a2, FB): Call TP(x2, x1, FB, a1)
      If a1 = -9999 Then a1 = a2 - FB / 2
     Else
      Call LK(x1, a1, FB): Call TP(x1, x2, FB, a2)
      If a2 = -9999 Then a2 = a1 + FB / 2
     End If
    End If
   Else
    If Abs(x2) = Abs(x1) Then Call LK(x1, a1, FB): Call LK(x2, a2, FB)
    If Abs(x2) > Abs(x1) Then
     Call LK(x2, a2, FB): Call TP(x2, x1, FB, a1)
     If a1 = -9999 Then a1 = Sgn(x1) * Abs(a2) Else a1 = Sgn(x1) * (Sgn(x1) * a1 + FB / 2)
    Else
     Call LK(x1, a1, FB): Call TP(x1, x2, FB, a2)
     If a2 = -9999 Then a2 = Sgn(x2) * Abs(a1) Else a2 = Sgn(x2) * (Sgn(x2) * a2 + FB / 2)
    End If
   End If
   zs = a2 - a1: fzs = 10 ^ Int(Log(zs) / Log(10))
   If Abs(Int(Abs(a1) / fzs * 10) - Abs(a1) / fzs * 10) > 0.0001 Then a1 = Sgn(a1) * Int(Abs(a1) / fzs * 10 + 1) / 10 * fzs
   If Abs(Int(Abs(a2) / fzs * 10) - Abs(a2) / fzs * 10) > 0.0001 Then a2 = Sgn(a2) * Int(Abs(a2) / fzs * 10 + 1) / 10 * fzs
   zs = a2 - a1: fzs = 10 ^ Int(Log(zs) / Log(10))
   choosep = 100000#
   For i = 1 To 10
    midval = zs / (fzs * i / 10)
    If Abs(Int(midval + 0.0001) - midval) < 0.0001 And Abs(midval - 5) <= choosep Then choosep = Abs(midval - 5): choosei = i
   Next i
   DA1 = fzs * choosei / 10
End Sub

Sub plotg_main(object1 As Object)
   Rem 绘制多条X-Y曲线
   Rem 以"grdata.mid"文件输入数据,格式:
   Rem Y坐标轴总数(yaxis_num){Enter}
   Rem X1坐标(px1)、Y1坐标(py1)、X2坐标(px2)、Y2坐标(py2)、标题(title_name$){Enter}
   Rem X坐标:类型(xaxis_type)、最小值(xaxis_min)、最大值(xaxis_max)、分隔数值(xaxis_interval)、可视性(xaxis_visible)、字体形式(xaxis_format$){Enter}
   Rem 顶右边界可视性(TRborder_visible)、两Y轴之间距(twoyaxis_interval)、X坐标名称(xaxis_name$){Enter}
   Rem 字体大小:标题(title_fontsize)、坐标轴(axis_fontsize)、轴标注(axisname_fontsize)、曲线标注(grnote_fontsize){Enter}
   Rem [
   Rem   曲线条数(yaxis_grnum)、Y坐标名称(yaxis_name$){Enter}
   Rem   Y坐标:类型(yaxis_type)、最小值(yaxis_min)、最大值(yaxis_max)、分隔数值(yaxis_interval)、字体形式(yaxis_format$){Enter}
   Rem   [
   Rem     曲线:点数(grpoint)、类型(gr_type)、标注可视性(grnote_visible)、名称(grnote_name$){Enter}
   Rem     线条属性(Lstyle)、线条宽度(Lwidth)、线条颜色(Lcolor)、点属性(Pstyle)、点宽度(Pwidth)、点颜色(Pcolor){Enter}
   Rem     [
   Rem       X点数值(grdatx),Y点数值(grdaty){Enter}......]]]
   Rem
   Rem  xaxis_type:1(数值型)、2(字符型);yaxis_type:1(直角)、2(对数);
   Rem  xaxis_visible、TRborder_visible:-1(可视)、0(不可视)
   Rem  gr_type:1(常规)、2(直方图)、3(水平线)
   Static yaxis_wid() As Single
   ReDim X(250), Y(250)
   ReDim yaxis_wid(yaxis_num)
    
   If Abs(xaxis_min - xaxis_max) < 0.0001 Or Abs(xaxis_interval) < 0.0001 Then
    grnum = 0
    xmax = -1000000000#: xmin = 1000000000#
    For i = 1 To yaxis_num
     For j = 1 To yaxis_grnum(i)
      grnum = grnum + 1
      For k = 1 To grpoint(grnum)
       If grdatx(grnum, k) >= xmax Then xmax = grdatx(grnum, k)
       If grdatx(grnum, k) <= xmin Then xmin = grdatx(grnum, k)
      Next k
     Next j
    Next i
    If xmax < -100000000# Then xmin = 0#: xmax = 1#
    If Abs(xmax - xmin) <= 0.0001 Then
     If Abs(xmax) < 0.001 Then xmin = 0#: xmax = 1# Else xmin = 0#: xmax = 2 * xmax
    End If
    Call PLOT(xmin, xmax, xaxis_min, xaxis_max, xaxis_interval)
   End If
   
   grnum = 0
   For i = 1 To yaxis_num
    If Abs(yaxis_min(i) - yaxis_max(i)) < 0.0001 Or Abs(yaxis_interval(i)) < 0.0001 Then
     ymax = -1000000000#: ymin = 1000000000#
     For j = 1 To yaxis_grnum(i)
      grnum = grnum + 1
      For k = 1 To grpoint(grnum)
       If Abs(grdaty(grnum, k) + 999) > 0.0001 Then
        If grdaty(grnum, k) >= ymax Then ymax = grdaty(grnum, k)
        If grdaty(grnum, k) <= ymin Then ymin = grdaty(grnum, k)
       End If
      Next k
     Next j
     If ymax < -100000000# Then
      If yaxis_type(i) = 1 Then ymin = 0#: ymax = 1# Else ymin = 1#: ymax = 100#
     End If
     If Abs(ymax - ymin) <= 0.0001 Then
      If yaxis_type(i) = 1 Then
       If Abs(ymax) < 0.001 Then ymin = 0#: ymax = 1# Else ymin = 0#: ymax = 2 * ymax
      Else
       If Abs(ymax) < 0.001 Then ymin = 1#: ymax = 100# Else ymin = 10 ^ (Int(Log(ymax) / Log(10)) - 1): ymax = 2 * ymax
      End If
     End If
     If yaxis_type(i) = 1 Then
      Call PLOT(ymin, ymax, yaxis_min(i), yaxis_max(i), yaxis_interval(i))
     Else
      yaxis_min(i) = Int(Log(ymin) / Log(10))
      yaxis_max(i) = Int(Log(ymax) / Log(10)) + 1
      yaxis_interval(i) = 1
     End If
    Else
     grnum = grnum + yaxis_grnum(i)
    End If
   Next i
   
   object1.FontName = "Arial": object1.FontSize = axis_fontsize * formbl_x
   axis_len = 0: axis_height = object1.TextHeight(Trim$(Format$(xaxis_max, xaxis_format$)))
   For i = 1 To yaxis_num
    If yaxis_type(i) = 1 Then
     yaxis_wid(i) = object1.TextWidth(Trim$(Format$(yaxis_max(i), yaxis_format$(i))))
    Else
     yaxis_wid(i) = object1.TextWidth(Trim$(Format$(10 ^ yaxis_max(i), yaxis_format$(i))))
    End If
    If yaxis_wid(i) > axis_len Then axis_len = yaxis_wid(i)
   Next i
   
   object1.FontName = "楷体_GB2312": object1.FontSize = axisname_fontsize * formbl_x
   axisname_len = 0: axisname_height = object1.TextHeight(Trim$(xaxis_name$))
   For i = 1 To yaxis_num
    For j = 1 To 3
     midval = object1.TextWidth(Trim$(yaxis_name$(i, j)))
     If midval > axisname_len Then axisname_len = midval
    Next j
   Next i
   
   object1.FontName = "宋体": object1.FontSize = title_fontsize * formbl_x
   title_height = object1.TextHeight(title_name$)
   
   If Abs(twoyaxis_interval) < 0.0001 Then twoyaxis_interval = axisname_len + axis_len + 150
   
   If Abs(px2 - px1) < 0.0001 Or Abs(py2 - py1) < 0.0001 Then
    If yaxis_num >= 2 Then px1 = twoyaxis_interval * (yaxis_num - 1) + 50 Else px1 = twoyaxis_interval * yaxis_num + 50
    If yaxis_num >= 2 Then px2 = object1.ScaleWidth - twoyaxis_interval - 200 Else px2 = object1.ScaleWidth - 200
    py1 = title_height + 300
    py2 = object1.ScaleHeight - axis_height - axisname_height - 300
   End If
   
   Call drawg(object1)
   Call drawb(object1)
   
   object1.FontName = "宋体": object1.FontSize = title_fontsize * formbl_x
   If yaxis_num > 2 Then xlen = (px2 - px1) + (yaxis_num - 2) * twoyaxis_interval Else xlen = px2 - px1
   write_titlex = px1 - (xlen - (px2 - px1)) + (xlen - object1.TextWidth(title_name$)) / 2#
   write_titley = py1 - object1.TextHeight(title_name$) - 150
   object1.ForeColor = QBColor(0)
   object1.CurrentX = write_titlex: object1.CurrentY = write_titley
   object1.Print title_name$
   
   object1.FontName = "Arial": object1.FontSize = axisname_fontsize * formbl_x
   If xaxis_visible = -1 Then
    object1.CurrentX = px2 - object1.TextWidth(Trim$(xaxis_name$)) - 150: object1.CurrentY = py2 + axis_height + Int((py2 - py1) / 48#) + 80
    object1.Print xaxis_name$
   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#)
    beginx = startx - bbz * twoyaxis_interval + bbz * BIG_LINEY
    draw_wid = twoyaxis_interval - yaxis_wid(i) - (bbz + 1) / 2 * BIG_LINEY
    For j = 1 To 3
     If InStr(yaxis_name$(i, j), "(") <> 0 Then bbm = 100 Else bbm = 40
     object1.CurrentY = py1 + axis_height + (j - 1) * object1.TextHeight(yaxis_name$(i, j - 1)) + bbm
     object1.CurrentX = beginx + bbz * (draw_wid - object1.TextWidth(yaxis_name$(i, j))) / 2# + (bbz - 1) / 2 * object1.TextWidth(yaxis_name$(i, j))
     object1.Print yaxis_name$(i, j)
    Next j
   Next i
   
   Erase X, Y
End Sub

Sub plotg_tjzf(object1 As Object)
   Static fx(), xtix1(), xtic2() As Single
   Static tx() As String

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -