Manejar bitmaps en memoria
Usando APIs de Windows (GDI)

Fecha: 09 - Octubre - 2003
Autor: Antonio Moya goldelpucela@hotmail.com


Debido a haber encontrado escasísima documentación sobre el uso de GDI y contextos de dispositivos en memoria (sin necesidad de PictureBox o Formularios) envío en código que he desarrollado para modificar un bitmap en memoria
En el Código se crea un dispositivo en memoria con manejador CompDC que permite acceder a un BMP utilizando las APIs del GDI de Windows.
En el ejemplo leo los colores del bitmap y dibujo una línea azul como muestra.
Espero que a alguien le sirva.

 

' Declaraciones API Windows (GDI)
Public Declare Function GetObject Lib "gdi32" Alias _
        "GetObjectA" (ByVal hObject As Long, ByVal nCount As _
        Long, lpObject As Any) As Long
        
Public Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, _
        ByVal X As Long, ByVal y As Long, ByVal crColor As Long) As Long

Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, _
        ByVal y As Long) As Long

Public Const CLR_INVALID = &HFFFF


Public Type BITMAP
  bmType As Long ' Tipo del BMP, debe ser 0
  bmWidth As Long   ' Ancho en píxeles, debe ser mayor que 0
  bmHeight As Long  ' Alto en píxeles, debe ser mayor que 0
  bmWidthBytes As Long  ' número de lineas en cada línea escaneada
  bmPlanes As Integer
  bmBitsPixel As Integer ' número de bits para indicar el color de cada pixel
  bmBits As Long 
End Type

Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long




Private Sub Command2_Click()

Dim Col As Long
Dim Fil As Long
Dim lReturn As Long
Dim ColRes As Long
Dim a As StdPicture // biblioteca OLE Automation
Dim PInf As BITMAP

Set a = New StdPicture

' Cargo la imágen en un contenedor
Set a = LoadPicture(App.Path & "\modelo.BMP")

If a.Type <> vbPicTypeBitmap Then
    MsgBox "El tipo de la imagen no es correcto"
End If

' Obtengo la informacion del bmp en una estructura BITMAP
If GetObject(a.Handle, Len(PInf), PInf) = 0 Then
    MsgBox "Fallo GetObject"
End If


ColRes = PInf.bmBitsPixel / 8
ReDim F1(0 To (PInf.bmWidth * PInf.bmHeight * (ColRes + 1)) - 1) As Byte


' Creo un contexto de dispositivo en memoria
'   para contener el Bitmap
Dim CompDC As Long  ' Compatible DC to hold the bitmap
Dim di&

' Y asigno al contexto la imagen
CompDC = CreateCompatibleDC(0)
di = SelectObject(CompDC, a.Handle)

' Recojo los valores de los píxeles (colores)
For Col = 0 To 306 - 1
    For Fil = 0 To 153 - 1
        lReturn = GetPixel(CompDC, Col, Fil)
        If lReturn = CLR_INVALID Then
            ' Valor de pixel no válido, probablemente nos hemos salido de los
            ' límites del bitmap
            MsgBox Fil & " " & Col & "=" & lReturn
        End If
    Next
Next

' Inserto algún valor
' en este caso dibujo una rayita azul
For Col = 0 To 306 - 1
    For Fil = 0 To 153 - 1
        If Col = Fil Then
            lReturn = SetPixelV(CompDC, Col, Fil, vbBlue)
        End If
    Next
Next

' Guardo y libero memoria
SavePicture a, App.Path & "\aaa.BMP"
Call DeleteDC(CompDC)
Set a = Nothing

End Sub

ir al índice