BBC BASIC for Windows
IDE and Compiler >> Tools and Utilities >> Time sheet HOURS assistant program
http://bb4w.conforums.com/index.cgi?board=addins&action=display&num=1502143414

Time sheet HOURS assistant program
Post by michael on Aug 7th, 2017, 10:03pm

I made this program to help me do my work time sheet more quickly.
Try it out.
This works on BBCSDL and BBC4W including on MacOS
Let me know if there is any problems..
Code:
      PROCgraphics(1100,600)
      res=0
      ls= 0
      LET rs= 24
      counl%=290
      counr%=2110
      PROCsbox(250,700,2150,600,"15")
      PROCcolor("f","black")
      MOVE 100,650
      PRINT "           12 | 1 |  2 | 3  | 4  | 5 |  6 |  7 | 8  | 9 | 10 | 11 | 12 | 1  | 2 |  3 | 4  | 5  | 6 | 7  | 8  | 9 | 10 | 11 | 12"
      PROCsbox(100,5,2000,95,"green")
      PROCcolor("f","black")
      MOVE 100,50
      PRINT " Use Left and right mouse buttons to adjust begin and end day work hours"
      REM TRACKING STARTS HERE
      REPEAT
        MOUSE x,y,b
        PROCarrowu(counr%,590)
        PROCarrowd(counl%,710)
        MOVE 0,0
        WAIT 10
        IF x>counr% AND b=1 THEN counr%+=38:rs=rs+.5
        IF x<counr% AND b=1 THEN counr%-=38:rs=rs-.5
        IF x>counl% AND b=4 THEN counl%+=38:ls=ls+.5
        IF x<counl% AND b=4 THEN counl%-=38:ls=ls-.5
        IF ls <0 THEN ls =0
        IF rs >24 THEN rs =24
        IF ls >rs THEN ls-=.5:counl%=counl%-38
        IF rs <ls THEN rs+=.5:counr%=counr%+38
        IF counl%<290 THEN counl%=290
        IF counr%>2110 THEN counr%=2110
        IF counr%<290 THEN counr%=290
        IF counl%>2110 THEN counl%=2110
        PROCsbox(100,100,500,200,"white")
        MOVE 125,150
        PROCcolor("f","black")
        res=rs-ls
        PRINT "HOURS "+STR$(res)
      UNTIL FALSE
      END
      DEFPROCarrowu(x,y)
      PRIVATE xx,yy
      PROCcolor("f","black")
      LINE xx,yy,xx-20,yy-20
      LINE xx,yy,xx+20,yy-20
      PROCcolor("f","15")
      LINE x,y,x-20,y-20
      LINE x,y,x+20,y-20
      xx=x:yy=y
      ENDPROC
      DEFPROCarrowd(x,y)
      PRIVATE hh,vv
      PROCcolor("f","000,000,000")
      LINE hh,vv,hh-20,vv+20
      LINE hh,vv,hh+20,vv+20
      PROCcolor("f","15")
      LINE x,y,x-20,y+20
      LINE x,y,x+20,y+20
      hh=x:vv=y
      ENDPROC
      REM  GRAPHICS(x,y)
      DEF PROCgraphics(x,y)
      VDU 23,22,x;y;8,15,16,1
      OFF
      VDU 5
      ENDPROC
      REM SBOX **********************
      DEF PROCsbox(x%,y%,w%,h%,c$)
      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",c$)
      REPEAT
        LINE x%,y%,w%,y%
        y%=y%+1
      UNTIL y%=h%
      y%=ry%
      IF c$<>"0" THEN PROCcolor("f","000,000,000") ELSE PROCcolor("f","white")
      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
      PROCresetrgb
      ENDPROC
      REM RECT **********************
      DEFPROCrect(x%,y%,w%,h%)
      LOCAL sx%,sy%
      sx%=x%:sy%=y%
      IF x%>w% THEN x%=w%:w%=sx%
      IF y%>h% THEN y%=h%:h%=sy%
      LINE x%,y%,w%,y%
      LINE w%,y%,w%,h%
      LINE w%,h%,x%,h%
      LINE x%,h%,x%,y%
      ENDPROC
      REM pixel *******************
      DEFPROCpixel(x%,y%,c$)
      PROCcolor("f",c$)
      MOVE x%,y%:DRAW x%,y%
      ENDPROC
      REM SET  c$ can be colors like blue or 1 or a R,G,B color
      DEF PROCset(x%,y%,c$)
      LOCAL h%
      PROCcolor("f",c$)
      FOR h%=0 TO 20
        LINE x%+h%,y%,x%+h%,y%+20
      NEXT
      MOVE 0,0
      ENDPROC
      DEFPROCpaint(x%,y%,co$)
      PROCcolor("b",FNrgb(x%,y%)):PROCcolor("f",co$)
      FILL x%,y%
      ENDPROC
      REM restore default color palettes
      DEFPROCresetrgb
      COLOUR 0,0,0,0 :COLOUR 1,200,0,0 :COLOUR 2,000,200,000
      COLOUR 3,200,200,000:COLOUR 4,000,000,200:COLOUR 5,200,000,200
      COLOUR 6,000,200,200:COLOUR 7,200,200,200:COLOUR 8,056,056,056
      COLOUR 9,248,056,056:COLOUR 10,056,248,056:COLOUR 11,248,248,056
      COLOUR 12,056,056,248:COLOUR 13,248,056,248:COLOUR 14,056,248,248
      COLOUR 15,248,248,248
      ENDPROC
      DEF PROCcolor(fb$,rgb$)
      PRIVATE assemble$,br%,bg%,bb%
      IF rgb$="0" OR rgb$="black" THEN rgb$="000,000,000"
      IF rgb$="1" OR rgb$="red" THEN rgb$="200,000,000"
      IF rgb$="2" OR rgb$="green" THEN rgb$="000,200,000"
      IF rgb$="3" OR rgb$="yellow" THEN rgb$="200,200,000"
      IF rgb$="4" OR rgb$="blue" THEN rgb$="000,000,200"
      IF rgb$="5" OR rgb$="magenta" THEN rgb$="200,000,200"
      IF rgb$="6" OR rgb$="cyan" THEN rgb$="000,200,200"
      IF rgb$="7" OR rgb$="white" THEN rgb$="200,200,200"
      IF rgb$="8" OR rgb$="grey" THEN rgb$="056,056,056"
      IF rgb$="9" OR rgb$="light red" THEN rgb$="248,056,056"
      IF rgb$="10" OR rgb$="light green" THEN rgb$="056,248,056"
      IF rgb$="11" OR rgb$="light yellow" THEN rgb$="248,248,056"
      IF rgb$="12" OR rgb$="light blue" THEN rgb$="056,056,248"
      IF rgb$="13" OR rgb$="light magenta" THEN rgb$="248,056,248"
      IF rgb$="14" OR rgb$="light cyan" THEN rgb$="056,248,248"
      IF rgb$="15" OR rgb$="light white" THEN rgb$="248,248,248"
      assemble$=rgb$
      br%=VAL(MID$(assemble$,1,3)):bg%=VAL(MID$(assemble$,5,3)):bb%=VAL(MID$(assemble$,9,3))
      IF fb$="f" OR fb$="F" THEN COLOUR 0,br%,bg%,bb% : GCOL 0
      IF fb$="b" OR fb$="B" THEN COLOUR 1,br%,bg%,bb% : GCOL 128+1
      ENDPROC
      a      REM buttonz
      DEFFNbuttonz(X,Y,msg$)
      LOCAL initialx%,fi%,reduction%,tx,ty,mx%,my%,mb%,ad%,ady%,c$
      PRIVATE st$
      IF msg$<> "clearitall" THEN
        initialx%=LEN(msg$)
        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%
        MOUSE mx%,my%,mb%
        ad%=initialx%+8:ad%+=X:ady%=Y-28
        IF mx% >X AND mx%<ad% AND my%<Y+8 AND my%>ady% THEN
          c$="255,255,255"
          IF mb%=4 THEN st$=msg$
        ELSE c$="200,200,200"
        ENDIF
        IF FNrgb(X,Y)="000,000,000" THEN c$="200,200,200"
        PROCcolor("f",c$)
        IF FNrgb(X,Y)<>c$ THEN
          FOR fi%=12 TO 48
            LINE X-3,Y+20-fi%,X+initialx%+8,Y+20-fi%
          NEXT
          PROCcolor("f","000,000,000")
          MOVE tx,ty
          PRINT msg$
        ENDIF
      ENDIF
      IF msg$="clearitall" THEN st$=""
      MOVE 0,0 REM hide that thing
      =st$