|
|||||
<このサンプルの概要> PictureBoxに図形を表示する速度が遅いので、高速表示する方法を調査しました。 高速表示するためには図形を一つ一つ描画せず、メモリ上に展開した図形をPictureBoxに 高速転送する必要があります。その際使用するAPIはDrawDibDrawが最適だと思います。 また、DrawDibDrawを使用すれば図形の拡大/縮小も簡単に出来ますので大変便利です。 このサンプルを作る際にビットマップ(DIB)のフォーマットを勉強する機会があったので ビットマップ(BMP)を保存するサンプルも付けています。ビットマップ(DIB)のフォーマット で特に注意しなければならない事は、ビットデータの横幅が4バイトの倍数になるように 調整しなければならない事です。 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 |