ーーーー折れ線グラフ作成 Class1 ーーーー
'描画先のオブジェクト
Public objects As Object
'高さの分解能=最大値
Public pHight As Integer
'幅の分解能
Public pWidth As Integer
'横の余白
Public yoko As Integer
'下の余白
Public shita As Integer
'線の色の設定
Public LineColor As Long
'縦横の線の描画
Public lineDrow As Boolean
'横線の描画
Public horizontalLine As Boolean
'横線の色
Public horizontalLineColor As Long
'横線の数
Public horizontalLineSpase As Integer
'流れる線の描画
Public streamLine As Boolean
'流れる線の色
Public streamLineColor As Long
'流れる線の間隔 = 10Stepおきに描画など
Public streamLineSpase As Integer
Private WidthScale(1000) As Integer
Private streamLineDrowCount As Integer
Private streamLineDrowCountPos As Integer
Public Sub Step(setX As Integer)
Dim scaleX As Integer
Dim scaleY As Integer
Dim Bheight As Integer
Bheight = objects.Height - shita
Dim Bwidth As Integer
Bwidth = objects.Width - yoko * 2
scaleX = Bheight / pHight
scaleY = Bwidth / pWidth
Dim PointX As Integer
Dim PointY As Integer
PointX = Bheight - scaleX * setX
Dim pos As Integer
If streamLineDrowCountPos = streamLineSpase + 1 Then
streamLineDrowCountPos = 0
End If
streamLineDrowCount = streamLineDrowCountPos
streamLineDrowCountPos = streamLineDrowCountPos + 1
If horizontalLine Then
Dim horizontalLinePos As Integer
Dim horizontalLineCount As Integer
horizontalLineCount = Bheight / horizontalLineSpase
For pos = 0 To horizontalLineSpase
horizontalLinePos = horizontalLinePos + horizontalLineCount
objects.Line (yoko, Bheight - horizontalLinePos)- _
(Bwidth + yoko, Bheight - horizontalLinePos), horizontalLineColor
Next pos
End If
For pos = 0 To pWidth - 1
If Not (pos = pWidth - 1) Then
WidthScale(pos) = WidthScale(pos + 1)
Else
WidthScale(pos) = setX
End If
Next pos
Dim FrontPos As Integer
Dim LastPos As Integer
For pos = 0 To pWidth - 1
If pos = 0 Then
FrontPos = 0
Else
If pos = pWidth - 1 Then
FrontPos = pos
Else
FrontPos = pos - 1
End If
End If
If streamLine Then
If streamLineDrowCount = 0 Then
objects.Line (yoko + scaleY * pos, 0)-(yoko + scaleY * pos, Bheight), streamLineColor
End If
streamLineDrowCount = streamLineDrowCount + 1
If streamLineDrowCount > streamLineSpase Then streamLineDrowCount = 0
End If
objects.Line (yoko + scaleY * FrontPos, (Bheight - scaleX * WidthScale(FrontPos)))- _
(yoko + scaleY * pos, (Bheight - scaleX * WidthScale(pos))), LineColor
Next pos
If lineDrow Then
objects.Line (yoko, 0)-(yoko, Bheight)
objects.Line (yoko, Bheight)-(Bwidth + yoko, Bheight)
End If
End Sub
ーーーー使用方法ーーーー
Dim drows As Class1
Private Sub Form_Load()
Set drows = New Class1
Set drows.objects = Form1.Picture1
drows.pHight = 100
drows.pWidth = 100
drows.shita = 1000
drows.yoko = 1000
drows.LineColor = RGB(0, 0, 255)
drows.lineDrow = True
drows.streamLine = True
drows.streamLineColor = RGB(255, 0, 0)
drows.streamLineSpase = 10
drows.horizontalLine = True
drows.horizontalLineColor = RGB(0, 255, 0)
drows.horizontalLineSpase = 10
End Sub
Private Sub Timer2_Timer()
Picture1.Cls
drows.Step (描画する値)
End Sub