XProfan

cls
var hPic&=create("hPic",-1,"elk.png")
var text$=hpic2txt(hPic&,%bmpx,%bmpy)
deleteobject hPic&
assign #1,"bild.txt"
rewrite #1
print #1,text$
close #1
//
hPic&=txt2hpic(text$,%bmpx,%bmpy)
drawPic hPic&,0,0;0
deleteobject hPic&
waitinput
end

proc txt2hpic

    parameters s$,_width&,_height&
    s$=decode64(s$)
    var hPic&=create("hNewPic",_width&,_height&,0)
    var sz&=((_width&*328-1) | 3+1)*abs(_height&)
    declare mem#
    dim mem#,40
    long mem#,0=40,_width&,_height&,0,0,sz&
    byte mem#,12=1
    byte mem#,14=32
    external("gdi32.dll","SetDIBits",%hDC,hPic&,0,_height&,addr(s$),mem#,0)
    dispose mem#
    return hPic&

endproc

proc hpic2txt

    parameters h&,_width&,_height&
    var sz&=((_width&*328-1) | 3+1)*abs(_height&)
    declare mem#
    dim mem#,40
    long mem#,0=40,_width&,_height&,0,0,sz&
    byte mem#,12=1
    byte mem#,14=32
    declare pixels#
    dim pixels#,sz&

    ifnot external("gdi32.dll","GetDIBits",%hDC,h&,0,_height&,pixels#,mem#,0)

        dispose pixels#,mem#
        return 0

    endif

    var txt$=encode64(char$(pixels#,0,_width&*_height&*4-4))
    dispose pixels#,mem#
    return txt$

ENDPROC