English
Forum

Done: Image as txt

 

Thomas
Freier
I Search after a Possibility, The data one Bildes as or. in a txt-File abzuspeichern.
One example have I here found, the goes with something more Images me but too slow:
CompileMarkSeparation
declare a%, data_laenge%, data_anfang%,datei_laenge%,name_in$,name_out$,tmp$,temp$
declare bmp1&,MEdit&
Window 0,0-800,700
name_in$="ELK.png"
name_out$="ELK.txt"

if FileExists(name_in$)=0

    Print "kein Elch zu sehen..."

else

    MEdit& = CREATE("MultiEdit",%HWnd,"",5,40,380,560)
    bmp1&=Create("hPic",-1,name_in$)
    Create("Bitmap", %hwnd, bmp1&, 390, 0)
    DeleteObject bmp1&
    ..........................................Bilddaten in eine TXT
    Assign #1,name_in$
    OpenRW #1
    datei_laenge% = GetFileSize(#1)
    Assign #2,name_out$
    Rewrite #2
    data_laenge%=0

    WhileLoop datei_laenge%

        if data_laenge% < 10

            a%=GetByte(#1)
            print #2,str$(a%);",";

        else

            data_laenge%=0
            print #2
            a%=GetByte(#1)
            print #2,str$(a%);",";

        endif

        data_laenge%=data_laenge%+1

    EndWhile

    Close #1
    Close #2
    print "TXT > OK"
    ................................ aus TXT neues Bild erstellen
    assign #1,name_out$
    reset #1
    ClearList

    whilenot eof(#1)

        input #1,tmp$
        AddString tmp$

    wend

    close #1
    movelisttoedit(Medit&)
    tmp$=GetText$(Medit&,0)
    Assign #3,"ELK_neu.png"
    Rewrite #3

    whileloop len(tmp$)

        temp$=temp$+chr$(val(SubStr$(tmp$,&loop,",")))

    wend

    print #3,temp$
    close #3
    print "ELK_neu > OK"

    if FileExists("ELK_neu.png")=0

        Print "kein neuer Elch zu sehen..."

    else

        bmp1&=Create("hPic",-1,"ELK_neu.png")
        Create("Bitmap", %hwnd, bmp1&, 390, 300)
        DeleteObject bmp1&

    endif

endif

waitkey
end

gives it a better and faster method?

3 kB
Hochgeladen:11/28/09
Downloadcounter73
Download
 
Gruß Thomas
Windows XP SP2, XProfan X2
11/28/09  
 




Frank
Abbing
want You on The Grafikdaten the Bilds come or a Graphic image a Textbild basteln?
in the first drop should You your Image a DIB wandeln, then can The Grafikdaten simply from memory read.
 
11/28/09  
 




Thomas
Freier
I wanted to The Grafikdaten in a Textdatei einbetten. at that Open the File should from this data then again a graphic real prepares go. Frank, with your Datengenerator goes it Yes, but unfortunately not by Komandozeile, means Image real present > File loading and transfiguring > from the Clipboard in a, or spending same as Textdatei. How siehts with such Possibility from?

Edit: the Image should in a *.rtf with the indicated the site and Skalierung. The *.rtf enthällt furthermore the actual rtf-data + Kopfzeilen-, Listenstruktur- and Fußzeilendaten and can as Druckvorlage abgespeichert go. alternatively should I one Image seperat abspeichern and then at Open the Presentation Verify, whether the image yet present is. example time with a RTF- and TXT-editor viewing.

11 kB
Hochgeladen:11/28/09
Downloadcounter146
Download
 
Gruß Thomas
Windows XP SP2, XProfan X2
11/28/09  
 




Frank
Abbing
Should really now already weg. Probier time:

XProfan_Datengenerator "dateiname.xxx"


it ought to then a File "dateiname.xxx.data" prepares go.
 
11/28/09  
 




Thomas
Freier
thanks, Yes goes. now must I only time see, How I then from whom data, as they from the RTF into MultiEdit red go, again Image beget.
 
Gruß Thomas
Windows XP SP2, XProfan X2
11/28/09  
 




Frank
Abbing
moreover can you SetDIBitsToDevice() using. I rate you, you time intense with DIBs To keep busy.
 
11/28/09  
 



@Thomas: the here runs blitzschnell in Interpreter: (presentment2txt/ txt2presentment)
CompileMarkSeparation
cls
var hPic&=create("hPic",-1,"elk.png")
var text$=bild2txt(hPic&,%bmpx,%bmpy)
deleteobject hPic&
assign #1,"bild.txt"
rewrite #1
print #1,text$
close #1
//
hPic&=txt2bild(text$,%bmpx,%bmpy)
drawPic hPic&,0,0;0
deleteobject hPic&
waitinput
end

proc txt2bild

    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 bild2txt

    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

might one naturally too Size and others indicated yet along into The TXT pack, hierbei only time on the example reiner Pixeldaten.

74 kB
Hochgeladen:11/28/09
Downloadcounter101
Download
 
11/28/09  
 




Thomas
Freier
thanks on The Pixelspezialisten. will be well iFs Variante bring into action. The is Real quick what about me must not yet The XProfan_Datengenerator.exe enclosing, so it apiece ready becomes.
 
Gruß Thomas
Windows XP SP2, XProfan X2
11/28/09  
 




Frank
Abbing
I say Yes, use DIBs. If you nevertheless time with the Topic keep busy, i think, the rewards itself for you. at that finished code exists unfortunately quick The menace, the one it simply so undertaking.
 
11/28/09  
 




Thomas
Freier

at that finished code exists unfortunately quick The menace, the one it simply so undertaking.


Well, is Yes mostly neither wrong.
@iF, somehow Have I a problem from the Elk.txt one Image To produce (Screen1). with kleinerem Image see it rather from (Screen2). too over MultiEdit nothing better.
CompileMarkSeparation
declare text$
cls
var hPic&=create("hPic",-1,"Elk.png")
var x%=%bmpx
var y%=%bmpy
text$=hpic2txt(hPic&,%bmpx,%bmpy)
deleteobject hpic&
assign #1,"Elk.txt"
rewrite #1
print #1,text$
close #1
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ASSIGN #1,"Elk.txt"
RESET #1

WHILENOT @EOF(#1)

    INPUT #1,text$
    AddString text$

WEND

CLOSE #1
var medit&=Create("MultiEdit",%hwnd,"",1,1,400,700)
movelisttoedit(medit&)
text$=GetText$(Medit&,0)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
hPic&=txt2hpic(text$,x%,y%)
drawPic hPic&,0,0;0
deleteobject hPic&
waitinput
end

Gehts rather?

30 kB
Hochgeladen:12/05/09
Downloadcounter94
Download
23 kB
Hochgeladen:12/05/09
Downloadcounter102
Download
 
Gruß Thomas
Windows XP SP2, XProfan X2
12/05/09  
 



On the functions lying not, look:
CompileMarkSeparation
Gemerkt/Separiert von http://xprofan.com/thread.core?t=7956#bottom
declare text$
cls
var hPic&=create("hPic",-1,"Elk.png")
var x%=%bmpx
var y%=%bmpy
text$=bild2txt(hPic&,%bmpx,%bmpy)
deleteobject hpic&
hPic&=txt2bild(text$,x%,y%)
drawPic hPic&,0,0;0
deleteobject hPic&
waitinput
end

proc txt2bild

    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 bild2txt

    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

- goes with you means through something the String mci .., considerate the is at elk.png 460KB long.

Datei<>String: (file_get_contents and file_put_contents)
CompileMarkSeparation
proc FGC

    PARAMETERS FLE$

    IF %PCOUNT<1

        RETURN

    ENDIF

    var B&=FILESIZE(FLE$)

    IF B&<1

        RETURN ""

    ENDIF

    DECLARE MEM#
    DIM MEM#,B&
    var R&=BLOCKREAD(FLE$,MEM#,0,B&)
    var s$=CHAR$(MEM#,0,R&)
    DISPOSE MEM#
    RETURN ""+s$

endproc

proc FPC

    PARAMETERS FLE$,s$,_APPEND%

    IF %PCOUNT<1

        RETURN 0

    ENDIF

    IF %PCOUNT<2

        s$=""

    ENDIF

    IF %PCOUNT<3

        _APPEND%=0

    ENDIF

    var L&=LEN(s$)

    IF L&=0

        IF _APPEND%

            RETURN 1

        ENDIF

        var FH&=ASSIGN(FLE$)
        REWRITE FH&
        CLOSE FH&
        ASSIGN FH&,""
        RETURN 1

    ENDIF

    DECLARE MEM#
    DIM MEM#,L&+1

    IFNOT _APPEND%

        STRING MEM#,0=s$
        BLOCKWRITE FLE$,MEM#,0,L&
        DISPOSE MEM#

    ELSE

        var FH&=ASSIGN(FLE$)
        OPENRW FH&
        SEEK FH&,GETFILESIZE(FH&)
        STRING MEM#,0=s$
        BLOCKWRITE FH&,MEM#,0,L&
        DISPOSE MEM#
        CLOSE FH&
        ASSIGN FH&,""

    ENDIF

endproc

Print fgc("meineDatei") gives hold kompletten Content of "meineDatei" from and fpc("meineDatei","Hallo Welt") writes "Hallo Welt" in "meinedatei". be but almost sure, that print and input likewise with long Strings cope - even if (naturally) not binärsicher.
 
12/05/09  
 



Answer


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

2.073 Views

Untitledvor 0 min.
Langer01/01/22
Christof Neuß12/06/19
Jochen Roxlau04/14/15
Georg Teles10/14/14
More...

Themeninformationen

this Topic has 3 subscriber:

Thomas Freier (5x)
Frank Abbing (4x)
iF (2x)


Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.


all rightDatenschutzerklärung
i want none Cookie