لصنع فجوة داخل الفورم

استعرض الموضوع السابق استعرض الموضوع التالي اذهب الى الأسفل

default لصنع فجوة داخل الفورم

مُساهمة من طرف Admin في الثلاثاء أكتوبر 24, 2006 2:01 am

Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, _
ByVal Y3 As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 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 CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, _
ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, _
ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, _
ByVal hRgn As Long, ByVal bRedraw As Long) As Long

Private Function fMakeATranspArea(AreaType As String, _
pCordinate() As Long) As Boolean
Const RGN_DIFF = 4
Dim lOriginalForm As Long
Dim ltheHole As Long
Dim lNewForm As Long
Dim lFwidth As Single
Dim lFHeight As Single
Dim lborder_width As Single
Dim ltitle_height As Single

On Error GoTo Trap
lFwidth = ScaleX(Width, vbTwips, vbPixels)
lFHeight = ScaleY(Height, vbTwips, vbPixels)
lOriginalForm = CreateRectRgn(0, 0, lFwidth, lFHeight)
lborder_width = (lFHeight - ScaleWidth) / 2
ltitle_height = lFHeight - lborder_width - ScaleHeight
Select Case AreaType
Case "Elliptic"
ltheHole = CreateEllipticRgn(pCordinate(1), pCordinate(2), _
pCordinate(3), pCordinate(4))
Case "RectAngle"
ltheHole = CreateRectRgn(pCordinate(1), pCordinate(2), _
pCordinate(3), pCordinate(4))
Case "RoundRect"
ltheHole = CreateRoundRectRgn(pCordinate(1), pCordinate(2), _
pCordinate(3), pCordinate(4), pCordinate(5), pCordinate(6))
Case "Circle"
ltheHole = CreateRoundRectRgn(pCordinate(1), pCordinate(2), _
pCordinate(3), pCordinate(4), pCordinate(3), pCordinate(4))
Case Else
MsgBox "Unknown Shape!!"
Exit Function
End Select
lNewForm = CreateRectRgn(0, 0, 0, 0)
CombineRgn lNewForm, lOriginalForm, ltheHole, RGN_DIFF
SetWindowRgn hWnd, lNewForm, True
Me.Refresh
fMakeATranspArea = True
Exit Function
Trap:
MsgBox "error Occurred. Error # " & Err.Number & ", " & Err.Description
End Function

Private Sub Form_Load()
Dim lParam(1 To 6) As Long
lParam(1) = 100
lParam(2) = 208
lParam(3) = 50
lParam(4) = 50
lParam(5) = 666
lParam(6) = 555
'Call fMakeATranspArea("RoundRect", lParam())
'Call fMakeATranspArea("RectAngle", lParam())
'Call fMakeATranspArea("Circle", lParam())
Call fMakeATranspArea("Elliptic", lParam())
End Sub


عدل سابقا من قبل في الخميس أغسطس 16, 2007 10:44 am عدل 1 مرات

_________________
إذا أعجبك موضوع من مواضيعي فلا تقل شكـراً ...
بل قل الآتـي ::
اللهم اغفر له ولوالديه ولزوجته وابنائه ولأخوانه واخواته ولسائر المسلمين ماتقدم من ذنبهم وما تأخر..
وقِهم عذاب القبر وعذاب النار..
و أدخلهم الفردوس الأعلى مع الأنبياء والشهداء والصالحين ..
واجعل دعاءهم مستجاب في الدنيا والآخرة ..
اللـهم آميـن..اللـهم آميـن..اللـهم آميـن..

اخوكم جاد القرعان
الأردن- الطفيلة
jadquraan@yahoo.com
jad_quraansoft@hotmail.com
00962777765709

Admin
jadquraan
jadquraan

عدد الرسائل : 125
العمر : 34
تاريخ التسجيل : 19/10/2006

معاينة صفحة البيانات الشخصي للعضو http://jad4vb.lightbb.com

الرجوع الى أعلى الصفحة اذهب الى الأسفل

default شكر

مُساهمة من طرف العـطوي في الإثنين نوفمبر 13, 2006 3:29 pm

شكرا لك أخ جاد

العـطوي
عضو متميز
عضو متميز

عدد الرسائل : 43
تاريخ التسجيل : 06/11/2006

معاينة صفحة البيانات الشخصي للعضو

الرجوع الى أعلى الصفحة اذهب الى الأسفل

استعرض الموضوع السابق استعرض الموضوع التالي الرجوع الى أعلى الصفحة


 
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى