Foro | | | | Thomas Freier | Yo búsqueda después de uno Möglichkeit, el Daten uno Bildes como o. en uno txt-Expediente abzuspeichern. Ein Ejemplo Yo hier gefunden, el va en algo größeren Bildern me aber a langsam: KompilierenMarcaSeparacióndeclare 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
Gibt lo una bessere y schnellere Método? |
| | | | |
| | Frank Abbing | Willst du a el Grafikdaten des Bilds kommen oder de una Grafikbild una Textbild remendar? Im ersten Fall solltest du dein Bild en un DIB wandeln, entonces kannst el Grafikdaten simplemente de el Speicher auslesen. |
| | | | |
| | Thomas Freier | Yo quería el Grafikdaten en un Textdatei einbetten. Beim Öffnen el Expediente se de esta Daten entonces otra vez una Grafik real erstellt voluntad. Franco, con deinem Datengenerator es sí, aber por desgracia, no por Komandozeile, also Bild real disponible > Expediente invitar y umwandeln > de el Zwischenablage en un, oder Edición igual como Textdatei. Como siehts con solcher Möglichkeit de?
Editar: Das Bild se en un *.rtf con el Angaben el Lage y Skalierung. El *.rtf enthällt weiterhin el real rtf-Daten + Kopfzeilen-, Listenstruktur- y Fußzeilendaten y kann como Druckvorlage abgespeichert voluntad. Alternativ debería Yo una Bild seperat abspeichern y luego beim Öffnen el Presentación prüfen, si el Bild todavía disponible es. Ejemplo veces con un RTF- y TXT-Editor betrachten. |
| | | | |
| | Frank Abbing | Müsste eigentlich ahora ya ir. Probier veces:
XProfan_Datengenerator "dateiname.xxx"
Lo debería entonces una Expediente "dateiname.xxx.data" erstellt voluntad. |
| | | | |
| | Thomas Freier | Gracias, sí va. Nun muß Yo sólo veces sehen, Yo entonces de el Daten, si ellos de el RTF en una MultiEdit gelesen voluntad, otra vez una Bild erzeuge. |
| | | | |
| | Frank Abbing | Dazu kannst du SetDIBitsToDevice() benutzen. Yo rate dir, dich veces intensiv con DIBs a beschäftigen. |
| | | | |
| | | @Thomas: Das hier se ejecuta blitzschnell auch en el Interpreter: (bild2txt/ txt2bild) KompilierenMarcaSeparacióncls
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
Könnte uno natürlich auch Grösse y otro Angaben todavía con en el TXT packen, hierbei sólo veces al Ejemplo reiner Pixeldaten. |
| | | | |
| | Thomas Freier | Gracias a el Pixelspezialisten. Werde wohl iFs Variante einsetzen. El es echt rápidamente y yo muß no todavía el XProfan_Datengenerator.exe beilegen, así lo je fertig se. |
| | | | |
| | Frank Abbing | Yo sag sí, verwende DIBs. Solltest dich trotzdem veces con el Thema beschäftigen, Yo denke, el lohnt se para dich. Beim fertigen Code besteht desafortunadamente rápidamente el Gefahr, el uno ihn simplemente así übernimmt. |
| | | | |
| | Thomas Freier |
Beim fertigen Code besteht desafortunadamente rápidamente el Gefahr, el uno ihn simplemente así übernimmt.
Naja, es sí meist auch no verkehrt. @IF, irgendwie tener Yo una Problema de el Elk.txt una Bild a erzeugen (Screen1). En kleinerem Bild sieht lo mejor de (Screen2). Auch encima MultiEdit nichts Besseres. KompilierenMarcaSeparacióndeclare 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 mejor? |
| | | | |
| | | An el Características liegt no, mostrar: KompilierenMarcaSeparaciónGemerkt/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
- va con usted also por algo el String futsch, bedenke el es beim elk.png 460KB lang.
Datei<>String: (file_get_contents y file_put_contents) KompilierenMarcaSeparación
proc FGC
PARAMETERS FLE$
IF %PCOUNT<1
RETORNO
ENDIF
var B&=FILESIZE(FLE$)
IF B&<1
RETORNO ""
ENDIF
DECLARE MEM#
DIM MEM#,B&
var R&=BLOCKREAD(FLE$,MEM#,0,B&)
var S$=CHAR$(MEM#,0,R&)
DISPOSE MEM#
RETORNO ""+S$
ENDPROC
proc FPC
PARAMETERS FLE$,S$,_APPEND%
IF %PCOUNT<1
RETORNO 0
ENDIF
IF %PCOUNT<2
S$=""
ENDIF
IF %PCOUNT<3
_APPEND%=0
ENDIF
var L&=LEN(S$)
IF L&=0
IF _APPEND%
RETORNO 1
ENDIF
var FH&=ASSIGN(FLE$)
REWRITE FH&
CLOSE FH&
ASSIGN FH&,""
RETORNO 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
Imprimir fgc("meineDatei") son sólo kompletten Inhalt de "meineDatei" de y fpc("meineDatei","Hallo Welt") schreibt "Hallo Welt" en "meinedatei". Bin aber fast sicher, dass imprimir y input ebenso con langen Cuerdas zurechtkommen - auch si (natürlich) no binärsicher. |
| | | | |
|
RespuestaThemeninformationenDieses Thema ha 3 subscriber: |