Results 1 to 2 of 2

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

  1. #1

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    3,904

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

    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
    Code:
    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)
    VB6 2D Sprite control

    To live is difficult, but we do it.

  2. #2

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    3,904

    Re: [VB6- DIB's] - transparent opacy by pixel

    Code:
    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
    VB6 2D Sprite control

    To live is difficult, but we do it.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width