这是我刚刚在论坛中回复一个网友贴子时写的代码。其实我们想到绘制一个异形图像时完全可以指定一个绘图区域来完成。
Private
Declare
Function
CreateEllipticRgn Lib
"
gdi32
"
(ByVal X1
As
Long
, ByVal Y1
As
Long
, ByVal X2
As
Long
, ByVal Y2
As
Long
)
As
Long
Private Declare Function DeleteObject Lib " gdi32 " (ByVal hObject As Long ) As Long
Private Declare Function SelectObject Lib " gdi32 " (ByVal hdc As Long , ByVal hObject As Long ) As Long
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 Sub Command1_Click()
Dim lngPrevRgn As Long
Dim lngNewRgn As Long
Picture1.Cls
If Check1.Value = 1 Then
' ' 建立一个圆形区域
lngNewRgn = CreateEllipticRgn( 0 , 0 , CLng (Picture1.ScaleWidth), CLng (Picture1.ScaleHeight))
' ' 将建立的区域选入绘图场景
lngPrevRgn = SelectObject(Picture1.hdc, lngNewRgn)
End If
' ' 绘图
BitBlt Picture1.hdc, 0 , 0 , Picture1.ScaleWidth, Picture1.ScaleWidth, Picture2.hdc, 0 , 0 , vbSrcCopy
If Check1.Value = 1 Then
' ' 释放建立的区域
DeleteObject SelectObject(Picture1.hdc, lngPrevRgn)
End If
End Sub
Private Declare Function DeleteObject Lib " gdi32 " (ByVal hObject As Long ) As Long
Private Declare Function SelectObject Lib " gdi32 " (ByVal hdc As Long , ByVal hObject As Long ) As Long
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 Sub Command1_Click()
Dim lngPrevRgn As Long
Dim lngNewRgn As Long
Picture1.Cls
If Check1.Value = 1 Then
' ' 建立一个圆形区域
lngNewRgn = CreateEllipticRgn( 0 , 0 , CLng (Picture1.ScaleWidth), CLng (Picture1.ScaleHeight))
' ' 将建立的区域选入绘图场景
lngPrevRgn = SelectObject(Picture1.hdc, lngNewRgn)
End If
' ' 绘图
BitBlt Picture1.hdc, 0 , 0 , Picture1.ScaleWidth, Picture1.ScaleWidth, Picture2.hdc, 0 , 0 , vbSrcCopy
If Check1.Value = 1 Then
' ' 释放建立的区域
DeleteObject SelectObject(Picture1.hdc, lngPrevRgn)
End If
End Sub