Author Topic: Circle Filled  (Read 2772 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
Circle Filled
« on: February 28, 2018, 02:25:50 pm »
I had fun this morning trying to get this going, not quite right but close enough to give idea.

Code: QB64: [Select]
  1. _TITLE "*** Circle Filled *** by bplus 2018-02-28"
  2. CONST sw = 600
  3. CONST sh = 600
  4. SCREEN _NEWIMAGE(sw, sh, 32)
  5. _SCREENMOVE 100, 20
  6.  
  7. TYPE circles
  8.     x AS INTEGER
  9.     y AS INTEGER
  10.     r AS INTEGER
  11. i = 0
  12. REDIM cs(i) AS circles
  13. r = 150
  14. WHILE r >= 2
  15.     IF i > 0 THEN
  16.         FOR y = r TO sh - r STEP r / 2
  17.             FOR x = r TO sw - r STEP r / 2
  18.                 ck = 1
  19.                 FOR c = 0 TO i - 1
  20.                     IF ((x - cs(c).x) ^ 2 + (y - cs(c).y) ^ 2) ^ .5 < r + cs(c).r THEN ck = 0: EXIT FOR
  21.                 NEXT
  22.                 IF ck THEN 'new circle  draw it
  23.                     COLOR _RGB32(155 + r, 155 + r, 155 + r)
  24.                     fcirc x, y, r
  25.                     CIRCLE (x, y), r, _RGB32(255, 255, 255)
  26.                     cs(i).x = x
  27.                     cs(i).y = y
  28.                     cs(i).r = r
  29.                     i = i + 1
  30.                     REDIM _PRESERVE cs(i) AS circles
  31.                 END IF
  32.             NEXT
  33.         NEXT
  34.         'keep reducing r until smallest r desired
  35.         r = r - 1
  36.     ELSE
  37.         'start this sucker in top left corner of screen
  38.         cs(i).x = r
  39.         cs(i).y = r
  40.         cs(i).r = r
  41.         COLOR _RGB32(155 + r, 155 + r, 155 + r)
  42.         fcirc cs(i).x, cs(i).y, cs(i).r
  43.         CIRCLE (cs(i).x, cs(i).y), cs(i).r, _RGB32(255, 255, 255)
  44.         i = i + 1
  45.         REDIM _PRESERVE cs(i) AS circles
  46.     END IF
  47.  
  48.  
  49. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  50. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  51.     DIM subRadius AS LONG, RadiusError AS LONG
  52.     DIM X AS LONG, Y AS LONG
  53.  
  54.     subRadius = ABS(R)
  55.     RadiusError = -subRadius
  56.     X = subRadius
  57.     Y = 0
  58.  
  59.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  60.  
  61.     ' Draw the middle span here so we don't draw it twice in the main loop,
  62.     ' which would be a problem with blending turned on.
  63.     LINE (CX - X, CY)-(CX + X, CY), , BF
  64.  
  65.     WHILE X > Y
  66.         RadiusError = RadiusError + Y * 2 + 1
  67.         IF RadiusError >= 0 THEN
  68.             IF X <> Y + 1 THEN
  69.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  70.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  71.             END IF
  72.             X = X - 1
  73.             RadiusError = RadiusError - X * 2
  74.         END IF
  75.         Y = Y + 1
  76.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  77.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  78.     WEND
  79.  
  80.  

If you know what I am trying to get at, feel free to show me the way. :)
Circle filled.PNG
* Circle filled.PNG (Filesize: 23.44 KB, Dimensions: 605x630, Views: 435)