Clipping Region RED EYE

'Clipping Region RED EYE



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()

    'Change scale mode for Form

    Me.ScaleMode = vbPixels

End Sub



Private Sub Form_Paint()

    Form_Resize

End Sub



Private Sub Form_Resize()

Dim Ret As Long

'destroy the previous region

DeleteObject hRgn

'create an elliptic region

hRgn = CreateEllipticRgn(0, 0, Me.ScaleWidth, _

Me.ScaleHeight)

'select this elliptic region into the form's device context

SelectClipRgn Me.hdc, hRgn

'move the clipping region

OffsetClipRgn Me.hdc, 10, 10

'generate a new clipping region

IntersectClipRect Me.hdc, 10, 10, 500, 300

'clear the form

Me.Cls

'draw a Black rectangle over the entire form

Me.Line (0, 0)-(Me.ScaleWidth, Me.ScaleHeight), vbRed, BF

'create a temporary region

Ret = CreateEllipticRgn(0, 0, 1, 1)

'copy the current clipping region into the temporary region

GetClipRgn Me.hdc, Ret

'set the new window region

SetWindowRgn Me.hWnd, Ret, True

End Sub



Private Sub Form_Unload(Cancel As Integer)

    'clean up

    DeleteObject hRgn

End Sub



Private Sub Form_Click()

    'unload the form when the user clicks on it

    Unload Me

End Sub