Post by tenochtitlanuk on Jun 6, 2018 8:33:03 GMT -5
Only realised a few days ago that my site linked to several forum posts that are now defunct. I'm recreating them as normal web pages on my site, as I have already done for 90%+ of my LB stuff.
First is just a cheerful way to create circular-symmetrical outlines and fill with colour. Partly prompted by stuff on the JB forum about filled shapes...
Image is an animation of the program's output but each frame is just a quick doodle. It's not a way to create great art!
Present version of code is..
'**********************************************************************
'** **
'** kaleidoscope4.bas tenochtitlanuk June 2018 **
'** **
'**********************************************************************
' to-dos:
' fast movement leaves gaps. Hard unless save all previous positions and 'echos'.
' add an 'undo' to the fill?
' change 'save' routine so won't save over another saved image. DONE
' check area allowed to draw in and shade appropriately ( as originally).
global radius, theta, hdc, targetcolor, pi
pi =180 *atn( 1)
nomainwin ' un-rem for debugging..
WindowWidth =600
WindowHeight =600
button #w.b1, "Save Image", [saveImage], LR, 110, 20
open "Paint your star!" for graphics_nsb as #w
hw =hwnd( #w) ' <<<<<<<<<<<<<<<<<
calldll #user32, "GetDC", hw as ulong, hdc as ulong ' <<<<<<<<<<<<<<<<<
#w "trapclose quit"
#w "when leftButtonMove [paint]"
#w "when rightButtonUp [colFill]"
#w "color 240 240 240 ; backcolor 240 240 240 ; goto 300 300 ; down"
#w "size 1 ; color black; circle 250 ; size 4" ' large size so gaps less likely
N =5 ' number of rotations /symmeetry
kal =1 ' kal =0 for N-fold symmetry, kal =1 for added kaleidoscope reflections.
wait
[paint]
x =MouseX -300
y =300 -MouseY
radius =( x^2 +y^2)^0.5
theta =180 /pi *atan2( y, x)
if theta >180 /N or radius <20 or radius >250 then wait
if theta <0 -180 /N then wait
for i =0 to N -1
angle =i *360 /N
call set radius, angle -theta
if kal =1 then call set radius, angle +theta
next i
wait
[colFill]
xVar =MouseX -300: yVar =MouseY -300 ' w.r.t. centre of graphic area
print "Mouse clicked for fill colour at "; xVar; ", "; yVar; " from centre."
colordialog "0 0 0", fillCol$
#w "color "; fillCol$; " ; backcolor "; fillCol$
if fillCol$ ="" then end
targetcolor =0 ' this is the colour of the outline to fill out to.
radius =( xVar^2 +yVar^2)^0.5
theta =180 /pi *atan2( yVar, xVar)
print " This was radius "; int( radius); " angle "; int( theta); " degrees clockwise w.r.t. centre."
for i =0 to N -1
angle =i *360 /N
xV =300 +int( radius *cosRad( angle +theta)) ' using coordinates w.r.t. top left as origin
yV =300 +int( radius *sinRad( angle +theta))
#w "size 8 ; down ; set "; xV; " "; yV
#w "up ; size 3"
print " Fill from "; using( "####", xV); " "; using( "####", yV)
calldll #gdi32, "ExtFloodFill",_
hdc as ulong,_
xV as long,_
yV as long,_
targetcolor as long,_
_FLOODFILLBORDER as long,_ 'ie fill out 'til this colour is met... <<<<<<<<<<<<<<<<<<<<<<<<<<
result as long
xV =300 +int( radius *cosRad( angle -theta))
yV =300 +int( radius *sinRad( angle -theta))
print " Fill from "; using( "####", xV); " "; using( "####", yV)
calldll #gdi32, "ExtFloodFill",_
hdc as ulong,_
xV as long,_
yV as long,_
targetcolor as long,_
_FLOODFILLBORDER as long,_ 'ie fill out 'til this colour is met... <<<<<<<<<<<<<<<<<<<<<<<<<<
result as long
next i
#w "color black ; down"
scan
wait
function sinRad( t)
sinRad =sin( t *pi /180)
end function
function cosRad( t)
cosRad =cos( t *pi /180)
end function
[saveImage]
#w "getbmp scr 0 0 595 580"
filedialog "Save As...", "*.bmp", fn$
bmpsave "scr", fn$
wait
sub set r, t
if r <250 then
t =t *pi /180
x =300 +r *cos( t): y =300 +r *sin( t)
#w "set "; x; " "; y
end if
end sub
function atan2( y, x)
pi =atn( 1) *4
if x <>0 then arctan = atn( y /x)
select case
case x >0
atan2 =arctan
case y >=0 and x <0
atan2 =pi +arctan
case y <0 and x <0
atan2 =arctan -pi
case y >0 and x =0
atan2 =pi /2
case y <0 and x =0
atan2 =pi /-2
end select
end function
sub quit h$
close #w
calldll #user32, "ReleaseDC", hw as ulong, hdc as ulong, ret as void 'release the DC <<<<<<
end
end sub