0
은 (i_MC라고 함)에 PictureBox 있고 난 일을 그 위에 간단한 이미지 (m_ImgMCN)를 그리는하십시오에특수 그리기 투명 그림
지금Call i_MC.PaintPicture(m_ImgMCN, 0, 0, i_MC.width, i_MC.height)
내가이 사진을 투명한 이미지를 넣어 싶습니다 특정 위치. 하나의 문제로 꽤 잘 수행되는 샘플 코드를 발견했습니다. 두 번째 (투명) 이미지로 덮어서는 안되는 이미지 부분이 일반 검정색으로 덮어 씁니다.
그림 속성을 설정하여 위의 배경 이미지를 그릴 경우 완벽하게 작동합니다. 이것이 어떤 스트레칭도 허용하지 않기 때문에 이것을 할 수 없습니다.
투명 이미지는 마스크 된 색상을 포함하는 상자보다 작은 간단한 이미지입니다.
이 코드는 원래 activevb.de에있는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
, 난 조금 조금을 변경하지 않고 수정 : 나는 다음 샘플 코드 (모든 상자에 대한 사실 .AutoRedraw = 및 .ScaleMode는 = 3 '픽셀)을 사용했습니다 알고리즘 또는 기능. 나는 원래 기사에 대한 링크를 게시 할 수 있습니다.
성공없이, 나는 다른 중간 사진의 크기를 수정하려고했지만, 그것은 이미지 틀린 그림 계속 :
투명 그림이 정확 그려진 이미지의 부분은 배경이입니다 포함. 사진의 나머지 부분 (algo가 닿아서는 안되는 부분)은 검은 색으로 덮어 씁니다.
어떤 아이디어라도 받아 들일 수 있습니다. 24 비트 알파 블렌드 이미지를 그리는 알고리즘도 좋을 것입니다! 나는 꽤 오랫동안 봤 거든 코드의 작동 조각을 찾지 못했습니다.
추신 : 이것은 일반 오래된 VB6, .NET 또는 다른 언어로 이동하는 것은 불행히도 옵션이 아닙니다.
미리 감사드립니다.