This is for a program that takes an arbitrary number of items (assumed to be of equal size) and lays them out using whatever ratio the user chooses, e.g., 1:1, 3:4, 3.5:2.5, etc.
I looked up how to calculate a ratio (been a loooong time since school) and found a simple explanation, but already the algorithm or my code is failing:
For ratio 1:1 with 16 items, it should be 4 rows, 4 columns, but it calculates 8 rows, 8 columns.
For ratio 3:4 and 12 items, it should output 4 rows, 3 columns, but we get 5.142857 rows, 6.857143 rows.
If someone can point out the error of my ways that would be great.
I looked up how to calculate a ratio (been a loooong time since school) and found a simple explanation, but already the algorithm or my code is failing:
For ratio 1:1 with 16 items, it should be 4 rows, 4 columns, but it calculates 8 rows, 8 columns.
For ratio 3:4 and 12 items, it should output 4 rows, 3 columns, but we get 5.142857 rows, 6.857143 rows.
If someone can point out the error of my ways that would be great.
Code: (Select All)
Option _Explicit
Type LayoutType
Horizontal As Single
Vertical As Single
Name As String
End Type ' LayoutType
Dim iLoop As Integer
Dim iCount As Integer
Dim iLayoutCount As Integer
Dim sNextName As String
Dim RatioSum As Single
Dim ColumCount As Single
Dim RowCount As Single
Dim sngRowCol As Single
Dim iEvenCount As Integer
Dim iSquareCount As Integer
Dim in$
' LAYOUTS
ReDim arrLayout(1 To 32) As LayoutType
' INIT SCREEN
Screen _NewImage(1280, 1024, 32)
_ScreenMove 0, 0
' =============================================================================
' INITIALIZE LAYOUT OPTIONS
iLayoutCount = 0
Restore RatioData
Do
iLayoutCount = iLayoutCount + 1
Read arrLayout(iLayoutCount).Horizontal
Read arrLayout(iLayoutCount).Vertical
Read sNextName: arrLayout(iLayoutCount).Name = Replace$(sNextName, ";", ",")
If arrLayout(iLayoutCount).Horizontal = 0 Then Exit Do
Loop
RatioData:
Data 1,1,Square (profile pictures; social media)
Data 3,2,Classic 35mm (4x6; 6x9; etc.) (landscape)
Data 2,3,Classic 35mm (4x6; 6x9; etc.) (portrait)
Data 3.5,2.5,5x7 photo (landscape)
Data 2.5,3.5,5x7 photo (portrait)
Data 1.29,1,Standard letter size (8.5x11) (landscape)
Data 1,1.29,Standard letter size (8.5x11) (portrait)
Data 1.414,1,A4 paper (landscape)
Data 1,1.414,A4 paper (portrait)
Data 4,3,Older PC monitor + analog TV (640x480; 1024x768; etc.) (landscape)
Data 3,4,Older PC monitor + analog TV (640x480; 1024x768; etc.) (portrait)
Data 5,4,Art prints + medium format (8x10; 16x20) (landscape)
Data 4,5,Art prints + medium format (8x10; 16x20) (portrait)
Data 14,11,legal paper (11x14) (landscape)
Data 11,14,legal paper (11x14) (portrait)
Data 16,9,Standard HD display (1920x1080; 1280x720; etc.) (landscape)
Data 9,16,Standard HD display (1920x1080; 1280x720; etc.) (portrait)
Data 0,0,Custom (user enters ratio)
' =============================================================================
' PROMPUT USER TO ENTER A NUMBER THEN CALCULATE ROWS/COLUMNS BASED ON LAYOUT RATIOS
Do
Do
Cls
Print "Ratio Test"
Print
Input "Number of items? (0 to exit)"; in$
_KeyClear: '_DELAY 1
If IsNumber%(in$) = _TRUE Then
iCount = Val(in$)
Exit Do
End If
Loop
If iCount < 1 Then Exit Do
' -----------------------------------------------------------------------------
' Get even # of items
If IsEven%(iCount) = _TRUE Then
iEvenCount = iCount
Else
iEvenCount = iCount + 1
End If
' -----------------------------------------------------------------------------
' Get total # of items we would need for an equal number of rows and columns
sngRowCol = Sqr(iCount)
If sngRowCol = Int(sngRowCol) Then
iSquareCount = iCount
Else
' ADD ITEMS TO ALLOW FOR SQUARE LAYOUT
iSquareCount = iCount
Do
iSquareCount = iSquareCount + 1
sngRowCol = Sqr(iSquareCount)
If sngRowCol = Int(sngRowCol) Then Exit Do
Loop
End If
' -----------------------------------------------------------------------------
' SHOW ACTUAL COUNT + EVEN COUNT + COUNT NEEDED FOR SQUARE LAYOUT
Print "iCount = " + _Trim$(Str$(iCount))
Print "iEvenCount = " + _Trim$(Str$(iEvenCount))
Print "iSquareCount = " + _Trim$(Str$(iSquareCount))
Print
' -----------------------------------------------------------------------------
' SHOW RATIOS WITH CALCULATED NUMBER OF ROWS/COLUMNS FOR EACH
' From the internet:
' To calculate values corresponding to a ratio, for example 4:3 or 3:4
' 1. Calculate the sum of the ratio parts.
' The ratio is 3:4.
' The sum of ratio parts: 3 + 4 = 7
' 2. Divide the given number by the sum of the ratio parts.
' Let the given number be x.
' Result = x/7
' 3. Multiply the result by each part of the ratio.
' 1st part = x/7 * 3 = (3*x)/7
' 2nd part = x/7 * 4 = (4*x)/7
' Solution:
' The values corresponding to the 3:4 ratio from a number x are (3*x)/7 and (4*x)/7
For iLoop = 1 To iLayoutCount
If arrLayout(iLoop).Horizontal > 0 And arrLayout(iLoop).Vertical > 0 Then
'if arrLayout(iLoop).Horizontal = arrLayout(iLoop).Vertical then
If _TRUE = _FALSE Then
' SEPARATE CASE FOR EQUAL / SQUARE ?
Else
RatioSum = arrLayout(iLoop).Horizontal + arrLayout(iLoop).Vertical
' DOESN'T WORK:
ColumCount = (iEvenCount / RatioSum) * arrLayout(iLoop).Horizontal
RowCount = (iEvenCount / RatioSum) * arrLayout(iLoop).Vertical
Print _Trim$(Str$(iLoop)) + ". " + _
arrLayout(iLoop).Name + " " + _
"H:" + _Trim$(Str$(arrLayout(iLoop).Horizontal)) + " " + _
"V:" + _Trim$(Str$(arrLayout(iLoop).Vertical)) + " " + _
_Trim$(Str$(ColumCount)) + " columns, " + _
_Trim$(Str$(RowCount)) + " rows."
'' DOESN'T WORK:
'ColumCount = (arrLayout(iLoop).Horizontal * iEvenCount) / RatioSum
'RowCount = (arrLayout(iLoop).Vertical * iEvenCount) / RatioSum
'Print _Trim$(Str$(iLoop)) + ". " + _
' arrLayout(iLoop).Name + " " + _
' "H:" + _Trim$(Str$(arrLayout(iLoop).Horizontal)) + " " + _
' "V:" + _Trim$(Str$(arrLayout(iLoop).Vertical)) + " " + _
' _Trim$(Str$(ColumCount)) + " columns, " + _
' _Trim$(Str$(RowCount)) + " rows."
' OK WHY ARE WE GETTING SUCH WONKY NUMBERS?
' FIGURE OUT FOR RatioSum = 2, Total = 16:
' ColumCount RowCount
' ----------------------- --------------------- ----------------
' (Horizontal * RatioSum) + (Vertical * RatioSum) = Total * RatioSum
' (H * 2 ) + (V * 2 ) = 8 * 2
' (4 * 2 ) + (4 * 2 ) = 16
' Yields:
' Total / RatioSum = ( (Horizontal * RatioSum) + (Vertical * RatioSum) ) / RatioSum
' 16 / 2 = ( (H * 2 ) + (V * 2 ) ) / 2
' 8 = ( (H * 2 ) + (V * 2 ) ) / 2
' 16 = (H * 2 ) + (V * 2 )
' 16 - (2V) = 2H
' I vaguely recall solving for 2 variables in algebra
' but I'm so damn rusty it escapes me!
End If
End If
Next iLoop
Print
Print "PRESS ANY KEY TO TRY A DIFFERENT COUNT"
Sleep
_KeyClear: '_DELAY 1
Loop
Cls: Print: Print "Finished"
End
' /////////////////////////////////////////////////////////////////////////////
' Returns TRUE if number n is even
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
' see also: IsOdd%
Function IsEven% (n)
If n Mod 2 = 0 Then
IsEven% = _TRUE
Else
IsEven% = _FALSE
End If
End Function ' IsEven%
' /////////////////////////////////////////////////////////////////////////////
' Returns TRUE if value OriginalString$ is numeric.
' Re: Does a Is Number function exist in QB64?
' https://www.qb64.org/forum/index.php?topic=896.15
' Version 2 by madscijr
' Returns TRUE (-1) if string is an integer, FALSE (0) if not
' Version 1 by MWheatley
' Reply #18 on: January 01, 2019, 11:24:30 AM
' returns 1 if string is an integer, 0 if not
Function IsNumber% (OriginalString$)
Dim bResult%: bResult% = _FALSE
Dim iLoop%
Dim TestString$
'Dim bNegative%
Dim iDecimalCount%
Dim sNextChar$
'THEY SHOULD TRIM OUTSIDE THE FUNCTION!
'TestString$ = _TRIM$(OriginalString$)
If Len(OriginalString$) > 0 Then
TestString$ = ""
If Left$(OriginalString$, 1) = "+" Then
TestString$ = Right$(OriginalString$, Len(OriginalString$) - 1)
'bNegative% = FALSE
ElseIf Left$(OriginalString$, 1) = "-" Then
TestString$ = Right$(OriginalString$, Len(OriginalString$) - 1)
'bNegative% = TRUE
Else
TestString$ = OriginalString$
'bNegative% = FALSE
End If
If Len(TestString$) > 0 Then
bResult% = _TRUE
iDecimalCount% = 0
For iLoop% = 1 To Len(TestString$)
sNextChar$ = Mid$(TestString$, iLoop%, 1)
If sNextChar$ = "." Then
iDecimalCount% = iDecimalCount% + 1
If iDecimalCount% > 1 Then
' TOO MANY DECIMAL POINTS, INVALID!
bResult% = _FALSE
Exit For
End If
ElseIf Asc(sNextChar$) < 48 Or Asc(sNextChar$) > 57 Then
' NOT A NUMERAL OR A DECIMAL, INVALID!
bResult% = _FALSE
Exit For
End If
Next iLoop%
End If
End If
IsNumber% = bResult%
End Function ' IsNumber%
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' found at abandoned, outdated and now likely malicious qb64 dot net website
' http://www.qb64.[net]/forum/index_topic_5964-0/
'
'SUMMARY:
' Purpose: A library of custom functions that transform strings.
' Author: Dustinian Camburides (dustinian@gmail.com)
' Platform: QB64 (www.qb64.org)
' Revision: 1.6
' Updated: 5/28/2012
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
' VARIABLES:
Dim Text2 As String
Dim Find2 As String
Dim Add2 As String
Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
Dim strBefore As String ' The characters before the string to be replaced.
Dim strAfter As String ' The characters after the string to be replaced.
' INITIALIZE:
' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
Text2 = Text1
Find2 = Find1
Add2 = Add1
lngLocation = InStr(1, Text2, Find2)
' PROCESSING:
' While [Find2] appears in [Text2]...
While lngLocation
' Extract all Text2 before the [Find2] substring:
strBefore = Left$(Text2, lngLocation - 1)
' Extract all text after the [Find2] substring:
strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
' Return the substring:
Text2 = strBefore + Add2 + strAfter
' Locate the next instance of [Find2]:
lngLocation = InStr(1, Text2, Find2)
' Next instance of [Find2]...
Wend
' OUTPUT:
Replace$ = Text2
End Function ' Replace$
