Filled Circles and Ellipses (collaborative)

[Junior Librarian]

Filled Circles and Ellipses

Contributor(s): @bplus, @Pete, @SMcNeill, @STxAxTIC
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=1044.0

Description:
We develop four variations on the CIRCLE command in the form of four SUBs:
(i) CircleFill = Filled circle
(ii) EllipseFill = Filled ellipse
(iii) EllipseTilt = Tilted ellipse
(iv) EllipseTiltFill = Tilted and filled ellipse

These works have been optimized for speed and respect for alpha transparency.

Source Code:

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 600, 32)
2.  
3. DIM TransRed AS _UNSIGNED LONG
4. DIM TransGreen AS _UNSIGNED LONG
5. DIM TransBlue AS _UNSIGNED LONG
6. TransRed = _RGBA(255, 0, 0, 128)
7. TransGreen = _RGBA(0, 255, 0, 128)
8. TransBlue = _RGBA(0, 0, 255, 128)
9.  
10. CALL CircleFill(100, 100, 75, TransRed)
11. CALL CircleFill(120, 120, 75, TransBlue)
12.  
13. CALL EllipseFill(550, 100, 150, 75, TransBlue)
14. CALL EllipseFill(570, 120, 150, 75, TransGreen)
15.  
16. CALL EllipseTilt(200, 400, 150, 75, 0, TransGreen)
17. CALL EllipseTilt(220, 420, 150, 75, 3.14 / 4, TransRed)
18.  
19. CALL EllipseTiltFill(0, 550, 400, 150, 75, 3.14 / 6, TransRed)
20. CALL EllipseTiltFill(0, 570, 420, 150, 75, 3.14 / 4, TransGreen)
21.  
22. END
23.  
24. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
25.     ' CX = center x coordinate
26.     ' CY = center y coordinate
27.     '  R = radius
28.     '  C = fill color
29.     DIM Radius AS INTEGER, RadiusError AS INTEGER
30.     DIM X AS INTEGER, Y AS INTEGER
31.     Radius = ABS(R)
32.     RadiusError = -Radius
33.     X = Radius
34.     Y = 0
35.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
36.     LINE (CX - X, CY)-(CX + X, CY), C, BF
37.     WHILE X > Y
38.         RadiusError = RadiusError + Y * 2 + 1
39.         IF RadiusError >= 0 THEN
40.             IF X <> Y + 1 THEN
41.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
42.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
43.             END IF
44.             X = X - 1
45.             RadiusError = RadiusError - X * 2
46.         END IF
47.         Y = Y + 1
48.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
49.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
50.     WEND
51. END SUB
52.  
53. SUB EllipseFill (CX AS INTEGER, CY AS INTEGER, a AS INTEGER, b AS INTEGER, C AS _UNSIGNED LONG)
54.     ' CX = center x coordinate
55.     ' CY = center y coordinate
56.     '  a = semimajor axis
57.     '  b = semiminor axis
58.     '  C = fill color
59.     IF a = 0 OR b = 0 THEN EXIT SUB
60.     DIM h2 AS _INTEGER64
61.     DIM w2 AS _INTEGER64
62.     DIM h2w2 AS _INTEGER64
63.     DIM x AS INTEGER
64.     DIM y AS INTEGER
65.     w2 = a * a
66.     h2 = b * b
67.     h2w2 = h2 * w2
68.     LINE (CX - a, CY)-(CX + a, CY), C, BF
69.     DO WHILE y < b
70.         y = y + 1
71.         x = SQR((h2w2 - y * y * w2) \ h2)
72.         LINE (CX - x, CY + y)-(CX + x, CY + y), C, BF
73.         LINE (CX - x, CY - y)-(CX + x, CY - y), C, BF
74.     LOOP
75. END SUB
76.  
77. SUB EllipseTilt (CX, CY, a, b, ang, C AS _UNSIGNED LONG)
78.     '  CX = center x coordinate
79.     '  CY = center y coordinate
80.     '   a = semimajor axis
81.     '   b = semiminor axis
82.     ' ang = clockwise orientation of semimajor axis in radians (0 default)
83.     '   C = fill color
84.     FOR k = 0 TO 6.283185307179586 + .025 STEP .025
85.         i = a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
86.         j = -a * COS(k) * SIN(ang) + b * SIN(k) * COS(ang)
87.         i = i + CX
88.         j = -j + CY
89.         IF k <> 0 THEN
90.             LINE -(i, j), C
91.         ELSE
92.             PSET (i, j), C
93.         END IF
94.     NEXT
95. END SUB
96.  
97. SUB EllipseTiltFill (destHandle&, CX, CY, a, b, ang, C AS _UNSIGNED LONG)
98.     '  destHandle& = destination handle
99.     '  CX = center x coordinate
100.     '  CY = center y coordinate
101.     '   a = semimajor axis
102.     '   b = semiminor axis
103.     ' ang = clockwise orientation of semimajor axis in radians (0 default)
104.     '   C = fill color
105.     DIM max AS INTEGER, mx2 AS INTEGER, i AS INTEGER, j AS INTEGER
106.     DIM prc AS _UNSIGNED LONG
107.     DIM D AS INTEGER, S AS INTEGER
108.     D = _DEST: S = _SOURCE
109.     prc = _RGB32(255, 255, 255, 255)
110.     IF a > b THEN max = a + 1 ELSE max = b + 1
111.     mx2 = max + max
112.     tef& = _NEWIMAGE(mx2, mx2)
113.     _DEST tef&
114.     _SOURCE tef&
115.     FOR k = 0 TO 6.283185307179586 + .025 STEP .025
116.         i = max + a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
117.         j = max + a * COS(k) * SIN(ang) - b * SIN(k) * COS(ang)
118.         IF k <> 0 THEN
119.             LINE (lasti, lastj)-(i, j), prc
120.         ELSE
121.             PSET (i, j), prc
122.         END IF
123.         lasti = i: lastj = j
124.     NEXT
125.     DIM xleft(mx2) AS INTEGER, xright(mx2) AS INTEGER, x AS INTEGER, y AS INTEGER
126.     FOR y = 0 TO mx2
127.         x = 0
128.         WHILE POINT(x, y) <> prc AND x < mx2
129.             x = x + 1
130.         WEND
131.         xleft(y) = x
132.         WHILE POINT(x, y) = prc AND x < mx2
133.             x = x + 1
134.         WEND
135.         WHILE POINT(x, y) <> prc AND x < mx2
136.             x = x + 1
137.         WEND
138.         IF x = mx2 THEN xright(y) = xleft(y) ELSE xright(y) = x
139.     NEXT
140.     _DEST destHandle&
141.     FOR y = 0 TO mx2
142.         IF xleft(y) <> mx2 THEN LINE (xleft(y) + CX - max, y + CY - max)-(xright(y) + CX - max, y + CY - max), C, BF
143.     NEXT
144.     _DEST D: _DEST S
145.     _FREEIMAGE tef&
146. END SUB
147.  

Attachments:
 

Ellipses.bas

                                                                                                                                         (191 downloads previously)