Simple coordinates equation or impossible coordinates equation?

[STxAxTIC]

Hey bplus,

You're welcome to try to tweak that busted function if you find the time. I remember that whole development arc well - and judging the lion by his claw, whoever put the finishing touches on ellipsetiltfill was definitely not me. On the other hand, ellipsetilt and ellipsefill still look like my handywork. In other words, that error started with someone else. I'll try to find it if you don't get there first.

[Petr]

I didn't really understand too much, about what you and STxAxTIC are talking about here. Is it about drawing a cone? Or to fill in an ellipse? I tried a simple program to fill the cone. I had to use the trick to get the right bottom diameter. When I wanted to calculate it (we will not lie, mathematics is my death), so it just did not work. The angle to be entered is the angle at the top of the cone. I tried to count it all through the sinus theorem. Unfortunately, probably because of the sum of the angles in the triangle, where their sum is 180 degrees, the angle at the vertex cannot be greater than 90 degrees. (Or, again, bug is here between keyboard and chair)  :)

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 600, 256)
2.  
3. tm = 1
4. DO
5.     t = t + tm
6.     CLS
7.     R 400, 50, 300, t
8.     LOCATE 1: PRINT t
9.     SLEEP
10.     IF t > 90 OR t < 1 THEN tm = tm * -1
11. LOOP
12.  
13.  
14. SUB R (hx, hy, v, u)
15.     uu = _D2R(u) '                       angle on top vertex
16.     y = hy + v '                         lower y = upper y + v (v = height)
17.     polomer = SIN(uu) * v '              radius on bottom
18.  
19.  
20.     nx1 = hx - (polomer * SIN(uu)) '     left X point on radius
21.     nx2 = hx + (polomer * SIN(uu)) '     right X point on radius
22.  
23.     de = (nx2 - nx1) / 2 '              radius for ellipse
24.     CIRCLE (hx, y), de, 14, _PI, _PI(2), .1
25.     LINE (nx1, y)-(hx, hy), 14
26.     LINE (nx2, y)-(hx, hy), 14
27.     PAINT (hx, hy + v / 2), 14, 14
28. END SUB
29.  

[SierraKen]

That's neat Petr, that draws cones similar to what bplus made. But what I am going for is probably even harder. I want 2 open ended circles, one on each end. Like the second one bplus made which is really good and he calls them megaphones.  A circle on each end, like a tube. But one circle is a different size than the other. And not just filled in like with PAINT or something, but with a 3D effect using low to high shades of color. Like a megaphone. I apologize for saying 2D earlier, I was wrong. Here is the first way I made it earlier using my circle code and LINE commands for each point. But using the full circles draws just too much I think, or the shade is off. I added the Save feature when I was wanting to save these to .bmp.

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 600, 32)
2. start:
3. _TITLE "Cone Maker - by Ken G."
4. _LIMIT 1000
5. CLS
6. x1:
7. INPUT "X1 (0-800) = ", x1
8. IF x1 < 0 OR x1 > 800 THEN PRINT "Out of range, try again.": GOTO x1:
9. y1:
10. INPUT "Y1 (0-600) = ", y1
11. IF y1 < 0 OR y1 > 600 THEN PRINT "Out of range, try again.": GOTO y1:
12. r1:
13. INPUT "Radius (1-400) = ", r1
14. IF r1 < 1 OR r1 > 400 THEN PRINT "Out of range, try again.": GOTO r1:
15. x2:
16. INPUT "X2 (0-800) = ", x2
17. IF x2 < 0 OR x2 > 800 THEN PRINT "Out of range, try again.": GOTO x2:
18. y2:
19. INPUT "Y2 (0-600) = ", y2
20. IF y2 < 0 OR y2 > 600 THEN PRINT "Out of range, try again.": GOTO y2:
21. r2:
22. INPUT "Radius (1-400) = ", r2
23. IF r2 < 1 OR r2 > 400 THEN PRINT "Out of range, try again.": GOTO r2:
24. gaps:
25. INPUT "Gap Space (.01-5) = ", gap
26. IF gap < .01 THEN PRINT "Gap is too small, try again.": GOTO gaps:
27. CLS
28. one:
29. _LIMIT 1000
30. seconds = seconds + gap
31. s = (60 - seconds) * 6 + 180
32. xx1 = INT(SIN(s / 180 * 3.141592) * r1) + x1
33. xx2 = INT(SIN(s / 180 * 3.141592) * r2) + x2
34. yy1 = INT(COS(s / 180 * 3.141592) * r1) + y1
35. yy2 = INT(COS(s / 180 * 3.141592) * r2) + y2
36.  
37. CIRCLE (xx1, yy1), 2, _RGB32(127, 216, 127)
38. CIRCLE (xx2, yy2), 2, _RGB32(127, 216, 127)
39. LINE (xx1, yy1)-(xx2, yy2), _RGB32(0, seconds * 4, 0)
40. IF seconds > 60 THEN
41.     seconds = 0
42.     _TITLE "Press S to Save to .bmp file, or do again press Y or N."
43.     GOTO again:
44. END IF
45. GOTO one:
46. again:
47. ag$ = INKEY$
48. IF ag$ = "y" OR ag$ = "Y" THEN GOTO start:
49. IF ag$ = "n" OR ag$ = "N" THEN END
50. IF ag$ = "s" OR ag$ = "S" THEN GOTO saving:
51. GOTO again:
52.  
53. 'This section saves the calendar to a BMP file along with the SUB at the end of this program.
54. saving:
55. 'Saving
56. 'This section first saves your picture as temp.bmp and then
57. 'asks you a name for your picture and then renames temp.bmp to your name.
58. _TITLE "Saving"
59. 'Now we call up the SUB to save the image to BMP.
60. SaveImage 0, "temp.bmp"
61. _DELAY .25
62. SCREEN 0
63. CLS
64. COLOR 12
65. PRINT "                       Saving"
66. PRINT
67. PRINT "         Your bmp file will be saved in the"
68. PRINT "         same directory as this program is."
69. PRINT "         It can be used with almost any"
70. PRINT "         other graphics program or website."
71. PRINT "         It is saved using:"
72. PRINT "         width: 800  height: 600 pixels."
73. PRINT
74. PRINT "         Type a name to save your picture"
75. PRINT "         and press the Enter key. Do not"
76. PRINT "         add .bmp at the end, the program"
77. PRINT "         will do it automatically."
78. PRINT
79. PRINT "         Also do not use the name temp"
80. PRINT "         because the program uses that name"
81. PRINT "         and it would be erased the next time"
82. PRINT "         you save a picture."
83. PRINT "         Example: MyPic"
84. PRINT "         Quit and Enter key ends program."
85. PRINT
86. INPUT "         ->"; nm$
87. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
88. nm$ = nm$ + ".bmp"
89. 'Checking to see if the file already exists on your computer.
90. theFileExists = _FILEEXISTS(nm$)
91. IF theFileExists = -1 THEN
92.     PRINT
93.     PRINT "       File Already Exists"
94.     PRINT "       Saving will delete your old"
95.     PRINT "       bmp picture."
96.     PRINT "       Would you like to still do it?"
97.     PRINT "       (Y/N)."
98.     PRINT "       Esc goes to start screen."
99.     llloop:
100.     _LIMIT 100
101.     ag2$ = INKEY$
102.     IF ag2$ = CHR$(27) THEN GOTO start:
103.     IF ag2$ = "" THEN GOTO llloop:
104.     IF ag2$ = "y" OR ag$ = "Y" THEN
105.         SHELL _HIDE "DEL " + nm$
106.         GOTO saving2:
107.     END IF
108.     GOTO llloop:
109. END IF
110. saving2:
111. SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
112. nm$ = ""
113. FOR snd = 100 TO 700 STEP 100
114.     SOUND snd, 2
115. NEXT snd
116. m = 0
117. _TITLE "Cone Maker - by Ken G."
118. CLS
119. GOTO start:
120.  
121.  
122. 'This section saves the .bmp picture file.
123. SUB SaveImage (image AS LONG, filename AS STRING)
124.     bytesperpixel& = _PIXELSIZE(image&)
125.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
126.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
127.     x& = _WIDTH(image&)
128.     y& = _HEIGHT(image&)
129.     b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + STRING$(16, 0) 'partial BMP header info(???? to be filled later)
130.     IF bytesperpixel& = 1 THEN
131.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
132.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
133.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
134.         NEXT
135.     END IF
136.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
137.     lastsource& = _SOURCE
138.     _SOURCE image&
139.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
140.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
141.         r$ = ""
142.         FOR px& = 0 TO x& - 1
143.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
144.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
145.         NEXT px&
146.         d$ = d$ + r$ + padder$
147.     NEXT py&
148.     _SOURCE lastsource&
149.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
150.     b$ = b$ + d$ ' total file data bytes to create file
151.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
152.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
153.     f& = FREEFILE
154.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
155.     OPEN filename$ + ext$ FOR BINARY AS #f&
156.     PUT #f&, , b$
157.     CLOSE #f&
158. END SUB
159.  
160.  

[bplus]

Wow has this test code revealed allot of messed up things:
First tiltedEllipseFill then
fTri: Steves recent mods adding STATIC and removing _FREEIMAGE, do not work with transparencies specially in my quad function which merely calls fTri twice.
RotoZoom2, tried and true was leaving seams in the rotozoomed rotated filled ellipsii

So all those fixed now, I left transparencies in to show the nice seamless tilted ellipsii fills, Ken just replace with solid colors for 3D faking, just replace 2x's in the &Hxx.... with &HFF:

Code: QB64: [Select]

1. _TITLE "fTiltEllipse tests" 'b+ 2019-12-15
2. 'test code from "Draw megaphone Test, click 4 points in clockwise direction first pair is one opening and 2nd is 2nd." 'B+ 2019-12-15
3.  
4. CONST xmax = 800, ymax = 600
5. SCREEN _NEWIMAGE(xmax, ymax, 32)
6. _SCREENMOVE 300, 40
7.  
8. DO
9.     CLS
10.     WHILE pi < 4 'get 4 mouse clicks
11.         _PRINTSTRING (5, 5), SPACE$(20)
12.         _PRINTSTRING (5, 5), "Need 4 clicks, have" + STR$(pi)
13.         WHILE _MOUSEINPUT: WEND
14.         IF _MOUSEBUTTON(1) AND oldMouse = 0 THEN 'new mouse down
15.             pi = pi + 1
16.             mx(pi) = _MOUSEX: my(pi) = _MOUSEY
17.             CIRCLE (mx(pi), my(pi)), 2
18.         END IF
19.         oldMouse = _MOUSEBUTTON(1)
20.         _DISPLAY
21.         _LIMIT 60
22.     WEND
23.     LINE (mx(2), my(2))-(mx(3), my(3))
24.     LINE (mx(4), my(4))-(mx(1), my(1))
25.     ang1 = _ATAN2(my(2) - my(1), mx(2) - mx(1))
26.     maj1 = (_HYPOT(mx(1) - mx(2), my(1) - my(2))) / 2
27.     min1 = .1 * maj1
28.     cx1 = (mx(1) + mx(2)) / 2
29.     cy1 = (my(1) + my(2)) / 2
30.     EllipseTilt cx1, cy1, maj1, min1, ang1, &HFFFFFFFF
31.     ang2 = _ATAN2(my(3) - my(4), mx(3) - mx(4))
32.     maj2 = (_HYPOT(mx(3) - mx(4), my(3) - my(4))) / 2
33.     min2 = .1 * maj2
34.     cx2 = (mx(3) + mx(4)) / 2
35.     cy2 = (my(3) + my(4)) / 2
36.     EllipseTilt cx2, cy2, maj2, min2, ang2, &HFFFFFFFF
37.     _DISPLAY
38.     _DELAY 3
39.     CLS
40.     _PRINTSTRING (5, 5), "Sleeping, wake with click or keypress..."
41.     fTiltEllipse 0, cx2, cy2, maj2, min2, ang2, &H880000FF 'check trnasparency
42.     fquad mx(1), my(1), mx(2), my(2), mx(3), my(3), mx(4), my(4), &H880000FF
43.     fTiltEllipse 0, cx1, cy1, maj1, min1, ang1, &H88FFFF00
44.     _DISPLAY
45.     cSleep 45
46.  
47.     pi = 0 'point index
48. LOOP UNTIL _KEYDOWN(27)
49.  
50.  
51.  
52. 'thanks STxAxTIC from Toolbox
53. SUB EllipseTilt (CX, CY, a, b, ang, C AS _UNSIGNED LONG)
54.     DIM k, i, j
55.     '  CX = center x coordinate
56.     '  CY = center y coordinate
57.     '   a = semimajor axis  major radius
58.     '   b = semiminor axis  minor radius
59.     ' ang = clockwise orientation of semimajor axis in radians (0 default)
60.     '   C = fill color
61.     FOR k = 0 TO 6.283185307179586 + .025 STEP .025
62.         i = a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
63.         j = -a * COS(k) * SIN(ang) + b * SIN(k) * COS(ang)
64.         i = i + CX
65.         j = -j + CY
66.         IF k <> 0 THEN
67.             LINE -(i, j), C
68.         ELSE
69.             PSET (i, j), C
70.         END IF
71.     NEXT
72. END SUB
73.  
74. 'relace broken toolbax code
75. 'this needs RotoZoom3 to rotate image BUT it can now scale it also!
76. SUB fTiltEllipse (destH AS LONG, ox AS INTEGER, oy AS INTEGER, majorRadius AS INTEGER, minorRadius AS INTEGER, radianAngle AS SINGLE, c AS _UNSIGNED LONG)
77.     'setup isolated area, draw fFlatEllipse and then RotoZoom the image into destination
78.     'ox, oy is center of ellipse
79.     'majorRadius is 1/2 the lonest axis
80.     'minorRadius is 1/2 the short axis
81.     'radianAngle is the Radian Angle of Tilt
82.     'c is of course color
83.     sd& = _DEST
84.     temp& = _NEWIMAGE(2 * majorRadius, 2 * minorRadius, 32)
85.     _DEST temp&
86.     fEllipse majorRadius, minorRadius, majorRadius, minorRadius, c
87.     _DEST destH
88.     RotoZoom3 ox, oy, temp&, 1, 1, radianAngle
89.     _FREEIMAGE temp&
90.     _DEST sd&
91. END SUB
92.  
93. 'modified 2019-12-15 _seamless added, rotation convert to radians
94. SUB RotoZoom3 (X AS LONG, Y AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, radianRotation AS SINGLE) ' 0 at end means no scaling of x or y
95.     DIM px(3) AS SINGLE: DIM py(3) AS SINGLE
96.     W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
97.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
98.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
99.     sinr! = SIN(-radianRotation): cosr! = COS(-radianRotation)
100.     FOR i& = 0 TO 3
101.         x2& = (px(i&) * cosr! + sinr! * py(i&)) + X * xScale: y2& = (py(i&) * cosr! - px(i&) * sinr!) + Y * yScale
102.         px(i&) = x2&: py(i&) = y2&
103.     NEXT
104.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
105.     _MAPTRIANGLE _SEAMLESS(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
106. END SUB
107.  
108. 'this seems to work as well as any
109. SUB fEllipse (CX AS LONG, CY AS LONG, xRadius AS LONG, yRadius AS LONG, c AS _UNSIGNED LONG)
110.     DIM scale AS SINGLE, x AS LONG, y AS LONG
111.     scale = yRadius / xRadius
112.     LINE (CX, CY - yRadius)-(CX, CY + yRadius), c, BF
113.     FOR x = 1 TO xRadius
114.         y = scale * SQR(xRadius * xRadius - x * x)
115.         LINE (CX + x, CY - y)-(CX + x, CY + y), c, BF
116.         LINE (CX - x, CY - y)-(CX - x, CY + y), c, BF
117.     NEXT
118. END SUB
119.  
120. ' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]:    http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
121. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
122.     DIM D AS LONG
123.     D = _DEST
124.     a& = _NEWIMAGE(1, 1, 32)
125.     _DEST a&
126.     PSET (0, 0), K
127.     _DEST D
128.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
129.     _FREEIMAGE a& '<<< this is important!
130. END SUB
131.  
132. '2019-11-20 Steve saves some time with STATIC and saves and restores last dest
133. SUB ftri1 (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
134.     DIM D AS LONG
135.     STATIC a&
136.     D = _DEST
137.     IF a& = 0 THEN a& = _NEWIMAGE(1, 1, 32)
138.     _DEST a&
139.     PSET (0, 0), K
140.     _DEST D
141.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
142. END SUB
143.  
144. 'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
145. SUB fquad (x1, y1, x2, y2, x3, y3, x4, y4, K AS _UNSIGNED LONG)
146.     ftri x1, y1, x2, y2, x4, y4, K
147.     ftri x3, y3, x2, y2, x4, y4, K
148. END SUB
149.  
150. SUB cSleep (secsWait AS DOUBLE) 'wait for keypress or mouseclick, solves midnight problem nicely I think
151.     DIM wayt AS INTEGER, oldMouse AS INTEGER, k AS LONG, startTime AS DOUBLE
152.  
153.     startTime = TIMER
154.     wayt = 1
155.     _KEYCLEAR
156.     WHILE wayt
157.         WHILE _MOUSEINPUT: WEND
158.         IF _MOUSEBUTTON(1) AND oldMouse = 0 THEN wayt = 0
159.         oldMouse = _MOUSEBUTTON(1) ' <<< this is Steve's cool way to get clear of mouse click
160.         k = _KEYHIT: IF k > 0 THEN _KEYCLEAR: wayt = 0
161.         IF TIMER - startTime < 0 THEN 'past midnight
162.             IF TIMER + 24 * 60 * 60 - startTime > secsWait THEN wayt = 0
163.         ELSE
164.             IF TIMER - startTime >= secsWait THEN wayt = 0
165.         END IF
166.         _LIMIT 30
167.     WEND
168. END SUB
169.  
170.  

[SierraKen]

Bplus, that works great!

[SMcNeill]

Isn't this simple little demo what you were trying to accomplish?

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 600, 32)
2.  
3. LINE (100, 100)-(200, 300)
4. Cone 100, 100, 10, 200, 300, 30, &H77FFFFFF
5. LINE (100, 300)-(300, 100)
6. Cone 100, 300, 30, 300, 100, 120, &H337700FF
7.  
8.  
9.  
10.  
11. SUB Cone (x1, y1, r1, x2, y2, r2, kolor AS _UNSIGNED LONG)
12.     rise = y2 - y1
13.     runn = x2 - x1
14.     slope = rise / runn
15.     rchange = r2 - r1
16.     RateOfRadiusChange = rchange / runn
17.     FOR i = 0 TO runn
18.         CircleFill x1 + i, y1 + i * slope, r1 + RateOfRadiusChange * i, kolor
19.         SLEEP
20.     NEXT
21. END SUB
22.  
23. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
24.     ' CX = center x coordinate
25.     ' CY = center y coordinate
26.     '  R = radius
27.     '  C = fill color
28.     DIM Radius AS INTEGER, RadiusError AS INTEGER
29.     DIM X AS INTEGER, Y AS INTEGER
30.     Radius = ABS(R)
31.     RadiusError = -Radius
32.     X = Radius
33.     Y = 0
34.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
35.     LINE (CX - X, CY)-(CX + X, CY), C, BF
36.     WHILE X > Y
37.         RadiusError = RadiusError + Y * 2 + 1
38.         IF RadiusError >= 0 THEN
39.             IF X <> Y + 1 THEN
40.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
41.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
42.             END IF
43.             X = X - 1
44.             RadiusError = RadiusError - X * 2
45.         END IF
46.         Y = Y + 1
47.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
48.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
49.     WEND
50. END SUB
51.  

There's one stray SLEEP statement in there, so you can watch as it works, so feel free to take it out if it's not something you're interested in having in your own code.  ;)

[bplus]

Nice one Steve, that is simpler. ;)

[SierraKen]

Yes Steve, thank you. But every single time I try to make subs they don't work unless I copy other people's code. I am brand new at SUB's, so please tell me why this has a Syntax Error. I'm trying to let the user define the variables instead. Thanks.

Cone x1, y1, r1, x2, y2, r2

[SMcNeill]

Yes Steve, thank you. But every single time I try to make subs they don't work unless I copy other people's code. I am brand new at SUB's, so please tell me why this has a Syntax Error. I'm trying to let the user define the variables instead. Thanks.

Cone x1, y1, r1, x2, y2, r2

Can you share the rest of the code and the error message?  By itself, I can’t see any reason why it’d fail.

[SierraKen]

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 600, 32)
2.  
3. INPUT "X1 = ", x1
4. INPUT "Y1 = ", y1
5. INPUT "Radius = ", r1
6. INPUT "X2 = ", x2
7. INPUT "Y2 = ", y2
8. INPUT "Radius = ", r2
9.  
10. Cone x1, y1, r1, x2, y2, r2
11.  
12.  
13. 'LINE (100, 100)-(200, 300)
14. 'Cone 100, 100, 10, 200, 300, 30, &H77FFFFFF
15. 'LINE (100, 300)-(300, 100)
16. 'Cone 100, 300, 30, 300, 100, 120, &H337700FF
17.  
18.  
19.  
20.  
21. SUB Cone (x1, y1, r1, x2, y2, r2, kolor AS _UNSIGNED LONG)
22.     kcolor = kcolor + 1
23.     rise = y2 - y1
24.     runn = x2 - x1
25.     slope = rise / runn
26.     rchange = r2 - r1
27.     RateOfRadiusChange = rchange / runn
28.     FOR i = 0 TO runn
29.         CircleFill x1 + i, y1 + i * slope, r1 + RateOfRadiusChange * i, kolor
30.         SLEEP
31.     NEXT
32. END SUB
33.  
34. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
35.     ' CX = center x coordinate
36.     ' CY = center y coordinate
37.     '  R = radius
38.     '  C = fill color
39.     DIM Radius AS INTEGER, RadiusError AS INTEGER
40.     DIM X AS INTEGER, Y AS INTEGER
41.     Radius = ABS(R)
42.     RadiusError = -Radius
43.     X = Radius
44.     Y = 0
45.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
46.     LINE (CX - X, CY)-(CX + X, CY), C, BF
47.     WHILE X > Y
48.         RadiusError = RadiusError + Y * 2 + 1
49.         IF RadiusError >= 0 THEN
50.             IF X <> Y + 1 THEN
51.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
52.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
53.             END IF
54.             X = X - 1
55.             RadiusError = RadiusError - X * 2
56.         END IF
57.         Y = Y + 1
58.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
59.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
60.     WEND
61. END SUB
62.  
63.  

[SierraKen]

Here is a picture of the screen with the error message.

[SMcNeill]

You’re missing a parameter; you aren’t sending the sub a color value. 

Cone x1, Y1, r1, X2, Y2, R2, kolor <— the last parameter is missing.

[SierraKen]

Thanks Steve. It works now.