Private Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hdcDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hdcSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal crTransparent As Long) As Long
Private Sub Command1_Click()
TransparentBlt Picture1.Hdc, 0, 0, 100, 100, Picture2.hdc, 0, 0, 100, 100, 0 '最后一个参数是指出要透明化的颜色值,这里是黑色
End Sub
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Const srccopy = &HCC0020
Private Const srcinvert = &H660046
Private Const srcpaint = &HEE0086
Private Sub Command1_Click()
Dim w As Long
Dim h As Long
black = RGB(0, 0, 0)
white = RGB(255, 255, 255)
'将度量单位转换为象素
w = Picture1.Width / Screen.TwipsPerPixelX
h = Picture1.Height / Screen.TwipsPerPixelY
'拷贝Picture1到Picture2上
r% = BitBlt(Picture2.hdc, 0, 0, w, h, Picture1.hdc, 0, 0, srccopy)
'将Picture2中的图像制作成蒙板
For i = 0 To h
For j = 0 To w
currentcolor = GetPixel(Picture2.hdc, j, i)
If currentcolor <> black Then
retlong = SetPixel(Picture2.hdc, j, i, white)
End If
Next j
Next i
'Picture1和Picture2作反相运算产生的图像存于Picture1中
r% = BitBlt(Picture1.hdc, 0, 0, w, h, Picture2.hdc, 0, 0, srcinvert)
'用或运算将Picture2图像贴于背景Picture3
r% = BitBlt(Picture3.hdc, 30, 30, w - 5, h - 5, Picture2.hdc, 0, 0, srcpaint)
'用异或运算再将Picture1图像贴于背景Picture3
r% = BitBlt(Picture3.hdc, 30, 30, w - 5, h - 5, Picture1.hdc, 0, 0, srcinvert)
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Form_Load()
Picture2.Width = Picture1.Width
Picture2.Height = Picture1.Height
End Sub