NonSoft

Win32ApiによりBITMAPを高速表示するサンプル(VB6)


 サンプル(ソース/コード)
<このサンプルの概要>
以下のWin32Apiを使用したサンプルソースです。
(1)DrawDibOpen
(2)DrawDibClose
(3)DrawDibDraw

VB.NETでApiを宣言(Declare)する場合はVB.NET用に変換する必要があります。
変換方法のサンプルはこちらです。VB6とVB.NETのAPI宣言(Declare)の違いを比較したサンプル

C#.NETでApiを宣言(Declare)する場合はC#.NET用に変換する必要があります。
変換方法のサンプルはこちらです。VB6とC#.NETのAPI宣言(Declare)の違いを比較したサンプル

その他のサンプルソースはこちらです。
Win32Api定義のサンプル サンプルソース

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(999) 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

' DIBハンドル
Private hDrawDib As Long

Private Sub Form_Load()
    ' DIBオープン
    hDrawDib = DrawDibOpen()
    ' PictureBoxの自動再描画設定
    Picture1.AutoRedraw = True
End Sub

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

Private Sub Picture1_Click()
    Dim fname As String
    fname = "X.BMP"
    
    If FileLen(fname) > 0 Then
        ' BITMAPファイルオープン
        Dim fno As Integer
        fno = FreeFile
        Open fname For Binary As fno
    
        ' BITMAPFILEHEADERの読み込み
        Dim Bitf As BITMAPFILEHEADER
        Get fno, , Bitf
        
        ' BITMAPINFOHEADERの読み込み
        Dim Biti As BITMAPINFO
        Get fno, , Biti.bmiHeader
        
        ' RGBQUADの読み込み
        Dim cnum As Long
        cnum = Biti.bmiHeader.biClrUsed
        If cnum = 0 Then
            cnum = 2 ^ Biti.bmiHeader.biBitCount
        End If
        Dim i As Long
        For i = 0 To cnum - 1
            Get #1, , Biti.bmiColors(i)
        Next
        
        ' DIBイメージの読み込み
        Dim Bits() As Byte
        If FileLen(fname) - Len(Bitf) - Len(Biti.bmiHeader) - _
                (cnum * 4) - 1 >= 0 Then
            ReDim Bits( FileLen(fname) - Len(Bitf) - Len(Biti.bmiHeader) - _
                (cnum * 4) - 1) As Byte
        End If
        Get fno, , Bits
        Close
    
        ' 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 If
End Sub