المشاركات : 491
المواضيع 63
الإنتساب : Sep 2013
السمعة :
2
الشكر: 33
تم شكره 272 مرات في 75 مشاركات
السلام عليكم
كيف ننشئ مخطط دائري
كما في الصورة
http://im33.gulfup.com/OgnRL.jpg
المشاركات : 164
المواضيع 0
الإنتساب : Aug 2013
السمعة :
1
الشكر: 0
تم شكره 36 مرات في 7 مشاركات
هذا مثال منقول يحتوي على دالة رسم المقطع الدائري
ضع 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
وهذه النتيجة
المشاركات : 491
المواضيع 63
الإنتساب : Sep 2013
السمعة :
2
الشكر: 33
تم شكره 272 مرات في 75 مشاركات
و كيف نحدد زاوية او مقدار كل قطاع دائري
المشاركات : 164
المواضيع 0
الإنتساب : Aug 2013
السمعة :
1
الشكر: 0
تم شكره 36 مرات في 7 مشاركات
النسبة المئوية هي اللي باللون الأحمر (وعدلت الدالة عشان تتلافى مشكلة تطابق الصفر وال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
المشاركات : 491
المواضيع 63
الإنتساب : Sep 2013
السمعة :
2
الشكر: 33
تم شكره 272 مرات في 75 مشاركات
شكرا جزيلا بس سؤال أخير اللون الشفاف او بلا لون شو رقمه في QBColor(9)
المشاركات : 164
المواضيع 0
الإنتساب : Aug 2013
السمعة :
1
الشكر: 0
تم شكره 36 مرات في 7 مشاركات
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
المشاركات : 491
المواضيع 63
الإنتساب : Sep 2013
السمعة :
2
الشكر: 33
تم شكره 272 مرات في 75 مشاركات
هل يمكن رسم الشكل على الفورم مباشرة او طريقة اذا ما نقلت عنصرا ما و ليكن تكست بوكس و ضعته فوقها يظهر فوق الصورة
|