Dim px(100) As Single, py(100) As Single '用來存放100個點的橫坐標和縱坐標
Dim minx, maxx, miny, maxy, y '繪圖區域坐標設定
Dim w, h, nw, num, N
Private Sub Form_Load()
Pic.Cls
'畫外側的線
Me.ForeColor = vbRed '畫線默認顏色為紅色
Me.DrawWidth = 3 '線的寬度為3
Me.FontSize = 12 '字體為12號字
Me.FontBold = True '加粗
Me.Line (Pic.Left, Pic.Top + Pic.Height + 30)-(Pic.Left + Pic.Width, Pic.Top + Pic.Height + 30) '畫外側橫線
Me.Line (Pic.Left - 30, Pic.Top)-(Pic.Left - 30, Pic.Top + Pic.Height) '畫外側豎線
'畫刻度
For i = 0 To 4
Me.Line (Pic.Left - 120, Pic.Top + Pic.Height * i / 4)-(Pic.Left, Pic.Top + Pic.Height * i / 4)
Me.Line (Pic.Left + Pic.Width * i / 4, Pic.Top + Pic.Height)-(Pic.Left + Pic.Width * i / 4, Pic.Top + Pic.Height + 120)
Me.CurrentX = Pic.Left - 1000
Me.CurrentY = Pic.Top + (Pic.Height * (4 - i) / 4) + 15
Me.Print Format(i * 100 / 4, "00.00")
'Label2(i).Left = Pic.Left - Label2(i).Width - 150
'Label2(i).Top = Pic.Top + (Pic.Height * (4 - i) / 4) + 15
Label1(i).Left = Pic.Left + (Pic.Width * i / 4) - Label1(i).Width / 2
Label1(i).Top = Pic.Top + Pic.Height + Label1(i).Height + 120
Next
minx = 0
maxx = Pic.Width
miny = 0
maxy = Pic.Height
Init
End Sub
Sub Init()
Dim mW As Integer
Dim mH As Integer
'畫網格
For i = 1 To 12 '畫橫線12跟
mW = Pic.Width * (i / 12)
If i Mod 3 = 0 Then
Pic.DrawStyle = 0 '實線的橫線
Else
Pic.DrawStyle = 4 '否則畫虛線
End If
Pic.Line (mW, 0)-(mW, Pic.Height) '定義完畫線
Next
For i = 1 To 12 '畫豎線12跟
mH = Pic.Height * (i / 12)
If i Mod 3 = 0 Then
Pic.DrawStyle = 0 '畫實線
Else
Pic.DrawStyle = 4 '畫虛線
End If
Pic.Line (0, mH)-(Pic.Width, mH) '定義完畫線
Next
End Sub
Function GetNTime(ByVal mMs As Integer) As String '時間函式
Dim mH, mM, mS As String '定義小時,分鐘,秒為字串型
Dim mA As String '定義當前時間為字串型
Dim mT As Long '定義總共秒數為長數值型
Dim tk '一維陣列變體型別
mA = Format(Now, "hh-mm-ss") '當前時間
tk = Split(mA, "-") '取mA中的小時,分鐘,秒
mH = tk(0) '小時賦給mH
mM = tk(1) '分鐘賦給mM
mS = tk(2) '秒賦給mS
mT = mH * 3600 + (mM + mMs) * 60 + mS '計算當前所有的秒數
GetNTime = Format(mT \ 3600, "00") & ":" & Format(mT \ 60 Mod 60, "00") & ":" & Format(mT Mod 60, "00")
End Function
Private Sub Timer1_Timer()
Dim i
Label1(0).Caption = Format(Now, "hh:mm:ss") '將當前時間給lable1(0)
For i = 1 To 4 '依次把時間賦給之后的lable()
Label1(i).Caption = GetNTime(i * 5)
Next
End Sub
Private Sub Timer2_Timer()
h = maxy - miny '繪圖區域高度
w = maxx - minx '繪圖區域寬度
nw = w / 100 '曲線上相鄰兩點的橫坐標間距
num = 100 '設定一屏100個點
Pic.Cls
'畫外側的線
Me.ForeColor = vbRed '畫線默認顏色為紅色
Me.DrawWidth = 3 '線的寬度為3
Me.FontSize = 12 '字體為12號字
Me.FontBold = True '加粗
Me.Line (Pic.Left, Pic.Top + Pic.Height + 30)-(Pic.Left + Pic.Width, Pic.Top + Pic.Height + 30) '畫外側橫線
Me.Line (Pic.Left - 30, Pic.Top)-(Pic.Left - 30, Pic.Top + Pic.Height) '畫外側豎線
'畫刻度
For i = 0 To 4
Me.Line (Pic.Left - 120, Pic.Top + Pic.Height * i / 4)-(Pic.Left, Pic.Top + Pic.Height * i / 4)
Me.Line (Pic.Left + Pic.Width * i / 4, Pic.Top + Pic.Height)-(Pic.Left + Pic.Width * i / 4, Pic.Top + Pic.Height + 120)
Me.CurrentX = Pic.Left - 1000
Me.CurrentY = Pic.Top + (Pic.Height * (4 - i) / 4) + 15
Me.Print Format(i * 100 / 4, "00.00")
'Label2(i).Left = Pic.Left - Label2(i).Width - 150
'Label2(i).Top = Pic.Top + (Pic.Height * (4 - i) / 4) + 15
Label1(i).Left = Pic.Left + (Pic.Width * i / 4) - Label1(i).Width / 2
Label1(i).Top = Pic.Top + Pic.Height + Label1(i).Height + 120
Next
minx = 0
maxx = Pic.Width
miny = 0
maxy = Pic.Height
Init
If N < num Then '還沒有100個點,曲線尚未繪制右邊界,用line方法在目標圖片框上直接繪制,不用平移
For i = N To N
x = minx + i * nw '給橫坐標賦值
y = miny + 0.1 * h + Rnd * 0.8 * h '給縱坐標賦值
px(i) = x
py(i) = y
Next i
Else
For i = 0 To 97 '陣列裝滿順次前移將第一個元素丟掉
py(i) = py(i + 1)
px(i) = minx + i * nw
Next i
px(98) = minx + 98 * nw
py(98) = py(99)
py(99) = miny + 0.1 * h + Rnd * 0.8 * h '陣列最后一個元素始終存放最新值
px(99) = minx + 99 * nw
'得到兩個點后可以畫點
If N >= 2 Then
Pic.DrawWidth = 2
Pic.PSet (px(0), py(0))
For i = 1 To N
Pic.Line -(px(i - 1), py(i - 1)), vbRed
Next i
End If
End If
End Sub
以上是我改的程式,下面這個是仿照的一個樣本,這個程式可以畫曲線圖
Dim px(100) As Single, py(100) As Single '用來存放100個點的橫坐標和縱坐標
Dim minx, maxx, miny, maxy, y '繪圖區域坐標設定
Dim w, h, nw, num, N
Private Sub Form_Load()
'利用VB方法畫溫度測量曲線,溫度范圍是10-40攝氏度顯示
Picture1.Cls
Picture1.ScaleMode = 0 '用戶自定義
Picture1.Scale (0, Picture1.Height)-(Picture1.Width, 0) '繪圖區域設定
minx = 0 + 10
maxx = Picture1.Width - 10
miny = 0 + 10
maxy = Picture1.Height - 10
Picture1.DrawWidth = 1
Picture1.Line (minx, maxy)-(maxx, miny), vbBlue, B '繪制坐標軸外圍矩形
For y = miny To maxy Step (maxy - miny) / 3 '繪制水平格線
Picture1.Line (minx, y)-(maxx, y), vbBlue
Next y
Picture1.PSet (minx, miny + (maxy - miny) / 3), vbBlue '繪制20、30、40攝氏度
Picture1.Print "20"
Picture1.PSet (minx, miny + (maxy - miny) * 2 / 3), vbBlue
Picture1.Print "30"
Picture1.PSet (minx, maxy), vbBlue
Picture1.Print "40"
'繪制中間虛線
For y = miny To maxy Step (maxy - miny) / 30 '繪制水平格線
Picture1.DrawStyle = 3
Picture1.Line (minx, y)-(maxx, y), vbBlue
Next y
N = 0 '圖上點數初始值為0
End Sub
Private Sub Timer1_Timer()
Dim i
h = maxy - miny '繪圖區域高度
w = maxx - minx '繪圖區域寬度
nw = w / 100 '曲線上相鄰兩點的橫坐標間距
num = 100 '設定一屏100個點
'每次timer中picture都全部重畫
Picture1.Cls
Picture1.ScaleMode = 0
Picture1.Scale (0, Picture1.Height)-(Picture1.Width, 0) '繪圖區域設定
minx = 0 + 10
maxx = Picture1.Width - 10
miny = 0 + 10
maxy = Picture1.Height - 10
Picture1.DrawWidth = 1
Picture1.Line (minx, maxy)-(maxx, miny), vbBlue, B '繪制坐標軸外圍矩形
For y = miny To maxy Step (maxy - miny) / 3 '繪制水平格線
Picture1.Line (minx, y)-(maxx, y), vbBlue
Next y
Picture1.PSet (minx, miny + (maxy - miny) / 3), vbBlue
Picture1.Print "20"
Picture1.PSet (minx, miny + (maxy - miny) * 2 / 3), vbBlue
Picture1.Print "30"
Picture1.PSet (minx, maxy), vbBlue
Picture1.Print "40"
'繪制中間虛線
For y = miny To maxy Step (maxy - miny) / 30
Picture1.DrawStyle = 3
Picture1.Line (minx, y)-(maxx, y), vbBlue
Next y
'開始畫點
If N < num Then '還沒有100個點,曲線尚未繪制右邊界,用line方法在目標圖片框上直接繪制,不用平移
For i = N To N
x = minx + i * nw '給橫坐標賦值
y = miny + 0.1 * h + Rnd * 0.8 * h '給縱坐標賦值
px(i) = x
py(i) = y
Next i
N = N + 1 '計數
Print N '列印當前計數值
Else
For i = 0 To 97 '陣列裝滿順次前移將第一個元素丟掉
py(i) = py(i + 1)
px(i) = minx + i * nw
Next i
px(98) = minx + 98 * nw
py(98) = py(99)
py(99) = miny + 0.1 * h + Rnd * 0.8 * h '陣列最后一個元素始終存放最新值
px(99) = minx + 99 * nw
End If
'得到兩個點后可以畫點
If N >= 2 Then
Picture1.DrawWidth = 2
Picture1.PSet (px(0), py(0))
For i = 1 To N
Picture1.Line -(px(i - 1), py(i - 1)), vbRed
Next i
End If
End Sub
求各位大神不吝賜教
uj5u.com熱心網友回復:
為什么寫這些低層次的代碼而不使用現成的Microsoft Chart控制元件。uj5u.com熱心網友回復:
我是初學者,太難的還不會。大神有什么指教嗎?我的這個曲線就是畫不出來uj5u.com熱心網友回復:
回復于: 2014-08-24 23:57:48為什么寫這些低層次的代碼而不使用現成的Microsoft Chart控制元件。
我是初學者,太難的還不會。大神有什么指教嗎?我的這個曲線就是畫不出來
uj5u.com熱心網友回復:
Me.AutoRedraw=True
轉載請註明出處,本文鏈接:https://www.uj5u.com/gongcheng/113921.html
標籤:資源
上一篇:ObjectARX中getSymbolTable函式和getBlockTable函式有什么區別??
下一篇:自動撥打電話功能
