?? plotgra.bas
字號:
ReDim fx(100), xtic1(100), xtic2(100)
Static ltg As String
ReDim tx(100)
xs = object1.ScaleWidth * 0.15 / 2 + object1.TextWidth("100") * 0.8
ys = object1.ScaleHeight * 0.25 / 2 - object1.TextHeight("100") * 0.8
'xe = object1.ScaleWidth * (1 - .15 / 2) + object1.TextWidth("100") * .8
ye = object1.ScaleHeight * (1 - 0.25 / 2) - object1.TextHeight("100") * 0.8
ltg = "y"
ltype = 2
Open "zfdata.mid" For Input As #4
Input #4, nn
nn = 6
For i = 1 To nn
Input #4, tx(i), fx(i)
Next i
Close #4
NY = 8
xcq = object1.ScaleWidth / 40 '200
ycq = object1.ScaleHeight / 40 '200
yd = (ye - ys) / NY '200#
'xx = (object1.ScaleWidth * .8 - xcq * (nn + 1) * 1.05) / nn: xd = xx / 3
xx = object1.ScaleWidth * 0.8 / ((nn + 1) / 3 + nn): xd = xx / 3
'xd = 400#: xx = 1000#
zfcolor = 12: yymax = ye + ycq + yd + 100
For i = 1 To nn
xtic1(i) = xs + xd + (i - 1) * (xx + xd)
xtic2(i) = xs + i * (xx + xd)
Next i
fx(nn + 1) = 0#
Call maxmin(fx(), nn + 1, fxmax, fxmin)
Call bhx(fx(), ys, ye, nn + 1)
If UCase$(ltg) = "Y" Then
object1.Line (xs, yymax - ys)-(xtic2(nn) + xd, yymax - ys), QBColor(0)
object1.Line -(xtic2(nn) + xd + xcq, yymax - (ys + ycq)), QBColor(0)
object1.Line -(xtic2(nn) + xd + xcq, yymax - (ye + yd + ycq)), QBColor(8)
object1.Line -(xs + xcq, yymax - (ye + yd + ycq)), QBColor(8)
object1.Line -(xs + xcq, yymax - (ys + ycq)), QBColor(8)
object1.Line -(xs, yymax - ys), QBColor(8)
object1.Line -(xs, yymax - (ye + yd)), QBColor(0)
object1.Line -(xs + xcq, yymax - (ye + yd + ycq)), QBColor(8)
Else
object1.Line (xs, yymax - ys)-(xtic2(nn) + xd, yymax - ys)
object1.Line -(xtic2(nn) + xd, yymax - ys)
object1.Line -(xtic2(nn) + xd, yymax - (ye + yd))
object1.Line -(xs, yymax - (ye + yd))
object1.Line -(xs, yymax - ys)
End If
dyt = fxmax / NY
dyy = (ye - ys) / NY
For i = 1 To NY + 1
YT = (i - 1) * dyt
yy = ys + (i - 1) * dyy
If i > 1 Then
If UCase$(ltg) = "Y" Then
yyycq = yy + ycq
object1.PSet (xs + xcq, yymax - yyycq), QBColor(0)
xt2 = xtic1(1)
If yy < fx(1) And yy > fx(1) - ycq Then
xt2 = xt2 + (yyycq - fx(1)) * xcq / ycq
End If
object1.Line -(xt2, yymax - yyycq), QBColor(0)
For k = 1 To nn
If yy < fx(k) Then
object1.PSet (xtic2(k) + xcq, yymax - yyycq), QBColor(0)
Else
object1.Line -(xtic2(k) + xcq, yymax - yyycq), QBColor(0)
End If
xt2 = xtic2(k) + xd
If yy < fx(k + 1) And yy > fx(k + 1) - ycq Then
xt2 = xt2 + (yyycq - fx(k + 1)) * xcq / ycq
End If
object1.Line -(xt2, yymax - yyycq), QBColor(0)
Next k
object1.Line -(xtic2(nn) + xd + xcq, yymax - yyycq), QBColor(0)
object1.Line (xs + xcq, yymax - yyycq)-(xs, yymax - yy), QBColor(0)
Else
object1.Line (xs, yymax - yy)-(xtic1(1), yymax - yy)
For k = 1 To nn
If yy < fx(k) Then
object1.PSet (xtic2(k), yymax - yy)
Else
object1.Line -(xtic2(k), yymax - yy)
End If
object1.Line -(xtic2(k) + xd, yymax - yy)
Next k
object1.Line -(xtic2(nn) + xd, yymax - yy)
End If
End If
object1.Line (xs, yymax - yy)-(xs + 100, yymax - yy), QBColor(0)
If Abs(YT) > 0.00001 Then
Bit = Int(Log(Abs(YT)) / Log(10))
YT = Int(YT / 10 ^ Bit * 100) / 100 * 10 ^ Bit
End If
printtext$ = Str$(YT)
object1.CurrentX = xs - object1.TextWidth(printtext$) * 1.1
object1.CurrentY = yymax - (yy + object1.TextHeight(printtext$) * 0.5)
object1.Print Str$(YT)
Next i
'繪制柱體
For i = 1 To nn
Call pat(xtic1(i), xtic2(i), ys, fx(i), ltype, yymax, object1)
If UCase$(ltg) = "Y" Then
object1.Line (xtic1(i), yymax - fx(i))-(xtic1(i) + xcq, yymax - (fx(i) + ycq)), QBColor(zfcolor)
object1.Line -(xtic2(i) + xcq, yymax - (fx(i) + ycq)), QBColor(zfcolor)
object1.Line -(xtic2(i), yymax - fx(i)), QBColor(zfcolor)
object1.Line (xtic2(i) + xcq, yymax - (fx(i) + ycq))-(xtic2(i) + xcq, yymax - (ys + ycq)), QBColor(zfcolor)
object1.Line -(xtic2(i), yymax - ys), QBColor(zfcolor)
End If
object1.Line (xtic1(i), yymax - ys)-(xtic1(i), yymax - fx(i)), QBColor(zfcolor)
object1.Line -(xtic2(i), yymax - fx(i)), QBColor(zfcolor)
object1.Line -(xtic2(i), yymax - ys), QBColor(zfcolor)
Next i
'繪制Y方向第一條內線
If UCase$(ltg) = "Y" Then
object1.PSet (xs + xcq, yymax - (ys + ycq)), QBColor(8)
For i = 1 To nn
xt1 = xtic1(i)
If fx(i) < ys + ycq Then xt1 = (ys + ycq - fx(i)) * xcq / ycq + xtic1(i)
object1.Line -(xt1, yymax - (ys + ycq)), QBColor(8)
object1.PSet (xtic2(i) + xcq, yymax - (ys + ycq)), QBColor(8)
Next i
object1.Line -(xtic2(nn) + xd + xcq, yymax - (ys + ycq)), QBColor(8)
End If
For i = 1 To nn
object1.CurrentX = xtic1(i) + xx / 2# - object1.TextWidth(tx(i))
object1.CurrentY = yymax - (ys - object1.TextHeight(tx(i)) * 0.5)
object1.Print tx(i)
Next i
End Sub
Sub post(x0, y0, hl, corp, ik, object1 As Object)
Rem 標寫圖形符號
Rem hl ---- 以坐標點為中心的圖符高度;
Rem ik ---- 控制繪制圖符的類型:
Rem -1:無
Rem 0:空心園; 1:實心園; 2:空心矩形; 3:實心矩形; 4:十字符號; 5:米形符號;
Rem 6:空心三角形; 7:實心三角形; 8:空心四角星; 9:實心四角星; 10:空心五角星;11:實心五角星;
Rem 12:空心六角星;13:實心六角星;14:空心七角星; 15:實心七角星;16:空心八角星;17:實心八角星.
Static xxq(), yyq() As Single
ReDim xxq(200), yyq(200)
h = 0.5 * hl
If ik < 0 Or ik > 17 Then Exit Sub
Select Case ik
Case 0:
object1.FillStyle = 0
object1.FillColor = objBackColor
object1.Circle (x0, y0), h, corp
object1.FillStyle = 1
Case 1:
object1.FillStyle = 0
object1.FillColor = corp
object1.Circle (x0, y0), h, corp
object1.FillStyle = 1
Case 2:
object1.FillStyle = 0
object1.FillColor = objBackColor
object1.Line (x0 - h, y0 - h)-(x0 + h, y0 + h), corp, B
object1.FillStyle = 1
Case 3:
object1.Line (x0 - h, y0 - h)-(x0 + h, y0 + h), corp, BF
Case 4, 5:
object1.Line (x0 - h, y0)-(x0 + h, y0), corp
object1.Line (x0, y0 - h)-(x0, y0 + h), corp
If ik = 5 Then
object1.Line (x0 + 0.707 * h, y0 - 0.707 * h)-(x0 - 0.707 * h, y0 + 0.707 * h), corp
object1.Line (x0 - 0.707 * h, y0 - 0.707 * h)-(x0 + 0.707 * h, y0 + 0.707 * h), corp
End If
Case 6, 7:
aj = 210# / 180# * 3.1416: aj1 = 330# / 180# * 3.1416
object1.Line (x0, y0 + h)-(x0 + h * Cos(aj), y0 + h * Sin(aj)), corp
object1.Line -(x0 + h * Cos(aj1), y0 + h * Sin(aj1)), corp
object1.Line -(x0, y0 + h), corp
If ik = 7 Then
If h > 2 Then
For ah = h To 2 Step -2
object1.Line (x0, y0 + ah)-(x0 + ah * Cos(aj), y0 + ah * Sin(aj)), corp
object1.Line -(x0 + ah * Cos(aj1), y0 + ah * Sin(aj1)), corp
object1.Line -(x0, y0 + ah), corp
Next ah
End If
End If
Case Is >= 8
jiaos = Int((ik + 0.5) / 2#)
sc = 0.4
djiao = 2# * 3.1416 / jiaos
astart = 0.5 * 3.1416
aend = 2.5 * 3.1416 + 0.1
n = 0
For ai = astart To aend Step djiao
n = n + 1
xxq(2 * n - 1) = x0 + h * Cos(ai): yyq(2 * n - 1) = y0 + h * Sin(ai)
xxq(2 * n) = x0 + sc * h * Cos(ai + 0.5 * djiao): yyq(2 * n) = y0 + sc * h * Sin(ai + 0.5 * djiao)
Next ai
object1.PSet (xxq(1), yyq(1)), corp
For i = 2 To 2 * n
object1.Line -(xxq(i), yyq(i)), corp
Next i
If ik Mod 2 <> 0 Then
If h > 2 Then
For ah = h To 2 Step -2
n = 0
For ai = astart To aend Step djiao
n = n + 1
xxq(2 * n - 1) = x0 + ah * Cos(ai): yyq(2 * n - 1) = y0 + ah * Sin(ai)
xxq(2 * n) = x0 + sc * ah * Cos(ai + 0.5 * djiao): yyq(2 * n) = y0 + sc * ah * Sin(ai + 0.5 * djiao)
Next ai
object1.PSet (xxq(1), yyq(1)), corp
For i = 2 To 2 * n
object1.Line -(xxq(i), yyq(i)), corp
Next i
Next ah
End If
End If
End Select
Erase xxq, yyq
End Sub
Sub TP(F1, F2, FB, PP)
For i = 0 To Abs(F1) * 2 / FB + 0.5
If Abs(F2) < i * FB / 2 Then PP = Sgn(F2) * (i - 1) * FB / 2: Exit Sub
Next i
PP = -9999
End Sub
Sub trigle1(x1, y1, x2, y2, cor1, cor2, object1 As Object)
For i = y1 To y2
object1.Line (x1 + 1, i)-(x2, y2), cor2
Next
object1.Line (x1 + 1, y1)-(x2, y2), cor1
End Sub
Sub trigle2(x1, y1, x2, y2, cor1, cor2, object1 As Object)
For i = x1 To x2
object1.Line (i, y1 + 2)-(x2, y2), cor2
Next
object1.Line (x1, y1 + 2)-(x2, y2), cor1
End Sub
Public Sub init_data()
Lcolor(1) = &HFF&: Lcolor(2) = &HFF0000: Lcolor(3) = &HC000&
Lcolor(4) = &H800080: Lcolor(5) = &H808000: Lcolor(6) = &HC0&
Lcolor(7) = &H8080&: Lcolor(8) = &H800000
For i = 1 To grnum_max
gr_type(i) = 1: Pstyle(i) = i - 1
Lstyle(i) = 0: Lwidth(i) = 1
Pwidth(i) = 40: Pcolor(i) = Lcolor(i)
grnote_visible(i) = -1: grnote_LR(i) = -1
Next i
px1 = 0#: py1 = 0#: px2 = 0#: py2 = 0#
xaxis_type = 1: xaxis_visible = -1
xaxis_min = 0#: xaxis_max = 0#: xaxis_interval = 0#: twoyaxis_interval = 0#
TRborder_visible = -1
title_fontsize = 14: axis_fontsize = 6.5: axisname_fontsize = 9: grnote_fontsize = 8
For i = 1 To yaxis_num 'y軸數量
yaxis_type(i) = 1: yaxis_min(i) = 0#
yaxis_max(i) = 0#: yaxis_interval(i) = 0#
Next i
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -