Найти наименьшую площадь прямоугольника, образованного случайными точками - VB
Формулировка задачи:
пожалуйста помогите решать проблему
В плоскостье есть 20 точек. (с помощью RND). Определить ими составляемых возможные прямоугольники, нарисовать в PictureBox-е, найти наименьшую площадь имеющий прямоугольник и печать подготовлена в соответствии с пунктами прямоугольных координатах.
Решение задачи: «Найти наименьшую площадь прямоугольника, образованного случайными точками»
textual
Листинг программы
- Const Tolerance = 0.01
- Const Vertex = 20
- Private Sub Form_Click()
- Dim i As Long, j As Long, Y As Long, z As Long, pos() As Single, _
- m As Single, p1 As Long, p2 As Long, p3 As Long, p4 As Long, _
- min As Single, f As Boolean
- Randomize: Cls
- ReDim pos(Vertex - 1, 1)
- For i = 0 To Vertex - 1
- pos(i, 0) = Int(Rnd * 10) / 10: pos(i, 1) = Int(Rnd * 10) / 10
- Circle (pos(i, 0), pos(i, 1)), 0.01, vbRed
- Next
- min = 1
- For i = 0 To Vertex - 1: For j = 0 To Vertex - 1: For Y = 0 To Vertex - 1: For z = 0 To Vertex - 1
- If Not (i = j Or i = Y Or i = z Or j = Y Or j = z Or Y = z) Then
- m = Rect(pos(i, 0), pos(i, 1), pos(j, 0), pos(j, 1), pos(Y, 0), pos(Y, 1), pos(z, 0), pos(z, 1))
- If m < min And m > 0 Then
- f = True
- min = m
- p1 = i: p2 = j: p3 = Y: p4 = z
- Line (pos(p1, 0), pos(p1, 1))-(pos(p2, 0), pos(p2, 1))
- Line -(pos(p3, 0), pos(p3, 1))
- Line -(pos(p4, 0), pos(p4, 1))
- Line -(pos(p1, 0), pos(p1, 1))
- End If
- End If
- Next: Next: Next: Next
- If Not f Then MsgBox "ГЌГҐГІ ïðÿìîóãîëüГ*èêîâ": Exit Sub
- DrawWidth = 4
- Line (pos(p1, 0), pos(p1, 1))-(pos(p2, 0), pos(p2, 1)), vbRed
- Line -(pos(p3, 0), pos(p3, 1)), vbRed
- Line -(pos(p4, 0), pos(p4, 1)), vbRed
- Line -(pos(p1, 0), pos(p1, 1)), vbRed
- DrawWidth = 1
- MsgBox "s=" & Format(min, "#0.000")
- Refresh
- End Sub
- Private Function Rect(ByVal x1 As Single, ByVal y1 As Single, _
- ByVal x2 As Single, ByVal y2 As Single, _
- ByVal x3 As Single, ByVal y3 As Single, _
- ByVal x4 As Single, ByVal y4 As Single) As Single
- Dim l1 As Single, l2 As Single
- Dim px4 As Single, dy4 As Single
- dx4 = x3 + x1 - x2
- dy4 = y3 + y1 - y2
- If Abs(dx4 - x4) > Tolerance Or Abs(dy4 - y4) > Tolerance Then Exit Function
- If (x1 = x2 And y1 = y2) Or (x3 = x2 And y3 = y2) Then Exit Function
- x1 = x1 - x2: y1 = y1 - y2: x3 = x3 - x2: y3 = y3 - y2
- l1 = Sqr(x1 * x1 + y1 * y1): x1 = x1 / l1: y1 = y1 / l1
- l2 = Sqr(x3 * x3 + y3 * y3): x3 = x3 / l2: y3 = y3 / l2
- If Abs(x1 * x3 + y1 * y3) < Tolerance Then ' äîïóñê
- Rect = l1 * l2
- End If
- End Function
- Private Sub Form_Load()
- Height = (Height - ScaleHeight) + 5000
- Width = (Width - ScaleWidth) + 5000
- AutoRedraw = True: Scale (0, 0)-(1, 1)
- End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д