Read Bitmap into a 2D array
test in form1.frm
![Name: GetImgARgb.jpg
Views: 43
Size: 58.4 KB]()
in bas:
get rgb info:
test in form1.frm
Code:
Private Sub Form_Load()
StartUpGDIPlus
Dim Data() As RgbType
Data = GetPicBmpData_RGB(App.Path & "\BMP1.bmp")
MsgBox "One Pixel rgb=" & Data(0, 0).Red & "," & Data(0, 0).Green & "," & Data(0, 0).Blue
'One Pixel rgb=2,22,222
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
CloseGdiPlus
End Subin bas:
Code:
Option Explicit
Enum Status
OK = 0
GenericError = 1
InvalidParameter = 2
OutOfMemory = 3
ObjectBusy = 4
InsufficientBuffer = 5
NotImplemented = 6
Win32Error = 7
WrongState = 8
Aborted = 9
FileNotFound = 10
ValueOverflow = 11
AccessDenied = 12
UnknownImageFormat = 13
FontFamilyNotFound = 14
FontStyleNotFound = 15
NotTrueTypeFont = 16
UnsupportedGdiplusVersion = 17
GdiplusNotInitialized = 18
PropertyNotFound = 19
PropertyNotSupported = 20
ProfileNotFound = 21
End Enum
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Type GdiplusStartupOutput
NotificationHook As Long
NotificationUnhook As Long
End Type
Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Status
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Status
Private Declare Function GdiplusStartup Lib "GDIPlus" (ByRef token As Long, ByRef lpInput As GdiplusStartupInput, ByRef lpOutput As GdiplusStartupOutput) As Status
Private Const GdiplusVersion As Long = 1&
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, Bitmap As Long) As Long
Public Declare Function GdipGetImageWidth Lib "GDIPlus" ( _
ByVal pImage As Long, _
ByRef nWidth As Long _
) As Long
Public Declare Function GdipGetImageHeight Lib "GDIPlus" ( _
ByVal pImage As Long, _
ByRef nHeight As Long _
) As Long
Public Declare Function GdipBitmapLockBits Lib "GDIPlus" ( _
ByVal pBitmap As Long, _
ByRef prect As RECTL, _
ByVal Flags As Long, _
ByVal pixelFormat As Long, _
ByRef lockedBitmapData As BitmapData _
) As Long
Public Type BitmapData
Width As Long
Height As Long
Stride As Long
pixelFormat As Long
Scan0 As Long
Reserved As Long
End Type
'
Public Type RECTL
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type Argb
Blue As Byte
Green As Byte
Red As Byte
Alphi As Byte
End Type
Public Type RgbType
Blue As Byte
Green As Byte
Red As Byte
End Type
Public Enum ImageLockMode
ImageLockModeRead = &H1
ImageLockModeWrite = &H2
ImageLockModeUserInputBuf = &H4
End Enum
'
Public Enum PixelFormats
PixelFormat24bppRGB = &H21808
PixelFormat32bppRGB = &H22009
PixelFormat32bppARGB = &H26200A
PixelFormat32bppPARGB = &HD200B
End Enum
Dim lngGdipToken As Long
Function StartUpGDIPlus(Optional ByVal GdipVersion As Long = GdiplusVersion) As Boolean
Dim GdipStartupInput As GdiplusStartupInput
Dim GdipStartupOutput As GdiplusStartupOutput
GdipStartupInput.GdiplusVersion = GdipVersion
If GdiplusStartup(lngGdipToken, GdipStartupInput, GdipStartupOutput) = OK Then
StartUpGDIPlus = True
End If
End Function
Sub CloseGdiPlus()
GdiplusShutdown lngGdipToken
End Sub
Function GetPicBmpData(File1 As String, Optional W As Long, Optional H As Long) As Byte()
Dim Bitmap As Long, RC As RECTL
Dim Data() As Byte
GdipCreateBitmapFromFile StrPtr(File1), Bitmap
GdipGetImageWidth Bitmap, W
GdipGetImageHeight Bitmap, H
RC.Right = W
RC.Bottom = H
Dim FormatID As Long, Wsize As Long
FormatID = PixelFormat32bppARGB
Wsize = 4
' FormatID = PixelFormat24bppRGB
'Wsize = 3
ReDim Data(RC.Right * Wsize * RC.Bottom - 1)
Dim BmpData As BitmapData
With BmpData
.Width = W
.Height = H
.pixelFormat = FormatID
'.Scan0 = VarPtr(data(0, 0))
.Scan0 = VarPtr(Data(0))
.Stride = Wsize * CLng(W)
End With
GdipBitmapLockBits Bitmap, RC, ImageLockModeUserInputBuf Or ImageLockModeWrite Or ImageLockModeRead, FormatID, BmpData
GetPicBmpData = Data
GdipDisposeImage Bitmap
End Function
Function GetPicBmpDataXY(File1 As String) As Long()
Dim Bitmap As Long
Dim RC As RECTL
Dim Data() As Long 'DATA(W,H),LONG TYPE=4 BYTE,ARGB
Dim tdata() As Long
GdipCreateBitmapFromFile StrPtr(File1), Bitmap
GdipGetImageWidth Bitmap, RC.Right
GdipGetImageHeight Bitmap, RC.Bottom
ReDim Data(RC.Bottom - 1, RC.Right - 1)
ReDim tdata(RC.Bottom - 1, RC.Right - 1)
Dim BmpData As BitmapData
Dim FormatID As Long
FormatID = PixelFormat32bppARGB
With BmpData
.Width = RC.Right
.Height = RC.Bottom
.pixelFormat = FormatID
.Scan0 = VarPtr(Data(0, 0))
.Stride = 4 * CLng(RC.Right)
End With
GdipBitmapLockBits Bitmap, RC, ImageLockModeUserInputBuf Or ImageLockModeWrite Or ImageLockModeRead, FormatID, BmpData
GetPicBmpDataXY = Data()
End Function
Function GetPicBmpData_Argb(File1 As String) As Argb()
Dim Bitmap As Long
Dim RC As RECTL
Dim Data() As Argb 'DATA(W,H),LONG TYPE= ARGB
GdipCreateBitmapFromFile StrPtr(File1), Bitmap
GdipGetImageWidth Bitmap, RC.Right
GdipGetImageHeight Bitmap, RC.Bottom
ReDim Data(RC.Bottom - 1, RC.Right - 1)
Dim BmpData As BitmapData
Dim FormatID As Long
FormatID = PixelFormat32bppARGB
With BmpData
.Width = RC.Right
.Height = RC.Bottom
.pixelFormat = FormatID
.Scan0 = VarPtr(Data(0, 0))
.Stride = 4 * CLng(RC.Right)
End With
GdipBitmapLockBits Bitmap, RC, ImageLockModeUserInputBuf Or ImageLockModeWrite Or ImageLockModeRead, FormatID, BmpData
GetPicBmpData_Argb = Data()
GdipDisposeImage Bitmap
End FunctionCode:
Public Type RgbType
Blue As Byte
Green As Byte
Red As Byte
End Type
Function GetPicBmpData_RGB(File1 As String) As RgbType()
Dim Bitmap As Long
Dim RC As RECTL
Dim Data() As RgbType 'DATA(W,H),LONG TYPE= RGB
GdipCreateBitmapFromFile StrPtr(File1), Bitmap
GdipGetImageWidth Bitmap, RC.Right
GdipGetImageHeight Bitmap, RC.Bottom
ReDim Data(RC.Bottom - 1, RC.Right - 1)
Dim BmpData As BitmapData
Dim FormatID As Long
FormatID = PixelFormat24bppRGB
With BmpData
.Width = RC.Right
.Height = RC.Bottom
.pixelFormat = FormatID
.Scan0 = VarPtr(Data(0, 0))
.Stride = 3 * CLng(RC.Right)
End With
GdipBitmapLockBits Bitmap, RC, ImageLockModeUserInputBuf Or ImageLockModeWrite Or ImageLockModeRead, FormatID, BmpData
GdipDisposeImage Bitmap
GetPicBmpData_RGB = Data()
End Function