Resumen Bitmaps transparentes


Te mando en ejemplo para Win32 sin incluir las APIS que las puedes sacar del Api Viewer (debes incluir un picture con una imagen)

'Set the picturebox picture property to a bitmap that has various colours on
white background
'and it's ScaleMode property to 3 - Pixel.

Option Explicit


Private Sub Command1_Click()
    Dim R As RECT
    With R
       .Right = Picture1.ScaleWidth
       .Bottom = Picture1.ScaleHeight
    End With
    Call TransparentBlt(Form1.hdc, Form1.hdc, Picture1.hdc, R, 20, 20,
&H8000000F)
End Sub



Private Sub TransparentBlt(OutDstDC&, DstDC&, SrcDC&, SrcRect As RECT,
DstX%, DstY%, TransColor&)

   '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

    Dim nRet&, W%, H%
    Dim MonoMaskDC&, hMonoMask&
    Dim MonoInvDC&, hMonoInv&
    Dim ResultDstDC&, hResultDst&
    Dim ResultSrcDC&, hResultSrc&
    Dim hPrevMask&, hPrevInv&
    Dim hPrevSrc&, hPrevDst&

    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&)
    MonoInvDC& = CreateBitmap&(W%, H%, 1, 1, ByVal 0&)
    hPrevMask& = SelectObject&(MonoMaskDC&, hMonoMask&)
    hPrevInv& = SelectObject&(MonoInvDC&, MonoInvDC&)

   '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&
    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)

   'output results
    nRet = BitBlt(OutDstDC&, DstX%, DstY%, W%, H%, ResultDstDC&, 0, 0,
vbSrcCopy)

   'clean up
    hMonoMask& = SelectObject&(MonoMaskDC&, hPrevMask&)
    DeleteObject hMonoMask&

    hMonoInv& = SelectObject&(MonoInvDC&, hPrevInv&)
    DeleteObject hMonoInv&

    hResultDst = SelectObject&(MonoInvDC&, hPrevDst&)
    DeleteObject hResultDst

    hResultSrc = SelectObject&(ResultSrcDC, hPrevSrc&)
    DeleteObject hResultSrc

    DeleteDC MonoMaskDC&
    DeleteDC MonoInvDC&
    DeleteDC ResultDstDC&
    DeleteDC ResultSrcDC

End Sub

> -----Mensaje original-----
>
> Rafael E. Sánchez Ruiloba
> Servicex Dpto.4



Resumen Resumen

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com