Twin Basic

Module TestUDTClass
    Enum ExistStatus
        isExist = 1
        isNotExist = 2
    End Enum
    Type tFile
        ExistFlag As ExistStatus
        FullPath As String
        Size As Long
        ReadS As FileReadSDeleg '= AddressOf FileReadS
        Data() As Byte
    End Type
    Private Delegate Function FileReadSDeleg (ByRef tpFl As Any) As String
    
    Sub tFileInitialize(tFl As tFile, FilePath As String)
        With tFl
            If .ExistFlag = 0 Then
                If Len(Dir$(FilePath)) Then
                    .ExistFlag = isExist
                    .Size = FileLen(FilePath)
                    .FullPath = FilePath
                    .ReadS = AddressOf FileReadS
                Else
                    .ExistFlag = isNotExist
                End If
            End If
        End With
    End Sub      
    
    Private Function FileReadS(tFl As tFile) As String
        With tFl
            If .ExistFlag = isExist Then
                If IsArrayInitialized(.Data) = False Then
                    ReDim .Data(.Size - 1)
                    Dim flNum As Long = FreeFile
                    Open .FullPath For Binary As flNum
                    Get flNum, 1, .Data
                    Close flNum
                End If
                FileReadS = .Data 
            End If
        End With
    End Function    
End Module

Option Explicit
#If Win64 Then
    Const ptrSz = 8
#Else
    Const ptrSz = 4
#End If
#If VBA7 Then
'    Private Declare PtrSafe Function arrPtr Lib "VBE7" Alias "VarPtr" (var() As Any) As LongPtr
'    Private Declare PtrSafe Function GetObjectW Lib "gdi32" (ByVal hGDIObj As LongPtr, ByVal cbBuffer As Long, ByVal lpvObject As LongPtr) As Long
'    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function arrPtr Lib "msvbvm60" Alias "VarPtr" (var() As Any) As Long
    Private Declare Function GetObjectW Lib "gdi32" (ByVal hGDIObj As LongPtr, ByVal cbBuffer As Long, ByVal lpvObject As LongPtr) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#End If
 
Public Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
 
Private Type SAFEARRAYBOUND
    cElements    As Long
    lLbound      As Long
End Type
 
Private Type SAFEARRAY2D
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As LongPtr
    Bounds(1)  As SAFEARRAYBOUND
End Type
 
Private Enum SafeArrayFeatures
    FADF_AUTO = &H1
    FADF_STATIC = &H2
    FADF_EMBEDDED = &H4
    FADF_FIXEDSIZE = &H10
    FADF_RECORD = &H20
    FADF_HAVEIID = &H40
    FADF_HAVEVARTYPE = &H80
    FADF_BSTR = &H100
    FADF_UNKNOWN = &H200
    FADF_DISPATCH = &H400
    FADF_VARIANT = &H800
End Enum
 
Private Type BITMAP
  bmType As Long
  bmWidth As Long
  bmHeight As Long
  bmWidthBytes As Long
  bmPlanes As Integer
  bmBitsPixel As Integer
  bmBits As LongPtr
End Type
 
Sub test()
    Dim oPic        As stdole.StdPicture
    Dim RGBqAr()    As RGBQUAD
    Dim pRGBqAr     As LongPtr
    Dim bmBitmap    As BITMAP
    Dim tSA         As SAFEARRAY2D
    Dim NullPtr     As LongPtr
    Dim i As Long, j As Long
    Dim r As Byte, g As Byte, b As Byte
    
    Set oPic = stdole.LoadPicture("C:\Users\User\Pictures\Безымянный.bmp") '<== adjust path\name to suit.
    
    GetObjectW oPic.Handle, LenB(bmBitmap), VarPtr(bmBitmap)
    
    'define our 2D safearray that will hold the pixel data.
    With tSA
        .cDims = 2 '2D
        .fFeatures = FADF_AUTO Or FADF_FIXEDSIZE
        .cbElements = 4 'LenB(RGBQUAD)
        '.cLocks = 1
        .pvData = bmBitmap.bmBits
        .Bounds(0).cElements = bmBitmap.bmHeight
        .Bounds(1).cElements = bmBitmap.bmWidth
    End With
    pRGBqAr = arrPtr(RGBqAr)    
    CopyMemory ByVal pRGBqAr, VarPtr(tSA), ptrSz
    
    For i = 0 To bmBitmap.bmWidth - 1
        For j = 0 To bmBitmap.bmHeight
            With RGBqAr(i, j)
                r = .rgbRed
                g = .rgbGreen
                b = .rgbBlue
                Debug.Print "Pixel:(" & i & "," & j & ")", "Color:" & Hex$(VBA.RGB(r, g, b))
            End With
        Next
    Next
    
    CopyMemory ByVal pRGBqAr, NullPtr, ptrSz    
End Sub