Author |
Topic: Decimal to Hexadecimal tool (FIXED) (Read 284 times) |
|
michael
Senior Member
member is offline
Posts: 335
|
 |
Decimal to Hexadecimal tool (FIXED)
« Thread started 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
|
| « Last Edit: Aug 29th, 2017, 10:50am by michael » |
 Logged
|
I like making program generators and like reinventing the wheel
|
|
|
DDRM
Administrator
member is offline
Gender: 
Posts: 321
|
|
Re: Compact Decimal to Hexadecimal tool
« Reply #1 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
|
|
Logged
|
|
|
|
DDRM
Administrator
member is offline
Gender:
Posts: 321
|
|
Re: Compact Decimal to Hexadecimal tool
« Reply #2 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
|
|
Logged
|
|
|
|
michael
Senior Member
member is offline
Posts: 335
|
|
Re: Decimal to Hexadecimal tool (FIXED)
« Reply #3 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.
|
|
Logged
|
I like making program generators and like reinventing the wheel
|
|
|
sveinioslo
Developer
member is offline
Posts: 64
|
|
Re: Decimal to Hexadecimal tool (FIXED)
« Reply #4 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
|
|
Logged
|
|
|
|
michael
Senior Member
member is offline
Posts: 335
|
|
Re: Decimal to Hexadecimal tool (FIXED)
« Reply #5 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
|
|
Logged
|
I like making program generators and like reinventing the wheel
|
|
|
|
