Author |
Topic: sbox - the smart bordered box (may 21,2016) (Read 432 times) |
|
michael
Senior Member
member is offline
Posts: 335
|
 |
sbox - the smart bordered box (may 21,2016)
« Thread started on: May 20th, 2016, 02:13am » |
|
The command:
sbox(x,y,h,v)
x,y the first coordinates.. (somewhere on the screen)
h,v the second set of coordinates (somewhere on the screen)
It doesn't matter where the coordinates are on the screen, it will always draw a proper bordered box
Code: 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
|
| « Last Edit: May 21st, 2016, 8:59pm by michael » |
 Logged
|
I like making program generators and like reinventing the wheel
|
|
|
DDRM
Administrator
member is offline
Gender: 
Posts: 321
|
|
Re: Border box tool and improved text tool+ideas
« Reply #1 on: May 20th, 2016, 08:08am » |
|
Hi Michael,
I made these routines when I was thinking about the colour picker problem. Are they any use?
PROCReadPalette and PROCReadPaletteN needs a 1 dimensional array big enough to hold the N colours you want to read: typically 16 (0-15) for the "normal" colours you can set with COLOUR. This is useful to capture the default palette before you start messing around with the colours - but you could also use it to store the current position before altering it in one of your subroutines. The version without an N reads 16 entries; the N variant allows you to read however many you like.
PROCSetPalette and PROCSetPaletteN take the resulting array and set the palette to the stored colour numbers. The version without an N sets 16 entries; the N variant allows you to set however many you like.
PROCSetGreyScale fills an array with an even grey scale, which you can then pass to PROCSetPalette.
PROCSetDefaultColours fills an array with the default colour numbers, which you can then pass to PROCSetPalette. I just ran PROCReadPalette and wrote down the output...
PROCChooseColour I think you've seen before. It's here so you can modify the palette entries and then redisplay, to check it's all working correctly.
Best wishes,
D
Code:
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
|
|
Logged
|
|
|
|
michael
Senior Member
member is offline
Posts: 335
|
|
Re: sbox - the smart bordered box (may 21,2016)
« Reply #2 on: May 31st, 2016, 12:07pm » |
|
I do like your RGB color picker tool. I would like to modify it so that it shows the proper RGB values also.. Ill work on that
|
|
Logged
|
I like making program generators and like reinventing the wheel
|
|
|
|
