REM width;height;charwidth,charheight,number of colors,character set VDU 23,22,1024;600;8,15,16,1 :REM max width is 1920 and 1440 height REM Turn off the text cursor _ OFF VDU 5 : REM Treat text as graphics (transparent background) REM block(x,y,h,v) --- Always have the lower left corner a lesser number than the last 2 coordinates PROCsbox(100,100,500,500) PROCsbox(800,800,500,500) PROCsbox(0,1000,500,500) REM pr(x,y,"message",R 0-255,G 0-255,B 0-255) PROCpr(120,450,"I put a box here",100,200,200) WAIT 0 END DEF PROCsbox(x%,y%,w%,h%) LOCAL ry%,sx%,sy% sx%=x%:sy%=y% IF x%>w% THEN x%=w%:w%=sx% IF y%>h% THEN y%=h%:h%=sy% ry%=y% PROCcolor("f",255,255,255) REPEAT LINE x%,y%,w%,y% y%=y%+1 UNTIL y%=h% y%=ry% PROCcolor("f",0,0,0) LINE x%+2,y%+2,w%-2,y%+2 LINE w%-2,y%+2,w%-2,h%-4 LINE w%-2,h%-4,x%+2,h%-4 LINE x%+2,h%-4,x%+2,y%+2 ENDPROC REM color "F"or"B", r,g,b DEF PROCcolor(fb$,r%,g%,b%) IF fb$="f" OR fb$="F" THEN COLOUR 0,r%,g%,b% : GCOL 0 IF fb$="b" OR fb$="B" THEN COLOUR 1,r%,g%,b% : GCOL 128+1 ENDPROC REM X,Y,text color,message,r,g,b REM ************************************************************************ DEF PROCpr(X,Y,msg$,r,g,b) LOCAL initialx%,fi%,reduction%,tx,ty initialx%=LEN(msg$) COLOUR 0,r,g,b GCOL 0 LET tx= X+initialx%+25 LET ty= Y:reduction%=0 reduction%=initialx%/2 reduction%=reduction%*6 IF initialx%<20 THEN reduction%=reduction%/2 initialx%=initialx%*22-reduction% FOR fi%=12 TO 48 LINE X-3,Y+20-fi%,X+initialx%+8,Y+20-fi% NEXT COLOUR 0,0,0,0 GCOL 0 MOVE tx,ty PRINT msg$ MOVE 0,0 REM hide that thing ENDPROC
DIM pal%(15),greys%(15) PROCReadPalette(pal%()) PROCShowPalette(50,50) PROCSetGreyScale(greys%()) PROCSetPalette(greys%()) PROCShowPalette(50,100) PROCSetDefaultColours(greys%()) PROCSetPalette(greys%()) PROCShowPalette(50,150) PROCSetPalette(pal%()) PROCShowPalette(50,170) PROCChooseColour(1,500,320) PROCShowPalette(50,230) END : DEFPROCReadPaletteN(p%(),ncols%) DEFPROCReadPalette(p%()):LOCAL ncols%:ncols%=16 LOCAL tcol%,x% tcol%=POINT(0,0) FOR x%=0 TO ncols%-1 GCOL x% PLOT 69,0,0 p%(x%)=TINT(0,0) NEXT x% GCOL tcol% PLOT 69,0,0 ENDPROC : DEFPROCSetPaletteN(p%(),ncols%) DEFPROCSetPalette(p%()):LOCAL ncols%:ncols%=16 LOCAL x% FOR x%=0 TO ncols%-1 COLOUR x%,(p%(x%) AND &FF),(p%(x%)>>8) AND &FF, (p%(x%)>>16) AND &FF NEXT x% ENDPROC : DEFPROCSetGreyScale(p%()) LOCAL x% FOR x%=0 TO 15 p%(x%)=x%*16*&10101 NEXT x% ENDPROC : DEFPROCSetDefaultColours(p%()) p%()=0,&C8,&C800,&C8C8,&C80000,&C800C8,&C8C800,&C8C8C8,&383838,&3838F8,&38F838,&38F8F8,&F83838,&F838F8,&F8F838,&FFFFFF ENDPROC : DEFPROCShowPalette(px%,py%) FOR x%=0 TO 15 GCOL x% RECTANGLE FILL px%+20*x%,py%,20,20 NEXT x% GCOL 0 RECTANGLE px%,py%,320,20 ENDPROC : DEFPROCChooseColour(cn%,px%,py%) LOCAL x%,y%,z%,r%,g%,b%,done% LOCAL w%,h% done%=FALSE *REFRESH OFF w%=@vdu%!208*2 :REM The width of the current window in BB4W graphics units h%=@vdu%!212*2 :REM The height of the current window in BB4W graphics units REM Make sure the picker doesn't fall off the edge of the screen, making the OK button impossible to click! IF px%>w%-502 THEN px%=w%-502 IF py%>h%-102 THEN py%=h%-102 REM Now we'll save the area that will have the colour picker in to a temporary file OSCLI "SCREENSAVE """+@tmp$+"tempscreenbit.bmp"+""" "+STR$(px%)+","+STR$(py%)+",502,102" REM Clear the space to black GCOL 0 RECTANGLE FILL px%,py%,500,100 GCOL 15 RECTANGLE px%,py%,500,100 RECTANGLE px%+4, py%+4,492,92 REPEAT GCOL 0 RECTANGLE FILL px%+6,py%+6,488,88 GCOL 15 VDU 5 MOVE px%+8,py%+30 PRINT"B" RECTANGLE px%+30,py%+10,255,20 MOVE px%+8,py%+60 PRINT"G" RECTANGLE px%+30,py%+40,255,20 MOVE px%+8,py%+90 PRINT"R" RECTANGLE px%+30,py%+70,255,20 LINE px%+30+r%,py%+70,px%+30+r%,py%+90 LINE px%+30+g%,py%+40,px%+30+g%,py%+60 LINE px%+30+b%,py%+10,px%+30+b%,py%+30 COLOUR 7,r%,g%,b% GCOL 7 RECTANGLE FILL px%+300,py%+10,90,80 GCOL 15 RECTANGLE px%+410,py%+10,80,80 MOVE px%+430,py%+65 PRINT "OK" VDU 4 MOUSE x%,y%,z% IF z%>0 THEN CASE TRUE OF WHEN y%>py%+9 AND y%<py%+31 AND x%>px%+29 AND x%<px%+286:b%=x%-30 -px% WHEN y%>py%+39 AND y%<py%+61 AND x%>px%+29 AND x%<px%+286:g%=x%-30-px% WHEN y%>py%+69 AND y%<py%+91 AND x%>px%+29 AND x%<px%+286:r%=x%-30-px% WHEN y%>py%+10 AND y%<py%+90 AND x%>px%+410 AND x%<px%+490:done%=TRUE ENDCASE ENDIF *REFRESH UNTIL done% COLOUR 7,200,200,200 REM OK, Restore the original picture, and delete our temporary file. OSCLI "DISPLAY """+@tmp$+"tempscreenbit.bmp"+""" "+STR$(px%)+","+STR$(py%)+",502,102" OSCLI "DEL """+@tmp$+"tempscreenbit.bmp"+"""" *REFRESH ON COLOUR cn%,r%,g%,b% ENDPROC