XProfan

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

tandis que 1

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

Wend

...deleteObject(myDisplayHPic&)
end

proc digitsHPic.create

    parameters digits$,charWidth&,charHeight&
    cas digits$=» : digits$="0"
    var hPic&=create("hNewPic",len(digits$)*charWidth&,charHeight&,0)
    digitsHPic.renew(hPic&,digits$,charWidth&,charHeight&)
    return hPic&

endproc

proc digitsHPic.renew

    parameters hPic&,digits$,charWidth&,charHeight&
    var c&=len(digits$)
    casenot c& : return
    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$,&loop+1,1))-48)*7
        digitsHPic.renew.line(0,&loop*charWidth&+innerCharX&+lnsz&,innerCharY& , &loop*charWidth&+innerCharX&+innerCharWidth&-lnsz&,innerCharY& )
        digitsHPic.renew.line(1,&loop*charWidth&+innerCharX&,innerCharY&+lnsz& , &loop*charWidth&+innerCharX&,innerCharYM&-lnsz& )
        digitsHPic.renew.line(2,&loop*charWidth&+innerCharX&+innerCharWidth&,innerCharY&+lnsz& , &loop*charWidth&+innerCharX&+innerCharWidth&,innerCharYM&-lnsz& )
        digitsHPic.renew.line(3,&loop*charWidth&+innerCharX&+lnsz&,innerCharYM& , &loop*charWidth&+innerCharX&+innerCharWidth&-lnsz&,innerCharYM& )
        digitsHPic.renew.line(4,&loop*charWidth&+innerCharX&,innerCharYM&+lnsz& , &loop*charWidth&+innerCharX&,innerCharY&+innerCharHeight&-lnsz& )
        digitsHPic.renew.line(5,&loop*charWidth&+innerCharX&+innerCharWidth&,innerCharYM&+lnsz& , &loop*charWidth&+innerCharX&+innerCharWidth&,innerCharY&+innerCharHeight&-lnsz& )
        digitsHPic.renew.line(6,&loop*charWidth&+innerCharX&+lnsz&,innerCharY&+innerCharHeight& , &loop*charWidth&+innerCharX&+innerCharWidth&-lnsz&,innerCharY&+innerCharHeight& )

    Wend

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

    whileLoop 0,c&-1

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

    Wend

    endPaint

    proc digitsHPic.renew.line

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

    endproc

endproc