Forum | | | | | 
Thomas
Freier | je cherche pour einer Possibilité, qui données eines Bildes comme bzw. dans einer txt-Dossier abzuspeichern.
un Beispiel habe je ici trouvé, cela allez chez quelque chose größeren Bildern mir mais trop lente:
KompilierenMarqueSéparationdeclare 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 une bessere et schnellere Methode? |
 | | | | | | |
| | 
Frank
Abbing | veux du à qui Grafikdaten des Bilds venons ou bien aus einem Grafikbild une Textbild bricoler?
Im ersten le cas devrait du dein Bild dans un DIB wandeln, ensuite peux qui Grafikdaten simple aus dem grenier auslesen. |
| | | | | | |
| |
Thomas
Freier | je voulais qui Grafikdaten dans un Textdatei einbetten. Beim Öffnen qui Dossier soll aus cette données ensuite wieder une Grafik réel erstellt volonté. Frank, avec deinem Datengenerator ca va oui, mais malheureusement pas per Komandozeile, alors Bild réel vorhanden > Dossier magasin et transformer > aus qui Zwischenablage dans un, ou bien Ausgabe juste comme Textdatei. comment siehts avec solcher Possibilité aus?
Éditer: cela Bild soll dans un *.rtf avec den Angaben qui situation et Skalierung. qui *.rtf enthällt weiterhin qui réel rtf-données + Kopfzeilen-, Listenstruktur- et Fußzeilendaten et peux comme Druckvorlage abgespeichert volonté. Alternativ devrait je un Bild seperat abspeichern et ensuite beim Öffnen qui Présentation vérifier, si cela Bild encore vorhanden ist. Beispiel la fois avec einem RTF- et TXT-Editor betrachten. |
| | | | | | |
| |
Frank
Abbing | Müsste eigentlich maintenant déjà aller. Probier la fois:
XProfan_Datengenerator "dateiname.xxx" 
Es sollte ensuite une Dossier "dateiname.xxx.data" erstellt volonté. |
| | | | | | |
| |
Thomas
Freier | | merci, oui allez. eh bien doit je seulement la fois voyons, comment je ensuite aus den données, si vous aus qui RTF dans un MultiEdit gelesen volonté, wieder un Bild erzeuge. |
| | | | | | |
| |
Frank
Abbing | | en supplément peux du SetDIBitsToDevice() benutzen. je taux dir, toi la fois intensif avec DIBs trop beschäftigen. |
| | | | | | |
| |  | @Thomas: cela ici fonctionne blitzschnell aussi im Interpreter: (bild2txt/ txt2bild)
KompilierenMarqueSéparationcls
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 | | merci à qui Pixelspezialisten. Werde wohl iFs variante einsetzen. qui ist vraie vite et je dois pas encore qui XProfan_Datengenerator.exe beilegen, so es je fertig wird. |
| | | | | | |
| |
Frank
Abbing | | je sag oui, verwende DIBs. Solltest toi quand même la fois avec dem Thema beschäftigen, je denke, cela lohnt sich pour toi. Beim fertigen Code besteht malheureusement vite qui péril, cela on ihn simple so übernimmt. |
| | | | | | |
| |
Thomas
Freier |
Beim fertigen Code besteht malheureusement vite qui péril, cela on ihn simple so übernimmt.
bof, ist oui meist aussi pas verkehrt.
@iF, irgendwie hab je un Problem aus qui Elk.txt un Bild trop erzeugen (Screen1). chez kleinerem Bild sieht es besser aus (Screen2). aussi sur MultiEdit rien Besseres.
KompilierenMarqueSéparationdeclare 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? |
| | | | | | |
| | | à den Funktionen liegt es pas, exposition:
KompilierenMarqueSéparationGemerkt/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 et file_put_contents)
KompilierenMarqueSéparation
proc FGC
PARAMETERS FLE$
IF %PCOUNT<1
RETOUR
ENDIF
var B&=FILESIZE(FLE$)
IF B&<1
RETOUR »
ENDIF
DECLARE MEM#
DIM MEM#,B&
var R&=BLOCKREAD(FLE$,MEM#,0,B&)
var S$=CHAR$(MEM#,0,R&)
DISPOSE MEM#
RETOUR »+S$
endproc
proc FPC
PARAMETERS FLE$,S$,_APPEND%
IF %PCOUNT<1
RETOUR 0
ENDIF
IF %PCOUNT<2
S$=»
ENDIF
IF %PCOUNT<3
_APPEND%=0
ENDIF
var L&=LEN(S$)
IF L&=0
IF _APPEND%
RETOUR 1
ENDIF
var FH&=ASSIGN(FLE$)
REWRITE FH&
CLOSE FH&
ASSIGN FH&,»
RETOUR 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
|
| | | | | | |
|
répondreOptions du sujet | 2.084 Views |
Themeninformationencet Thema hat 3 participant: |
(452)
Deutsch
English
Français
Español
Italia
