ビットマップの内容を配列に

＜VBのPsetが遅いと感じている人へ＞

１、CreateDIBitmapで新規にビットマップを作成
↓
２、SelectObjectで一時的にＤＣを解放（これをしないとGetDIBitsが使用不可能）
↓
３、SetDIBitsでビットマップを設定
↓
４、ＤＣを返す
↓
５、DeleteObjectで１で作成したビットマップを削除

まず、ＶｉｓｕａｌＢａｓｉｃを起動してプロジェクトを新しく作成してください。標準モジュールを追加し、次のコードを張り付けて下さい。これは関数化されています。引数は、BpPictureboxが操作先のピクチャーボックス、BpBitmapDataが実際の色が格納された配列です（二次元の配列（（ｘ、ｙ）の形で格納）

動作確認：Visual Basic 5.0(Visual Basic 4.0でも問題なく動作するはずです),Windows98

Option Explicit 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 Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type Private Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors(255) As RGBQUAD End Type Type BITMAP bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Byte bmBitsPixel As Byte bmBits As Long End Type Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hObject As Long) As Long Private Declare Function DeleteObject Lib "GDI32" (ByVal hObject As Long) As Long Private Declare Function CreateDIBitmap Lib "GDI32" (ByVal hDC As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO, ByVal wUsage As Long) As Long Private Declare Function GetObject Lib "GDI32" Alias "GetObjectA" (ByVal hObject&, ByVal nCount&, lpObject As Any) As Long Private Declare Function SetDIBits Lib "GDI32" (ByVal hDC&, ByVal hBitmap&, ByVal nStartScan&, ByVal nNumScans&, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage&) As Long Public Function SetBitmapData(BpPicturebox As PictureBox, BpBitmapData() As RGBQUAD) As Long Dim TempBmp As Long Dim OldBmp As Long Dim BmpInfo As BITMAPINFO Dim ret As Long Dim Pic() As RGBQUAD Dim BmpData As BITMAP Dim i As Long, j As Long ret = GetObject(BpPicturebox.Image, 24, BmpData) With BmpInfo With .bmiHeader .biSize = Len(BmpInfo.bmiHeader) .biWidth = BmpData.bmWidth .biHeight = BmpData.bmHeight .biPlanes = 1 .biBitCount = 32 .biCompression = 0 .biSizeImage = BmpData.bmWidth * BmpData.bmHeight * 4 .biClrUsed = 0 End With End With ReDim Pic(BmpData.bmWidth * BmpData.bmHeight) For i = 0 To BmpData.bmHeight - 1 For j = 0 To BmpData.bmWidth Pic(i * BmpData.bmWidth + j) = BpBitmapData(BmpData.bmWidth - j, BmpData.bmHeight - i) Next Next TempBmp = CreateDIBitmap(BpPicturebox.hDC, BmpInfo.bmiHeader, 0, 0, BmpInfo, 0) OldBmp = SelectObject(BpPicturebox.hDC, TempBmp) ret = SetDIBits(BpPicturebox.hDC, OldBmp, 0, BmpData.bmHeight, Pic(0), BmpInfo, 0) If ret = 0 Then SetBitmapData = -1 End If TempBmp = SelectObject(BpPicturebox.hDC, OldBmp) ret = DeleteObject(TempBmp) BpPicturebox.Refresh End Function

テレワークならECナビ Yahoo 楽天 LINEがデータ消費ゼロで月額500円〜！
無料ホームページ 無料のクレジットカード 海外格安航空券　海外旅行保険が無料！ 海外ホテル