Code: (Select All)
$NoPrefix
ReDim Shared Room(1000, 1000) As Integer
Dim Shared ProjectName As String * 12 'try AS STRING * 5 ----> Out of memory bug occur here
ProjectName$ = "Test"
Type Room1D
As Integer Sx, Ex, Sy, Ey, Typ, Draw, C, Width, Depth
As String * 10 Name
End Type
ReDim Shared Room1(0) As Room1D
Room1(0).Sx = 20
Room1(0).Ex = 100
Room1(0).Sy = 20
Room1(0).Ey = 1000
Room1(0).Typ = 0
Room1(0).Draw = -1
Room1(0).C = 1
Room1(0).Width = 20
Room1(0).Depth = 20
ReDim _Preserve Room1(1) As Room1D
Print "Saving:"
Dim As Integer LB1, LB2, UB1, UB2
LB1 = LBound(Room, 1)
LB2 = LBound(Room, 2)
UB1 = UBound(Room, 1)
UB2 = UBound(Room, 2)
Print "Lbound nr 1 - Room :", LB1
Print "Lbound nr 2 - Room: ", LB2
Print "Ubound nr 1 - Room:", UB1
Print "Ubound nr 2 - Room:", UB2
Print "Project name string: ", ProjectName$ 'shared string variable
LB1 = LBound(Room1)
UB1 = UBound(Room1)
Print "Lbound - Room1:", LB1
Print "Ubound - Room1", UB1
If FileExists("test") Then Kill "test"
SaveRoom "test"
LoadRoom "test"
Print "---------------------------"
Print "Loaded is:"
LB1 = LBound(Room, 1)
LB2 = LBound(Room, 2)
UB1 = UBound(Room, 1)
UB2 = UBound(Room, 2)
Print "Lbound nr 1 - Room :", LB1
Print "Lbound nr 2 - Room: ", LB2
Print "Ubound nr 1 - Room:", UB1
Print "Ubound nr 2 - Room:", UB2
Print "Project name string: ", ProjectName$
LB1 = LBound(Room1)
UB1 = UBound(Room1)
Print "Lbound - Room1:", LB1
Print "Ubound - Room1", UB1
Sub LoadRoom (Project$)
ff = FreeFile
If _FileExists(Project$) Then
Open Project$ For Binary As #ff
Dim As Integer LB1, LB2, UB1, UB2
ReDim ProjectName As String * 16
Get #ff, , LB1
Get #ff, , LB2
Get #ff, , UB1
Get #ff, , UB2
ReDim Room(LB1 To UB1, LB2 To UB2) As Integer
Get #ff, , Room()
Get #ff, , ProjectName$ 'try comment this in both (loadroom and saveroom) and try again
Get #ff, , LB1
Get #ff, , UB1
ReDim Room1(LB1 To UB1) As Room1D
Get #ff, , Room1()
Else
errStat = _MessageBox("Error!", "File " + Project$ + " not exists.", "ok", "error", 1&)
End If
End Sub
Sub SaveRoom (Project$)
ff = FreeFile
If _FileExists(Project$) Then
errStat = _MessageBox("Error!", "File " + Project$ + " already exists. Overwrite?", "yesnocancel", "error", 2&)
If errStat = 1 Then GoTo OverWrite
Else
OverWrite:
ff = FreeFile
Open Project$ For Binary As #ff
Dim As Integer LB1, LB2, UB1, UB2
LB1 = LBound(Room, 1)
LB2 = LBound(Room, 2)
UB1 = UBound(Room, 1)
UB2 = UBound(Room, 2)
Put #ff, , LB1
Put #ff, , LB2
Put #ff, , UB1
Put #ff, , UB2
Put #ff, , Room()
Put #ff, , ProjectName$ 'try comment this in both (loadroom and saveroom) and try again
LB1 = LBound(Room1)
UB1 = UBound(Room1)
Put #ff, , LB1
Put #ff, , UB1
Put #ff, , Room1()
End If
End Sub
I discovered unexpected behavior in the source code provided. I save the contents of the fields with information about the size of the fields to a file and then read that information. Focus on the Room1 array size read (the last two entries). Then try changing above in the declaration DIM SHARED ProjectName AS STRING *12 to a different size *. When I entered *5, an error occurred - out of memory. When I changed it differently, the output of the read values LBOUND and UBOUND, which are written after this string in the test file, also changed.
If I disable writing and then reading ProjectName$ variable in LoadRoom and SaveRoom and then load, everything works fine.
Tested in QB64Pe x32 v3.12