تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
انشاء قوس
#1
السلام عليكم

كيف نرسم الامور التالية في الفورم و هي : نصف دائرة و ربع دائرة و قوس
الرد }}}}
تم الشكر بواسطة:
#2
السلام عليكم...

ضع كل الكود التالي في 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

نرجو الاستفادة و السلام.
بِسْمِ اللهِ الرَّحْمَنِ الرَّحِيمِ ( وَ مَا تُقَدِّمُوا لِأَنفُسِكُم مِّنْ خَيْرٍ تَجِدُوهُ عِندَ اللهِ هُوَ خَيْراً وَ أَعْظَمَ أَجْراً ) صَدَقَ اللهُ الْعَظِيمُ
الرد }}}}
تم الشكر بواسطة:
#3
مشكور اخي ناجي
الرد }}}}
تم الشكر بواسطة:
#4
لكنني اريد ايضا تحريك هذا القوس او الدائرة او النصف دائرة
الرد }}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
Smile انشاء مشروع في الvb.6 كترينا 1 120 07-07-16, 09:38 PM
آخر رد: Amir_alzubidy
  التعديل على كود انشاء ترقيم تلقائي ذاتي abouassem 12 3,473 07-04-15, 11:30 AM
آخر رد: الرجاء الوفيه
  كيف يتم انشاء استعلام كشف حساب مثل الذي في الصوره المرفقة من خلال فجوال البيسك الى قاعدة البيانات ؟؟ softmail8 1 598 16-02-15, 10:32 AM
آخر رد: Ashraf Elafify
  استفسار حول انشاء برنامج بلاحقة (امتداد) com مبرمج الحب 4 586 05-08-13, 05:11 PM
آخر رد: مبرمج الحب
  انشاء تلقائي asto 11 1,438 31-05-13, 06:17 AM
آخر رد: asto
  هل في الامكان انشاء فورم يتم إستدعاء الصوره من الماسح الضوئي (Scanner) مباشره ؟؟ softmail8 4 900 17-04-13, 09:35 PM
آخر رد: softmail8
  شرح طريقة انشاء barcode بسهوله ولد رائع 2 1,621 28-02-13, 01:12 AM
آخر رد: ولد رائع
  مساعده بطريقة انشاء كائن عبر الاكواد او انشاء تكست بوكس او ليبل عبر الاكواد the viper 2 394 23-11-12, 12:39 AM
آخر رد: the viper
  انشاء تابع asto 0 315 05-10-12, 03:11 AM
آخر رد: asto

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم