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())