BBC BASIC for Windows
IDE and Compiler >> Tools and Utilities >> Decimal to Hexadecimal tool (FIXED)
http://bb4w.conforums.com/index.cgi?board=addins&action=display&num=1503975983
Decimal to Hexadecimal tool (FIXED)
Post by michael on Aug 29th, 2017, 03:06am

I made this for a task bar tool in the case that I want to convert a Decimal to Hexadecimal. So I would make an executable and place it on my task bar for quick access.

Any problems let me know. I am reusing some old code and modernized it a bit. (ok now it has had a face lift)

Code:
      REM Repurposed for a DECIMAL to HEXIDECIMAL tool **********************
      REM gbx% and gby% NEED to be whole numbers and need to be global ( they hold shared text input location )
      gbx%=0:gby%=0:split%=0:cursor%=0 :REM GLOBAL VARIABLES
      REM split% holds the divide location of the string so edits can be made. ( this is where it gets technical)
      tempstr$=""
      lx=0:ly=0:lh=0:lv=0:fc%=0
      REM define my line position
      li=0
      PROCgraphics(450,200)
      REPEAT
        REPEAT
          PROCcolor("b","200,200,200")
          CLG:PROC_color("F",255,255,255)
          MOVE 10,250:PROC_color("F",0,0,0):PRINT "Type in a decimal number to get a Hexadecimal value"
          MOVE 10,300:PRINT" DECIMAL TO HEXADECIMAL TOOL"
          REM H,V,TEXTLIMIT (getting simpler?)
          PROC_input(10,200,50):REM **************************END OF PROGRAM ****************************
          PROC_color("f",0,0,0)
          fc%=VAL(MESSAGE$)
          hx$=STR$~(fc%)
          PRINT:PRINT "HEX value is:  &";hx$
          REM setup buttons before use
          REM             x , y ,size,"fillcolor","command"
          res$=FNabutton(10,50,50,"yellow","fill")
          PROCcolor("f","black")
          MOVE 80,85:PRINT "<< LEFT CLICK BOX TO CONTINUE"
          REM TRACKING STARTS HERE
          REPEAT
            res$=""
            IF FNabutton(10,50,50,"blue","right")="right" THEN res$="right"
            PROCsbox(250,700,2150,600,"15")
            MOVE 260,650:PRINT res$
            WAIT 10
          UNTIL res$="right"
    
        UNTIL FALSE
        END
        REM handy graphics tool to modernize this old program
        DEF PROCgraphics(x,y)
        VDU 23,22,x;y;8,15,16,1
        OFF
        VDU 5
        ENDPROC
        REM x,y is lower left and c$=fillcolor:com$-command
        DEFFNabutton(x,y,size%,c$,com$)
        MOUSE mx,my,mb
        LOCAL ret$
        PROCcolor("f","5")
        PROCrect(x,y,x+size%,y+size%)
        IF com$="fill" THEN
          PROCsbox(x+2,y+2,x+size%-2,y+size%-2,c$)
        ENDIF
        IF mx>x AND mx<x+size% AND my>y AND my<y+size% THEN
          PROCcolor("f","15"):PROCrect(x,y,x+size%,y+size%)
          IF mb=4 THEN ret$=com$
        ENDIF
        =ret$
        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 H,V,TEXTLIMIT (simpler?)
        DEF PROC_input(bx,by,textlimit)
        LOCAL rback%,gback%,bback%
        rback%=255:gback%=255:bback%=255
        LOCAL rfore%,gfore%,bfore%,fill
        rfore%=0:gfore=0:bfore=0
        gbx%=bx:gby%=by:initialx%=0:sl%=0:key$="":MESSAGE$="":MES$=""
        initialx%=textlimit*16.2
        FOR fill=1 TO 58
          PROC_color("f",255,255,255):LINE bx+3,by+20-fill,bx+initialx%,by+20-fill
        NEXT fill
        PROC_color("f",0,0,0):LINE bx+3,by+20,bx+initialx%,by+20:LINE bx+3,by+20-fill,bx+initialx%,by+20-fill
        REPEAT
          REPEAT
            key$ =INKEY$(1)
            PROC_color("F",rfore%,gfore%,bfore%)
            MOVE bx,by:PRINT MESSAGE$;"_"
            sl%=LEN(MESSAGE$)
            remains%=sl%-cursor%
            lstring$=LEFT$(MESSAGE$,cursor%):rstring$=RIGHT$(MESSAGE$,remains%)
          UNTIL key$ <>""
          sl%=LEN(MESSAGE$)
          IF INKEY(-48) sl%=LEN(MESSAGE$)-1:key$=""
          REPEAT UNTIL INKEY(0)=-1
          IF MESSAGE$<> MESSAGE$ OR sl%<LEN(MESSAGE$) THEN
            PROC_color("F",rback%,gback%,bback%)
            MOVE bx,by
            PRINT MESSAGE$;"_"
          ENDIF
          MES$=MID$(MESSAGE$,0,sl%)
          MESSAGE$=MES$
          PROC_color("F",rback%,gback%,bback%):MOVE bx,by:PRINT MESSAGE$;"_"
          IF LEN(key$) = 1 THEN
            IF LEN(MESSAGE$)<textlimit THEN PROC_color("F",rback%,gback%,bback%):MOVE bx,by:PRINT MESSAGE$;"_": MESSAGE$=MESSAGE$+key$
            REM (jump)
          ENDIF
        UNTIL INKEY(-74)
        ENDPROC
        ENDPROC
        REM ***********************this is my super custom text box tool ***********************
        REM X,Y,text color,boarder color,message,r,g,b
        REM ************************************************************************
        DEF PROC_pr(X,Y,C,CT,msg$,r,g,b)
        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 fill=1 TO 58
          LINE X+3,Y+20-fill,X+initialx%,Y+20-fill
        NEXT fill
        GCOL CT
        MOVE tx,ty
        PRINT msg$
        GCOL C
        LINE X,Y+20,X+initialx%,Y+20
        LINE X,Y+20,X,Y-40
        LINE X,Y-40,X+initialx%,Y-40
        LINE X+initialx%,Y-40,X+initialx%,Y+20
        LINE X-5,Y+25,X+initialx%+5,Y+25
        LINE X-5,Y+25, X-5,Y-45
        LINE X+initialx%+5,Y+25,X+initialx%+5,Y-45
        LINE X-5,Y-45,X+initialx%+5,Y-45
        MOVE 0,0 REM hide that thing
        ENDPROC
  
        REM ******************this is a custom Foreground and Background control tool (too much?) *****************
        REM color "F"or"B", r,g,b
        DEF PROC_color(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 WORD extractor ****************************************Because I dont want to need any other library?*********************************************************
        DEF FNew(txt$,coun)
        DIM wl$(255)
        LOCAL chk$,ps%,sl%,wc%,getword$
        FOR x=0 TO 255
          wl$(x)=""
        NEXT x
        chk$="":wc%=0
        sl%=LEN(txt$):ps%=1
        REPEAT
          chk$=MID$(txt$,ps%,1):ps%=ps%+1
          IF chk$=" " THEN chk$="":getword$="yes"
          wl$(wc%)=wl$(wc%)+chk$
          IF getword$="yes" THEN wc%=wc%+1:getword$="no":chk$=""
        UNTIL ps%>sl%
        =wl$(coun)
        DEFPROCpaint(x%,y%,co$)
        PROCcolor("b","0"):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
Re: Compact Decimal to Hexadecimal tool
Post by DDRM on Aug 29th, 2017, 09:51am

Hi Michael,

Works OK and looks nice, but it doesn't give you long to write the answer down!

Could it leave the hex value up until you type something different in the input box?

Best wishes,

D
Re: Compact Decimal to Hexadecimal tool
Post by DDRM on Aug 29th, 2017, 10:50am

Hi Michael,

I know your version uses your own routines, and is cross-platform compatible - but this is the BB4W forum, so here's a version for Windows, showing how it could be more compact. It doesn't check for lower case letters in the hex numbers... It doesn't need/want/supply the leading "&", but you could add that if you want it...

This is the first time I've ever used FN_setproc in one of my programs! :-)

Best wishes,

D
Code:
      INSTALL @lib$+"WINLIB5"
      VDU 23,22,320;80;8,16,16,0
      sb1%=FN_staticbox("Decimal",20,45,100,20,100,0)
      DecEB%=FN_editbox("",20,20,100,20,101,0)
      sb2%=FN_staticbox("Hex value",200,45,102,20,100,0)
      HexEB%=FN_editbox("",200,20,100,20,103,0)
      action%=FN_button("Convert",130,20,60,40,FN_setproc(PROCConvert),0)
      REPEAT
        WAIT 1
      UNTIL FALSE
      END
      DEFPROCConvert
      LOCAL d$,h$
      PRIVATE d%,h%
      d$=FNgettext(DecEB%)
      h$=FNgettext(HexEB%)
      IF d%<>VAL(d$) THEN
        d%=VAL(d$):h%=d%:PROCsettext(HexEB%,STR$~(h%))
      ELSE
        h%=EVAL("&"+h$):d%=h%:PROCsettext(DecEB%,STR$(d%))
      ENDIF
      ENDPROC
      :
      DEF FNgettext(hbox%)
      LOCAL text%
      DIM text% LOCAL 65535
      SYS "GetWindowText", hbox%, text%, 65535
      = $$text%
      :
      DEF PROCsettext(hbox%,t$)
      SYS "SetWindowText", hbox%, t$
      ENDPROC
Re: Decimal to Hexadecimal tool (FIXED)
Post by michael on Aug 29th, 2017, 10:56am

I put a new button tool in the program and gave it a facelift so it works as you suggested.

Your tool is very nice and flexible. Thanks for that.
Re: Decimal to Hexadecimal tool (FIXED)
Post by sveinioslo on Aug 31st, 2017, 2:07pm

Here's my dialogue box version.
Hex numbers can be upper or lowercase.
One can use a leading '&' or not.
The conversion is done 'on the fly' both ways. 32 bit only.

Regards Svein

Code:
      EN_KILLFOCUS = 512
      EN_SETFOCUS = 256
      EN_UPDATE = &400
      WM_COMMAND = 273
      Forever=0
      DIM Text% 255

      INSTALL @lib$+"winlib2"
      INSTALL @lib$+"eventlib"
      INSTALL @lib$+"stringlib"
      PROC_eventinit
      PROC_eventregister(WM_COMMAND,PROCfocus())

      Dlg%=FN_newdialog("",0,0,160,30,8,300)
      Dlg%!16=(Dlg%!16 OR &40000000) AND NOT &80400000
      PROC_static(Dlg%,"Hexadecimal",0,8,1,64,10,1)
      PROC_static(Dlg%,"Decimal",0,88,1,64,10,1)
      Hex%=100  : PROC_editbox(Dlg%,"",Hex%,8,12,64,12,0)
      Deci%=101 : PROC_editbox(Dlg%,"",Deci%,88,12,64,12,0)
      PROC_showdialog(Dlg%)
      REM Dock the dialog
      DIM rc{l%,t%,r%,b%}
      SYS "GetWindowRect", !Dlg%, rc{}
      SYS "GetWindowLong", @hwnd%, -16 TO style%
      SYS "SetWindowLong", @hwnd%, -16, style% AND NOT &50000
      SYS "AdjustWindowRect", rc{}, style% AND NOT &50000, 0
      SYS "SetWindowPos", @hwnd%, 0, 0, 0, rc.r%-rc.l%, rc.b%-rc.t%, 102
      SYS "SetWindowText", @hwnd%, "Hex_Deci_32"

      ON CLOSE QUIT
      ON ERROR PROCclear : REM just empty boxes and continue

      REPEAT WAIT 0
        PROC_eventpoll
      UNTIL Forever

      DEF PROCfocus(M%,W%,L%)
      LOCAL I%,V%,text$,a$
      V%=W%>>16 : W%=W%AND&FFFF
      IF V%=EN_KILLFOCUS THEN Focus%=0
      IF V%=EN_SETFOCUS THEN Focus%=1 : Box%=W%
      IF V%=EN_UPDATE AND Focus%=1 AND W%=Box% THEN
        IF Box%=Hex% THEN
          SYS "GetDlgItemText", !Dlg%, Hex%, Text%, 255 : text$=FN_upper($$Text%)
          IF ASC(text$)=38 THEN a$="" ELSE a$="&"
          IF text$="" OR text$="&" THEN
            SYS "SetDlgItemText", !Dlg%, Deci%, ""
          ELSE
            SYS "SetDlgItemInt", !Dlg%, Deci%, EVAL(a$+text$)
          ENDIF
        ELSE
          SYS "GetDlgItemInt", !Dlg%, Deci%, 0, 1 TO I%
          SYS "SetDlgItemText", !Dlg%, Hex%, STR$~I%
        ENDIF
      ENDIF
      ENDPROC

      DEF PROCclear
      SYS "SetDlgItemText", !Dlg%, Hex%, ""
      SYS "SetDlgItemText", !Dlg%, Deci%, ""
      ENDPROC
Re: Decimal to Hexadecimal tool (FIXED)
Post by michael on Sep 1st, 2017, 02:15am

That is very handy ! It will be great for vertex colors. I may use my colormixer tool to give instant hexadecimal results for colors that you can mix with a equalizer slider (3 sliders)..

If anyone wants to try their hand at doing it, the colormixer tool is inside RETROLIB 10