BBC BASIC for Windows
IDE and Compiler >> Tools and Utilities >> sbox - the smart bordered box (may 21,2016)
http://bb4w.conforums.com/index.cgi?board=addins&action=display&num=1463710394

sbox - the smart bordered box (may 21,2016)
Post by michael 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

 

Re: Border box tool and improved text tool+ideas
Post by DDRM 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
 



Re: sbox - the smart bordered box (may 21,2016)
Post by michael 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