スプライト処理テスト(T)             <TOP>


にわか勉強のスプライト処理テストであることをお断りしておきます。

BitBlt 画像転送

GetDC デバイスコンテキスト取得

ReleaseDC デバイスコンテキスト解放

 

Form設定

PictureBoxを3個とTimerを貼り付けます。

    Picture1(450×160ピクセル)backcolor.bmp:背景色用(450×80ピクセル)

    実は、Picture1に下記背景色を上下2段に読み込んでいます。(bikeを表示した後、次を表示させるために一度消去しなければならないのですが、背景色の模様を合わせるため)

    Picture2(56×52ピクセル):bike.bmp:バイク移動用

    Picture3(56×52ピクセル):bike2.bmp:バイクマスク用

     

まだまだ未完成で、タイマーインターバル、移動量等を変えてテストしていますがフリッカが出るようです。

 

参照

スプライト処理A

 

'================================================================
'= スプライト処理テスト
'=    (Sprite.bas)
'================================================================
#include "Windows.bi"

' ビットブロック転送を行う。コピー元からコピー先のデバイスコンテキストへ、指定された長方形内の各ピクセルの色データをコピー
Declare Function Api_BitBlt& Lib "gdi32" Alias "BitBlt" (ByVal hDestDC&, ByVal X&, ByVal Y&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal dwRop&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

#define MERGEPAINT &HBB0226             '反転した転送元ビットマップとパターンビットマップを論理OR演算子で結合
#define SRCAND &H8800C6                 '転送先の画像とAND演算して転送
#define SRCCOPY &HCC0020                'そのまま転送
#define SRCERASE &H440328               '転送先ビットマップを反転、その結果と転送元ビットマップを論理AND演算子で結合
#define SRCINVERT &H660046              '転送先の画像とXOR演算して転送
#define SRCPAINT &HEE0086               '転送先の画像とOR演算して転送

Var shared Picture1 As Object : Picture1.Attach GetDlgItem("Picture1")
Var shared Picture2 As Object : Picture2.Attach GetDlgItem("Picture2")
Var shared Picture3 As Object : Picture3.Attach GetDlgItem("Picture3")
Var shared Timer1 As Object : Timer1.Attach GetDlgItem("Timer1")
Var shared Bitmap As Object : BitmapObject Bitmap

Var shared hDC1 As Long
Var shared hDC2 As Long
Var shared hDC3 As Long
Var shared X As Integer
Var shared Y As Integer
Var shared W As Long
Var shared H As Long
Var shared M As Long

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var Ret As Long

    X = 0                                        '最初のX位置
    Y = 15                                       '最初のY位置
    M = 5                                        '移動量
    W = Picture2.GetWidth
    H = Picture2.GetHeight

    'Picture1上半分にbackcolor.bmpを読み込む
    Bitmap.LoadFile "backcolor.bmp"
    Picture1.DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject

    'Picture1下半分にbackcolor.bmpを読み込む     '苦し紛れのbike消去用
    Bitmap.LoadFile "backcolor.bmp"
    Picture1.DrawBitmap Bitmap, 0, 80
    Bitmap.DeleteObject

    'Picture2にbike1.bmpを読み込む
    Bitmap.LoadFile "bike1.bmp"
    Picture2.DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject

    'Picture3にbike2.bmp(白抜き)を読み込む
    Bitmap.LoadFile "bike2.bmp"
    Picture3.DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject

    'Picture毎のDC取得
    hDC1 = Api_GetDC(Picture1.GethWnd)
    hDC2 = Api_GetDC(Picture2.GethWnd)
    hDC3 = Api_GetDC(Picture3.GethWnd)

    Timer1.SetInterval 10
    Timer1.Enable -1
end sub

'================================================================
'=  移動処理
'================================================================
Declare Sub Bike_Move edecl ()
Sub Bike_Move()
    Var Ret As Long

    'Picture1の下半分の同位置画像を上半分にコピー(無理やりbike消去^^;)
    Ret = Api_BitBlt(hDC1, X - M, 0, W, 80, hDC1, X - M, 80, SRCCOPY)

    'Picture1の画像とPicture3のマスク画像(bike2.bmp)をORで合成(SRCPAINT)=白抜き画像
    Ret = Api_BitBlt(hDC1, X, Y, W, H, hDC3, 0, 0, SRCPAINT)

    'Picture1の画像とPicture2の画像(bike1.bmp)をANDで合成(SRCAND)
    Ret = Api_BitBlt(hDC1, X, Y, W, H, hDC2, 0, 0, SRCAND)
End Sub

'================================================================
'=    
'================================================================
Declare Sub Timer1_Timer edecl ()
Sub Timer1_Timer()
    X = X + M : If X > GetWidth + M Then X = 0
    Y = Int(Rnd(1) * 5) + 5
    Bike_Move
End Sub

'================================================================
'= 
'================================================================
Declare Sub MainForm_QueryClose(Cancel As Integer, ByVal Mode As Integer)
Sub MainForm_QueryClose(Cancel As Integer, ByVal Mode As Integer)
    Var Ret As Long

    If Cancel = 0 Then
        Ret = Api_ReleaseDC(Picture1.GethWnd, hDC1)
        Ret = Api_ReleaseDC(Picture2.GethWnd, hDC2)
        Ret = Api_ReleaseDC(Picture3.GethWnd, hDC3)
        End
    End If
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End