[VB6] - sobre velocidade

Cambalinho

Power Member
tenho 2 procedimentos excelentes, mas preciso de velocidade:(
Código:
Public Sub CaptureContainer(ByVal DestinationHDC As Long, ByVal SourceHWND As Long, ByVal SourceX As Long, ByVal SourceY As Long, ByVal SourceWidth As Long, ByVal SourceHeight As Long)
    Dim SourceDC As Long
    SourceDC = GetDC(SourceHWND)
    BitBlt DestinationHDC, 0, 0, SourceWidth, SourceHeight, SourceDC, SourceX, SourceY, vbSrcCopy
End Sub

Código:
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(ByVal Picturehdc As Long, ByVal Picturehandle As Long, ByVal Parentpicturehdc As Long, ByVal Parentpicturehandle As Long, ByVal Alpha As Long, ByVal TransparentColor As Long, ByVal inWidth As Long, ByVal 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
    
    SetDIBits Parentpicturehdc, Parentpicturehandle, _
        0, inHeight, ParentImage(0, 0), _
        bi32BitInfo, 0
    
    'StretchDIBits Parentpicturehdc, 0, 0, inWidth, inHeight, 0, 0, _
                        inWidth, inHeight, ParentImage(0, 0), bi32BitInfo, 0, vbSrcCopy
End Sub
alguem me pode dar dicas para acelerar estes procedimentos?
obrigado
 
Back
Topo