[lnkForumImage]
TotalShareware - Download Free Software
Confronta i prezzi di migliaia di prodotti.
Asp Forum
 Home | Login | Register | Search 


 

Forums >

microsoft.public.vb.general.discussion

Spiral out a grid

Larry Serflaten

1/7/2012 2:32:00 PM

I am looking for some formula that will let me fill a grid in a spiral
fashion. If I could use a square, it would be fairly simple, but the
end result needs to mark all the points of a circle. The problem is
that the angular velosity that works for the initial rounds, skips
grid cells when the distance from the center is increased. If I use an
angular velocity that works for the outward areas, then I am wasting
effort (taking to long) for the inward areas. It ultimately comes down
to using the right angular velocity with respect to the radius of the
circle. A series of circles would be OK also, as long as all grid
cells get filled.

Here is some example code for a 100 X 100 grid, I will be using
something closer to a 300 X 300 grid....

Thanks for any help in this matter!
LFS


Option Explicit

Private Grid(0 To 100, 0 To 100) As Long


Private Sub Form_Load()
Dim Angle!, Distance!, Spread!, Turn As Single
Dim GX&, GY&, CX&, CY As Long
Dim FullCircle As Single

Me.ScaleMode = vbPixels
FullCircle = Atn(1) * 8
CX = 50
CY = 50
Spread = 1.001
Show

Distance = 0.6
While Distance < 48
' Calculations
Angle = Angle + Spread
If Angle > FullCircle Then
Spread = Spread - 0.00002 - (0.4 ^ Distance)
If Spread < 0.002 Then Spread = 0.002
Debug.Print Spread
Angle = Angle - FullCircle
Distance = Distance + 0.98
'ShowGrid ' UN REM for speed drawing
End If
' Convert to grid
GX = Cos(Angle) * Distance + CX
GY = Sin(Angle) * Distance + CY
Grid(GX, GY) = Grid(GX, GY) + 1
ShowGrid ' REM to speed up drawing
DoEvents
Wend

End Sub

Sub ShowGrid()
Dim X&, Y&
For Y = 0 To 100
For X = 0 To 100
Select Case Grid(X, Y)
Case 0
Line (X * 5, Y * 5)-Step(5, 5), vbBlack, BF
Case 1
Line (X * 5, Y * 5)-Step(5, 5), vbWhite, BF
Case 2
Line (X * 5, Y * 5)-Step(5, 5), vbYellow, BF
Case Else
Line (X * 5, Y * 5)-Step(5, 5), vbRed, BF
End Select
Next X, Y
Me.PSet (0, 520), BackColor
Print " CELL HIT TALLIES:"
Print " Black=0 hits White=1 hit Yellow= 2 hits Red=
Too many"

End Sub
20 Answers

unknown

1/7/2012 8:05:00 PM

0

"Larry Serflaten" <serflaten@gmail.com> wrote in message
news:e37f1541-430d-4ea0-9611-336002c766ff@t13g2000yqg.googlegroups.com...
>I am looking for some formula that will let me fill a grid in a spiral
> fashion. If I could use a square, it would be fairly simple, but the
> end result needs to mark all the points of a circle. The problem is
> that the angular velosity that works for the initial rounds, skips
> grid cells when the distance from the center is increased. If I use an
> angular velocity that works for the outward areas, then I am wasting
> effort (taking to long) for the inward areas. It ultimately comes down
> to using the right angular velocity with respect to the radius of the
> circle. A series of circles would be OK also, as long as all grid
> cells get filled.
>
> Here is some example code for a 100 X 100 grid, I will be using
> something closer to a 300 X 300 grid....

It's not clear what you want to do. Is it for drawing a static picture, or
moving an object, or something else? In the first case, it's easy because
you can draw it based on grid coordinates and just loop through X and Y. In
the second case, it's more difficult, because as you mentioned you need to
make smaller angular increments as the radius gets larger, otherwise you end
up with gaps. The formula needed to determine this step based on radius is
the same as for arc lengths, which is:

s = r * Theta

In your case, the arc length at the end of the circle is one pixel(s=1), so
the angle increment is:

Theta = 1 / r

You better make this even smaller to insure that Integer rounding errors
don't result in pixel gaps. Try multiplying it with 0.75 for example.

See the diagram on the right in this page:

http://en.wikipedia.org/wiki/Angle#Measur...

I changed this line of code:

Angle = Angle + Spread

To:

Angle = Angle + (1 / Distance)

And I don't see red pixels(Too many times the same pixel was redrawn), but I
see few black and yellow pixels.


Jimekus

1/8/2012 1:38:00 AM

0

On Jan 8, 9:04 am, "Farnsworth" <nos...@nospam.com> wrote:
> "Larry Serflaten" <serfla...@gmail.com> wrote in message
>
> news:e37f1541-430d-4ea0-9611-336002c766ff@t13g2000yqg.googlegroups.com...
>
> >I am looking for some formula that will let me fill a grid in a spiral
> > fashion.  If I could use a square, it would be fairly simple, but the
> > end result needs to mark all the points of a circle. The problem is
> > that the angular velosity that works for the initial rounds, skips
> > grid cells when the distance from the center is increased. If I use an
> > angular velocity that works for the outward areas, then I am wasting
> > effort (taking to long) for the inward areas. It ultimately comes down
> > to using the right angular velocity with respect to the radius of the
> > circle.  A series of circles would be OK also, as long as all grid
> > cells get filled.

I use several methods to colorize spirals. My coordinates are the
result of matrix inversions of differential equations and are
therefore multidimensional. I use a series of bands in order to create
the shortest path spiral and all my methods involve creating
triangles, in a fan shape, onto the backbuffer of a rendering device.
Using the 2D GradientFillTri is easy but using Direct 3D is harder.

Larry Serflaten

1/8/2012 1:59:00 AM

0

On Jan 7, 2:04 pm, "Farnsworth" <nos...@nospam.com> wrote:

> In your case, the arc length at the end of the circle is one pixel(s=1), so
> the angle increment is:
>
> Theta = 1 / r
>
> You better make this even smaller to insure that Integer rounding errors
> don't result in pixel gaps. Try multiplying it with 0.75 for example.

Thanks, I tried using slightly smaller values but would see a lot of
red when
all the cells finaly got covered. I also tried using Double precision
variables to
see if that would help fill in the gaps, but it did not. I opted to
use the simplier
formula, which left me with:

Angle = Angle + Spread
Spread = 1 / Distance
Distance = Distance + (Spread / FullCircle)

Used for each iteration. That also left cells untouched, but it had a
low occurance
of multiple hits all the way out to 300 X 300. I decided I could use
that formula if I
also test and mark the 4 adjacent cells at each point along the
route. (If 0 Then 1)

Its rather surprising how simple that formula is once you know it! As
you saw, I
was way off using some exponential calculations. Thanks for the nudge
in the
right direction!

LFS

Larry Serflaten

1/8/2012 3:12:00 AM

0

OK, it looks like Goggle groups re-formats the messages to a certain line length. Sorry about the broken lines. I'm going to have to look into to that if I want to try to post code again....

Schmidt

1/8/2012 5:25:00 AM

0

Am 07.01.2012 15:32, schrieb Larry Serflaten:

> ...
> A series of circles would be OK also, as long
> as all grid cells get filled.

I take it, that the speed of the check-routine is
of the essence (and not the drawing/visualizing-code)?

Anyways, below is some fast snippet, which is accomplishing
the task in a "non-spiralic, but concentric fashion",
extending the Radius in single Pixel-Increments -
thereby wasting only about 27% of the time in
Pixel-DoubleChecks (meaning 73% is ending up white,
all the rest of the concentric area is yellow Pixels).
Extra-Code, "to keep everything white" would
need a more complex check-routine, which
in the end would run slower than the version
below (with the "27% overscan").

Time needed (on a Intel 2.8GHz-CPU) using a 300x300
Grid, checking the Radius in a loop from 1 to 148
needs about 0.2-0.3msec (native-Code, all Options checked).

Just in case, this is for a fast circular
Collision-Detection, then there's even more
efficient ways, to accomplish that (depending
on the "shape of the other objects around").


'***Into a Form, then click the Form
Option Explicit

Private Declare Function StretchDIBits& Lib "gdi32" (ByVal hDC&, _
ByVal x&, ByVal y&, ByVal dx&, ByVal dy&, ByVal SrcX&, ByVal SrcY&, _
ByVal Srcdx&, ByVal Srcdy&, lpBits As Any, lpBitsInfo As Any, ByVal _
wUsage&, ByVal dwRop&)

Private Const SqPxls& = 300
Private Const CX& = SqPxls \ 2, CY& = SqPxls \ 2


Private Grid(0 To SqPxls, 0 To SqPxls) As Long
Private Pxls(0 To SqPxls, 0 To SqPxls) As Long


Private Sub Form_Click()
Dim R As Double, T As Single
Erase Grid

T = Timer
For R = 1 To SqPxls \ 2 - 2
CheckAlongRadius R

' If R Mod 5 = 0 Then ShowGrid
Next R
Caption = Timer - T

ShowGrid
End Sub

'this is acutally performing a "quadrant-based"
'circular check, using the circle-formula: R^2 = X^2 + Y^2
'(trigon. functions as Sin/Cos are much slower than
' simple Mul/Add-Integer-Ops)
Private Sub CheckAlongRadius(ByVal R As Long)
Dim x As Long, y As Long, RSquare As Long

RSquare = R * R
x = 0: y = R 'let's start at this point
Do
Grid(CX + x, CY + y) = Grid(CX + x, CY + y) + 1
Grid(CX - x, CY - y) = Grid(CX - x, CY - y) + 1
Grid(CX + y, CY - x) = Grid(CX + y, CY - x) + 1
Grid(CX - y, CY + x) = Grid(CX - y, CY + x) + 1

If Abs((x + 1) * (x + 1) + y * y - RSquare) > _
Abs((y - 1) * (y - 1) + x * x - RSquare) Then _
y = y - 1 Else x = x + 1

Loop Until x = R And y = 0 'our "quadrant-finished"-condition
End Sub

Private Sub ShowGrid()
Dim x As Long, y As Long

For y = 0 To UBound(Grid, 2)
For x = 0 To UBound(Grid, 1)
Select Case Grid(x, y)
Case 0: Pxls(x, y) = vbBlack
Case 1: Pxls(x, y) = vbWhite
Case 2: Pxls(x, y) = vbCyan 'ending up yellow
Case Else: Pxls(x, y) = vbBlue 'ending up red
End Select
Next x
Next y

ScaleMode = vbPixels
DrawArr hDC, 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub DrawArr(hDC, x, y, dx, dy)
Dim BI&(9)
BI(0) = 40
BI(1) = UBound(Pxls, 1) + 1
BI(2) = -UBound(Pxls, 2) + 1
BI(3) = 1 + 65536 * 32 '32bpp
StretchDIBits hDC, x, y, dx, dy, 0, 0, BI(1), Abs(BI(2)), _
Pxls(0, 0), BI(0), 0, vbSrcCopy
End Sub

Olaf

Larry Serflaten

1/8/2012 10:22:00 PM

0

On Jan 7, 11:24 pm, Schmidt <s...@online.de> wrote:

> > A series of circles would be OK also, as long
> > as all grid cells get filled.
>
> I take it, that the speed of the check-routine is
> of the essence (and not the drawing/visualizing-code)?
>
> Anyways, below is some fast snippet, which is accomplishing
> the task in a "non-spiralic, but concentric fashion",
> extending the Radius in single Pixel-Increments -


Thanks Olaf, you are correct, its the grid filling aspect
and not the visualization that was important. I am
thinking I can put this to use fairly easily.

LFS

unknown

1/8/2012 11:34:00 PM

0

Larry Serflaten wrote:
> Thanks Olaf, you are correct, its the grid filling aspect
> and not the visualization that was important. I am
> thinking I can put this to use fairly easily.

Here is a method that guarantees that each pixel is drawn only once. It
scans the grid by row and column and computes the distance and angle for
each pixel for later use, so during filling the grid, you only use the
precomputed values from a lookup table, and choose the pixel's color. To try
the sample below, add a Timer to Form1 and use the following code:

Option Explicit

Const PI = 3.14159265358979
Const PixelSize = 3

Private Type TLookupTable
Distance As Long ' Distance from center
Angle As Double
End Type
Const GRID_SIZE = 100
Private LookupTable(0 To GRID_SIZE - 1, 0 To GRID_SIZE - 1) As TLookupTable
Const CX = GRID_SIZE / 2
Const CY = GRID_SIZE / 2

Private Sub CalculateLookupTable()
Dim x As Long
Dim y As Long

For x = 0 To UBound(LookupTable, 1)
For y = 0 To UBound(LookupTable, 2)
LookupTable(x, y).Distance = Sqr((x - CX) ^ 2 + (y - CY) ^ 2)
If (x - CX) = 0 Then
' Avoid division by zero
LookupTable(x, y).Angle = Atn(1) * 2
Else
LookupTable(x, y).Angle = Atn((y - CY) / (x - CX))
End If
Next
Next
End Sub

Private Sub Form_Load()
Me.Width = Screen.TwipsPerPixelX * (GRID_SIZE * PixelSize + 50)
Me.Height = Screen.TwipsPerPixelY * (GRID_SIZE * PixelSize + 50)
Me.ScaleMode = vbPixels
Me.AutoRedraw = True

CalculateLookupTable

Timer1.Interval = 100
End Sub

Private Sub Timer1_Timer()
Timer1.Enabled = False
DrawSpiral
End Sub

Private Sub DrawSpiral()
Dim x As Long
Dim y As Long
Dim Color As Long

For x = 0 To UBound(LookupTable, 1)
For y = 0 To UBound(LookupTable, 2)
If LookupTable(x, y).Distance < 40 Then
' Some random formula to choose the color based
' on Angle and distance
Color = 128 + 255 * (LookupTable(x, _
y).Angle / (2 * PI)) + 5 * LookupTable(x, y).Distance
DrawBigPixel x, y, Color
Else
' Erase the pixel
DrawBigPixel x, y, 0
End If
Next
Next

End Sub

Private Sub DrawBigPixel(ByVal x As Long, ByVal y As Long, _
ByVal Color As Long)
Line (x * PixelSize, y * PixelSize)-Step(PixelSize, PixelSize), Color, _
BF
End Sub

Larry Serflaten

1/9/2012 1:13:00 PM

0

On Jan 8, 5:34 pm, "Farnsworth" <nos...@nospam.com> wrote:
>
> Here is a method that guarantees that each pixel is drawn only once. It
> scans the grid by row and column and computes the distance and angle for
> each pixel for later use, so during filling the grid, you only use the
> precomputed values from a lookup table, and choose the pixel's color.

Thanks for the effort. Only, one of the conditions also was to spiral
outward
from the center. I thought about using a lookup table, (an array of
points) but
it would have been more effort than its worth in that I'd still have
to figure out
how to put them in order (spiral out) and then would have to de-dupe
the
points that got hit multiple times.

I figured once I got the spiral pattern done, I could use that code
straight away,
without having to remove duplicated points in an array.

With Olaf's code I will only hit a small percentage of the points a
second time,
which is going to be acceptable in this case. I still might use a
lookup table in
that it would suit the implementation to have the points in sequencial
order.
But I first want to see how the 'code only' solution might work within
the
rest of the program....

LFS

unknown

1/9/2012 7:39:00 PM

0

Larry Serflaten wrote:
> On Jan 8, 5:34 pm, "Farnsworth" <nos...@nospam.com> wrote:
>>
>> Here is a method that guarantees that each pixel is drawn only once.
>> It scans the grid by row and column and computes the distance and
>> angle for each pixel for later use, so during filling the grid, you
>> only use the precomputed values from a lookup table, and choose the
>> pixel's color.
>
> Thanks for the effort. Only, one of the conditions also was to spiral
> outward
> from the center. I thought about using a lookup table, (an array of
> points) but
> it would have been more effort than its worth in that I'd still have
> to figure out
> how to put them in order (spiral out) and then would have to de-dupe
> the
> points that got hit multiple times.
>
> I figured once I got the spiral pattern done, I could use that code
> straight away,
> without having to remove duplicated points in an array.
>
> With Olaf's code I will only hit a small percentage of the points a
> second time,
> which is going to be acceptable in this case. I still might use a
> lookup table in
> that it would suit the implementation to have the points in sequencial
> order.
> But I first want to see how the 'code only' solution might work within
> the
> rest of the program....

With spiraling, you can record if a pixel is drawn, and store the result in
an array, but the trick is to multiply by 512 instead of 300, so VB would
use efficient bit shifts. For example, if you have this:

Const GRID_SIZE = 300

Private DrawnBefore(0 To GRID_SIZE * GRID_SIZE - 1) As Byte

And when you draw a pixel, you do this:

DrawnBefore(x + y * GRID_SIZE) = 1

So you would need to change it to the following:

Private DrawnBefore(0 To 512 * GRID_SIZE - 1) As Byte

DrawnBefore(x + y * 512) = 1

I know that VB in this case would use bit shifts rather than multiplication,
so it's faster. Here is a routine to obtain the power of 2 number if you
want it to be flexible:

Option Explicit

Private Sub Form_Load()
Debug.Print GetMinPowerOfTwo(100)
Debug.Print GetMinPowerOfTwo(300)
Debug.Print GetMinPowerOfTwo(512)
End Sub

' Returns the power of 2 higher than the given
' value, unless it's already a power of 2.
' Example: for N = 300, it returns 512.
' for N = 512, it returns 512.
Private Function GetMinPowerOfTwo(ByVal N As Long) As Long
Dim i As Long

For i = 30 To 0 Step -1
If (2 ^ i And N) <> 0 Then
' Are the lower bits all 0?
If ((2 ^ i - 1) And N) = 0 Then
' Yes, example N = 256
GetMinPowerOfTwo = 2 ^ i
Exit Function
Else
' No, example N = 257
GetMinPowerOfTwo = 2 ^ (i + 1)
Exit Function
End If
End If
Next
End Function

Output:

128
512
512

news

6/30/2014 6:57:00 AM

0

On Mon, 30 Jun 2014 06:25:50 +0000 (UTC), Dennis
<tsalagi18NOSPAM@hotmail.com> wrote:

>Fred Goldstein wrote:
>
>> This reminds me of two falsehoods that Austria famously hopes people
>> believe, that Beethoven was Austrian and Hitler was German.
>
>After WWII ended, Austria told the new powers that it had been Hitler's
>first victim. and they seem to have bought it. They did not get the
>punishment that Germany did, and they avoided being taken over by the
>Communists.

But it took until 1955 for the Russians to leave Austria.

--
Francis Xavier Turlough
University of the Witwatersrand
Johannesburg
South Africa