REM SET MODE TO 8 USING VDU
VDU 22,8
REM SET LINE THICKNESS TO 3
VDU 23,23,3|
OFF
GCOL 1
REM believe me... this was tough to get right
REM "filename",H,V,R,G,B - you dont need to add .BMP to the filename
PROC_donut("donut1",100,100,200,200,200)
PROC_donut("donut2",200,200,150,200,200)
PROC_donut("donut3",300,300,200,200,150)
PROC_donut("donut4",400,400,200,150,200)
(mou)
GOTO (mou)
DEF PROC_donut(filename$,H,V,RR,GG,BB)
PROC_ellipsering(3,3,H,V,30,40,RR,GG,BB,10)
PROC_sphere(H,V,10,RR,GG,BB,7)
filename$=filename$+".BMP"
file1$=@usr$+ filename$
h$=STR$(H-40)
v$=STR$(V-40)
size$=STR$(80)
combinit$=h$+","+v$+","+size$+","+size$
pos1$=combinit$
OSCLI "SCREENSAVE "+file1$+" "+pos1$
ENDPROC
DEF PROC_ellipsering(CENTERH,CENTERV,H,V,SIZE,THICKNESS,X,C,A,DI)
IF SIZE > THICKNESS THEN SIZE = THICKNESS
OC=THICKNESS/2
OUTCENTERH=CENTERH+OC
OUTCENTERV=CENTERV+OC
R=0
SWITCH=0
DEPTHCOUNT=SIZE/2
FOR Y=1 TO DEPTHCOUNT
COLOUR 1,X,C,A
ELLIPSE H,V,OUTCENTERH-R,OUTCENTERV-R
ELLIPSE H,V,OUTCENTERH+R,OUTCENTERV+R
R=R+1
(leap)
X=X-DI
C=C-DI
A=A-DI
IF X<2 THEN X=2
IF C<2 THEN C=2
IF A<2 THEN A=2
NEXT Y
ENDPROC
ENDPROC
DEF PROC_sphere(H,V,SIZE,R,G,B,DI)
r%=R
g%=G
b%=B
size%=SIZE
dimmer%=DI
FOR x%=0 TO size%
c%=50
r%=r%-dimmer%
g%=g%-dimmer%
b%=b%-dimmer%
IF r% <2 THEN r%=2
IF g% <2 THEN g%=2
IF b%<2 THEN b%=2
IF r%<50 AND g%<50 AND b%<50 THEN GOTO (jump)
COLOUR 1,r%,g%,b%
CIRCLE H,V,x%
(jump)
NEXT x%
ENDPROC
SWP_HIDEWINDOW = &80
SWP_NOMOVE = 2
SWP_NOSIZE = 1
SWP_NOZORDER = 4
SWP_SHOWWINDOW = 64
LR_LOADFROMFILE = 16
BM_SETIMAGE = 247
BS_BITMAP = &80
ON CLOSE : PROCclose : QUIT
INSTALL @lib$+"winlib5"
INSTALL @lib$+"timerlib"
REM SET MODE TO 8 USING VDU
VDU 22,8
REM SET LINE THICKNESS TO 3
VDU 23,23,3|
REM OFF
GCOL 1
REM create and save button images------------------------------------
file1$=@usr$+"donut1.bmp"
file2$=@usr$+"donut2.bmp"
file3$=@usr$+"donut3.bmp"
file1b$=@usr$+"donut4.bmp"
CLS
REM -----------------------------------------------------------------
REM create buttons --------------------------------------------------
butnu1=FN_button("",300,200,40,40,FN_setproc(PROCbutnu1),BS_BITMAP)
butnu2=FN_button("",340,200,40,40,FN_setproc(PROCbutnu2),BS_BITMAP)
butnu3=FN_button("",380,200,40,40,FN_setproc(PROCbutnu3),BS_BITMAP)
REM -----------------------------------------------------------------
REM assign images to buttons----------------------------------------
SYS "LoadImage", 0, file1$, 0, 40, 40, LR_LOADFROMFILE TO hbitmap1
SYS "SendMessage", butnu1, BM_SETIMAGE, 0, hbitmap1
SYS "LoadImage", 0, file2$, 0, 40, 40, LR_LOADFROMFILE TO hbitmap2
SYS "SendMessage", butnu2, BM_SETIMAGE, 0, hbitmap2
SYS "LoadImage", 0, file3$, 0, 40, 40, LR_LOADFROMFILE TO hbitmap3
SYS "SendMessage", butnu3, BM_SETIMAGE, 0, hbitmap3
SYS "LoadImage", 0, file1b$, 0, 40, 40, LR_LOADFROMFILE TO hbitmap1b
REM -----------------------------------------------------------------
REM MAIN --------------------------------
(mou)
WAIT 0 : REM just wait, nothing to do !
GOTO (mou)
END
REM -------------------------------------
REM clicking buttons will jump here automatically -------------------
DEF PROCbutnu1 : PRINTTAB(0,27);"Button 1" : PROCflash1
DEF PROCbutnu2 : PRINTTAB(0,27);"Button 2" : PROCflash2
DEF PROCbutnu3 : PRINTTAB(0,27);"Button 3" : PROCflash3
LOCAL X,Y,CC,I%
FOR I%=1 TO 20000
X=RND(100)
Y=RND(100)
CC=RND(200)
COLOUR 1,X+Y,CC,Y+X
LINE X,Y,X,Y
NEXT I%
ENDPROC
REM -----------------------------------------------------------------
DEF PROCflash1 : LOCAL A%
SYS "SendMessage", butnu1, BM_SETIMAGE, 0, hbitmap1b
A%=FN_ontimer(100,PROCflash1off,0)
ENDPROC
DEF PROCflash1off
SYS "SendMessage", butnu1, BM_SETIMAGE, 0, hbitmap1
ENDPROC
DEF PROCflash2 : LOCAL A%
SYS "SendMessage", butnu2, BM_SETIMAGE, 0, hbitmap1b
A%=FN_ontimer(100,PROCflash2off,0)
ENDPROC
DEF PROCflash2off
SYS "SendMessage", butnu2, BM_SETIMAGE, 0, hbitmap2
ENDPROC
DEF PROCflash3 : LOCAL A%
SYS "SendMessage", butnu3, BM_SETIMAGE, 0, hbitmap1b
A%=FN_ontimer(100,PROCflash3off,0)
ENDPROC
DEF PROCflash3off
SYS "SendMessage", butnu3, BM_SETIMAGE, 0, hbitmap3
ENDPROC
DEF PROC_button(H,V,BEGIN,SIZE,X,C,A,DI,butnu)
R=X
G=C
B=A
P=SIZE-BEGIN
P=P/2
P=BEGIN+P
FOR Y=P TO SIZE
COLOUR 1,X,C,A
LINE H-Y,V-Y,H+Y,V-Y
LINE H+Y,V-Y,H+Y,V+Y
LINE H+Y,V+Y,H-Y,V+Y
LINE H-Y,V+Y,H-Y,V-Y
X=X-DI
C=C-DI
A=A-DI
IF X<2 THEN X=2
IF C<2 THEN C=2
IF A<2 THEN A=2
NEXT Y
FOR Y=BEGIN TO P
COLOUR 1,X,C,A
LINE H-Y,V-Y,H+Y,V-Y
LINE H+Y,V-Y,H+Y,V+Y
LINE H+Y,V+Y,H-Y,V+Y
LINE H-Y,V+Y,H-Y,V-Y
X=X+DI
C=C+DI
A=A+DI
NEXT Y
COLOUR 1,R,G,B
FILL H,V
ENDPROC
REM delete the stuff we made
DEF PROCclose
SYS "DeleteObject", hbitmap1
SYS "DeleteObject", hbitmap2
SYS "DeleteObject", hbitmap3
SYS "DeleteObject", hbitmap1b
PROC_closewindow(butnu1)
PROC_closewindow(butnu2)
PROC_closewindow(butnu3)
ENDPROC