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

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

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

まず、ＶｉｓｕａｌＢａｓｉｃを起動してプロジェクトを新しく作成してください。ピクチャーボックスとコマンドボタンを貼り付け、ピクチャーボックスのAutoReviewとAutoSizeプロパティはTrueにしておいてください。適当な、ビットマップをピクチャーボックスに読み込み以下のコードを貼り付けて実行し、コマンドボタンを押せば、Picという配列にＲ，Ｇ，Ｂ別に色が格納されるはずです。なお、配列の０は右下になります。注意してください。

動作確認：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 Private 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 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 GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As RGBQUAD, lpBI As BITMAPINFO, ByVal wUsage 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 Sub Command1_Click() Dim ret As Long Dim bmpinfo As BITMAPINFO Dim tempbmp As Long Dim oldbmp As Long Dim Pic() As RGBQUAD With bmpinfo With .bmiHeader .biSize = Len(bmpinfo.bmiHeader) .biWidth = Picture1.ScaleWidth / Screen.TwipsPerPixelX .biHeight = Picture1.ScaleHeight / Screen.TwipsPerPixelY .biPlanes = 1 .biBitCount = 32 .biCompression = 0 .biSizeImage = Picture1.ScaleWidth / Screen.TwipsPerPixelX * Picture1.ScaleHeight / Screen.TwipsPerPixelY * 4 .biClrUsed = 0 End With End With tempbmp = CreateDIBitmap(Picture1.hdc, bmpinfo.bmiHeader, 0, 0, bmpinfo, 0) oldbmp = SelectObject(Picture1.hdc, tempbmp) ReDim Pic(bmpinfo.bmiHeader.biWidth * bmpinfo.bmiHeader.biHeight) ret = GetDIBits(Picture1.hdc, oldbmp, 0, bmpinfo.bmiHeader.biHeight, Pic(0), bmpinfo, 0) If ret = 0 Then MsgBox "取得に失敗しました" End If tempbmp = SelectObject(Picture1.hdc, oldbmp) ret = DeleteObject(tempbmp) End Sub

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