|
|
Post by Admin on Mar 31, 2018 23:18:00 GMT
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
|
|
