2009-09-03 8 views
0

は(I_MCと呼ばれる)のPictureBoxを持って、私はやってそれを簡単な画像(m_ImgMCN)を描きます特定の位置。私はサンプルコードを見つけました。これは、1つの問題でかなりうまくいきます。2番目の(透明な)画像で上書きしてはならない画像の部分は、黒く塗りつぶされています。特別抽選透明画素

ピクチャプロパティを設定することで、上からの背景イメージが描画されている場合、アルゴは完全に機能します。これは伸張を許さないため、これを行うことはできません。

透明イメージは、マスクされた色を含むボックスよりも小さい単純なイメージです。私は、次のサンプルコード(すべてのボックスと.ScaleMode = 3「の画素に対する真.AutoRedraw =)を使用した:

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ビットアルファベットの画像をペイントするアルゴリズムもうまくいくでしょう!私はかなり長い間googledしていて、コードの一部を見つけられませんでした。

PS:これは普通のVB6で、.NETやその他の言語に移行することは残念なことにオプションではありません。

ありがとうございます。

答えて

0

です。私の友人はTransparentBlt (MSDN)-WinAPIの機能を使ってヒントを教えてくれました。今はかなりうまく動作します。それを見た人に感謝します。

TY & GN8

についてのatmocreations

関連する問題