椭圆,圆形 CreateEllipticRgn '建立椭圆形区域Public Declare Function CreateEllipticRgn Lib "gdi32" Alias "CreateEllipticRgn" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long 多边形 CreatePolygonRgn '建立多边形区域Public Declare Function CreatePolyPolygonRgn Lib "gdi32" Alias "CreatePolyPolygonRgn" (lpPoint As POINTAPI, lpPolyCounts As Long, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
'''圆形PICTUREBOX代码: Private Declare Function GetClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long Private Declare Function IntersectClipRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long Private Declare Function OffsetClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long 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 SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long Dim hRgn As Long Private Sub Form_Load() Picture1.ScaleMode = vbPixels Set Picture1.Picture = LoadPicture("C:\Documents and Settings\wxy\My Documents\My Pictures\ÑùÆ·.jpg") End Sub Private Sub Form_Paint() Form_Resize End Sub Private Sub Form_Resize() Dim Ret As Long
DeleteObject hRgn
If Picture1.ScaleWidth > Picture1.ScaleHeight Then hRgn = CreateEllipticRgn(0, 0, Picture1.ScaleHeight - 10, Picture1.ScaleHeight - 10) Else hRgn = CreateEllipticRgn(0, 0, Picture1.ScaleWidth - 10, Picture1.ScaleWidth - 10) End If
SelectClipRgn Picture1.hdc, hRgn OffsetClipRgn Picture1.hdc, 10, 10 Ret = CreateEllipticRgn(0, 0, 0, 0) GetClipRgn Picture1.hdc, Ret SetWindowRgn Picture1.hWnd, Ret, True End Sub Private Sub Form_Unload(Cancel As Integer) DeleteObject hRgn End Sub Private Sub Form_Click() MsgBox "Click Form !" End SubPrivate Sub Picture1_Click() MsgBox "Click Picture !" End Sub'''只要能获得其 HDC ,理论上做任何形状都可以
CreateEllipticRgn '建立椭圆形区域Public Declare Function CreateEllipticRgn Lib "gdi32" Alias "CreateEllipticRgn" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
多边形
CreatePolygonRgn '建立多边形区域Public Declare Function CreatePolyPolygonRgn Lib "gdi32" Alias "CreatePolyPolygonRgn" (lpPoint As POINTAPI, lpPolyCounts As Long, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function GetClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function IntersectClipRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function OffsetClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
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 SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Dim hRgn As Long
Private Sub Form_Load()
Picture1.ScaleMode = vbPixels
Set Picture1.Picture = LoadPicture("C:\Documents and Settings\wxy\My Documents\My Pictures\ÑùÆ·.jpg")
End Sub
Private Sub Form_Paint()
Form_Resize
End Sub
Private Sub Form_Resize()
Dim Ret As Long
DeleteObject hRgn
If Picture1.ScaleWidth > Picture1.ScaleHeight Then
hRgn = CreateEllipticRgn(0, 0, Picture1.ScaleHeight - 10, Picture1.ScaleHeight - 10)
Else
hRgn = CreateEllipticRgn(0, 0, Picture1.ScaleWidth - 10, Picture1.ScaleWidth - 10)
End If
SelectClipRgn Picture1.hdc, hRgn
OffsetClipRgn Picture1.hdc, 10, 10
Ret = CreateEllipticRgn(0, 0, 0, 0)
GetClipRgn Picture1.hdc, Ret
SetWindowRgn Picture1.hWnd, Ret, True
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteObject hRgn
End Sub
Private Sub Form_Click()
MsgBox "Click Form !"
End SubPrivate Sub Picture1_Click()
MsgBox "Click Picture !"
End Sub'''只要能获得其 HDC ,理论上做任何形状都可以