[RESOLVED] [VB6- DIB's] - transparent opacy by pixel

[joaquim]

i rebuild my code for do the opacy.
but i don't understand why takes so many time and the results aren't what i expected

Option Explicit

Private Type BITMAPINFOHEADER
  biSize As Long
  biWidth As Long
  biHeight As Long
  biPlanes As Integer
  biBitCount As Integer
  biCompression As Long
  biSizeImage As Long
  biXPelsPerMeter As Double
  biClrUsed As Double
End Type

Private Type BITMAPINFO
  bmiHeader As BITMAPINFOHEADER
  bmiColors As Long
End Type

Private Declare Function StretchDIBits Lib "gdi32" (ByVal hdc As Long, _
  ByVal x As Long, ByVal y As Long, ByVal dWidth As Long, ByVal dHeight _
  As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal SrcWidth As _
  Long, ByVal SrcHeight As Long, lpBits As Any, lpBI As BITMAPINFO, _
  ByVal wUsage As Long, ByVal RasterOp As Long) As Long

Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long

Dim bi32BitInfo As BITMAPINFO
Dim OriginalImage() As Long, ParentImage() As Long

Private Function DIBRGB(ByVal c As Long) As Long
  DIBRGB = (c And &HFF&) * &H10000 Or (c And &HFF00&) Or (c And &HFF0000) \ &H10000
End Function

Public Sub DIBOpacy(Picture As Object, Parentpicture As Object, Alpha As Long, TransparentColor As Long, Optional PosX As Long = 0, Optional PosY As Long = 0)
    Dim inWidth As Long
    Dim inHeight As Long
    Dim SrcRed As Long, SrcBlue As Long, SrcGreen As Long
    Dim DstRed As Long, DstBlue As Long, DstGreen As Long
    Dim R As Long, G As Long, B As Long
    Dim x As Long, y As Long
    
    inWidth = Picture.ScaleWidth
    inHeight = Picture.ScaleHeight
    ReDim OriginalImage(inWidth - 1, inHeight - 1)
    ReDim ParentImage(inWidth - 1, inHeight - 1)
    With bi32BitInfo.bmiHeader
        .biBitCount = 32
        .biPlanes = 1
        .biSize = Len(bi32BitInfo.bmiHeader)
        .biWidth = inWidth
        .biHeight = inHeight
        .biSizeImage = 4 * inWidth * inHeight
    End With
    TransparentColor = DIBRGB(TransparentColor)
    GetDIBits Picture.hdc, Parentpicture.Image.Handle, 0, inHeight, OriginalImage(0, 0), bi32BitInfo, 0
    GetDIBits Parentpicture.hdc, Parentpicture.Image.Handle, 0, inHeight, ParentImage(0, 0), bi32BitInfo, 0
    Alpha = 255 - (Alpha * 255 / 100)
    
    For y = 0 To inHeight - 1
        For x = 0 To inWidth - 1
            If OriginalImage(x, y) <> TransparentColor Then
                DstBlue = ParentImage(x, y) And 255
                DstGreen = (ParentImage(x, y) And 65535) \ 256
                DstRed = (ParentImage(x, y) And &HFF0000) \ 65536
                
                SrcBlue = OriginalImage(x, y) And 255
                SrcGreen = (OriginalImage(x, y) And 65535) \ 256
                SrcRed = (OriginalImage(x, y) And &HFF0000) \ 65536
                
                R = (Alpha * (SrcRed + 256 - DstRed)) / 256 + DstRed - Alpha
                G = (Alpha * (SrcGreen + 256 - DstGreen)) / 256 + DstGreen - Alpha
                B = (Alpha * (SrcBlue + 256 - DstBlue)) / 256 + DstBlue - Alpha
                ParentImage(x, y) = RGB(R, G, B)
            Else
                ParentImage(x, y) = TransparentColor
            End If
        Next x
    Next y
    
    StretchDIBits Parentpicture.hdc, PosX, PosY, inWidth, inHeight, 0, 0, _
                        inWidth, inHeight, ParentImage(0, 0), bi32BitInfo, 0, vbSrcCopy
End Sub

is the RGB calculation correct?
(i must calculate the DIB pixel to RGB(in these case is BGR) for combine the 2 pixeles)

[joaquim]

Option Explicit

Private Type BITMAPINFOHEADER
  biSize As Long
  biWidth As Long
  biHeight As Long
  biPlanes As Integer
  biBitCount As Integer
  biCompression As Long
  biSizeImage As Long
  biXPelsPerMeter As Double
  biClrUsed As Double
End Type

Private Type BITMAPINFO
  bmiHeader As BITMAPINFOHEADER
  bmiColors As Long
End Type

Private Declare Function StretchDIBits Lib "gdi32" (ByVal hdc As Long, _
  ByVal x As Long, ByVal y As Long, ByVal dWidth As Long, ByVal dHeight _
  As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal SrcWidth As _
  Long, ByVal SrcHeight As Long, lpBits As Any, lpBI As BITMAPINFO, _
  ByVal wUsage As Long, ByVal RasterOp As Long) As Long

Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long

Dim bi32BitInfo As BITMAPINFO
Dim OriginalImage() As Long, ParentImage() As Long

Private Function DIBRGB(ByVal c As Long) As Long
  DIBRGB = (c And &HFF&) * &H10000 Or (c And &HFF00&) Or (c And &HFF0000) \ &H10000
End Function

'FinalPixel = (AlphaValue * (Source + 256 - Destination)) / 256 + Destination - AlphaValue
Public Sub DIBTransparentAlphaBlend(ByRef Picturehdc As Long, ByRef Picturehandle As Long, ByRef Parentpicturehdc As Long, ByRef Parentpicturehandle As Long, ByRef Alpha As Long, ByRef TransparentColor As Long, ByRef inWidth As Long, ByRef inHeight As Long)
   
    Dim SrcRed As Long, SrcBlue As Long, SrcGreen As Long
    Dim DstRed As Long, DstBlue As Long, DstGreen As Long
    Dim R As Long, G As Long, B As Long
    Dim x As Long, y As Long
    
    
    
    ReDim OriginalImage(inWidth - 1, inHeight - 1)
    ReDim ParentImage(inWidth - 1, inHeight - 1)
    
    With bi32BitInfo.bmiHeader
        .biBitCount = 32
        .biPlanes = 1
        .biSize = Len(bi32BitInfo.bmiHeader)
        .biWidth = inWidth
        .biHeight = inHeight
        .biSizeImage = 4 * inWidth * inHeight
    End With
    TransparentColor = DIBRGB(TransparentColor)
    GetDIBits Picturehdc, Picturehandle, 0, inHeight, OriginalImage(0, 0), bi32BitInfo, 0
    GetDIBits Parentpicturehdc, Parentpicturehandle, 0, inHeight, ParentImage(0, 0), bi32BitInfo, 0
    Alpha = 255 - (Alpha * 255 / 100)
    'On Error Resume Next
    For y = 0 To inHeight - 1
        For x = 0 To inWidth - 1
            If OriginalImage(x, y) <> TransparentColor Then
            
               DstRed = ParentImage(x, y) And 255
                DstGreen = (ParentImage(x, y) And 65535) \ 256
                DstBlue = (ParentImage(x, y) And &HFF0000) \ 65536
                
               SrcRed = OriginalImage(x, y) And 255
                SrcGreen = (OriginalImage(x, y) And 65535) \ 256
                SrcBlue = (OriginalImage(x, y) And &HFF0000) \ 65536
                
                R = (Alpha * (SrcRed + 256 - DstRed)) / 256 + DstRed - Alpha
                G = (Alpha * (SrcGreen + 256 - DstGreen)) / 256 + DstGreen - Alpha
                B = (Alpha * (SrcBlue + 256 - DstBlue)) / 256 + DstBlue - Alpha
                
                ParentImage(x, y) = RGB(R, G, B)
            Else
                ParentImage(x, y) = TransparentColor
            End If
        Next x
    Next y
    
    StretchDIBits Parentpicturehdc, 0, 0, inWidth, inHeight, 0, 0, _
                        inWidth, inHeight, ParentImage(0, 0), bi32BitInfo, 0, vbSrcCopy
End Sub

these sub works fine.. except the speed
maybe my problem is another... i will mark resolved.
thanks to all