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