السلام عليكم...
ضع كل الكود التالي في Module:
كود :
Public Enum EPartialCircle
epcQuadranr = 90 ' رسم ربع دائرة
epcHalf = 180 ' رسم نصف دائرة
epcTriquadrant = 270 ' رسم ثلاثة أرباع الدائرة
End Enum
Public Const PI As Double = 3.14159265358979
' دالة لتحويل الزوايا من نظام الدرجات إلى النظام القطري
Public Function DegToRad(AngleDeg As Double) As Double
DegToRad = AngleDeg * PI / 180
End Function
' دالة لتحويل الزوايا من النظام القطري إلى نظام الدرجات
Public Function RadToDeg(AngleRad As Double) As Double
RadToDeg = AngleRad * 180 / PI
End Function
' إجراء لرسم جزء من الدائرة
Public Sub DrawPartialCircle(AObject As Object, ByVal APortion As EPartialCircle, ByVal CenterX As Double, ByVal CenterY As Double, _
ByVal Radius As Double, ByVal StartDegAngle As Double, _
Optional ByVal ALineSize As Long = 1, _
Optional ByVal ALineColor As OLE_COLOR = vbBlack, _
Optional ByVal IsFilled As Boolean = False, _
Optional ByVal AFillColor As OLE_COLOR = vbWhite)
Dim AStartAngle As Double
Dim AEndAngle As Double
Dim OldDrawMode As DrawModeConstants
Dim OldDrawStyle As DrawStyleConstants
Dim OldDrawWidth As Integer
Dim OldFillStyle As FillStyleConstants
Dim OldFillColor As OLE_COLOR
' الاحتفاظ بالخصائص الأصلية للكائن
OldDrawMode = AObject.DrawMode
OldDrawStyle = AObject.DrawStyle
OldDrawWidth = AObject.DrawWidth
OldFillStyle = AObject.FillStyle
OldFillColor = AObject.FillColor
' ضبط الخصائص المطلوبة
AObject.DrawMode = 13 ' Copy Pen
AObject.DrawStyle = 0 ' Solid
AObject.DrawWidth = ALineSize
If IsFilled Then
AObject.FillStyle = 0 ' Solid
Else
AObject.FillStyle = 1 ' Transparent
End If
AObject.FillColor = AFillColor
' تحويل الزوايا
AStartAngle = DegToRad(StartDegAngle)
AEndAngle = DegToRad((StartDegAngle + APortion) Mod 360)
If AStartAngle = 0 Then AStartAngle = 0.00000000000001
If AEndAngle = 0 Then AEndAngle = 0.00000000000001
' رسم الجزء المطلوب
AObject.Circle (CenterX, CenterY), Radius, ALineColor, -AStartAngle, -AEndAngle
' استعادة القيم الأصلية لخصائص الكائن
AObject.DrawMode = OldDrawMode
AObject.DrawStyle = OldDrawStyle
AObject.DrawWidth = OldDrawWidth
AObject.FillStyle = OldFillStyle
AObject.FillColor = OldFillColor
End Sub
' إجراء لرسم قوس
Public Sub DrawArc(AObject As Object, ByVal CenterX As Double, ByVal CenterY As Double, ByVal Radius As Double, _
ByVal StartDegAngle As Double, ByVal EndDegAngle As Double, _
Optional ByVal ALineSize As Long = 1, Optional ByVal ALineColor As OLE_COLOR = vbBlack)
Dim AStartAngle As Double
Dim AEndAngle As Double
Dim OldDrawMode As DrawModeConstants
Dim OldDrawStyle As DrawStyleConstants
Dim OldDrawWidth As Integer
OldDrawMode = AObject.DrawMode
OldDrawStyle = AObject.DrawStyle
OldDrawWidth = AObject.DrawWidth
AObject.DrawMode = 13 ' Copy Pen
AObject.DrawStyle = 0 ' Solid
AObject.DrawWidth = ALineSize
AStartAngle = DegToRad(StartDegAngle)
AEndAngle = DegToRad(EndDegAngle)
AObject.Circle (CenterX, CenterY), Radius, ALineColor, AStartAngle, AEndAngle
AObject.DrawMode = OldDrawMode
AObject.DrawStyle = OldDrawStyle
AObject.DrawWidth = OldDrawWidth
End Sub
*** الإجراء الأول DrawPartialCircle يرسم جزء من دائرة (ربع أو نصف أو ثلاثة أرباع) حسب قيمة البارامتر الثاني (APortion) الذي يأخذ إحدى القيم: epcQuadranr لربع الدائرة، أو epcHalf لنصف الدائرة أو epcTriquadrant لثلاثة أرباع الدائرة.
= بقية البارامترات كالتالي:
* البارامتر AObject لتمرير اسم الكائن المطلوب الرسم عليه، يمكن أن يكون Form أو PictureBox.
* البارامتران CenterX و CenterY يحددان إحداثيا نقطة مركز الدائرة.
* البارامتر Radius يحدد نصف قطر الدائرة.
* البارامتر StartDegAngle يحدد زاوية بداية الرسم بنظام الدرجات (من 0 إلى 360). الزاوية صفر تقع على الاتجاه الموجب لمحور السينات ( <-- إلى اليمين) و تزداد الزاوية باتجاه عكس اتجاه عقارب الساعة.
* البارامتر ALineSize اختياري و يحدد حجم خط الرسم. القيمة الافتراضية 1 (أي 1 بكسل).
* البارامتر ALineColor اختياري و يحدد لون خط الرسم. القيمة الافتراضية اللون الأسود.
* البارامتر IsFilled اختياري و بحدد ما إذا كان الجزء المرسوم سيكون معبأ بلون محدد أم لا. القيمة الافتراضية False أي أن الشكل المرسوم لن يكون معبأ.
* البارامتر AFillColor اختياري و يحدد لون التعبئة (في حالة كان البارامتر IsFilled مضبوطاً على True). القيمة الافتراضية اللون الأبيض.
*** الإجراء الثاني DrawArc لرسم قوس محدد بزاويتين (الزاوية الأولى للبداية و الزاوية الثانية للنهاية). بارامتراته تشبه بارامترات الإجراء الأول إلا أنها أقل حيث لا توجد تعبئة، مع إضافة البارامتر EndDegAngle الذي يحدد زاوبة نهاية القوس (و طبعاً البارامتر StartDegAngle يحدد زاوية بداية القوس).
*** لا ننس أن الرسم يتم في اتجاه عكس عقارب الساعة (هذا هو سلوك الوظيفة Circle في VB6).
مثال لرسم ثلاثة أرباع دائرة على الـ Form ابتداءً من الزاوية 270 مع تعبئة الشكل باللون الأحمر:
كود :
DrawPartialCircle Me, epcTriquadrant, 2400, 2400, 1200, 270, , , True, vbRed
مثال لرسم قوس على الـ Form ابتداءً من الزاوية 0 إلى الزاوية 135 بخط سمكه 3 بكسل و لونه أزرق:
كود :
DrawArc Me, 2400, 2400, 1200, 0, 135, 3, vbBlue
نرجو الاستفادة و السلام.