?? 曲線f2.frm
字號:
dblDatMax(intI) = -100000
For intJ = 1 To intCol
If dblData(intI, intJ) < dblDatMin(intI) Then _
dblDatMin(intI) = dblData(intI, intJ)
If dblData(intI, intJ) > dblDatMax(intI) Then _
dblDatMax(intI) = dblData(intI, intJ)
Next intJ
If dblDatMax(intI) - dblDatMin(intI) <= 0.0001 Then
MsgBox "數據的極大值和極小值太接近，請檢查數據或另編程序"
Unload Me
End
End If
Next intI
'變換數據值為坐標值
For intI = 1 To intRow
dblMaxMin = dblDatMax(intI) - dblDatMin(intI)
sngYInc = sngCH / dblMaxMin
For intJ = 1 To intCol
sngData(intI, intJ) = sngCH - sngYInc * _
(dblData(intI, intJ) - dblDatMin(intI))
Next intJ
Next intI
intS = 1 '寫刻度標識
End Sub
'改變圖形為原大的一半
Private Sub cmdLittle_Click()
intS1 = 34: intS2 = 24
Me.Scale (0, 0)-(intS1, intS2) '窗體的自定義坐標系
'為了給曲線騰出位置，將所有命令按鈕下移
cmdDraw.Top = 20
cmdPrint.Top = 20
cmdExit.Top = 20
cmdLittle.Top = 20
lblTitle.Top = 20
cmdDraw.Visible = True
intS = 0 '不寫刻度標識
Me.Cls
End Sub
'可以拖動圖題
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Source.Move X, Y
End Sub
'窗體作圖
Private Sub cmdDraw_Click()
On Error Resume Next
'繪曲線
For intI = 1 To intRow
Me.CurrentX = 0.1
Me.CurrentY = (intI - 1) * (sngCH + 0.5) + sngCH / 2 + 1.1
Me.Print strRowLabel(intI) '寫行標
'PSet繪起始點，起始點的X坐標是 1.5
Me.PSet (1.5, sngData(intI, 1) + (intI - 1) * (sngCH + 0.5) + 1.5)
For intJ = 2 To intCol '繪曲線
Me.Line -(1.5 + sngXInc * (intJ - 1), _
sngData(intI, intJ) + (intI - 1) * (sngCH + 0.5) + 1.5)
Next intJ
Next intI
'繪橫坐標軸
If intRow > 9 Then GoTo PP '超過9條曲線不繪X、Y軸
For intI = 1 To intRow
'PSet繪起始點，起始點的X坐標是 1.5
Me.PSet (1.5, intI * (sngCH + 0.5) + 1)
For intJ = 2 To intCol
'繪曲線
Me.Line -(1.5 + sngXInc * (intJ - 1), intI * (sngCH + 0.5) + 1)
'繪刻度線
Me.Line -(1.5 + sngXInc * (intJ - 1), intI * (sngCH + 0.5) + 1.1)
Me.Line -(1.5 + sngXInc * (intJ - 1), intI * (sngCH + 0.5) + 1)
Next intJ
Next intI
'在橫坐標軸刻度上寫列標
For intI = 1 To intRow
If intCol <= 40 Then
For intJ = 1 To intCol
Me.CurrentX = 1.5 + sngXInc * (intJ - 1)
Me.CurrentY = intI * (sngCH + 0.5) + 1.1
Me.Print strColLabel(intJ)
Next intJ
End If
Next intI
'繪縱坐標軸
For intI = 1 To intRow
Me.PSet (1.5, intI * (sngCH + 0.5) + 1)
Me.Line -(1.5, intI * (sngCH + 0.5) + 1 - sngCH)
Next intI
'在縱坐標軸上畫刻度線及寫刻度值
'sngCH是曲線的高度
For intI = 1 To intRow
dblMaxMin = dblDatMax(intI) - dblDatMin(intI)
For intJ = 1 To 4
'sngYScale為刻度的位置
sngYScale(intJ) = intI * (sngCH + 0.5) + 1 - sngCH / 4 * intJ
'intYScale為取整后的刻度值
intYScale(intJ) = dblDatMin(intI) + dblMaxMin / 4 * intJ
Next intJ
'在縱坐標軸上畫刻度線及寫刻度值
For intJ = 1 To 4
Me.PSet (1.5, sngYScale(intJ))
Me.Line -(1.4, sngYScale(intJ))
'只有極差是4的整數倍才都寫刻度值，這樣作是為了確保刻度是整數
If intS = 0 Then GoTo SS '“1/2”的情況下，不再寫縱軸刻度
If (dblMaxMin \ 4) * 4 = dblMaxMin Then
Me.CurrentX = 0.8
Me.CurrentY = sngYScale(intJ) - 0.1
Me.Print intYScale(intJ)
'如果極差是2的整數倍，只寫第2條和第4條刻度的刻度值
ElseIf (intJ = 2 Or intJ = 4) And _
(dblMaxMin \ 2) * 2 = dblMaxMin Then
Me.CurrentX = 0.8
Me.CurrentY = sngYScale(intJ) - 0.1
Me.Print intYScale(intJ)
End If
SS:
Next intJ
Next intI
PP:
cmdPrint.Visible = True
End Sub
'打印機作圖
Private Sub cmdPrint_Click()
'繪曲線
Dim DY As Single
On Error Resume Next
Printer.Scale (0, 0)-(intS1, intS2) '打印機的自定義坐標系
DY = 1 '如果曲線位置不好，可以修改源程序，調整DY值
For intI = 1 To intRow
Printer.CurrentX = 0.1
Printer.CurrentY = (intI - 1) * (sngCH + 0.5) + sngCH / 2 + 1.1 - DY
Printer.Print strRowLabel(intI) '寫行標（某條曲線名稱）
'PSet繪起始點，起始點的X坐標是 1.5
Printer.PSet (1.5, sngData(intI, 1) + (intI - 1) * (sngCH + 0.5) + 1.5 - DY)
For intJ = 2 To intCol '繪曲線
Printer.Line -(1.5 + sngXInc * (intJ - 1), _
sngData(intI, intJ) + (intI - 1) * (sngCH + 0.5) + 1.5 - DY)
Next intJ
Next intI
'繪橫坐標軸
If intRow > 9 Then GoTo PP '超過9條曲線不繪X、Y軸
For intI = 1 To intRow
'PSet繪起始點，起始點的X坐標是 1.5
Printer.PSet (1.5, intI * (sngCH + 0.5) + 1 - DY)
For intJ = 2 To intCol
'繪曲線
Printer.Line -(1.5 + sngXInc * (intJ - 1), intI * (sngCH + 0.5) + 1 - DY)
'繪刻度線
Printer.Line -(1.5 + sngXInc * (intJ - 1), intI * (sngCH + 0.5) + 1.1 - DY)
Printer.Line -(1.5 + sngXInc * (intJ - 1), intI * (sngCH + 0.5) + 1 - DY)
Next intJ
Next intI
'在橫坐標軸刻度上寫列標
For intI = 1 To intRow
If intCol <= 40 Then
For intJ = 1 To intCol
Printer.CurrentX = 1.5 + sngXInc * (intJ - 1)
Printer.CurrentY = intI * (sngCH + 0.5) + 1.1 - DY
Printer.Print strColLabel(intJ)
Next intJ
End If
Next intI
'繪縱坐標軸
For intI = 1 To intRow
Printer.PSet (1.5, intI * (sngCH + 0.5) + 1 - DY)
Printer.Line -(1.5, intI * (sngCH + 0.5) + 1 - sngCH - DY)
Next intI
'在縱坐標軸上畫刻度線及寫刻度值
'sngCH是曲線的高度
For intI = 1 To intRow
dblMaxMin = dblDatMax(intI) - dblDatMin(intI)
For intJ = 1 To 4
'sngYScale為刻度的位置
sngYScale(intJ) = intI * (sngCH + 0.5) + 1 - sngCH / 4 * intJ
'intYScale為取整后的刻度值
intYScale(intJ) = dblDatMin(intI) + dblMaxMin / 4 * intJ
Next intJ
'在縱坐標軸上畫刻度線及寫刻度值
For intJ = 1 To 4
Printer.PSet (1.5, sngYScale(intJ) - DY)
Printer.Line -(1.4, sngYScale(intJ) - DY)
'只有極差是4的整數倍才都寫刻度值，這樣作是為了確?？潭仁钦麛? If intS = 0 Then GoTo SS '縮小圖形時不寫縱軸刻度
If (dblMaxMin \ 4) * 4 = dblMaxMin Then
Printer.CurrentX = 0.8
Printer.CurrentY = sngYScale(intJ) - DY - 0.1
Printer.Print intYScale(intJ)
'如果極差是2的整數倍，只寫第2條和第4條刻度的刻度值
ElseIf (intJ = 2 Or intJ = 4) And _
(dblMaxMin \ 2) * 2 = dblMaxMin Then
Printer.CurrentX = 0.8
Printer.CurrentY = sngYScale(intJ) - DY - 0.1
Printer.Print intYScale(intJ)
End If
SS:
Next intJ
Next intI
PP:
Printer.EndDoc
End Sub
'退出
Private Sub cmdExit_Click()
Unload Me
frmFileName.Visible = True
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -