BBC BASIC
« Time sheet HOURS assistant program »

Welcome Guest. Please Login or Register.
Jan 20th, 2018, 4:19pm


Cross-platform BBC BASIC (Win32, Linux x86, Android, Mac OS-X, Raspberry Pi)

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: Time sheet HOURS assistant program  (Read 147 times)
michael
Full Member
ImageImageImage


member is offline

Avatar




PM


Posts: 141
xx Time sheet HOURS assistant program
« Thread started on: Aug 7th, 2017, 9:59pm »

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:19pm by michael » User IP Logged

I like reinventing the wheel, but for now I will work on tools for D3D
KenDown
New Member
Image


member is offline

Avatar




PM


Posts: 17
xx Re: Time sheet HOURS assistant program
« Reply #1 on: Sep 10th, 2017, 3:04pm »

Hmmm. Does it do anything other than calculate how many hours there are between x o'clock and y o'clock?

It would seem more intuitive to use the left mouse button for both start and end and determine which arrow is moved by the position of the mouse!

You need to have a way of indicating lunch breaks and other breaks (assuming they are counted) such as coffee or tea breaks. That could be something set in the middle, between the two arrows and again, set by the left mouse button.
User IP Logged

michael
Full Member
ImageImageImage


member is offline

Avatar




PM


Posts: 141
xx Re: Time sheet HOURS assistant program
« Reply #2 on: Sep 10th, 2017, 10:20pm »

Quote:
You need to have a way of indicating lunch breaks and other breaks (assuming they are counted) such as coffee or tea breaks. That could be something set in the middle, between the two arrows and again, set by the left mouse button.


Feel free to modify it for your needs. I am working on a 3D image design app. (cross platform)
User IP Logged

I like reinventing the wheel, but for now I will work on tools for D3D
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Donate $6.99 for 50,000 Ad-Free Pageviews!


This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls