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

كيف ننشئ مخطط دائري

كما في الصورة

http://im33.gulfup.com/OgnRL.jpg
الرد }}}
تم الشكر بواسطة:
#2
هذا مثال منقول يحتوي على دالة رسم المقطع الدائري

ضع Command وPictureBox ثم ضع هذا الكود
كود :
Option Explicit


Private Sub Command1_Click()
   Call DrawPiePiece(Picture1, 100, 100, 60, 0.001, 36, QBColor(9), QBColor(9))
   Call DrawPiePiece(Picture1, 100, 100, 60, 36, 55, QBColor(10), QBColor(10))
   Call DrawPiePiece(Picture1, 100, 100, 60, 55, 75, QBColor(11), QBColor(11))
   Call DrawPiePiece(Picture1, 100, 100, 60, 75, 99.999, QBColor(12), QBColor(12))
  
   Call DrawPiePiece(Picture1, 250, 100, 60, 0.001, 36, vbBlack, QBColor(9))
   Call DrawPiePiece(Picture1, 250, 100, 60, 36, 55, vbBlack, QBColor(10))
   Call DrawPiePiece(Picture1, 250, 100, 60, 55, 75, vbBlack, QBColor(11))
   Call DrawPiePiece(Picture1, 250, 100, 60, 75, 99.999, vbBlack, QBColor(12))

End Sub


Public Sub DrawPiePiece(pic As PictureBox, x As Integer, y As Integer, radius As Integer, fStart As Double, fEnd As Double, lineColor As Long, fillColor As Long)
   Const PI As Double = 3.14159265359
   pic.ScaleMode = vbPixels
  
   Dim CircleEnd As Double
   CircleEnd = -2 * PI
  
   pic.fillColor = fillColor
   pic.FillStyle = 0
  
   Dim dStart As Double
   Dim dEnd As Double
   dStart = fStart * (CircleEnd / 100)
   dEnd = fEnd * (CircleEnd / 100)
  
   pic.Circle (x, y), radius, lineColor, dStart, dEnd
End Sub

وهذه النتيجة
الرد }}}
تم الشكر بواسطة:
#3
و كيف نحدد زاوية او مقدار كل قطاع دائري
الرد }}}
تم الشكر بواسطة:
#4
النسبة المئوية هي اللي باللون الأحمر (وعدلت الدالة عشان تتلافى مشكلة تطابق الصفر وال100 على الدائرة)

[COLOR="#FF0000"]تلاحظ ان الجزء التالي يبدأ من نهاية اللي قبله
[/COLOR]

كود :
Option Explicit


Private Sub Command1_Click()
   Call DrawPiePiece(Picture1, 100, 100, 60, [color=#ff0000]0[/color], [color=#ff0000]36[/color], QBColor(9), QBColor(9))
   Call DrawPiePiece(Picture1, 100, 100, 60, [color=#ff0000]36[/color], [color=#ff0000]55[/color], QBColor(10), QBColor(10))
   Call DrawPiePiece(Picture1, 100, 100, 60, [color=#ff0000]55[/color], [color=#ff0000]75[/color], QBColor(11), QBColor(11))
   Call DrawPiePiece(Picture1, 100, 100, 60, [color=#ff0000]75[/color], [color=#ff0000]100[/color], QBColor(12), QBColor(12))
  
   Call DrawPiePiece(Picture1, 250, 100, 60, [color=#ff0000]0[/color], [color=#ff0000]36[/color], vbBlack, QBColor(9))
   Call DrawPiePiece(Picture1, 250, 100, 60, [color=#ff0000]36[/color], [color=#ff0000]55[/color], vbBlack, QBColor(10))
   Call DrawPiePiece(Picture1, 250, 100, 60, [color=#ff0000]55[/color], [color=#ff0000]75[/color], vbBlack, QBColor(11))
   Call DrawPiePiece(Picture1, 250, 100, 60, [color=#ff0000]75[/color], [color=#ff0000]100[/color], vbBlack, QBColor(12))

End Sub



Public Sub DrawPiePiece(pic As PictureBox, x As Integer, y As Integer, radius As Integer, [color=#ff0000]fStart [/color]As Double, [color=#ff0000]fEnd [/color]As Double, lineColor As Long, fillColor As Long)
   If fStart=0 Then fStart= 0.001
   If fStart=100 Then fStart= 99.999
   If fEnd=0 Then fEnd= 0.001
   If fEnd=100 Then fEnd= 99.999
   Const PI As Double = 3.14159265359
   pic.ScaleMode = vbPixels
  
   Dim CircleEnd As Double
   CircleEnd = -2 * PI
  
   pic.fillColor = fillColor
   pic.FillStyle = 0
  
   Dim dStart As Double
   Dim dEnd As Double
   dStart = fStart * (CircleEnd / 100)
   dEnd = fEnd * (CircleEnd / 100)
  
   pic.Circle (x, y), radius, lineColor, dStart, dEnd
End Sub
الرد }}}
تم الشكر بواسطة:
#5
شكرا جزيلا بس سؤال أخير اللون الشفاف او بلا لون شو رقمه في QBColor(9)
الرد }}}
تم الشكر بواسطة:
#6
asto كتب :شكرا جزيلا بس سؤال أخير اللون الشفاف او بلا لون شو رقمه في QBColor(9)

عشان اللون الشفاف قمت بتعديل الدالة (خلي لون التعبئة fillColor يساوي (-1) يعني ناقص واحد)

كود :
Option Explicit


Private Sub Command1_Click()
    Call DrawPiePiece(Picture1, 100, 100, 60, 0, 36, QBColor(9), QBColor(9))
    Call DrawPiePiece(Picture1, 100, 100, 60, 36, 55, QBColor(10), QBColor(10))
    Call DrawPiePiece(Picture1, 100, 100, 60, 55, 75, QBColor(11), [color=#FF0000][b]-1[/b][/color])
    Call DrawPiePiece(Picture1, 100, 100, 60, 75, 100, QBColor(12), QBColor(12))
    
    Call DrawPiePiece(Picture1, 250, 100, 60, 0, 36, vbBlack, QBColor(9))
    Call DrawPiePiece(Picture1, 250, 100, 60, 36, 55, vbBlack, QBColor(10))
    Call DrawPiePiece(Picture1, 250, 100, 60, 55, 75, vbBlack, [b][color=#FF0000]-1[/color][/b])
    Call DrawPiePiece(Picture1, 250, 100, 60, 75, 100, vbBlack, QBColor(12))

End Sub



Public Sub DrawPiePiece(pic As PictureBox, x As Integer, y As Integer, radius As Integer, fStart As Double, fEnd As Double, lineColor As Long, fillColor As Long)
    If fStart = 0 Then fStart = 0.001
    If fStart = 100 Then fStart = 99.999
    If fEnd = 0 Then fEnd = 0.001
    If fEnd = 100 Then fEnd = 99.999
    Const PI As Double = 3.14159265359
    pic.ScaleMode = vbPixels
    
    Dim CircleEnd As Double
    CircleEnd = -2 * PI
    
    If fillColor = -1 Then
        pic.FillStyle = 1
    Else
        pic.FillStyle = 0
        pic.fillColor = fillColor
    End If
    
    Dim dStart As Double
    Dim dEnd As Double
    dStart = fStart * (CircleEnd / 100)
    dEnd = fEnd * (CircleEnd / 100)
    
    pic.Circle (x, y), radius, lineColor, dStart, dEnd
End Sub
الرد }}}
تم الشكر بواسطة:
#7
هل يمكن رسم الشكل على الفورم مباشرة او طريقة اذا ما نقلت عنصرا ما و ليكن تكست بوكس و ضعته فوقها يظهر فوق الصورة
الرد }}}
تم الشكر بواسطة:


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


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