[asto]

السلام عليكم

مطلوب كود رسم خط مع امكانية السحب لتغيير الطول و التدوير لتغيير الزاوية بواسطة الماوس فقط (كما هو حال الخط في برنامج الورد)

و كود لحساب طوله بالبكسل و السنتمتر

و زر انشاء تكست جديد و خط جديد في كل مرة للضغط

[عبد الله190]

السلام عليكم
في هذا المثال ضع على الفورم: الأداة picture1
ثم أكتب الكود التالي وعند تشغيل البرنامج اضغط بالزر الأيسر للفأرة في أي نقطة من picture1 وقم بسحب الفأرة إلى أي مكان

كود :

Dim x1 As Integer
Dim y1 As Integer
Dim x2 As Integer
Dim y2 As Integer
Dim nbclick As Byte
Dim outil As String
Const vers_degre = 180 / 3.141592

Private Sub picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)


Dim longueur, tanalpha
If outil = "خط" Then
    If nbclick = 1 Then
       ' picture1.Cls   '  إذا أردت رسم خط فقط فعل هذا الأمر بحذف العلامة قبله
        picture1.Line (x1, y1)-(X, Y)
        longueur = Sqr((X - x1) ^ 2 + (Y - y1) ^ 2)
        If X <> x1 Then
        tanalpha = (Y - y1) / (X - x1)
        
        End If
    End If
End If
  If Index = 0 Then outil = "خط"

End Sub
Private Sub picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 0 Then
nbclick = nbclick + 1
    If nbclick = 1 Then
        picture1.Picture = picture1.Image
        x1 = X
        y1 = Y
    End If
    If nbclick = 2 Then
        x2 = X
        y2 = Y
       ' picture1.Cls
        picture1.Line (x1, y1)-(x2, y2)
        nbclick = 0
    End If
    
End If

End Sub

تقبل تحيات أخيك الخير طهوري المعروف بعبد الله190 من الجزائر

[asto]

مشكور جدا يا اخ عبدالله190