Найти наименьшую площадь прямоугольника, образованного случайными точками - VB

Узнай цену своей работы

Формулировка задачи:

пожалуйста помогите решать проблему В плоскостье есть 20 точек. (с помощью RND). Определить ими составляемых возможные прямоугольники, нарисовать в PictureBox-е, найти наименьшую площадь имеющий прямоугольник и печать подготовлена в соответствии с пунктами прямоугольных координатах.

Решение задачи: «Найти наименьшую площадь прямоугольника, образованного случайными точками»

textual
Листинг программы
  1. Const Tolerance = 0.01
  2. Const Vertex = 20
  3.  
  4. Private Sub Form_Click()
  5.     Dim i As Long, j As Long, Y As Long, z As Long, pos() As Single, _
  6.         m As Single, p1 As Long, p2 As Long, p3 As Long, p4 As Long, _
  7.         min As Single, f As Boolean
  8.     Randomize: Cls
  9.     ReDim pos(Vertex - 1, 1)
  10.     For i = 0 To Vertex - 1
  11.         pos(i, 0) = Int(Rnd * 10) / 10: pos(i, 1) = Int(Rnd * 10) / 10
  12.         Circle (pos(i, 0), pos(i, 1)), 0.01, vbRed
  13.     Next
  14.     min = 1
  15.     For i = 0 To Vertex - 1: For j = 0 To Vertex - 1: For Y = 0 To Vertex - 1: For z = 0 To Vertex - 1
  16.         If Not (i = j Or i = Y Or i = z Or j = Y Or j = z Or Y = z) Then
  17.             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))
  18.             If m < min And m > 0 Then
  19.                 f = True
  20.                 min = m
  21.                 p1 = i: p2 = j: p3 = Y: p4 = z
  22.                 Line (pos(p1, 0), pos(p1, 1))-(pos(p2, 0), pos(p2, 1))
  23.                 Line -(pos(p3, 0), pos(p3, 1))
  24.                 Line -(pos(p4, 0), pos(p4, 1))
  25.                 Line -(pos(p1, 0), pos(p1, 1))
  26.             End If
  27.         End If
  28.     Next: Next: Next: Next
  29.    
  30.     If Not f Then MsgBox "ГЌГҐГІ ïðÿìîóãîëüГ*èêîâ": Exit Sub
  31.     DrawWidth = 4
  32.     Line (pos(p1, 0), pos(p1, 1))-(pos(p2, 0), pos(p2, 1)), vbRed
  33.     Line -(pos(p3, 0), pos(p3, 1)), vbRed
  34.     Line -(pos(p4, 0), pos(p4, 1)), vbRed
  35.     Line -(pos(p1, 0), pos(p1, 1)), vbRed
  36.     DrawWidth = 1
  37.     MsgBox "s=" & Format(min, "#0.000")
  38.    
  39.     Refresh
  40. End Sub
  41.  
  42. Private Function Rect(ByVal x1 As Single, ByVal y1 As Single, _
  43.                         ByVal x2 As Single, ByVal y2 As Single, _
  44.                         ByVal x3 As Single, ByVal y3 As Single, _
  45.                         ByVal x4 As Single, ByVal y4 As Single) As Single
  46.     Dim l1 As Single, l2 As Single
  47.     Dim px4 As Single, dy4 As Single
  48.    
  49.     dx4 = x3 + x1 - x2
  50.     dy4 = y3 + y1 - y2
  51.    
  52.     If Abs(dx4 - x4) > Tolerance Or Abs(dy4 - y4) > Tolerance Then Exit Function
  53.    
  54.     If (x1 = x2 And y1 = y2) Or (x3 = x2 And y3 = y2) Then Exit Function
  55.    
  56.     x1 = x1 - x2: y1 = y1 - y2: x3 = x3 - x2: y3 = y3 - y2
  57.     l1 = Sqr(x1 * x1 + y1 * y1): x1 = x1 / l1: y1 = y1 / l1
  58.     l2 = Sqr(x3 * x3 + y3 * y3): x3 = x3 / l2: y3 = y3 / l2
  59.     If Abs(x1 * x3 + y1 * y3) < Tolerance Then ' äîïóñê
  60.        Rect = l1 * l2
  61.     End If
  62. End Function
  63.  
  64. Private Sub Form_Load()
  65.     Height = (Height - ScaleHeight) + 5000
  66.     Width = (Width - ScaleWidth) + 5000
  67.     AutoRedraw = True: Scale (0, 0)-(1, 1)
  68. End Sub

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


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

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

11   голосов , оценка 3.636 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы