.:: پر کردن فرم با حالتی زیبا ::.
پر کردن فرم با حالتی زیبا
برای این کار کدهای زیر را در قسمت کد نویسی فرمتان پیست کنید
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_Activate()
Dim Ret As Long
DeleteObject hRgn
hRgn = CreateEllipticRgn(0, 0, Me.ScaleWidth, Me.ScaleHeight)
SelectClipRgn Me.hdc, hRgn
OffsetClipRgn Me.hdc, 10, 1
IntersectClipRect Me.hdc, 10, 10, 500, 3001
Me.Cls
Me.Line (0, 0)-(Me.ScaleWidth, Me.ScaleHeight), vbBlack, BF
Ret = CreateEllipticRgn(0, 0, 1, 1)
GetClipRgn Me.hdc, Ret
SetWindowRgn Me.hWnd, Ret, True
End Sub
Private Sub Form_Load()
Me.ScaleMode = vbPixels
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteObject hRgn
End Sub
Private Sub Form_Click()
Unload Me
End Sub
پایان
