'APIの宣言
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
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

'本当のBITMAPINFO型とは違います。
Private Type BITMAPINFO
        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 Sub Picture1_Click()
Dim bmpinfo As BITMAPINFO
Dim hbm As Long, ohbm As Long
Dim pixel() As Long

Picture1.AutoRedraw = True
Picture1.ScaleMode = 3    'ピクセル

'初期化
With bmpinfo
    .biBitCount = 32
    .biHeight = Picture1.ScaleHeight
    .biPlanes = 1
    .biSize = 40
    .biWidth = Picture1.ScaleWidth
End With

'ビットマップ作成
hbm = CreateCompatibleBitmap(Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight)
'選択中のビットマップにはGetDIBitsが使えない
'ので空のビットマップをセット
ohbm = SelectObject(Picture1.hdc, hbm)

'配列の宣言
ReDim pixel(Picture1.ScaleWidth - 1, Picture1.ScaleHeight - 1) As Long

'色を取得,Pixel配列には画像の色が入る
GetDIBits Picture1.hdc, ohbm, 0, Picture1.ScaleHeight, pixel(0, 0), bmpinfo, 0

'高さを−にするとビットマップが逆転する
bmpinfo.biHeight = -bmpinfo.biHeight
'色をセット
SetDIBits Picture1.hdc, ohbm, 0, Picture1.ScaleHeight, pixel(0, 0), bmpinfo, 0

'ビットマップをセット
SelectObject Picture1.hdc, ohbm

Picture1.Refresh

'ビットマップを削除
DeleteObject hbm

End Sub