如何绘制圆形图像？

     这是我刚刚在论坛中回复一个网友贴子时写的代码。其实我们想到绘制一个异形图像时完全可以指定一个绘图区域来完成。

 

 

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