BBC BASIC for Windows
« Time sheet HOURS assistant program »

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: Time sheet HOURS assistant program  (Read 196 times)
michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
xx Time sheet HOURS assistant program
« Thread started 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$
 
« Last Edit: Aug 7th, 2017, 10:17pm by michael » 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