PDA

نسخه کامل مشاهده نسخه کامل : .:: پر کردن فرم با حالتی زیبا ::.



Vb1471
01-07-2010, 20:57
پر کردن فرم با حالتی زیبا







برای این کار کدهای زیر را در قسمت کد نویسی فرمتان پیست کنید


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


پایان

Morteza561
01-07-2010, 21:20
سه تا پیشنهاد دارم داداش:

1- اگر از جایی برای نقل مطلب استفاده می کنید. اسم مرجع رو بگید.

2- برای نوشتن کدها از تگ Code استفاده کنید.

3- برای این موضوعات تاپیک هایی تو انجمن هست. بهتره همونا رو ادامه بدید و تاپیک ها رو زیاد نکنید.

ممنون ...:11: