Найти наименьшую площадь прямоугольника, образованного случайными точками - 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

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

11   голосов , оценка 3.636 из 5
Похожие ответы