2009-09-03 69 views
0

了一個圖片(稱爲i_MC),我就可以畫一個簡單的圖像(m_ImgMCN)做:特殊繪製透明圖片

Call i_MC.PaintPicture(m_ImgMCN, 0, 0, i_MC.width, i_MC.height) 

現在我想提出一個透明的圖像上這張照片,在具體位置。我發現了一個示例代碼,它能夠很好地解決一個問題:不應該透過第二張(透明)圖像透支的部分圖像會以純黑色透支。

如果通過設置Picture-property來繪製上面的背景圖像,則算法可以很好地工作。不能做到這一點,因爲這不允許任何拉伸。

透明圖像是一個簡單的圖像,比包含被遮罩的顏色的框更小。我用以下示例代碼(.AutoRedraw =適用於所有盒子和.ScaleMode = 3「像素):

Option Explicit 
Private Declare Function BitBlt Lib "gdi32" (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" (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" (ByVal hdc As _ 
     Long, ByVal crColor As Long) As Long 

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As _ 
     Long, ByVal hObject As Long) As Long 

Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal _ 
     hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) _ 
     As Long 

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc _ 
     As Long) As Long 

Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) _ 
     As Long 

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject _ 
     As Long) As Long 

Private Type RECT 
    Left As Long 
    Top As Long 
    Right As Long 
    Bottom As Long 
End Type 
Dim R As RECT 

Private Sub TranspPic(OutDstDC&, DstDC&, SrcDC&, SrcRect _ 
         As RECT, ByVal DstX&, ByVal DstY&, _ 
         TransColor&) 

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

    W = SrcRect.Right - SrcRect.Left 
    H = SrcRect.Bottom - SrcRect.Top 

    'Generieren einer Monochromen & einer inversen Maske 
    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) 

    'Puffer erstellen 
    ResultDstDC = CreateCompatibleDC(DstDC) 
    ResultSrcDC = CreateCompatibleDC(DstDC) 
    hResultDst = CreateCompatibleBitmap(DstDC, W, H) 
    hResultSrc = CreateCompatibleBitmap(DstDC, W, H) 
    hPrevDst = SelectObject(ResultDstDC, hResultDst) 
    hPrevSrc = SelectObject(ResultSrcDC, hResultSrc) 

    'Sourcebild in die monochrome Maske kopieren 
    Dim OldBC As Long 
    OldBC = SetBkColor(SrcDC, TransColor) 
    Result = BitBlt(MonoMaskDC, 0, 0, W, H, SrcDC, _ 
        SrcRect.Left, SrcRect.Top, vbSrcCopy) 
    TransColor = SetBkColor(SrcDC, OldBC) 

    'Inverse Maske erstellen 
    Result = BitBlt(MonoInvDC, 0, 0, W, H, _ 
        MonoMaskDC, 0, 0, vbNotSrcCopy) 

    'Hintergrund des Zielbildes auslesen 
    Result = BitBlt(ResultDstDC, 0, 0, W, H, _ 
        DstDC, DstX, DstY, vbSrcCopy) 

    'AND mit der Maske 
    Result = BitBlt(ResultDstDC, 0, 0, W, H, _ 
        MonoMaskDC, 0, 0, vbSrcAnd) 

    'Überlappung des Sourcebildes mit dem Zielbild auslesen 
    Result = BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, _ 
        SrcRect.Left, SrcRect.Top, vbSrcCopy) 

    'AND mit der invertierten, monochromen Maske 
    Result = BitBlt(ResultSrcDC, 0, 0, W, H, _ 
        MonoInvDC, 0, 0, vbSrcAnd) 

    'XOR mit beiden 
    Result = BitBlt(ResultDstDC, 0, 0, W, H, _ 
        ResultSrcDC, 0, 0, vbSrcInvert) 

    'Ergebnis in das Zielbild kopieren 
    Result = BitBlt(OutDstDC, DstX, DstY, W, H, _ 
        ResultDstDC, 0, 0, vbSrcCopy) 

    'Erstellte Objekte & DCs wieder freigeben 
    hMonoMask = SelectObject(MonoMaskDC, hPrevMask) 
    DeleteObject hMonoMask 
    DeleteDC MonoMaskDC 

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

    hResultDst = SelectObject(ResultDstDC, hPrevDst) 
    DeleteObject hResultDst 
    DeleteDC ResultDstDC 

    hResultSrc = SelectObject(ResultSrcDC, hPrevSrc) 
    DeleteObject hResultSrc 
    DeleteDC ResultSrcDC 
End Sub 

Private Sub MovePicTo(ByVal X&, ByVal Y&) 
    i_MC.Cls 
    picSrc.Picture = m_ImgMCN 
    With R 
     .Left = 0 
     .Top = 0 
     .Right = Picture2.ScaleWidth 
     .Bottom = Picture2.ScaleHeight 
    End With 
    Call TranspPic(i_MC.hdc, i_MC.hdc, picSrc.hdc, R, X, Y, vbWhite) 
    i_MC.Refresh 
    DoEvents 
End Sub 

此代碼最初駐留在activevb.de,我修改它一點點不改變算法或功能。我可能會發布鏈接到原始文章。

沒有成功,我試圖修改尺寸不同的中間的照片,但它一直畫的圖像錯誤:

其中透明像素繪製正確的圖像部分,背景是包括在內。圖片的其餘部分(算法不應觸及的部分)被黑色覆蓋。

任何想法是讚賞。一個算法來繪製24位的alphablended圖像也不錯!我搜索了很長時間,沒有找到一段代碼。

PS:這是普通的舊VB6,移動到.NET或任何其他語言不幸是不是一種選擇。

在此先感謝和問候

回答

0

該死。我的一位朋友使用WinAPI的函數TransparentBlt (MSDN)給我提示。現在作品很好。感謝那些看過它的人。

TY & GN8

問候atmocreations