السلام عليكم
مطلوب كود رسم خط مع امكانية السحب لتغيير الطول و التدوير لتغيير الزاوية بواسطة الماوس فقط (كما هو حال الخط في برنامج الورد)
و كود لحساب طوله بالبكسل و السنتمتر
و زر انشاء تكست جديد و خط جديد في كل مرة للضغط
السلام عليكم
في هذا المثال ضع على الفورم: الأداة 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 من الجزائر
مشكور جدا يا اخ عبدالله190