Imageserien in Streifen fassen...

Übersicht

BlitzBasic

Codearchiv

	mkorth Betreff: Imageserien in Streifen fassen...	Mi, Mai 27, 2009 21:27 Antworten mit Zitat
Falls es wer gebrauchen kann, würde es mich freuen. Ist lauffähig, daher weiss nicht ob es als "codeschnipsel gültig ist". Allerdings habe ich keine Ahnung wo ich es sonst posten sollte, da es fuer ein Projekt viel zu klein ist... Es ist auch nicht unbedingt das gelbe vom Ei wenn man sich die Steuervariablen ansieht (xeres hats mir schon geschrieben), aber soll ja keine Preise gewinnen, sondern nur nützlich sein. Ich erkenne keine Fehler und xeres hats einmal überschaut, viele Verbesserungen gefunden, aber auch keine funktionellen Fehler bemängelt. Sollte jemand Probleme mit manchen Auflösungen haben, so wäre eine Info nett. Denn bei mir funktionieren Z.B. einige Auflösungen und andere wiederum nicht (ab bild x ein verzerrtes Ergebniss). das kann aber bei mir an einer alten Graka und/oder Treiber liegen. Infos dazu: https://www.blitzforum.de/foru...hp?t=31811 Nun zum Code: Manchmal will man kein Video erstellen. So kann man damit z.B. die aus 3D Max erstellten Einzelbilder in einem Streifen zusammenfassen, oder halt selbstgezeichnete Bilder, usw.. Programm muss im gleichen Ordner sein (falls code nicht verändert, also wie der Code hier steht), Bilder müssen gleichnamig + Nummeriert sein. Wird aber alles erklärt innerhalb der Eingaben.... Code: [AUSKLAPPEN] [EINKLAPPEN] AppTitle "ImageSequenzer V1","Die Anwendung wirklich verlassen?" Graphics 640,480,16,2 Global QDateiname$ Global ZDateiname$ Global Bildnummer1$ Global Bildmaxnummer$ Global suffix$ Global Arbeit Global fertig Global init Global Bildinfobild Global Breite, Hoehe Global Bilderanzahl Global erstes,letztes Global megaimage Global Frameaktuell Global pufferbild Global bildnummer1laenge Global bildaktuell Global working Global jobdone Global loopimage Global imageloopini Global bildcounter frameaktuell = 0 jobdone = False working = False fertig = False Arbeit = False QDateiname$ = "nichts gewählt" ZDateiname$ = "nichts gewählt" Suffix$ = ".xxx" frametimer = CreateTimer (10) ClsColor 0,0,0 Color 255,255,255 SetBuffer BackBuffer() While Not KeyHit(1) Or ende = 1 Cls Text 320,200,"ImageSequenzer V1",1,1 Text 320,260,"1 - QuellDateiname: "+QDateiname$,1,1 Text 320,280,"2 - Zieldateiname: "+ZDateiname$,1,1 Text 320,300,"3 - erstes Bild: "+Bildnummer1,1,1 Text 320,320,"4 - letztes Bild: "+Bildmaxnummer,1,1 Text 320,340,"5 - Dateiendung (Jpg,Jpeg,Png,Bmp): "+suffix$,1,1 Text 320,360,"6 - Imagesequenzer Starten",1,1 Text 320,380,"7 - Anwendung beenden",1,1 If jobdone = True Then Text 320,400,"8 - erstellte Sequenz laden und in loop abspielen",1,1 EndIf Line 0,220,640,220 Line 0,180,640,180 If fertig = True Then Text 320,100,"Datei "+Zdateiname$+suffix$+" wurde erstellt",1,1 DrawImage Bildinfobild,1,1 Text 460,20,"Formatbreite: "+Breite Text 460,40,"Formathoehe: "+Hoehe Text 460,60,"Gesamtbilder: "+Bilderanzahl Text 460,80,"Endbreite: "+BreiteBilderanzahl Text 460,100,"Vidmem frei : "+Int(Int(AvailVidMem ()/1024)/1024)+" MB" ;------------------------------------------------ EndIf If arbeit = False Then ;--------1------------ If KeyHit (2) Then FlushKeys Text 10,40,"(bis dahin wo sich Zahlen ändern ohne suffix (.xxx))" Locate 10,20 QDateiname = Input ("Bitte Den Dateinamen angeben : ") FlushKeys EndIf ;--------1------------ ;--------2------------ If KeyHit (3) Then FlushKeys Text 10,40,"(Den gewünschten Dateinamen der erstellten Imagesequenz)" Locate 10,20 ZDateiname = Input ("Bitte Den Dateinamen angeben : ") FlushKeys EndIf ;--------2------------ ;--------3------------ If KeyHit (4) Then FlushKeys Text 10,40,"(Das erste Bild der Serie - Bsp: test0001.png = 0001)" Locate 10,20 Bildnummer1 = Input ("Bitte Anfangsnummer (incl. vorgestellten Nullen) eingeben: ") FlushKeys EndIf ;--------3------------ ;--------5------------ If KeyHit (6) Then FlushKeys Text 10,40,"(Die Dateiendung eingeben - test.png = .png - Grosskleinschrift beachten)" Locate 10,20 suffix$ = Input ("Bitte den suffix der Quelldatei angeben: ") FlushKeys EndIf ;--------5------------ ;--------4------------ If KeyHit (5) Then FlushKeys Text 10,40,"(Das letzte Bild der Serie - Bsp: test0011.png = 0011)" Locate 10,20 Bildmaxnummer = Input ("Bitte Endnummer (incl. vorgestellten Nullen) eingeben: ") FlushKeys EndIf ;--------4------------ ;--------6------------ If KeyHit (7) Then Text 320,40,"Arbeit wird eingeleitet............",1,1 Arbeit = True FlushKeys EndIf ;--------6------------ ;--------7------------ If KeyHit(8) Then ende = 1 EndIf ;--------7------------ EndIf If jobdone = True Then ;--------8------------ If KeyHit(9) Then playimage= True FlushKeys EndIf ;--------8------------ EndIf If playimage = True Then imageloop() If Arbeit = True Then bildseq() EndIf Flip 0 WaitTimer (frametimer) Wend ;------erstellte sequenz laden----- ;------und loopen------------------ Function imageloop() If imageloopini = False Then loopimage = LoadAnimImage (Zdateiname$+".bmp",Breite,Hoehe,0,Bilderanzahl) imageloopini = True Bilcounter = 0 EndIf If imageloopini = True Then DrawImage loopimage,100,100,Bildcounter Bildcounter = Bildcounter +1 If bildcounter = Bilderanzahl Then Bildcounter = 0 EndIf End Function ;---------------------------------- ;----------------Die function zum zusammenfügen----------------- Function bildseq() ;initialisieren---------- If Fertig = False If Init = False Bildinfobild = LoadImage (QDateiname$+Bildnummer1$+suffix$) Breite = ImageWidth (Bildinfobild) Hoehe = ImageHeight (BildinfoBild) ResizeImage Bildinfobild,Int(Breite/5),Int(Hoehe/5) bildnummer1laenge = Len (Bildnummer1$) erstes = Int(Bildnummer1$) letztes = Int(Bildmaxnummer$) Bilderanzahl = (letztes - erstes)+1 megaimage = CreateImage (BreiteBilderanzahl,Hoehe) init = True working = True Frameaktuell = 0 EndIf EndIf ;---------------------- ;---aus der Ini bekannte Daten anzeigen---------- Text 320,100,QDateiname$+Bildnummer1$+suffix$,1,1 DrawImage Bildinfobild,1,1 Text 460,20,"Formatbreite: "+Breite Text 460,40,"Formathoehe: "+Hoehe Text 460,60,"Gesamtbilder: "+Bilderanzahl Text 460,80,"Endbreite: "+BreiteBilderanzahl Text 460,100,"Vidmem frei : "+Int(Int(AvailVidMem ()/1024)/1024)+" MB" ;------------------------------------------------ ;---Framestring wandeln zum laden---------------- ;---Pufferframe laden und setzen----------------- ;------------------------------------------------ If working = True If Frameaktuell < Bilderanzahl Then Bildaktuell = erstes+frameaktuell Bildaktuellstring$ = Str (Bildaktuell) bildaktuelllaenge = Len (Bildaktuellstring$) pufferbild = LoadImage (QDateiname$+(Left$(Bildnummer1$,(Bildnummer1laenge-Bildaktuelllaenge)))+(Right$(Bildaktuellstring$,Bildaktuelllaenge))+suffix$) SetBuffer ImageBuffer (megaimage) DrawImage pufferbild,(FrameaktuellBreite),0 SetBuffer BackBuffer () ResizeImage Pufferbild,Int(Breite/5),Int(Hoehe/5) DrawImage pufferbild,200,0 FreeImage (pufferbild) Frameaktuell = Frameaktuell + 1 Else SaveImage (megaimage,ZDateiname$+".bmp") Working = False fertig = True Arbeit = False jobdone = True FreeImage (megaimage) EndIf EndIf ;----------------------------------------------- End Function ;--------------------------------------------------------------- Hoffe der ein oder andere kanns gebrauchen. Gruß, mkorth

mkorth

Betreff: Imageserien in Streifen fassen...

Mi, Mai 27, 2009 21:27
Antworten mit Zitat

Falls es wer gebrauchen kann, würde es mich freuen.

Ist lauffähig, daher weiss nicht ob es als "codeschnipsel gültig ist". Allerdings habe ich keine Ahnung wo ich es sonst posten sollte, da es fuer ein Projekt viel zu klein ist...

Es ist auch nicht unbedingt das gelbe vom Ei wenn man sich die Steuervariablen ansieht (xeres hats mir schon geschrieben), aber soll ja keine Preise gewinnen, sondern nur nützlich sein.

Ich erkenne keine Fehler und xeres hats einmal überschaut, viele Verbesserungen gefunden, aber auch keine funktionellen Fehler bemängelt. Sollte jemand Probleme mit manchen Auflösungen haben, so wäre eine Info nett. Denn bei mir funktionieren Z.B. einige Auflösungen und andere wiederum nicht (ab bild x ein verzerrtes Ergebniss). das kann aber bei mir an einer alten Graka und/oder Treiber liegen.

Infos dazu:
https://www.blitzforum.de/foru...hp?t=31811

Nun zum Code:
Manchmal will man kein Video erstellen. So kann man damit z.B. die aus 3D Max erstellten Einzelbilder in einem Streifen zusammenfassen, oder halt selbstgezeichnete Bilder, usw..

Programm muss im gleichen Ordner sein (falls code nicht verändert, also wie der Code hier steht), Bilder müssen gleichnamig + Nummeriert sein. Wird aber alles erklärt innerhalb der Eingaben....

Code: [AUSKLAPPEN]

AppTitle "ImageSequenzer V1","Die Anwendung wirklich verlassen?"

Graphics 640,480,16,2

Global QDateiname$
Global ZDateiname$
Global Bildnummer1$
Global Bildmaxnummer$
Global suffix$
Global Arbeit
Global fertig
Global init
Global Bildinfobild
Global Breite, Hoehe
Global Bilderanzahl
Global erstes,letztes
Global megaimage
Global Frameaktuell
Global pufferbild
Global bildnummer1laenge
Global bildaktuell
Global working
Global jobdone
Global loopimage
Global imageloopini
Global bildcounter

frameaktuell = 0
jobdone = False
working = False
fertig = False
Arbeit = False
QDateiname$ = "nichts gewählt"
ZDateiname$ = "nichts gewählt"
Suffix$ = ".xxx"

frametimer = CreateTimer (10)

ClsColor 0,0,0
Color 255,255,255

SetBuffer BackBuffer()

While Not KeyHit(1) Or ende = 1

Cls

Text 320,200,"ImageSequenzer V1",1,1

Text 320,260,"1 - QuellDateiname: "+QDateiname$,1,1
Text 320,280,"2 - Zieldateiname: "+ZDateiname$,1,1
Text 320,300,"3 - erstes Bild: "+Bildnummer1,1,1
Text 320,320,"4 - letztes Bild: "+Bildmaxnummer,1,1
Text 320,340,"5 - Dateiendung (Jpg,Jpeg,Png,Bmp): "+suffix$,1,1
Text 320,360,"6 - Imagesequenzer Starten",1,1
Text 320,380,"7 - Anwendung beenden",1,1

If jobdone = True Then
Text 320,400,"8 - erstellte Sequenz laden und in loop abspielen",1,1
EndIf

Line 0,220,640,220
Line 0,180,640,180
If fertig = True Then
Text 320,100,"Datei "+Zdateiname$+suffix$+" wurde erstellt",1,1
DrawImage Bildinfobild,1,1
Text 460,20,"Formatbreite: "+Breite
Text 460,40,"Formathoehe: "+Hoehe
Text 460,60,"Gesamtbilder: "+Bilderanzahl
Text 460,80,"Endbreite: "+Breite*Bilderanzahl
Text 460,100,"Vidmem frei : "+Int(Int(AvailVidMem ()/1024)/1024)+" MB"
;------------------------------------------------

EndIf

If arbeit = False Then
;--------1------------
If KeyHit (2) Then
FlushKeys
Text 10,40,"(bis dahin wo sich Zahlen ändern ohne suffix (.xxx))"
Locate 10,20
QDateiname = Input ("Bitte Den Dateinamen angeben : ")
FlushKeys
EndIf
;--------1------------

;--------2------------
If KeyHit (3) Then
FlushKeys
Text 10,40,"(Den gewünschten Dateinamen der erstellten Imagesequenz)"
Locate 10,20
ZDateiname = Input ("Bitte Den Dateinamen angeben : ")
FlushKeys
EndIf
;--------2------------

;--------3------------
If KeyHit (4) Then
FlushKeys
Text 10,40,"(Das erste Bild der Serie - Bsp: test0001.png = 0001)"
Locate 10,20
Bildnummer1 = Input ("Bitte Anfangsnummer (incl. vorgestellten Nullen) eingeben: ")
FlushKeys
EndIf
;--------3------------

;--------5------------
If KeyHit (6) Then
FlushKeys
Text 10,40,"(Die Dateiendung eingeben - test.png = .png - Grosskleinschrift beachten)"
Locate 10,20
suffix$ = Input ("Bitte den suffix der Quelldatei angeben: ")
FlushKeys
EndIf
;--------5------------

;--------4------------
If KeyHit (5) Then
FlushKeys
Text 10,40,"(Das letzte Bild der Serie - Bsp: test0011.png = 0011)"
Locate 10,20
Bildmaxnummer = Input ("Bitte Endnummer (incl. vorgestellten Nullen) eingeben: ")
FlushKeys
EndIf
;--------4------------

;--------6------------
If KeyHit (7) Then
Text 320,40,"Arbeit wird eingeleitet............",1,1
Arbeit = True
FlushKeys
EndIf
;--------6------------

;--------7------------
If KeyHit(8) Then
ende = 1
EndIf
;--------7------------
EndIf

If jobdone = True Then
;--------8------------
If KeyHit(9) Then
playimage= True
FlushKeys
EndIf
;--------8------------
EndIf

If playimage = True Then imageloop()

If Arbeit = True Then
bildseq()
EndIf

Flip 0
WaitTimer (frametimer)

Wend

;------erstellte sequenz laden-----
;------und loopen------------------
Function imageloop()

If imageloopini = False Then
loopimage = LoadAnimImage (Zdateiname$+".bmp",Breite,Hoehe,0,Bilderanzahl)
imageloopini = True
Bilcounter = 0
EndIf

If imageloopini = True Then

DrawImage loopimage,100,100,Bildcounter
Bildcounter = Bildcounter +1
If bildcounter = Bilderanzahl Then Bildcounter = 0

EndIf

End Function
;----------------------------------

;----------------Die function zum zusammenfügen-----------------
Function bildseq()

;initialisieren----------
If Fertig = False
If Init = False
Bildinfobild = LoadImage (QDateiname$+Bildnummer1$+suffix$)
Breite = ImageWidth (Bildinfobild)
Hoehe = ImageHeight (BildinfoBild)
ResizeImage Bildinfobild,Int(Breite/5),Int(Hoehe/5)
bildnummer1laenge = Len (Bildnummer1$)
erstes = Int(Bildnummer1$)
letztes = Int(Bildmaxnummer$)
Bilderanzahl = (letztes - erstes)+1
megaimage = CreateImage (Breite*Bilderanzahl,Hoehe)
init = True
working = True
Frameaktuell = 0
EndIf
EndIf
;----------------------

;---aus der Ini bekannte Daten anzeigen----------
Text 320,100,QDateiname$+Bildnummer1$+suffix$,1,1
DrawImage Bildinfobild,1,1
Text 460,20,"Formatbreite: "+Breite
Text 460,40,"Formathoehe: "+Hoehe
Text 460,60,"Gesamtbilder: "+Bilderanzahl
Text 460,80,"Endbreite: "+Breite*Bilderanzahl
Text 460,100,"Vidmem frei : "+Int(Int(AvailVidMem ()/1024)/1024)+" MB"
;------------------------------------------------

;---Framestring wandeln zum laden----------------
;---Pufferframe laden und setzen-----------------
;------------------------------------------------
If working = True

If Frameaktuell < Bilderanzahl Then
Bildaktuell = erstes+frameaktuell
Bildaktuellstring$ = Str (Bildaktuell)
bildaktuelllaenge = Len (Bildaktuellstring$)
pufferbild = LoadImage (QDateiname$+(Left$(Bildnummer1$,(Bildnummer1laenge-Bildaktuelllaenge)))+(Right$(Bildaktuellstring$,Bildaktuelllaenge))+suffix$)
SetBuffer ImageBuffer (megaimage)
DrawImage pufferbild,(Frameaktuell*Breite),0
SetBuffer BackBuffer ()
ResizeImage Pufferbild,Int(Breite/5),Int(Hoehe/5)
DrawImage pufferbild,200,0
FreeImage (pufferbild)
Frameaktuell = Frameaktuell + 1
Else
SaveImage (megaimage,ZDateiname$+".bmp")
Working = False
fertig = True
Arbeit = False
jobdone = True
FreeImage (megaimage)
EndIf

EndIf
;-----------------------------------------------

End Function
;---------------------------------------------------------------

Hoffe der ein oder andere kanns gebrauchen.

Gruß,
mkorth