BBC BASIC for Windows
« sbox - the smart bordered box (may 21,2016) »

Welcome Guest. Please Login or Register.
Apr 5th, 2018, 10:41pm



ATTENTION MEMBERS: Conforums will be closing it doors and discontinuing its service on April 15, 2018.
Ad-Free has been deactivated. Outstanding Ad-Free credits will be reimbursed to respective payment methods.

If you require a dump of the post on your message board, please come to the support board and request it.


Thank you Conforums members.

BBC BASIC for Windows Resources
Online BBC BASIC for Windows documentation
BBC BASIC for Windows Beginners' Tutorial
BBC BASIC Home Page
BBC BASIC on Rosetta Code
BBC BASIC discussion group
BBC BASIC for Windows Programmers' Reference

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: sbox - the smart bordered box (may 21,2016)  (Read 432 times)
michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
xx 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 » User IP Logged

I like making program generators and like reinventing the wheel
DDRM
Administrator
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 321
xx 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
 


User IP Logged

michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
xx 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
User IP Logged

I like making program generators and like reinventing the wheel
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

| |

This forum powered for FREE by Conforums ©
Terms of Service | Privacy Policy | Conforums Support | Parental Controls