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