Manejar bitmaps en memoria
Usando APIs de Windows (GDI)
Fecha: 09 - Octubre - 2003
Autor: Antonio Moya [email protected]
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