Results 1 to 1 of 1

Thread: Get Rgb info by GdipBitmapLockBits,Read Bitmap into a 2D array

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Get Rgb info by GdipBitmapLockBits,Read Bitmap into a 2D array

    Read Bitmap into a 2D array
    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 Sub
    Name:  GetImgARgb.jpg
Views: 521
Size:  58.4 KB

    in 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 Function
    get rgb info:
    Code:
    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
    Last edited by xiaoyao; Mar 23rd, 2021 at 12:08 AM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width