?? plotgra.bas
字號:
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 + -