Forum | | | | | 
Thomas
Freier | Ich suche nach einer Möglichkeit, die Daten eines Bildes als bzw. in einer txt-Datei abzuspeichern.
Ein Beispiel habe ich hier gefunden, das geht bei etwas größeren Bildern mir aber zu langsam:
KompilierenMarkierenSeparierendeclare 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 es eine bessere und schnellere Methode? |
 | | | | | | |
| | 
Frank
Abbing | Willst du an die Grafikdaten des Bilds kommen oder aus einem Grafikbild eine Textbild basteln?
Im ersten Fall solltest du dein Bild in eine DIB wandeln, dann kannst die Grafikdaten einfach aus dem Speicher auslesen. |
| | | | | | |
| |
Thomas
Freier | Ich wollte die Grafikdaten in eine Textdatei einbetten. Beim Öffnen der Datei soll aus diesen Daten dann wieder eine Grafik real erstellt werden. Frank, mit deinem Datengenerator geht es ja, aber leider nicht per Komandozeile, also Bild real vorhanden > Datei laden und umwandeln > aus der Zwischenablage in eine, oder Ausgabe gleich als Textdatei. Wie siehts mit solcher Möglichkeit aus?
Edit: Das Bild soll in eine *.rtf mit den Angaben der Lage und Skalierung. Die *.rtf enthällt weiterhin die eigentlichen rtf-Daten + Kopfzeilen-, Listenstruktur- und Fußzeilendaten und kann als Druckvorlage abgespeichert werden. Alternativ müsste ich ein Bild seperat abspeichern und dann beim Öffnen der Vorlage prüfen, ob das Bild noch vorhanden ist. Beispiel mal mit einem RTF- und TXT-Editor betrachten. |
| | | | | | |
| |
Frank
Abbing | Müsste eigentlich jetzt schon gehen. Probier mal:
XProfan_Datengenerator "dateiname.xxx" 
Es sollte dann eine Datei "dateiname.xxx.data" erstellt werden. |
| | | | | | |
| |
Thomas
Freier | | Danke, ja geht. Nun muß ich nur mal sehen, wie ich dann aus den Daten, wenn sie aus der RTF in ein MultiEdit gelesen werden, wieder ein Bild erzeuge. |
| | | | | | |
| |
Frank
Abbing | | Dazu kannst du SetDIBitsToDevice() benutzen. Ich rate dir, dich mal intensiv mit DIBs zu beschäftigen. |
| | | | | | |
| |  | @Thomas: Das hier läuft blitzschnell auch im Interpreter: (bild2txt/ txt2bild)
KompilierenMarkierenSeparierencls
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
|
| | | | | | |
| |
Thomas
Freier | | Danke an die Pixelspezialisten. Werde wohl iFs Variante einsetzen. Die ist echt schnell und ich muß nicht noch die XProfan_Datengenerator.exe beilegen, so es je fertig wird. |
| | | | | | |
| |
Frank
Abbing | | Ich sag ja, verwende DIBs. Solltest dich trotzdem mal mit dem Thema beschäftigen, ich denke, das lohnt sich für dich. Beim fertigen Code besteht leider schnell die Gefahr, das man ihn einfach so übernimmt. |
| | | | | | |
| |
Thomas
Freier |
Beim fertigen Code besteht leider schnell die Gefahr, das man ihn einfach so übernimmt.
Naja, ist ja meist auch nicht verkehrt.
@iF, irgendwie hab ich ein Problem aus der Elk.txt ein Bild zu erzeugen (Screen1). Bei kleinerem Bild sieht es besser aus (Screen2). Auch über MultiEdit nichts Besseres.
KompilierenMarkierenSeparierendeclare 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 besser? |
| | | | | | |
| | | An den Funktionen liegt es nicht, schau:
KompilierenMarkierenSeparierenGemerkt/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
Datei<>String: (file_get_contents und file_put_contents)
KompilierenMarkierenSeparieren
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
|
| | | | | | |
|
AntwortenThemenoptionen | 2.038 Betrachtungen |
ThemeninformationenDieses Thema hat 3 Teilnehmer: |
(1.111)
Deutsch
English
Français
Español
Italia
