|
Option Explicit
Private Declare Function BitBlt Lib "gdi32.dll" ( _
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 DeleteObject Lib "gdi32.dll" ( _
ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" ( _
ByVal hDC As Long, _
ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" ( _
ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" ( _
ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib _
"gdi32.dll" (ByVal hDC As Long, ByVal nWidth As Long, _
ByVal nHeight As Long) As Long
Public Sub MakePictureMask(picInput As PictureBox, _
picOutput As PictureBox)
Dim hBmp As Long
Dim hBmpOld As Long
Dim hDC As Long
Dim Width As Long
Dim Height As Long
With picInput
Width = .ScaleX(.Picture.Width, vbHimetric, vbPixels)
Height = .ScaleY(.Picture.Height, vbHimetric, vbPixels)
End With
hDC = CreateCompatibleDC(picInput.hDC)
hBmp = CreateCompatibleBitmap(hDC, Width, Height)
hBmpOld = SelectObject(hDC, hBmp)
Call BitBlt(hDC, 0, 0, Width, Height, picInput.hDC, 0, 0, _
vbSrcCopy)
Call BitBlt(picOutput.hDC, 0, 0, Width, Height, hDC, 0, 0, _
vbSrcCopy)
Call SelectObject(hDC, hBmpOld)
Call DeleteObject(hBmp)
Call DeleteDC(hDC)
picOutput.Refresh
End Sub
|
|