Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Moving over background larger than screen
#1
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 + ...
Reply
#2
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
Reply
#3
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.
Reply
#4
@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!
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#5
(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!
Reply
#6
@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.
Reply
#7
(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 + ...
Reply
#8
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 + ...
Reply
#9
Yeah 
I see a spider coming back!
Good Stuff.
A similar movement gained into this example by tiles
second example
Reply




Users browsing this thread: 1 Guest(s)