Posts: 4,023
Threads: 181
Joined: Apr 2022
Reputation:
226
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: 470
Threads: 85
Joined: Apr 2022
Reputation:
28
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,714
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: 662
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: 367
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" | | Randomize Timer | | Screen _NewImage(800, 600, 32) | | _ScreenMove 100, 20 | | | | Dim bg& | | bgw = 1600 | | 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 | | m = 1 | | While _KeyDown(27) = 0 | | Cls | | k = _KeyHit | | If k = 19200 Then | | If le - stepper >= 0 Then le = le - stepper | | End If | | If k = 19712 Then | | If le + stepper <= bgw - _Width - 1 Then le = le + stepper | | End If | | If k = 18432 Then | | If top - stepper >= 0 Then top = top - stepper | | End If | | If k = 20480 Then | | 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: 367
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,023
Threads: 181
Joined: Apr 2022
Reputation:
226
(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" | | Randomize Timer | | Screen _NewImage(800, 600, 32) | | _ScreenMove 100, 20 | | | | Dim bg& | | bgw = 1600 | | 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 | | m = 1 | | While _KeyDown(27) = 0 | | Cls | | k = _KeyHit | | If k = 19200 Then | | If le - stepper >= 0 Then le = le - stepper | | End If | | If k = 19712 Then | | If le + stepper <= bgw - _Width - 1 Then le = le + stepper | | End If | | If k = 18432 Then | | If top - stepper >= 0 Then top = top - stepper | | End If | | If k = 20480 Then | | 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,023
Threads: 181
Joined: Apr 2022
Reputation:
226
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: 367
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
|