Newsgroup: it.comp.lang.visual-basic
Titolo: Immagini trasparenti

Esiste una qualche ocx o che altro per riuscire a far capire a VB6 che un
colore di un immagine č trasparente?
Ciao e grazie
Marcus

 colore di un immagine è trasparente?
questo è il codice da mettere in un modulo:
Private Declare Function BitBlt Lib "Gdi32.dll" (ByVal hDCDest As Long,
ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal
nHeight As Long, ByVal hDCSrc As Long, ByVal XSrc As Long, ByVal YSrc As
Long, ByVal dwRop As Long) As Long
Private Declare Function CreateBitmap Lib "Gdi32.dll" (ByVal nWidth As Long,
ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long,
lpBits As Any) As Long
Private Declare Function SetBkColor Lib "Gdi32.dll" (ByVal hdc As Long,
ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "Gdi32.dll" (ByVal hdc As Long,
ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "Gdi32.dll" (ByVal hdc
As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "Gdi32.dll" (ByVal hdc As
Long) As Long
Private Declare Function DeleteDC Lib "Gdi32.dll" (ByVal hdc As Long) As
Long
Private Declare Function DeleteObject Lib "Gdi32.dll" (ByVal hObject As
Long) As Long
Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Public Sub TransparentBlt(OutDstDC As Long, DstDC As Long, SrcDC As Long,
SrcRect As RECT, DstX As Integer, DstY As Integer, TransColor As Long)
'Parametri:
    'DstDC- Device context into which image must be
    'drawn transparently
    'OutDstDC- Device context into image is actually drawn,
    'even though it is made transparent in terms of DstDC
    'Src- Device context of source to be made transparent
    'in color TransColor
    'SrcRect- Rectangular region within SrcDC to be made
    'transparent in terms of DstDC, and drawn to OutDstDC
    'DstX, DstY - Coordinates in OutDstDC (and DstDC)
    'where the transparent bitmap must go. In most
    'cases, OutDstDC and DstDC will be the same
    'TransColor - Il colore che si vuole rendere trasparente.
'-------------------------
    Dim nRet As Long, W As Integer, H As Integer
    Dim MonoMaskDC As Long, hMonoMask As Long
    Dim MonoInvDC As Long, hMonoInv As Long
    Dim ResultDstDC As Long, hResultDst As Long
    Dim ResultSrcDC As Long, hResultSrc As Long
    Dim hPrevMask As Long, hPrevInv As Long
    Dim hPrevSrc As Long, hPrevDst As Long
    'Prima questa funzione era nella form
    'Me.Cls
    W = SrcRect.Right - SrcRect.Left + 1
    H = SrcRect.Bottom - SrcRect.Top + 1
    'create monochrome mask and inverse masks
    MonoMaskDC = CreateCompatibleDC(DstDC)
    MonoInvDC = CreateCompatibleDC(DstDC)
    hMonoMask = CreateBitmap(W, H, 1, 1, ByVal 0&)
    hMonoInv = CreateBitmap(W, H, 1, 1, ByVal 0&)
    hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
    hPrevInv = SelectObject(MonoInvDC, hMonoInv)
    'create keeper DCs and bitmaps
    ResultDstDC = CreateCompatibleDC(DstDC)
    ResultSrcDC = CreateCompatibleDC(DstDC)
    hResultDst = CreateCompatibleBitmap(DstDC, W, H)
    hResultSrc = CreateCompatibleBitmap(DstDC, W, H)
    hPrevDst = SelectObject(ResultDstDC, hResultDst)
    hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
    'copy src to monochrome mask
    Dim OldBC As Long
    OldBC = SetBkColor(SrcDC, TransColor)
    nRet = BitBlt(MonoMaskDC, 0, 0, W, H, SrcDC, SrcRect.Left, SrcRect.Top,
vbSrcCopy)
    TransColor = SetBkColor(SrcDC, OldBC)
    'create inverse of mask
    nRet = BitBlt(MonoInvDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbNotSrcCopy)
    'get background
    nRet = BitBlt(ResultDstDC, 0, 0, W, H, DstDC, DstX, DstY, vbSrcCopy)
    'AND with Monochrome mask
    nRet = BitBlt(ResultDstDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbSrcAnd)
    'get overlapper
    nRet = BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, SrcRect.Left, SrcRect.Top,
vbSrcCopy)
    'AND with inverse monochrome mask
    nRet = BitBlt(ResultSrcDC, 0, 0, W, H, MonoInvDC, 0, 0, vbSrcAnd)
    'XOR these two
    nRet = BitBlt(ResultDstDC, 0, 0, W, H, ResultSrcDC, 0, 0, vbSrcInvert)
    'Visualizza l'immagine trasparente.
    nRet = BitBlt(OutDstDC, DstX, DstY, W, H, ResultDstDC, 0, 0, vbSrcCopy)
    'Libera le risorse utilizzate.
    hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
    DeleteObject hMonoMask
    hMonoInv = SelectObject(MonoInvDC, hPrevInv)
    DeleteObject hMonoInv
    hResultDst = SelectObject(ResultDstDC, hPrevDst)
    DeleteObject hResultDst
    hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
    DeleteObject hResultSrc
    DeleteDC MonoMaskDC
    DeleteDC MonoInvDC
    DeleteDC ResultDstDC
    DeleteDC ResultSrcDC
End Sub
e questo è un esempio di chiamata
(supponendo di avere l'immagine originale in una PictureBox chiamata
Picture1, con ScaleMode = vbPixel, e di mettere l'immagine col colore reso
trasparente (bianco) direttamente sulla form)
    Dim R As RECT
    With R
        .Left = 0
        .Top = 0
        .Right = Picture1.ScaleWidth - 1
        .Bottom = Picture1.ScaleHeight - 1
    End With
    TransparentBlt Me.hdc, Me.hdc, Picture1.hdc, R, 20, 0, vbWhite
Ciao
Faber

 Esiste una qualche ocx o che altro per riuscire a far capire a VB6 che un
