 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
|
| Nach oben |
|
 |
csde_rats
Anmeldungsdatum: 07.01.2007
Beiträge: 2292
Wohnort: Zwischen Sessel und Tastatur
|
 Verfasst am: 03.03.2007, 12:55 Titel: |
 |
|
Jo, danke 
/edit:
Prinzip habe ich jetzt verstanden. (dransezten & umarbeiten tu ich später)
/edit2:
Es gibt da doch noch ein Problem. Wie berechne ich nun die Bytes? wenn ich das mit anzahlbyt = lof(1) mache (die datei wurde mit binary as #1 geöffnet) stürzt es einfach ab  . Allein schon den speicher freizugeben mit imagecreate scheint er nicht richtig zu machen. außerdem ist es auch keine bilddatei, wo man sagen kann 400 hoch 300 breit!
| Code: |
'11.02.06 mit FB 0.15b ; by Volta
'Image gepackt in eine Datei schreiben
Option Explicit
'um diese Funktionen der gfxlib nutzen zu können muß ein Anweisung, wie unten SCREEN, aus
'der gfxlib im Programm benutzt werden. Damit wird die gfxlib in unser Programm gelinkt.
Declare Function Encode Alias "fb_hEncode" (ByVal lpIn As Any Ptr,_
ByVal asize As Integer,_
ByVal lpOut As Any Ptr,_
ByRef out_size AS Integer ) As Integer
Declare Function Decode Alias "fb_hDecode" (ByVal lpIn As Any Ptr,_
ByVal asize As Integer,_
ByVal lpOut As Any Ptr,_
ByRef out_size AS Integer ) As Integer
Dim As Integer breit, hoch, anzahlbyt, j, i, ff
Dim img As Integer Ptr
Dim bptr As UByte Ptr
'Screen 18,32
Screenres 320,200,32
breit = 400 'Bildbreite
hoch = 300 'Bildhöhe
img = ImageCreate (breit, hoch) 'Image erstellen
BLoad "aviplay.exe",img 'Bild laden
'Put (0, 50), img, PSet 'Image anzeigen
anzahlbyt = (breit * hoch * 4 ) +4 'Anzahl Byte
Dim Buffer (anzahlbyt) As UByte'in diesen Buffer wird das Image komprimiert
j = anzahlbyt
'Encode bekommt die Adresse des Image, Anzahl Byte des Image,
' die Adresse des Buffers,Anzahl Byte des Buffers
Encode (img, anzahlbyt, @Buffer(0), j)
'nach dem Aufruf enthält j die neue Anzahl Byte
Dim fName As String
fName = "output.img"
ff = FreeFile 'als Datei abspeichern
Open fname for binary Access write as #ff
For i = 0 To j-1
put #ff,, Buffer(i)
next
Close #ff
Sleep
ImageDestroy img
End
|
_________________
If hilfreicher_Beitrag then klick(location.here)
Klick |
|
| Nach oben |
|
|
csde_rats
Anmeldungsdatum: 07.01.2007
Beiträge: 2292
Wohnort: Zwischen Sessel und Tastatur
|
| Verfasst am: 03.03.2007, 23:07 Titel: |
|
|
So, nachdem ich mich von QB nach FB umgewöhnt habe, ist dieses, wunderbar funktionierendes Sample rausgekommen:
| Code: |
'11.02.06 mit FB 0.15b ; by Volta
'Image gepackt in eine Datei schreiben
Option Explicit
'um diese Funktionen der gfxlib nutzen zu können muß ein Anweisung, wie unten SCREEN, aus
'der gfxlib im Programm benutzt werden. Damit wird die gfxlib in unser Programm gelinkt.
Declare Function Encode Alias "fb_hEncode" (ByVal lpIn As Any Ptr,_
ByVal asize As Integer,_
ByVal lpOut As Any Ptr,_
ByRef out_size AS Integer ) As Integer
Declare Function Decode Alias "fb_hDecode" (ByVal lpIn As Any Ptr,_
ByVal asize As Integer,_
ByVal lpOut As Any Ptr,_
ByRef out_size AS Integer ) As Integer
Dim As integer breit, hoch, anzahlbyt, j, i, ff
Dim img As Integer Ptr
Dim bptr As UByte Ptr
dim src_len as longint
dim dest_len as longint
dim Eingangsdatei as string
dim Ausgangsdatei as string
Screenres 320,200,32: screen 18
width 80,30
input "Zu kompriemierende Datei: ", Eingangsdatei
input "Ausgangsdatei: ", Ausgangsdatei
open Eingangsdatei for binary as #1
src_len = lof(1)
print "Eingangsdateilaenge:"; src_len
img = Allocate(src_len)
if img = 0 then
print "Reserviere Speicher ... fehlgeschlagen":sleep
end
else
print "Reserviere Speicher ... erfolgreich"
print "Lade Datei..."
BLoad Eingangsdatei,img 'Datei Laden
anzahlbyt = src_len'Anzahl Byte
Dim Buffer (anzahlbyt) As UByte 'in diesen Buffer wird das Image komprimiert
j = anzahlbyt
'Encode bekommt die Adresse des Image, Anzahl Byte des Image,
' die Adresse des Buffers,Anzahl Byte des Buffers
Encode (img, anzahlbyt, @Buffer(0), j)
'nach dem Aufruf enthält j die neue Anzahl Byte
Dim fName As String
fName = Ausgangsdatei
ff = FreeFile 'als Datei abspeichern
Open fname for binary Access write as #ff
print "Erzeuge Ausgangsdatei..."
For i = 0 To j-1
put #ff,, Buffer(i)
next
print "... fertig"
print "Ausgangsdateigroessee:"; j
Close #ff
Sleep :Deallocate img:End
end if
|
_________________
If hilfreicher_Beitrag then klick(location.here)
Klick |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
