08-10-2022, 04:56 PM
This now work correctly. I forgot on rows 140 - 143 replacing map as map2& variables. Also FullScreen to row 111 is added.
Code: (Select All)
'Scrolling Map Example by SierraKen - August 9, 2022
Cls
Print " Random Large Map Maker"
Print: Print
Print " by SierraKen"
Print: Print
Print "This will create a large explorer-map.bmp file (currently around 30 mb in size)."
Print "After it loads the randomly made map picture, it will delete it off your"
Print "computer. Then you can use the arrow keys to walk around the map."
Print
Print "This is just an example to make something with a moving background."
Print "At first it will show a very large map graphic, just wait until around"
Print "20 seconds when it finishes the loading and calculation."
Print "The countdown timer will be in the topic bar above."
Print
Print "Currently the map only has randomly placed houses, but feel free to add anything"
Print "you wish. I placed notes in the QB64 code."
Print: Print
Input "Press Enter to start."; a$
Cls
Randomize Timer
Type object
x As Single
y As Single
End Type
Const keyUP = 18432
Const keyDOWN = 20480
Const keyLEFT = 19200
Const keyRIGHT = 19712
Const Esc = 27
Dim Shared player As object
Dim Shared camera As object
Dim Shared map As Long
Dim Shared map2 As Long
Dim playerSpeed As Single
Dim housex(30)
Dim housey(30)
Dim rx(250)
Dim ry(250)
start:
_Limit 2000
playerSpeed = 5
'------------------------------------------------------------------------------------------------------------
'Creates large "explorer-map.bmp" file to work off of. It will delete it after it is done loading and calculating.
'The Title Bar will show you how long of time it will take to load and calculate, which is around 20 seconds.
map2& = _NewImage(3000, 3000, 32)
'Screen map2&
_Dest map2&
_Source map2&
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Feel free to add any graphics between these 2 lines:
For h = 1 To 30
' _Limit 2000
again:
housex(h) = Rnd * 2500
housey(h) = Rnd * 2500
For check = 0 To h - 1
' _Limit 2000
If housex(check) > housex(h) - 150 And housex(check) < housex(h) + 150 And housey(check) > housey(h) - 225 And housey(check) < housey(h) + 225 Then GoTo again:
Next check
housex2 = (Rnd * 100) + 50
housey2 = (Rnd * 100) + 50
Line (housex(h), housey(h))-(housex(h) + housex2, housey(h) + housey2), _RGB32(255, 255, 255), B
Paint (housex(h) + 5, housey(h) + 5), _RGB32(216, 127, 78), _RGB32(255, 255, 255)
For sz = .25 To (housex2 / 2) Step .1
Circle (housex(h) + (housex2 / 2), housey(h)), sz, _RGB32(255, 255, 255), 2 * _Pi, _Pi, 1
Next sz
tt = 0
Paint (housex(h) + 2, housey(h) - (housey2 / 2) + 2), _RGB32(216, 127, 78), _RGB32(255, 255, 255)
Line (housex(h) + (housex2 / 2) - 10, housey(h) + (housey2 - 20))-(housex(h) + (housex2 / 2) + 10, housey(h) + housey2), _RGB32(255, 255, 255), B
Next h
For r = 1 To 250
' _Limit 2000
again2:
rx(r) = Rnd * 3000
ry(r) = Rnd * 3000
For check = 0 To 30
' _Limit 2000
If housex(check) > rx(r) - 150 And housex(check) < rx(r) + 150 And housey(check) > ry(r) - 225 And housey(check) < ry(r) + 225 Then GoTo again2:
Next check
size = Rnd * 20
Circle (rx(r), ry(r)), size, _RGB32(255, 255, 255)
Next r
Paint (2999, 2999), _RGB32(127, 172, 127), _RGB32(255, 255, 255)
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'SaveImage map2&, "explorer-map" 'The 20 second wait time is in the modified BMP SaveImage SUB.
'------------------------------------------------------------------------------------------------------------
'map2& = 0
'Cls
_Title "Map Explorer - by SierraKen"
Screen _NewImage(800, 600, 32)
_FullScreen 'upgrade
player.x = _Width / 2
player.y = _Height / 2
'map = _LoadImage("explorer-map.bmp", 32)
'_Dest map
'_Dest 0
'_Source 0
'Shell _DontWait _Hide "DEL explorer-map.bmp" 'Deletes big "explorer-map.bmp" file that it creates first, which is around 30 MB.
' KILL statement can do the same as DEL
t = 1
Do
Cls
_PutImage (camera.x, camera.y), map2& 'upgraded
If _KeyDown(keyUP) Then player.y = player.y - playerSpeed: t = t + 1
If _KeyDown(keyDOWN) Then player.y = player.y + playerSpeed: t = t + 1
If _KeyDown(keyLEFT) Then player.x = player.x - playerSpeed: t = t + 1
If _KeyDown(keyRIGHT) Then player.x = player.x + playerSpeed: t = t + 1
If _KeyDown(Esc) Then
Screen 0
_FreeImage map2&
System
End If
'here "map" replaced as "map2&"
If player.x < 0 Then player.x = 0
If player.x > _Width(map2&) Then player.x = _Width(map2&)
If player.y < 0 Then player.y = 0
If player.y > _Height(map2&) Then player.y = _Height(map2&)
adjustCamera
'Draw Head
For sz = .25 To 10 Step .25
Circle (player.x + camera.x, player.y + camera.y), sz, _RGB32(255, 166, 127)
Next sz
'Draw Smile
Circle (player.x + camera.x, player.y + camera.y + 2), 7, _RGB32(255, 0, 0), _Pi, 2 * _Pi, .5
'Draw Eyes
Circle (player.x + camera.x - 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
Circle (player.x + camera.x + 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
'hat
Line (player.x + camera.x - 10, player.y + camera.y - 10)-(player.x + camera.x + 10, player.y + camera.y - 9), _RGB32(155, 0, 0), BF
Line (player.x + camera.x - 5, player.y + camera.y - 9)-(player.x + camera.x + 5, player.y + camera.y - 15), _RGB32(155, 0, 0), BF
'Body
Line (player.x + camera.x - 10, player.y + camera.y + 10)-(player.x + camera.x + 10, player.y + camera.y + 40), _RGB32(155, 0, 0), BF
If t > 12 Then t = 1
If t > 0 And t < 6 Then
'Left Arm
For wid2 = .1 To 3 Step .1
Line (player.x + camera.x - 10 - wid2, player.y + camera.y + 10)-(player.x + camera.x - 20 - wid2, player.y + camera.y + 30), _RGB32(255, 166, 127)
Next wid2
'Right Arm
For wid1 = .1 To 3 Step .1
Line (player.x + camera.x + 10 + wid1, player.y + camera.y + 10)-(player.x + camera.x + 20 + wid1, player.y + camera.y + 30), _RGB32(255, 166, 127)
Next wid1
'Left leg
For wid2 = .1 To 3 Step .1
Line (player.x + camera.x - 10 + wid2, player.y + camera.y + 40)-(player.x + camera.x - 10 + wid2, player.y + camera.y + 60), _RGB32(255, 166, 127)
Next wid2
'Right leg
For wid1 = .1 To 3 Step .1
Line (player.x + camera.x + 10 - wid1, player.y + camera.y + 40)-(player.x + camera.x + 10 - wid1, player.y + camera.y + 60), _RGB32(255, 166, 127)
Next wid1
End If
If t > 5 And t < 13 Then
'Left Arm
For wid2 = .1 To 3 Step .1
Line (player.x + camera.x - 10 - wid2, player.y + camera.y + 10)-(player.x + camera.x - 30 - wid2, player.y + camera.y + 30), _RGB32(255, 166, 127)
Next wid2
'Right Arm
For wid1 = .1 To 3 Step .1
Line (player.x + camera.x + 10 + wid1, player.y + camera.y + 10)-(player.x + camera.x + 30 + wid1, player.y + camera.y + 30), _RGB32(255, 166, 127)
Next wid1
'Left leg
For wid2 = .1 To 3 Step .1
Line (player.x + camera.x - 10 + wid2, player.y + camera.y + 40)-(player.x + camera.x - 15 + wid2, player.y + camera.y + 60), _RGB32(255, 166, 127)
Next wid2
'Right leg
For wid1 = .1 To 3 Step .1
Line (player.x + camera.x + 10 - wid1, player.y + camera.y + 40)-(player.x + camera.x + 15 - wid1, player.y + camera.y + 60), _RGB32(255, 166, 127)
Next wid1
End If
_Display
_Limit 60
Loop
Sub adjustCamera
If player.x + camera.x > _Width / 2 Or player.x + camera.x < _Width / 2 Then
camera.x = _Width / 2 - player.x
End If
If camera.x > 0 Then camera.x = 0
If camera.x < -(_Width(map2&) - _Width) Then camera.x = -(_Width(map2&) - _Width)
If player.y + camera.y > _Height / 2 Or player.y + camera.y < _Height / 2 Then
camera.y = _Height / 2 - player.y
End If
If camera.y > 0 Then camera.y = 0
If camera.y < -(_Height(map2&) - _Height) Then camera.y = -(_Height(map2&) - _Height)
End Sub