サンプルです。
フォーム１[Form1]
├コマンドボタン１[Command1]
│
├コマンドボタン２[Command2]
│
├ピクチャボックス１[Pictur1]
││
│└ピクチャボックス２[Pictur2]
│
└ピクチャボックス３[Pictur3]
となるように画面に各コントロールを貼り付けてください。
ピクチャボックス２はピクチャボックス１の中に入れてください。
lngPicW/lngPicHでピクチャの１つの領域範囲を設定してます。
lngMoveVectでピクチャの移動量を設定してます。これはlngPicHを割り切れる数字に設定した方が、スムーズに動きます。
Option Explicit
Private Const lngPicW As Long = 100 'ピクチャの幅
Private Const lngPicH As Long = 100 'ピクチャの高さ
Private Const lngMoveVect As Long = 5 'ピクチャの移動量(高さを割り切れる数字が好ましい)
'スクロールを行うピクチャの高さ
Private lngScrollPicH As Long
Private Sub Command1_Click()
Dim wkAry As Variant
Dim i As Long
Dim lngCntPic As Long
'絵の情報
wkAry = Array( _
"C:\WINNT\しゃくなげ.bmp" _
, "C:\WINNT\グリーン ストーン.bmp" _
, "C:\WINNT\サポテック織り.bmp" _
, "C:\WINNT\サンタフェ.bmp" _
, "C:\WINNT\シャボン.bmp" _
)
'ピクチャの数
lngCntPic = UBound(wkAry) + 1
'スクロールピクチャの高さ取得
lngScrollPicH = (lngCntPic + 1) * lngPicH
With Me
.Command1.Enabled = False
.Command2.Enabled = True
With .Picture1
.Visible = True
End With
With .Picture2
.Visible = True
.Width = lngPicW
.Height = lngScrollPicH
.Left = 0
.Top = lngPicH - lngScrollPicH
End With
For i = 0 To lngCntPic - 1
.Picture3.Picture = LoadPicture(wkAry(i))
Call .Picture2.PaintPicture(.Picture3.Picture, 0, (lngCntPic - i) * lngPicH, lngPicW, lngPicH, 0, 0, .Picture3.ScaleWidth, .Picture3.ScaleHeight, vbSrcCopy)
If i = 0 Then
Call .Picture2.PaintPicture(.Picture3.Picture, 0, 0, lngPicW, lngPicH, 0, 0, .Picture3.ScaleWidth, .Picture3.ScaleHeight, vbSrcCopy)
End If
Next i
End With
End Sub
Private Sub Command2_Click()
Dim blnWork As Boolean
With Me
blnWork = Not .Timer1.Enabled
If blnWork Then
.Command2.Caption = "停止"
Else
.Command2.Caption = "回転"
End If
.Timer1.Enabled = blnWork
End With
End Sub
Private Sub Form_Load()
'各初期設定です
'あらかじめデザイン時にここのForm_Loadイベントでしていることを設定しておくと、Form_Loadのイベントは省略できます
With Me
With .Command1
.Caption = "初期設定"
.Enabled = True
End With
With .Command2
.Caption = "回転"
.Enabled = False
End With
With Timer1
.Enabled = False
.Interval = 1
End With
.ScaleMode = vbPixels
With .Picture1
.ScaleMode = vbPixels
.AutoSize = False
.Visible = False
.Appearance = 0
.BorderStyle = 0
.AutoRedraw = True
.Enabled = False
.Cls
.Width = lngPicW
.Height = lngPicH
End With
With .Picture2
.ScaleMode = vbPixels
.AutoSize = False
.Visible = False
.Appearance = 0
.BorderStyle = 0
.AutoRedraw = True
.Enabled = False
.Cls
End With
With .Picture3
.ScaleMode = vbPixels
.AutoSize = True
.Visible = False
.Appearance = 0
.BorderStyle = 0
.AutoRedraw = True
.Enabled = False
.Cls
End With
End With
End Sub
Private Sub Timer1_Timer()
Dim lngTop As Long
With Me
'TOP位置を計算
lngTop = .Picture2.Top + lngMoveVect
If lngTop >= 0 Then
lngTop = lngPicH - lngScrollPicH
End If
.Picture2.Top = lngTop
End With
End Sub
お礼
大変わかりやすく記入いただき、ありがとうございます ぜひ試してみます。