1. Este site usa cookies. Ao continuar a usar este site está a concordar com o nosso uso de cookies. Saber Mais.

[VB6] - sobre velocidade

Discussão em 'Programação' iniciada por Cambalinho, 14 de Janeiro de 2013. (Respostas: 0; Visualizações: 508)

  1. Cambalinho

    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
     

Partilhar esta Página