下記のプログラムを直すには？
解決FormにTimer1、Frame1、Command1を配置して
Frame1上にPicturebox1(0)、Picturebox1(1)を配置して
下記のプログラムを実行したところ、
表示と非表示を繰り返し行うと
PictureboxとLineにズレが生じてきてしまうのですが
どこを直したらよいのか教えていただけますか？
Option Explicit
Const TTT = 80
Dim Pf As String
Dim Pr As String
Dim n As Integer
Private Sub Form_Load()
Form1.Width = 10000
Form1.Height = 5850
Frame1.Visible = False
Frame1.Width = 8800
Frame1.Height = 3615
Frame1.Top = 800
Frame1.Left = 400
Command1.Top = 300
Command1.Left = 500
Command1.Caption = "表示"
End Sub
Private Sub Command1_Click()
Static OLD_X As Integer
Static OLD_Y As Integer
If Frame1.Visible = False Then
Frame1.Visible = True
Timer1.Interval = 100
Timer1.Enabled = True
For n = 0 To 1
Picture1(n).Appearance = 0 'picturebox の境界を消す。
Picture1(n).BorderStyle = 0
Picture1(n).Width = TTT * 110
Picture1(n).Height = 2800
Picture1(0).Left = 0
Picture1(n).Top = 300
Picture1(n).BackColor = &HFFC0C0 '背景色設定
SCALE_DRAW n
Next
Picture1(1).Left = Picture1(0).Left + Picture1(0).Width
Command1.Caption = "非表示"
Else
Timer1.Enabled = False
Frame1.Visible = False
Form1.Width = 9600
Command1.Caption = "表示"
End If
End Sub
Sub SCALE_DRAW(n)
Dim OLD_X As Integer, OLD_Y As Integer
Picture1(n).AutoRedraw = True
Picture1(n).DrawWidth = 2
Picture1(n).DrawStyle = 0
Picture1(n).ForeColor = &HFF&
End Sub
Private Sub Timer1_Timer()
DRAW
End Sub
Private Sub DRAW()
Dim Y As Integer
Static OLD_X As Integer
Static OLD_Y As Integer
Y = Int(Rnd * 2000)
'描画が端に来たらPictureを切り替える
If OLD_X > Picture1(0).Width Then
If Picture1(0).Left < Picture1(1).Left Then
Picture1(0).Left = Picture1(1).Left + Picture1(1).Width
Picture1(0).Cls
SCALE_DRAW (0)
Else
Picture1(1).Left = Picture1(0).Left + Picture1(0).Width
Picture1(1).Cls
SCALE_DRAW (1)
End If
OLD_X = 0
End If
'常に右側のPictureに描画
If Picture1(0).Left < Picture1(1).Left Then
If OLD_Y > 0 Then
Picture1(1).Line (OLD_X, OLD_Y)-(OLD_X + TTT, Y)
Picture1(0).Left = Picture1(0).Left - TTT
Picture1(1).Left = Picture1(0).Left + Picture1(0).Width
End If
Else
If OLD_Y > 0 Then
Picture1(0).Line (OLD_X, OLD_Y)-(OLD_X + TTT, Y)
Picture1(1).Left = Picture1(1).Left - TTT
Picture1(0).Left = Picture1(1).Left + Picture1(1).Width
End If
End If
OLD_X = OLD_X + TTT
OLD_Y = Y
End Sub
実はそこは宿題になっていたのです。(^^;
答えは簡単で
'描画が端に来たらPictureを切り替える
If OLD_X >= Picture1(0).Width Then '等号を入れる
If Picture1(0).Left < Picture1(1).Left Then
If OLD_Y >= 0 Then '等号を入れる
Picture1(1).Line (OLD_X, OLD_Y)-(OLD_X + TTT, Y)
If OLD_Y >= 0 Then '等号を入れる
Picture1(0).Line (OLD_X, OLD_Y)-(OLD_X + TTT, Y)
の三箇所に等号を入れるでした。(^^
ねろ様いつもお世話になっています。
以前このオシロスコープのような描画でお世話になりました年寄りの
冷や水です。
ぷち様。
ねろ様の回答で解決でしょう。
ただ次のようにサンプルデータを変更した場合、やっぱり継ぎ目で波
形がおかしくなります。お試しください。
'Y = Int(Rnd * 2000)
'--------------- SAMPLE DRAW DATA ---------------
Static YYY As Integer
' DRAW DATA => Y
'サンプル波形
Y = 1000 * Sin(YYY * 3.14 / 180) + 1200
'サンプル波形の調整
YYY = YYY + 10
If YYY > 360 Then YYY = 0
'------------------------------------------------
これは、Picture1を切り替える際にTTTを無視して切り替えている
ので書き残しがあるためです。
「'描画が端に来たらPictureを切り替える」の際、無条件に
OLD_X = 0 としていることが問題では無いでしょうか。
っていうか、以前の私のサンプルコードのミスです。
大変失礼しました。
前レスは前面撤回します。
継ぎ目がおかしいのではなく、またしても私の思い違いでした。
波形をみやすく描画するためYYY = YYY + 10としていたことが問題
だったようです。
お邪魔しました。
年寄りの冷や水さん
>波形をみやすく描画するためYYY = YYY + 10としていたことが問題
あんまり細かくやろうとすると、グラッフィクが追いつきませんね。
ぷちさん
罫線固定もあまり上手く言っていないような。一応サンプル載せておきますね。
要するにFrameを細くして罫線に見せています。
'*****************準備する物******************************
'1 Formの上にFrame1を置く
'2 Frame1の上にPicture1(0)とPicture1(1)を置く
'3 Frame1の上にFrame2とFrame3を置きindexを0とする
'4 Formの上にTimeer1を置く
'*********************************************************
Option Explicit
Const TTT = 80 '横の送り
Const Colno = 10 '横の分割
Const Rowno = 20 '縦の分割
Private Sub Form_Load()
Dim n As Integer
'フォームの大きさ--適当に
Me.Width = TTT * 120 'フォーム・ピクチャボックスの大きさ設定
Me.Height = 6720
With Frame1
.Top = 240
.Width = Me.Width - 400
.Left = 100
.Height = Me.Height - 1000
.BackColor = RGB(20, 20, 20)
.Appearance = 0
End With
For n = 1 To 10
Load Frame2(n) '横の線を追加
Next
For n = 1 To 20
Load Frame3(n) '縦の線の追加
Next
For n = 0 To 1
With Picture1(n)
.Width = Frame1.Width - 20
.Height = Frame1.Height - 20
.Left = 0
.Top = 0
.AutoRedraw = True
.DrawWidth = 2
.DrawStyle = 0
.Appearance = 0
.BorderStyle = 0
.ForeColor = RGB(0, 255, 200)
.BackColor = RGB(0, 0, 0) '背景色を黒に設定
End With
Next
Picture1(1).Left = Picture1(0).Left + Picture1(0).Width
Timer1.Interval = 100
Timer1.Enabled = True
ScaleDraw
End Sub
Private Sub ScaleDraw()
Dim n As Integer
For n = 0 To 10
With Frame2(n)
.Width = Picture1(0).Width
.Top = (Picture1(0).Height) / 10 * n + Picture1(0).Top
.Height = 5
.Left = Picture1(0).Left
.Appearance = 0
.BackColor = RGB(100, 100, 0)
.BorderStyle = 0
.Caption = ""
.ZOrder
.Visible = True
End With
Next
Frame2(5).BackColor = RGB(180, 200, 0) '中央線を強調
For n = 0 To 20
With Frame3(n)
.Left = (Picture1(0).Width) / 20 * n + Picture1(0).Left
.Top = 0
.Width = 5
.Height = Picture1(0).Height
.Appearance = 0
.BackColor = RGB(100, 100, 0)
.BorderStyle = 0
.Caption = ""
.ZOrder
.Visible = True
End With
Next
End Sub
Private Sub Timer1_Timer()
Draw
End Sub
Private Sub Draw()
Dim Y As Integer
Static OLD_X As Integer
Static OLD_Y As Integer
Y = Int(Rnd * Picture1(0).Height)
'描画が端に来たらPictureを切り替える
If OLD_X >= Picture1(0).Width Then
If Picture1(0).Left <= Picture1(1).Left Then
Picture1(0).Left = Picture1(1).Left + Picture1(1).Width
Picture1(0).Cls
Else
Picture1(1).Left = Picture1(0).Left + Picture1(0).Width
Picture1(1).Cls
End If
OLD_X = 0
End If
DoEvents
'常に右側のPictureに描画
If Picture1(0).Left <= Picture1(1).Left Then
Picture1(1).Line (OLD_X, OLD_Y)-(OLD_X + TTT, Y)
Picture1(0).Left = Picture1(0).Left - TTT
Picture1(1).Left = Picture1(0).Left + Picture1(0).Width
Else
Picture1(0).Line (OLD_X, OLD_Y)-(OLD_X + TTT, Y)
Picture1(1).Left = Picture1(1).Left - TTT
Picture1(0).Left = Picture1(1).Left + Picture1(1).Width
End If
OLD_X = OLD_X + TTT
OLD_Y = Y
DoEvents
End Sub
なるほど。
ありがとうございました。
| ツイート |  |