XProfan

decimals 0
randomize
window 1000,750
var myDisplayHPic&=digitsHPic.create("012345",32,64)

mientras que 1

    waitinput 500
    drawPic myDisplayHPic&,20,20;0
    digitsHPic.renew(myDisplayHPic&,str$(rnd(999999)),32,64)

wend

...deleteObject(myDisplayHPic&)
end

proc digitsHPic.create

    parámetros digits$,charWidth&,charHeight&
    caso digits$="" : digits$="0"
    var hPic&=create("hNewPic",len(digits$)*charWidth&,charHeight&,0)
    digitsHPic.renew(hPic&,digits$,charWidth&,charHeight&)
    volver hPic&

ENDPROC

proc digitsHPic.renew

    parámetros hPic&,digits$,charWidth&,charHeight&
    var c&=len(digits$)
    casenot c& : volver
    startPaint hPic&
    cls $3E3E3E
    var lnsz&=int(sqrt(charWidth&*charHeight&)*0.08)
    var innerCharWidth&=int(charWidth&*0.8)
    var innerCharHeight&=int(charHeight&*0.8)
    var innerCharYM&=int(charHeight&*0.5)
    var innerCharX&=int((charWidth&-innerCharWidth&)*0.5)
    var innerCharY&=int((charHeight&-innerCharHeight&)*0.5)
    var digs$="0000000001001010111011011011011101011010111101111101001011111111111011"
    var ch&=""

    whileLoop 0,c&-1

        ch&=(ord(mid$(digits$,&bucle+1,1))-48)*7
        digitsHPic.renew.line(0,&bucle*charWidth&+innerCharX&+lnsz&,innerCharY& , &bucle*charWidth&+innerCharX&+innerCharWidth&-lnsz&,innerCharY& )
        digitsHPic.renew.line(1,&bucle*charWidth&+innerCharX&,innerCharY&+lnsz& , &bucle*charWidth&+innerCharX&,innerCharYM&-lnsz& )
        digitsHPic.renew.line(2,&bucle*charWidth&+innerCharX&+innerCharWidth&,innerCharY&+lnsz& , &bucle*charWidth&+innerCharX&+innerCharWidth&,innerCharYM&-lnsz& )
        digitsHPic.renew.line(3,&bucle*charWidth&+innerCharX&+lnsz&,innerCharYM& , &bucle*charWidth&+innerCharX&+innerCharWidth&-lnsz&,innerCharYM& )
        digitsHPic.renew.line(4,&bucle*charWidth&+innerCharX&,innerCharYM&+lnsz& , &bucle*charWidth&+innerCharX&,innerCharY&+innerCharHeight&-lnsz& )
        digitsHPic.renew.line(5,&bucle*charWidth&+innerCharX&+innerCharWidth&,innerCharYM&+lnsz& , &bucle*charWidth&+innerCharX&+innerCharWidth&,innerCharY&+innerCharHeight&-lnsz& )
        digitsHPic.renew.line(6,&bucle*charWidth&+innerCharX&+lnsz&,innerCharY&+innerCharHeight& , &bucle*charWidth&+innerCharX&+innerCharWidth&-lnsz&,innerCharY&+innerCharHeight& )

    wend

    usepen 0,int(lnsz&*0.25),0
    usebrush 0,0

    whileLoop 0,c&-1

        rectangle &bucle*charWidth&,0 - &bucle*charWidth&+charWidth&,charHeight&

    wend

    endPaint

    proc digitsHPic.renew.line

        parámetros ln&,x&,y&,xx&,yy&
        usepen 0,lnsz&,if(byte(addr(digs$),ch&+ln&)-48,$22FF11,$4E4E4E)
        line x&,y& - xx&,yy&

    ENDPROC

ENDPROC