Posts: 4,020
Threads: 181
Joined: Apr 2022
Reputation:
225
12-02-2024, 03:56 PM
(This post was last modified: 12-02-2024, 04:27 PM by bplus.)
https://qb64phoenix.com/forum/showthread...4#pid30124
(It's reply #6 if you are dropped to bottom of page on links like I am in this forum.)
If @TempodiBasic can't figure it out then maybe other people could use help too...
Basic setup for playing a game over a very large background. Use arrow keys to move over background in that direction. If you stop, you have gone to edge of background.
Code: (Select All) _Title "Image bigger than screen" ' b+ 2024-12-02
Randomize Timer
Screen _NewImage(800, 600, 32)
_ScreenMove 100, 20
Dim bg&
bgw = 1600 ' double width and height for demo
bgh = 1200
bg& = _NewImage(bgw, bgh, 32)
_Dest bg&
For i = 1 To 80
Line (Rnd * bgw, Rnd * bgh)-Step(Rnd * 100 + 50, Rnd * 75 + 25), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), BF
Next
_Dest 0
d = 0: e = 0
While _KeyDown(27) = 0
Cls
k = _KeyHit
If k = 19200 Then d = -1: e = 0 ' left
If k = 19712 Then d = 1: e = 0 ' right
If k = 18432 Then e = -1: d = 0 ' up
If k = 20480 Then e = 1: d = 0 'down
top = top + e
If top < 0 Then top = 0
If top + _Height > bgh Then top = bgh - _Height
le = le + d
If le < 0 Then le = 0
If le + _Width > bgw Then le = bgw - _Width
_PutImage (0, 0)-(_Width, _Height), bg&, 0, (le, top)-(le + _Width, top + _Height)
_Display
_Limit 120
Wend
Of course you can do this step by step too with the arrow keys.
Code: (Select All) _Title "Step through Image bigger than screen" ' b+ 2024-12-02
Randomize Timer
Screen _NewImage(800, 600, 32)
_ScreenMove 100, 20
Dim bg&
bgw = 1600 ' double area for demo
bgh = 1200
bg& = _NewImage(bgw, bgh, 32)
_Dest bg&
For i = 1 To 80
Line (Rnd * bgw, Rnd * bgh)-Step(Rnd * 100 + 50, Rnd * 75 + 25), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), BF
Next
_Dest 0
stepper = 5 ' <<< set step size here!!!
While _KeyDown(27) = 0
Cls
k = _KeyHit
If k = 19200 Then ' left
If le - stepper >= 0 Then le = le - stepper
End If
If k = 19712 Then ' right
If le + stepper <= bgw - _Width - 1 Then le = le + stepper
End If
If k = 18432 Then ' up
If top - stepper >= 0 Then top = top - stepper
End If
If k = 20480 Then 'down
If top + stepper <= bgh - _Height - 1 Then top = top + stepper
End If
_PutImage (0, 0)-(_Width, _Height), bg&, 0, (le, top)-(le + _Width, top + _Height)
_Display
_Limit 120
Wend
b = b + ...
Posts: 459
Threads: 83
Joined: Apr 2022
Reputation:
25
A few years ago, when we found this out, I made Cave Fighter with scrolling background images. You can get a copy of it here:
https://qb64phoenix.com/forum/showthread.php?tid=3155
Posts: 2,717
Threads: 329
Joined: Apr 2022
Reputation:
222
Since you guys are all having fun with this, here's a Steve Simple version of screen scrolling at work. Just use the mouse and watch what happens!
Code: (Select All)
Screen _NewImage(800, 600, 32) 'the screen that the user is going to see
Background = _NewImage(800 * 3, 600 * 3, 32) 'my background which is 3 times larger than my screen
_Dest Background
_PrintMode _KeepBackground
'Create a background which we can scroll and view via the mouse
For x = 0 To 2
For y = 0 To 2
Line (x * 800, y * 600)-Step(800, 600), _RGB(x * 127.5, y * 127.5, Rnd * 256), BF 'draw each quadrent a different color
For i = 0 To 37
text$ = "QUADRENT" + Str$(y * 3 + x + 1) + ": LINE #" + Str$(i)
_PrintString (x * 800, y * 600 + i * _FontHeight), text$
Next
Next
Next
StartX = 800: StartY = 600
_MouseMove 400, 300 'center the mouse before we start scrolling like crazy
_Delay .2 'give the mouse time to move to the proper position for starting
Do
While _MouseInput: Wend
'If the mouse is near an edge, then change the starting points to reflect the scrolling
If _MouseX < 20 Then StartX = StartX - (20 - _MouseX): If StartX < 0 Then StartX = 0
If _MouseX > 779 Then StartX = StartX + (_MouseX - 779): If StartX > 1600 Then StartX = 1600
If _MouseY < 20 Then StartY = StartY - (20 - _MouseY): If StartY < 0 Then StartY = 0
If _MouseY > 579 Then StartY = StartY + (_MouseY - 579): If StartY > 1200 Then StartY = 1200
_PutImage (0, 0)-Step(800, 600), Background, 0, (StartX, StartY)-Step(800, 600)
_Display
_Limit 60
Loop Until _MouseButton(1) Or _MouseButton(2) 'press a mouse button to end
System
Note: The closer your mouse gets to the edge, the faster the scrolling. Advance your pointer slowly towards the edge and watch as the scroll speed increases and decreases as you approach the edge more.
Posts: 664
Threads: 97
Joined: Apr 2022
Reputation:
22
@SMcNeill: Breautiful!
Very smooth, and nice concise code.
I don't need this for any current progs, but it opens up a whole new can'o'word (games) for me!
Posts: 371
Threads: 30
Joined: Jul 2022
Reputation:
25
(12-02-2024, 03:56 PM)bplus Wrote: https://qb64phoenix.com/forum/showthread...4#pid30124
(It's reply #6 if you are dropped to bottom of page on links like I am in this forum.)
If @TempodiBasic can't figure it out then maybe other people could use help too...
Basic setup for playing a game over a very large background. Use arrow keys to move over background in that direction. If you stop, you have gone to edge of background.
Code: (Select All) _Title "Image bigger than screen" ' b+ 2024-12-02
Randomize Timer
Screen _NewImage(800, 600, 32)
_ScreenMove 100, 20
Dim bg&
bgw = 1600 ' double width and height for demo
bgh = 1200
bg& = _NewImage(bgw, bgh, 32)
_Dest bg&
For i = 1 To 80
Line (Rnd * bgw, Rnd * bgh)-Step(Rnd * 100 + 50, Rnd * 75 + 25), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), BF
Next
_Dest 0
d = 0: e = 0
While _KeyDown(27) = 0
Cls
k = _KeyHit
If k = 19200 Then d = -1: e = 0 ' left
If k = 19712 Then d = 1: e = 0 ' right
If k = 18432 Then e = -1: d = 0 ' up
If k = 20480 Then e = 1: d = 0 'down
top = top + e
If top < 0 Then top = 0
If top + _Height > bgh Then top = bgh - _Height
le = le + d
If le < 0 Then le = 0
If le + _Width > bgw Then le = bgw - _Width
_PutImage (0, 0)-(_Width, _Height), bg&, 0, (le, top)-(le + _Width, top + _Height)
_Display
_Limit 120
Wend
Of course you can do this step by step too with the arrow keys.
Code: (Select All) _Title "Step through Image bigger than screen" ' b+ 2024-12-02
Randomize Timer
Screen _NewImage(800, 600, 32)
_ScreenMove 100, 20
Dim bg&
bgw = 1600 ' double area for demo
bgh = 1200
bg& = _NewImage(bgw, bgh, 32)
_Dest bg&
For i = 1 To 80
Line (Rnd * bgw, Rnd * bgh)-Step(Rnd * 100 + 50, Rnd * 75 + 25), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), BF
Next
_Dest 0
stepper = 5 ' <<< set step size here!!!
While _KeyDown(27) = 0
Cls
k = _KeyHit
If k = 19200 Then ' left
If le - stepper >= 0 Then le = le - stepper
End If
If k = 19712 Then ' right
If le + stepper <= bgw - _Width - 1 Then le = le + stepper
End If
If k = 18432 Then ' up
If top - stepper >= 0 Then top = top - stepper
End If
If k = 20480 Then 'down
If top + stepper <= bgh - _Height - 1 Then top = top + stepper
End If
_PutImage (0, 0)-(_Width, _Height), bg&, 0, (le, top)-(le + _Width, top + _Height)
_Display
_Limit 120
Wend
Hi friend
I miss what is moving on the background so I add an Hero that stands on the bottom of the screen and runs left-right and down-up.
Here my MOD to your code
Code: (Select All)
_Title "Step through Image bigger than screen with HERO" ' b+ 2024-12-02 / TdB 2024-12-04
Randomize Timer
Screen _NewImage(800, 600, 32)
_ScreenMove 100, 20
Dim bg&
bgw = 1600 ' double area for demo
bgh = 1200
bg& = _NewImage(bgw, bgh, 32)
_Dest bg&
For i = 1 To 80
Line (Rnd * bgw, Rnd * bgh)-Step(Rnd * 100 + 50, Rnd * 75 + 25), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), BF
Next
_Dest 0
stepper = 5 ' <<< set step size here!!!
m = 1
While _KeyDown(27) = 0
Cls
k = _KeyHit
If k = 19200 Then ' left
If le - stepper >= 0 Then le = le - stepper
End If
If k = 19712 Then ' right
If le + stepper <= bgw - _Width - 1 Then le = le + stepper
End If
If k = 18432 Then ' up
If top - stepper >= 0 Then top = top - stepper
End If
If k = 20480 Then 'down
If top + stepper <= bgh - _Height - 1 Then top = top + stepper
End If
_PutImage (0, 0)-(_Width, _Height), bg&, 0, (le, top)-(le + _Width, top + _Height)
m = m * -1
MakeHero le, top + _Height - 60, m
_Display
_Limit 120
Wend
Sub MakeHero (X As Integer, Y As Integer, status As Integer)
If X > _Width - 40 Then X = _Width - 40
If Y > _Height - 60 Then Y = _Height - 60
Line (X + 20, Y)-(X, Y + 40), _RGBA32(127, 60, 227, 255)
Line (X + 20, Y)-(X + 40, Y + 40), _RGBA32(127, 60, 227, 255)
Line (X, Y + 40)-(X + 40, Y + 40), _RGBA32(127, 60, 227, 255)
Paint (X + 20, Y + 20), _RGBA32(127, 60, 227, 255), _RGBA32(127, 60, 227, 255)
Circle (X + 10, Y + 30), 5, _RGBA32(255, 6, 6, 255)
Circle (X + 30, Y + 30), 5, _RGBA32(255, 6, 6, 255)
If status = 1 Then
Line (X + 15, Y + 40)-(X + 20, Y + 60), _RGBA(127, 60, 227, 255), BF
Line (X + 30, Y + 40)-(X + 35, Y + 60), _RGBA(127, 60, 227, 255), BF
ElseIf status = -1 Then
Line (X + 10, Y + 40)-(X + 15, Y + 60), _RGBA(127, 60, 227, 255), BF
Line (X + 25, Y + 40)-(X + 30, Y + 60), _RGBA(127, 60, 227, 255), BF
End If
End Sub
I hope you like it!
Posts: 371
Threads: 30
Joined: Jul 2022
Reputation:
25
@SMcNeill
as told in the other thread a little tutorial STEP by STEP on scrolling in 2D graphic mode
read thread
it is very interesting and useful the scrolling by mouse on the edge like in C&C and AOE!
Smarter the relation between the distance of the mouse pointer from the edge of screen and the speed of scrolling.
Posts: 4,020
Threads: 181
Joined: Apr 2022
Reputation:
225
(12-04-2024, 01:29 AM)TempodiBasic Wrote: (12-02-2024, 03:56 PM)bplus Wrote: https://qb64phoenix.com/forum/showthread...4#pid30124
(It's reply #6 if you are dropped to bottom of page on links like I am in this forum.)
If @TempodiBasic can't figure it out then maybe other people could use help too...
Basic setup for playing a game over a very large background. Use arrow keys to move over background in that direction. If you stop, you have gone to edge of background.
Code: (Select All) _Title "Image bigger than screen" ' b+ 2024-12-02
Randomize Timer
Screen _NewImage(800, 600, 32)
_ScreenMove 100, 20
Dim bg&
bgw = 1600 ' double width and height for demo
bgh = 1200
bg& = _NewImage(bgw, bgh, 32)
_Dest bg&
For i = 1 To 80
Line (Rnd * bgw, Rnd * bgh)-Step(Rnd * 100 + 50, Rnd * 75 + 25), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), BF
Next
_Dest 0
d = 0: e = 0
While _KeyDown(27) = 0
Cls
k = _KeyHit
If k = 19200 Then d = -1: e = 0 ' left
If k = 19712 Then d = 1: e = 0 ' right
If k = 18432 Then e = -1: d = 0 ' up
If k = 20480 Then e = 1: d = 0 'down
top = top + e
If top < 0 Then top = 0
If top + _Height > bgh Then top = bgh - _Height
le = le + d
If le < 0 Then le = 0
If le + _Width > bgw Then le = bgw - _Width
_PutImage (0, 0)-(_Width, _Height), bg&, 0, (le, top)-(le + _Width, top + _Height)
_Display
_Limit 120
Wend
Of course you can do this step by step too with the arrow keys.
Code: (Select All) _Title "Step through Image bigger than screen" ' b+ 2024-12-02
Randomize Timer
Screen _NewImage(800, 600, 32)
_ScreenMove 100, 20
Dim bg&
bgw = 1600 ' double area for demo
bgh = 1200
bg& = _NewImage(bgw, bgh, 32)
_Dest bg&
For i = 1 To 80
Line (Rnd * bgw, Rnd * bgh)-Step(Rnd * 100 + 50, Rnd * 75 + 25), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), BF
Next
_Dest 0
stepper = 5 ' <<< set step size here!!!
While _KeyDown(27) = 0
Cls
k = _KeyHit
If k = 19200 Then ' left
If le - stepper >= 0 Then le = le - stepper
End If
If k = 19712 Then ' right
If le + stepper <= bgw - _Width - 1 Then le = le + stepper
End If
If k = 18432 Then ' up
If top - stepper >= 0 Then top = top - stepper
End If
If k = 20480 Then 'down
If top + stepper <= bgh - _Height - 1 Then top = top + stepper
End If
_PutImage (0, 0)-(_Width, _Height), bg&, 0, (le, top)-(le + _Width, top + _Height)
_Display
_Limit 120
Wend
Hi friend
I miss what is moving on the background so I add an Hero that stands on the bottom of the screen and runs left-right and down-up.
Here my MOD to your code
Code: (Select All)
_Title "Step through Image bigger than screen with HERO" ' b+ 2024-12-02 / TdB 2024-12-04
Randomize Timer
Screen _NewImage(800, 600, 32)
_ScreenMove 100, 20
Dim bg&
bgw = 1600 ' double area for demo
bgh = 1200
bg& = _NewImage(bgw, bgh, 32)
_Dest bg&
For i = 1 To 80
Line (Rnd * bgw, Rnd * bgh)-Step(Rnd * 100 + 50, Rnd * 75 + 25), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), BF
Next
_Dest 0
stepper = 5 ' <<< set step size here!!!
m = 1
While _KeyDown(27) = 0
Cls
k = _KeyHit
If k = 19200 Then ' left
If le - stepper >= 0 Then le = le - stepper
End If
If k = 19712 Then ' right
If le + stepper <= bgw - _Width - 1 Then le = le + stepper
End If
If k = 18432 Then ' up
If top - stepper >= 0 Then top = top - stepper
End If
If k = 20480 Then 'down
If top + stepper <= bgh - _Height - 1 Then top = top + stepper
End If
_PutImage (0, 0)-(_Width, _Height), bg&, 0, (le, top)-(le + _Width, top + _Height)
m = m * -1
MakeHero le, top + _Height - 60, m
_Display
_Limit 120
Wend
Sub MakeHero (X As Integer, Y As Integer, status As Integer)
If X > _Width - 40 Then X = _Width - 40
If Y > _Height - 60 Then Y = _Height - 60
Line (X + 20, Y)-(X, Y + 40), _RGBA32(127, 60, 227, 255)
Line (X + 20, Y)-(X + 40, Y + 40), _RGBA32(127, 60, 227, 255)
Line (X, Y + 40)-(X + 40, Y + 40), _RGBA32(127, 60, 227, 255)
Paint (X + 20, Y + 20), _RGBA32(127, 60, 227, 255), _RGBA32(127, 60, 227, 255)
Circle (X + 10, Y + 30), 5, _RGBA32(255, 6, 6, 255)
Circle (X + 30, Y + 30), 5, _RGBA32(255, 6, 6, 255)
If status = 1 Then
Line (X + 15, Y + 40)-(X + 20, Y + 60), _RGBA(127, 60, 227, 255), BF
Line (X + 30, Y + 40)-(X + 35, Y + 60), _RGBA(127, 60, 227, 255), BF
ElseIf status = -1 Then
Line (X + 10, Y + 40)-(X + 15, Y + 60), _RGBA(127, 60, 227, 255), BF
Line (X + 25, Y + 40)-(X + 30, Y + 60), _RGBA(127, 60, 227, 255), BF
End If
End Sub
I hope you like it!
I do like it, now I am challenged to to show how the hero can reach any point on the background thankyou for your reply!
b = b + ...
Posts: 4,020
Threads: 181
Joined: Apr 2022
Reputation:
225
12-04-2024, 03:00 AM
(This post was last modified: 12-04-2024, 03:30 PM by bplus.)
OK our hero, Spiderman, can step to any cell in background, one cell being spidy's radius (= HeroRadius here).
Code: (Select All) _Title "Hero Step through Image bigger than screen" ' b+ 2024-12-02
Randomize Timer
Screen _NewImage(800, 600, 32)
_ScreenMove 100, 20
Dim bg& ' bg = background so this is image handle
bgw = 1600 ' this is background width
bgh = 1200 ' this is background height
bg& = _NewImage(bgw, bgh, 32)
_Dest bg& ' make a random background of blocks
For i = 1 To 80
Line (Rnd * bgw, Rnd * bgh)-Step(Rnd * 500 - 250, Rnd * 400 - 200), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), BF
Next
_Dest 0
HeroStep = 5 ' each HeroStep moves our hero or background stpper pixels
HeroX = _Width / 2: HeroY = _Height / 2: HeroRadius = 50
While _KeyDown(27) = 0
Cls
k = _KeyHit
If k = 19200 Then ' left le = left edge
HeroHeading = _Pi
If le - HeroStep >= 0 Then
le = le - HeroStep
Else
If HeroX - HeroStep >= HeroRadius Then HeroX = HeroX - HeroStep
End If
End If
If k = 19712 Then ' right
HeroHeading = 0
If le + HeroStep <= bgw - _Width - 1 Then
le = le + HeroStep
Else
If HeroX + HeroStep <= _Width - HeroRadius Then HeroX = HeroX + HeroStep
End If
End If
If k = 18432 Then ' up
HeroHeading = _Pi * 3 / 2
If top - HeroStep >= 0 Then
top = top - HeroStep
Else
If HeroY - HeroStep >= HeroRadius Then HeroY = HeroY - HeroStep
End If
End If
If k = 20480 Then 'down
HeroHeading = _Pi / 2
If top + HeroStep <= bgh - _Height - 1 Then
top = top + HeroStep
Else
If HeroY + 5 <= _Height - HeroRadius Then HeroY = HeroY + HeroStep
End If
End If
_PutImage (0, 0)-(_Width, _Height), bg&, 0, (le, top)-(le + _Width, top + _Height)
drawSpinner HeroX, HeroY, .5, HeroHeading, &HFFAA2211
_Display
_Limit 30
Wend
' ==================== so less than 60 LOC to move our Hero over a back ground =====================
' !!!! All of the following routines are only needed for drawing our Hero in this Demo!!!!!!!!!!!
Sub drawSpinner (x As Integer, y As Integer, scale As Single, heading As Single, c As _Unsigned Long)
Dim x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd, red, blue, green
Static switch As Integer
switch = switch + 2
switch = switch Mod 16 + 1
red = _Red32(c): green = _Green32(c): blue = _Blue32(c)
r = 10 * scale
x1 = x + r * Cos(heading): y1 = y + r * Sin(heading)
r = 2 * r 'lg lengths
For lg = 1 To 8
If lg < 5 Then
a = heading + .9 * lg * _Pi(1 / 5) + (lg = switch) * _Pi(1 / 10)
Else
a = heading - .9 * (lg - 4) * _Pi(1 / 5) - (lg = switch) * _Pi(1 / 10)
End If
x2 = x1 + r * Cos(a): y2 = y1 + r * Sin(a)
drawLink x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(red + 20, green + 10, blue + 5)
If lg = 1 Or lg = 2 Or lg = 7 Or lg = 8 Then d = -1 Else d = 1
a1 = a + d * _Pi(1 / 12)
x3 = x2 + r * 1.5 * Cos(a1): y3 = y2 + r * 1.5 * Sin(a1)
drawLink x2, y2, 2 * scale, x3, y3, scale, _RGB32(red + 35, green + 17, blue + 8)
rd = Int(Rnd * 8) + 1
a2 = a1 + d * _Pi(1 / 8) * rd / 8
x4 = x3 + r * 1.5 * Cos(a2): y4 = y3 + r * 1.5 * Sin(a2)
drawLink x3, y3, scale, x4, y4, scale, _RGB32(red + 50, green + 25, blue + 12)
Next
r = r * .5
fcirc x1, y1, r, _RGB32(red - 20, green - 10, blue - 5)
x2 = x1 + (r + 1) * Cos(heading - _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading - _Pi(1 / 12))
fcirc x2, y2, r * .2, &HFF000000
x2 = x1 + (r + 1) * Cos(heading + _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading + _Pi(1 / 12))
fcirc x2, y2, r * .2, &HFF000000
r = r * 2
x1 = x + r * .9 * Cos(heading + _Pi): y1 = y + r * .9 * Sin(heading + _Pi)
TiltedEllipseFill 0, x1, y1, r, .7 * r, heading + _Pi, _RGB32(red, green, blue)
End Sub
Sub drawLink (x1, y1, r1, x2, y2, r2, c As _Unsigned Long)
Dim a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
a = _Atan2(y2 - y1, x2 - x1)
a1 = a + _Pi(1 / 2)
a2 = a - _Pi(1 / 2)
x3 = x1 + r1 * Cos(a1): y3 = y1 + r1 * Sin(a1)
x4 = x1 + r1 * Cos(a2): y4 = y1 + r1 * Sin(a2)
x5 = x2 + r2 * Cos(a1): y5 = y2 + r2 * Sin(a1)
x6 = x2 + r2 * Cos(a2): y6 = y2 + r2 * Sin(a2)
fquad x3, y3, x4, y4, x5, y5, x6, y6, c
fcirc x1, y1, r1, c
fcirc x2, y2, r2, c
End Sub
'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
Sub fquad (x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, x3 As Integer, y3 As Integer, x4 As Integer, y4 As Integer, c As _Unsigned Long)
ftri x1, y1, x2, y2, x4, y4, c
ftri x3, y3, x4, y4, x1, y1, c
End Sub
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Dim a&
a& = _NewImage(1, 1, 32)
_Dest a&
PSet (0, 0), K
_Dest 0
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
_FreeImage a& '<<< this is important!
End Sub
Sub TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c As _Unsigned Long)
Dim max As Integer, mx2 As Integer, i As Integer, j As Integer, k As Single, lasti As Single, lastj As Single
Dim prc As _Unsigned Long, tef As Long
prc = _RGB32(255, 255, 255, 255)
If a > b Then max = a + 1 Else max = b + 1
mx2 = max + max
tef = _NewImage(mx2, mx2)
_Dest tef
_Source tef 'point wont read without this!
For k = 0 To 6.2832 + .05 Step .1
i = max + a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang)
j = max + a * Cos(k) * Sin(ang) - b * Sin(k) * Cos(ang)
If k <> 0 Then
Line (lasti, lastj)-(i, j), prc
Else
PSet (i, j), prc
End If
lasti = i: lastj = j
Next
Dim xleft(mx2) As Integer, xright(mx2) As Integer, x As Integer, y As Integer
For y = 0 To mx2
x = 0
While Point(x, y) <> prc And x < mx2
x = x + 1
Wend
xleft(y) = x
While Point(x, y) = prc And x < mx2
x = x + 1
Wend
While Point(x, y) <> prc And x < mx2
x = x + 1
Wend
If x = mx2 Then xright(y) = xleft(y) Else xright(y) = x
Next
_Dest destHandle&
For y = 0 To mx2
If xleft(y) <> mx2 Then Line (xleft(y) + x0 - max, y + y0 - max)-(xright(y) + x0 - max, y + y0 - max), c, BF
Next
_FreeImage tef
End Sub
Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
EDIT: edited varaible names for crystal clear clarity
b = b + ...
Posts: 371
Threads: 30
Joined: Jul 2022
Reputation:
25
Yeah
I see a spider coming back!
Good Stuff.
A similar movement gained into this example by tiles
second example
|
