NonSoft - ビットマップ(DIB)の高速表示(アニメーション)と保存のサンプル(VB6)

ビットマップ(DIB)の高速表示(アニメーション)と保存のサンプル(VB6)

サンプルソース

＜このサンプルの概要＞
PictureBoxに図形を表示する速度が遅いので、高速表示する方法を調査しました。
高速表示するためには図形を一つ一つ描画せず、メモリ上に展開した図形をPictureBoxに
高速転送する必要があります。その際使用するAPIはDrawDibDrawが最適だと思います。
また、DrawDibDrawを使用すれば図形の拡大／縮小も簡単に出来ますので大変便利です。

このサンプルを作る際にビットマップ(DIB)のフォーマットを勉強する機会があったので
ビットマップ(BMP)を保存するサンプルも付けています。ビットマップ(DIB)のフォーマット
で特に注意しなければならない事は、ビットデータの横幅が４バイトの倍数になるように
調整しなければならない事です。

FormにPictureBoxとTimerとButtonを貼り付けてお試しください。

Option Explicit

' バックグラウンド描画
Const DDF_BACKGROUNDPAL = &H200

' BITMAPFILEHEADER構造体
Private Type BITMAPFILEHEADER
    bfType As Integer
    bfSize As Long
    bfReserved1 As Integer
    bfReserved2 As Integer
    bfOffBits As Long
End Type

' BITMAPINFOHEADER構造体
Private Type BITMAPINFOHEADER
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
End Type

' RGBQUAD構造体
Private Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
End Type

' BITMAPINFO構造体
Private Type BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors(255) As RGBQUAD
End Type

' DrawDibDraw関係API
Private Declare Function DrawDibOpen Lib "msvfw32.dll" () As Long
Private Declare Function DrawDibClose Lib "msvfw32.dll" (ByVal hdd As Long) As Long
Private Declare Function DrawDibDraw Lib "msvfw32.dll" (ByVal hdd As Long, ByVal hdc As Long, ByVal xDst As Long, ByVal yDst As Long, ByVal dxDst As Long, ByVal dyDst As Long, ByRef lpbi As BITMAPINFOHEADER, lpBits As Any, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dxSrc As Long, ByVal dySrc As Long, ByVal wFlags As Long) As Long

' BITMAPFILEHEADER領域
Private Bitf As BITMAPFILEHEADER
' BITMAPINFO領域
Private Biti As BITMAPINFO
' DIBイメージ領域
Private Bits() As Byte
' DIBハンドル
Private hDrawDib As Long

Private Sub Command1_Click()
    Dim fname As String
    fname = "X.BMP"
    
    ' ファイル削除
    Kill fname
    
    ' BITMAPファイルオープン
    Dim fno As Integer
    fno = FreeFile
    Open fname For Binary As fno

    ' カラー数計算
    Dim cnum As Long
    cnum = Biti.bmiHeader.biClrUsed
    If cnum = 0 Then
        cnum = 2 ^ Biti.bmiHeader.biBitCount
    End If
    
    ' BITMAPFILEHEADER設定
    Bitf.bfType = &H4D42
    Bitf.bfSize = Len(Bitf) + Len(Biti.bmiHeader) + cnum * 4 + UBound(Bits) + 1
    Bitf.bfReserved1 = 0
    Bitf.bfReserved2 = 0
    Bitf.bfOffBits = Len(Bitf) + Len(Biti.bmiHeader) + cnum * 4
    
    ' BITMAPFILEHEADERの書き込み
    Put fno, , Bitf
    
    ' BITMAPINFOHEADERの書き込み
    Put fno, , Biti.bmiHeader
    
    ' RGBQUADの書き込み
    Dim i As Long
    For i = 0 To cnum - 1
        Put #1, , Biti.bmiColors(i)
    Next
    
    ' DIBイメージの書き込み
    Put fno, , Bits
    Close

End Sub

Private Sub Form_Load()
    ' DIBオープン
    hDrawDib = DrawDibOpen()
    ' PictureBoxの自動再描画設定
    Picture1.AutoRedraw = True
    
    ' PictureBoxのサイズ設定
    Const BITMAP_WIDTH = 20
    Const BITMAP_HEIGHT = 10
    Const PICTURE_SCALE = 10
    Picture1.Width = BITMAP_WIDTH * Screen.TwipsPerPixelX * PICTURE_SCALE
    Picture1.Height = BITMAP_HEIGHT * Screen.TwipsPerPixelY * PICTURE_SCALE
    
    ' BITMAPINFOHEADER設定
    Biti.bmiHeader.biSize = 40                  ' BITMAPINFOHEADERのバイト数
    Biti.bmiHeader.biWidth = BITMAP_WIDTH       ' 幅のピクセル数
    Biti.bmiHeader.biHeight = BITMAP_HEIGHT     ' 高さのピクセル数
    Biti.bmiHeader.biPlanes = 1                 ' プレーン数(1固定)
    Biti.bmiHeader.biBitCount = 8               ' 1ピクセルのビット数
    Biti.bmiHeader.biCompression = 0            ' 圧縮方法(0=なし, 1=RLE-8, 2=RLE-4)
    Biti.bmiHeader.biSizeImage = 0              ' イメージサイズ
    Biti.bmiHeader.biXPelsPerMeter = 0          ' 水平解像度
    Biti.bmiHeader.biYPelsPerMeter = 0          ' 垂直解像度
    Biti.bmiHeader.biClrUsed = 0                ' カラー数(0の時はbiBitCountで計算)
    Biti.bmiHeader.biClrImportant = 0           ' 重要カラー
    
    ' RGBQUAD設定
    Dim i As Long
    For i = 0 To UBound(Biti.bmiColors)
        Biti.bmiColors(i).rgbBlue = (i Mod 4) * &H55
        Biti.bmiColors(i).rgbGreen = ((i \ 4) Mod 4) * &H55
        Biti.bmiColors(i).rgbRed = ((i \ 4 \ 4) Mod 4) * &H55
    Next
    
    ' DIBイメージ領域確保
    Dim w As Long
    w = Int((Biti.bmiHeader.biWidth + 3) / 4) * 4
    ReDim Bits(w * Biti.bmiHeader.biHeight - 1) As Byte
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ' DIBクローズ
    DrawDibClose hDrawDib
End Sub

Private Sub Timer1_Timer()
    Static page As Long
    page = (page + 1) Mod 2
    
    ' 設定(自作の格子模様)
    Dim x, y As Long
    Dim w As Long
    w = Int((Biti.bmiHeader.biWidth + 3) / 4) * 4
    For y = 0 To Biti.bmiHeader.biHeight - 1
        For x = 0 To Biti.bmiHeader.biWidth - 1
            Bits(y * w + x) = 0
            If (y Mod 2) = 0 Then
                Bits(y * w + x) = _
                    Bits(y * w + x) Or &H30
            End If
            If (x Mod 2) = 0 Then
                Bits(y * w + x) = _
                    Bits(y * w + x) Or &H3
            End If
            If (page Mod 2) = 1 Then
                Bits(y * w + x) = _
                    Bits(y * w + x) Or &HC
            End If
        Next x
    Next y
    
    ' DIBイメージをPictureBoxへ転送
    Call DrawDibDraw( _
        hDrawDib, _
        Picture1.hdc, _
        0, 0, _
        Picture1.Width / Screen.TwipsPerPixelX, _
        Picture1.Height / Screen.TwipsPerPixelY, _
        Biti.bmiHeader, _
        Bits(0), _
        0, 0, _
        Biti.bmiHeader.biWidth, _
        Biti.bmiHeader.biHeight, _
        DDF_BACKGROUNDPAL)
    
    ' 再描画
    Picture1.Refresh
End Sub

トップページ

ダウンロード

サンプルソース

ち～な～み～に～

その他のおすすめソフト