画像処理について。（移動）

質問

今、スロットのアプリケーションを作成中なのですが、
いまいちリールの回転が滑らかじゃありません。
試してみたのが、ピクチャーを１２３４５と作り、
１番目の画像を２番目へ.....と一つずつずらしていく方法
（画像をずらす）
もう一つ
１２３４５とピクチャーを作り、
ピクチャーボックスの位置を動かしていく方法
（１が２の位置へ２が...５が１の位置へ）
この二つの方法ではいまいち滑らかにリールが回転するようには、見えません。（timeの関数を使ってあります）
よい方法が有りましたらぜひ教えてください。

画像の変数（リール配列は２１個あります。）
画像の種類は７種類

回答No.2

TAGOSAKU7 · ベストアンサー

サンプルです。

フォーム１[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

お礼

大変わかりやすく記入いただき、ありがとうございます
ぜひ試してみます。

回答No.3

TAGOSAKU7

追記です
タイマーコントロールも必要です。。。

回答No.1

TAGOSAKU7

現在２１個のピクチャボックスを用意してるのでしょうか？
１つのピクチャボックスに描画することにより、処理が軽くなり、スライドをしてるように見せることができます。

２１個は面倒なので、仮に５個で説明します。

１つのピクチャの幅＝５０
１つのピクチャの高さ＝３０
とします。

１．ピクチャボックス１をフォーム中に用意する
２．ピクチャボックス１の幅＝５０／高さ＝３０
３．ピクチャボックス２をピクチャボックス１の中に用意する
４．ピクチャボックス２幅＝５０／高さ＝３０＊（５個＋１）
５．PaintPicturで上から１／５／４／３／２／１の順番で描画
６．ピクチャボックス２のTOPを（－１＊５＊３０）に設定
このとき一番下のピクチャが表示されているように見える。
７．ピクチャボックス２のTOP初期値がこの場合－１５０で、タイマーにより－１４９、－１４８と徐々にずらす。
８．ピクチャボックス２のTOP＝０のとき、６の処理へ戻る

お礼

お返事ありがとうございます。
さっそく試してみます。

お世話になりました。

補足

PaintPicturの使い方がいまいち分からないので、
すみませんが、コード付きで教えてもらえないでしょうか。
使った事のないコードなので、
よろしくお願いします。