Cambalinho
Power Member
tenho 2 procedimentos excelentes, mas preciso de velocidade
alguem me pode dar dicas para acelerar estes procedimentos?
obrigado
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
obrigado