But during the change of the n rectangles I saw that to solve it properly is not a easy task.
What is the best approach to fit n as equal rectangles as possible into a screen (image)?
Here my version:
Code: Select all
'Coded by UEZ build 2020-03-29
#Define Ceiling(x) (-((-(x) * 2.0 - 0.5) Shr 1))
Type vZone
Dim As Short x1, y1, x2, y2
Dim As Ulong c
End Type
'Original code by Neptilo @ https://math.stackexchange.com/questions/466198/algorithm-to-get-the-maximum-size-of-n-squares-that-fit-into-a-rectangle-with-a
'Modified by UEZ
Sub Split(Zones() As vZone, iZones As Ushort, iW As Ushort, iH As Ushort)
Dim As Single ratio = Iif(Frac(Sqr(iZones)) = 0, 1, iW / iH)
Dim As Single ncols_float = Sqr(iZones * ratio), nrows_float = iZones / ncols_float
'Find best option filling the whole height
Dim As Uinteger nrows1 = Ceiling(nrows_float), ncols1 = Ceiling(iZones / nrows1)
While nrows1 * ratio < ncols1
nrows1 += 1
ncols1 = Ceiling(iZones / nrows1)
Wend
Dim As Single cell_size1 = iH / nrows1
'Find best option filling the whole width
Dim As Uinteger ncols2 = Ceiling(ncols_float), nrows2 = Ceiling(iZones / ncols2)
While ncols2 < nrows2 * ratio
ncols2 += 1
nrows2 = Ceiling(iZones / ncols2)
Wend
Dim As Single cell_size2 = iW / ncols2
'Find the best values
Dim As Uinteger nrows, ncols
If cell_size1 < cell_size2 Then
nrows = nrows1
ncols = ncols1
Else
nrows = nrows2
ncols = ncols2
End If
Dim As Uinteger i,j, k, x, y
Dim As Integer dz = iZones - (nrows * ncols), bz = Iif(dz <> 0, 1, 0)
Dim As Single dx = iW / ncols, dy = iH / nrows
For j = 0 To nrows - 1 - bz
For i = 0 To ncols - 1
x = Cuint(i * dx)
Zones(k).x1 = x
Zones(k).x2 = x + dx
Zones(k).y1 = (j Mod nrows) * dy
Zones(k).y2 = Zones(k).y1 + dy
k += 1
Next
Next
If bz Then
ncols = iZones - k
dx = iW / ncols
For i = 0 To ncols - 1
x = Cuint(i * dx)
Zones(k).x1 = x
Zones(k).x2 = x + dx
Zones(k).y1 = (j Mod nrows) * dy
Zones(k).y2 = Zones(k).y1 + dy
k += 1
Next
End If
End Sub
Const As UShort iW = 1024, iH = 768
Const As ULong iBGColor = &hFF000000
ScreenRes iW, iH, 32, , 100
Dim As Ushort iZones = 33, i
Dim Shared As vZone Zones(iZones)
Split(Zones(), iZones, iW, iH)
Randomize , 2
For i = 0 To iZones - 1
Zones(i).c = &HFF000000 Or Culng(Rnd() * &hFFFFFF)
'? i & ": " & "x1="&Zones(i).x1, "y1=" & Zones(i).y1, "x2="&Zones(i).x2, "y2=" & Zones(i).y2
Line (Zones(i).x1, Zones(i).y1)-(Zones(i).x2, Zones(i).y2), Zones(i).c, BF
Draw String (Zones(i).x1 + 2, Zones(i).y1 + 2), Str(i + 1), &hFFFFFFFF
Next
Do
Sleep 10, 1
Loop Until Len(InKey())