SISTEMAS O.R.P

' 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

 
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