El arte de programar
Transparencias con Windows y GDI en Visual Basic
Noviembre 29th, 2004 - [Enlace local]
En el trabajo me surgió la problematica de hacer que una imágen tenga un grado de transparencia sobre otra. Esto, aunque parezca una trivialidad, no lo es puesto que aunque la solución original es generar una mascara para hacer la transparencia, el permitir que existan varios grados lo complica un poco. Sin embargo al final he conseguido compactarlo todo en un procedimiento para que pasandole como parametros el dispositivo de contexto de origen, el dispositivo de contexto de destino (y donde se almacenará el resultado de la transparencia), las dimensiones de la imagen (en mi caso suelo poner las dimensiones en pixeles del picturebox) y el grado porcentual de transparencia, se genera de un modo casi inmediato el efecto deseado. Aqui os dejo el código:
' AUTOR: Oscar RodrÃguez
' NOMBRE: Transparenta
' FUNCIONAMINETO: Esta función permite fusionar una imágen de frente con otra de fondo
' dado un grado de transparencia
' PARÃ?METROS:
' -OrigenDC: Dispositivo de Contexto de la imágen de frente
' -DestinoDC: Dispositivo de Contexto de la imágen de fondo y resultado de la operación
' -Anchura: Anchura de las imágenes
' -Altura: Altura de las imágenes
' -Transparencia: Grado de transparencia medida en %
Public Sub Transparenta(ByVal OrigenDC As Long, ByVal DestinoDC As Long, ByVal Anchura As Long, ByVal Altura As Long, ByVal Transparencia As Byte)
Dim bitmap_info As BITMAPINFO
Dim indice As Long, tamano As Long
Dim pixels() As Byte
Dim TemporalDC As Long, TemporalDC2 As Long, MascaraDC As Long
Dim BitMap As Long, AntiguoBitMap As Long, BitMap2 As Long
Dim AntiguoBitMap2 As Long, MascaraBitMap As Long, AntiguoMascaraBitMap As Long
Dim recta As RECT
Dim brocha As Long
' Creamos el DC y bitmap de la mascara
MascaraDC = CreateCompatibleDC(OrigenDC)
MascaraBitMap = CreateCompatibleBitmap(OrigenDC, Anchura, Altura)
AntiguoMascaraBitMap = SelectObject(MascaraDC, MascaraBitMap)
' Copiamos la imágen de frente a la mascara
BitBlt MascaraDC, 0, 0, Anchura, Altura, OrigenDC, 0, 0, SRCCOPY
' Establecemos las propiedades de la cabecera bitmap
With bitmap_info.bmiHeader
.biSize = 40
.biWidth = Anchura
.biHeight = Altura
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
End With
' Creamos el buffer donde almacenaremos los bytes de la imágen de la mascara
tamano = 4 * Anchura * Altura
ReDim pixels(tamano) As Byte
' Guardamos en el buffer los bytes de la imágen de la mascara
GetDIBits MascaraDC, MascaraBitMap, _
0, Altura, pixels(0), _
bitmap_info, DIB_RGB_COLORS
' Calculamos la transparencia según el % que nos han pasado
Transparencia = Transparencia * 255 / 100
' Recorremos todo el buffer para sustituir los colores distintos de blanco por
' el de la transparencia
For indice = 0 To tamano - 1 Step 4
If pixels(indice) <> 255 Or pixels(indice + 1) <> 255 Or pixels(indice + 2) <> 255 Then
pixels(indice) = Transparencia
pixels(indice + 1) = Transparencia
pixels(indice + 2) = Transparencia
End If
Next
' Copiamos los bytes modifcados del buffer de nuevo a la imágen de la mascara
SetDIBits MascaraDC, MascaraBitMap, _
0, Altura, pixels(0), _
bitmap_info, DIB_RGB_COLORS
' Establecemos los valores del rectangulo para que coincida con las dimensiones
' de las imágenes
recta.Top = 0
recta.Left = 0
recta.Right = Anchura
recta.Bottom = Altura
' Creamos una brocha blanca para pintar los DC temporales con ese color
brocha = CreateSolidBrush(&HFFFFFF)
' Creamos el DC y bitmap de la imágen temporal nº1
TemporalDC = CreateCompatibleDC(OrigenDC)
BitMap = CreateCompatibleBitmap(OrigenDC, Anchura, Altura)
AntiguoBitMap = SelectObject(TemporalDC, BitMap)
' Pintamos de blanco la imágen temporal nº1
FillRect TemporalDC, recta, brocha
' Copiamos la imágen de la mascara invertida en colores a la imágen temporal nº1
BitBlt TemporalDC, 0, 0, Anchura, Altura, MascaraDC, 0, 0, SRCINVERT
' Mezclamos la imágen de frente con la imágen temporal nº1
BitBlt TemporalDC, 0, 0, Anchura, Altura, OrigenDC, 0, 0, SRCAND
' Creamos el DC y bitmap de la imágen temporal nº2 y lo pintamos de blanco
TemporalDC2 = CreateCompatibleDC(DestinoDC)
BitMap2 = CreateCompatibleBitmap(DestinoDC, Anchura, Altura)
AntiguoBitMap2 = SelectObject(TemporalDC2, BitMap2)
' Pintamos de blanco la imágen temporal nº2
FillRect TemporalDC2, recta, brocha
' Copiamos la imágen de la mascara a la imágen temporal nº2
BitBlt TemporalDC2, 0, 0, Anchura, Altura, MascaraDC, 0, 0, SRCCOPY
' Mezclamos la imágen de fondo con la imágen temporal nº2
BitBlt TemporalDC2, 0, 0, Anchura, Altura, DestinoDC, 0, 0, SRCAND
' Copiamos la imágen temporal nº2 a la imágen de fondo
BitBlt DestinoDC, 0, 0, Anchura, Altura, TemporalDC2, 0, 0, SRCCOPY
' Sumamos la imágen temporal nº1 a la imágen de fondo
BitBlt DestinoDC, 0, 0, Anchura, Altura, TemporalDC, 0, 0, SRCPAINT
'Limpiamos el sistema
SelectObject TemporalDC, AntiguoBitMap
SelectObject TemporalDC2, AntiguoBitMap2
SelectObject MascaraDC, AntiguoMascaraBitMap
DeleteObject BitMap
DeleteObject BitMap2
DeleteObject MascaraBitMap
DeleteDC TemporalDC
DeleteDC TemporalDC2
DeleteDC MascaraDC
End Sub
Actualización 07/07/2005:
El código de aquà arrÃba es más limitado de lo que yo pensaba y hace cosas que no debiera, por lo que hoy que hemos estado probandolo lo hemos descartado y en su lugar he encontrado algo mucho más sencillo... La función AlphaBlend de la API de windows 98, Me, 2000 y XP:
Private Declare Function AlphaBlend _
Lib "msimg32" ( _
ByVal hDestDC As Long, _
ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal widthSrc As Long, _
ByVal heightSrc As Long, _
ByVal dreamAKA As Long) _
As Long
.
.
.
dim numero as Long
numero=127
numero=vbBlue - CLng(numero) * (vbYellow + 1)
AlphaBlend picture2.hDC, 0, 0, picture2.ScaleWidth, picture2.ScaleHeight, picture1.hDC, 0, 0, picture2.ScaleWidth, picture2.ScaleHeight, numero
Primero colocais en la variable número un valor entre 0 (transparente) y 255 (opaco) para definir el nivel de transparencia de la imagen origen con respecto a la de destino, posteriormente con una sencilla formula (no os calenteis mucho la cabeza, ya que es una regla nemotécnica para darle un valor) se saca el valor a pasar al último parámetro de la función. Luego ya en la función le pasais el hdc de destino, el punto x e y del empiece a trabajar del destino y el ancho y alto del destino, posteriormente los mismos parámetros pero esta vez los del origen.
Funciona bastante bién y estará en todos los windows modernos.