|
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
|
|