 |
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 |
Leader4
Anmeldungsdatum: 20.01.2005 Beiträge: 99 Wohnort: Leipzig
|
Verfasst am: 03.03.2007, 16:37 Titel: Suche Jpeg-Load mit Bildkomprimierung |
|
|
Hi.
Kennt irgendjemand ein Jpeg-Loader, der Bilder komprimiert darstellen kann, z. B. in der Größe 640x480 oder 320x240? Ich hab zwar schon welche gehabt, die allgemein sehr gut funktionierten, nur meine Bilder, die ich verarbeite, sind im Schnitt 3 bis 5 MegaPixel groß und wenn ich sie anzeigen lassen will, sehe ich maximal einen kleinen Ausschnitt der linken oberen Ecke.
Grüßle,
Leader4. _________________ Ein richtiger Programmierer muss so richtig faul sein und sich den ganzen Tag mit der Frage beschäftigen, wie man mal wieder etwas einfacher machen kann. |
|
Nach oben |
|
 |
Eternal_pain

Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
|
Nach oben |
|
 |
Michael712 aka anfänger, programmierer
Anmeldungsdatum: 26.03.2005 Beiträge: 1593
|
Verfasst am: 03.03.2007, 17:59 Titel: |
|
|
@Leader4: GIbst du mir bitte mal den Loader, dann gucke ich mal, was man da verändern kann, damit es geht  _________________
Code: | #include "signatur.bi" |
|
|
Nach oben |
|
 |
Eternal_pain

Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
Verfasst am: 03.03.2007, 18:19 Titel: |
|
|
Den hab ich leider nicht hab gerade verzweifelt dannach gesucht und nicht wirklich brauchbares zum Thema JPG gefunden. Muss es JPG sein, denn habe hier eine gute beschreibung über den Dateiaufbau von GIF unf PNG gefunden...
http://page.mi.fu-berlin.de/~kaudel/vortraege/GIF+PNG.pdf _________________
 |
|
Nach oben |
|
 |
Leader4
Anmeldungsdatum: 20.01.2005 Beiträge: 99 Wohnort: Leipzig
|
Verfasst am: 03.03.2007, 18:21 Titel: |
|
|
Der Code, der bei mir funktioniert ist:
Zitat: |
#include "freeimage.bi"
#include "crt.bi"
Declare Function GetJpeg(Byval File As String) As Any Ptr
Dim Image As Any Ptr
ScreenRes 640, 480, 32
Image = GetJpeg("bla.jpg")
If Image Then
Put (0, 0), Image
Else
Print "File not found"
End If
Sleep
Function GetJpeg(Byval File As String) As Any Ptr
Dim Dib As FIBITMAP Ptr
Dim Dib32 As FIBITMAP Ptr
Dim SprWidth As Integer
Dim SprHeight As Integer
Dim Sprite As Any Ptr
Dim Bits As Any Ptr
Dib = FreeImage_Load(FIF_JPEG, File, JPEG_DEFAULT)
If Dib = 0 Then Return 0
FreeImage_FlipVertical Dib
Dib32 = FreeImage_ConvertTo32Bits(Dib)
SprWidth = FreeImage_GetWidth(Dib32)
SprHeight = FreeImage_GetHeight(Dib32)
Sprite = ImageCreate(SprWidth, SprHeight)
Bits = FreeImage_GetBits(Dib32)
MemCpy CPtr(Zstring Ptr, Sprite) + 4, Bits, SprWidth * SprHeight * 4
FreeImage_Unload(Dib32)
FreeImage_Unload(Dib)
Return Sprite
End Function
|
Ich weiß nicht, von wem der Code genau ist, aber er funktioniert einwandfrei, nur dass das Bild in Originalgröße dargestellt wird und nicht komprimiert werden kann.
Freundliche Grüße,
Leader4.  _________________ Ein richtiger Programmierer muss so richtig faul sein und sich den ganzen Tag mit der Frage beschäftigen, wie man mal wieder etwas einfacher machen kann. |
|
Nach oben |
|
 |
Eternal_pain

Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
Verfasst am: 03.03.2007, 18:29 Titel: |
|
|
zum Thema JPG habe ich sonst nur noch das hier gefunden, zum ermitteln der Bildgrösse...
Code: |
Dim strDummy As String
Dim ff As Integer
Dim c As Integer
Dim S As String
Dim L As Long
Dim JPGWidth As Long
Dim JPGHeight As Long
ff = FreeFile()
Open "test.jpg" For Binary Access Read As #ff
' Test auf JPEG-Datei
If Input(2, #ff) <> (Chr$(&HFF) & Chr$(&HD8)) Then
Close #ff
?"fehler?? "
sleep
end
End If
strDummy = Input(2, #ff)
Do
L = Asc(Input(1, #ff))
L = L * 256 + Asc(Input(1, #ff))
S = Input(L - 2, #ff)
If c = &HC0 Or c = &HC2 Then
JPGWidth = Asc(Mid$(S, 4, 1))
JPGWidth = JPGWidth * 256 + Asc(Mid$(S, 5, 1))
JPGHeight = Asc(Mid$(S, 2, 1))
JPGHeight = JPGHeight * 256 + Asc(Mid$(S, 3, 1))
End If
If Input(1, #ff) <> Chr$(255) Then
Exit Do
End If
c = Asc(Input(1, #ff))
Loop While c <> &HD9
Close #ff
' Anzeige der ermittelten Information:
?JPGWidth
?JPGHeight
sleep
end
|
_________________
 |
|
Nach oben |
|
 |
Eternal_pain

Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
Verfasst am: 03.03.2007, 19:27 Titel: |
|
|
HAB ES
Code: |
Dib32 = FreeImage_Rescale (Dib32, 640, 480, 0)
|
Dieses Zeile in deinem Code nach deiner Zeile
Dib32 = FreeImage_ConvertTo32Bits(Dib)
eingeben.... _________________
 |
|
Nach oben |
|
 |
Eternal_pain

Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
Verfasst am: 03.03.2007, 19:36 Titel: |
|
|
Da müsste man vielleicht noch etwas dran arbeiten das er es Prozentual verkleinert... hab gerade mit ein paar verschieden Bildern experimentiert und es sieht net so toll aus wenn man schmale Bilder auf den ganzen Screen flatscht *g*
Code: |
#include "freeimage.bi"
#include "crt.bi"
Declare Function GetJpeg(Byval File As String) As Any Ptr
Dim Image As Any Ptr
ScreenRes 640, 480, 32
Image = GetJpeg("test.jpg")
If Image Then
Put (0, 0), Image
Else
Print "File not found"
End If
Sleep
Function GetJpeg(Byval File As String) As Any Ptr
Dim Dib As FIBITMAP Ptr
Dim Dib32 As FIBITMAP Ptr
Dim SprWidth As Integer
Dim SprHeight As Integer
Dim Sprite As Any Ptr
Dim Bits As Any Ptr
Dim Savex as integer
Dim savey as integer
Dib = FreeImage_Load(FIF_JPEG, File, JPEG_DEFAULT)
If Dib = 0 Then Return 0
FreeImage_FlipVertical Dib
Dib32 = FreeImage_ConvertTo32Bits(Dib)
SprWidth = FreeImage_GetWidth(Dib32)
SprHeight = FreeImage_GetHeight(Dib32)
if SprHeight>479 or SprWidth>639 Then
Savex=SprWidth : Savey=SprHeight
If savex-640 > savey-480 Then
Dib32 = FreeImage_Rescale (Dib32,SprWidth/(SprWidth/640),SprHeight/(SprHeight/640), 0)
Else
Dib32 = FreeImage_Rescale (Dib32,SprWidth/(SprWidth/480),SprHeight/(SprHeight/480), 0)
end if
end if
SprWidth = FreeImage_GetWidth(Dib32)
SprHeight = FreeImage_GetHeight(Dib32)
Sprite = ImageCreate(SprWidth, SprHeight)
Bits = FreeImage_GetBits(Dib32)
MemCpy CPtr(Zstring Ptr, Sprite) + 4, Bits, SprWidth * SprHeight * 4
FreeImage_Unload(Dib32)
FreeImage_Unload(Dib)
Return Sprite
End Function
|
vielleicht sollte man den Code noch etwas aufräumen aber so gehts  _________________
 |
|
Nach oben |
|
 |
Leader4
Anmeldungsdatum: 20.01.2005 Beiträge: 99 Wohnort: Leipzig
|
Verfasst am: 03.03.2007, 19:57 Titel: |
|
|
Cool, vielen Dank!!!!
Damit kann ich meine Bilderdatenbank ungemein verbessern.
Liebe Grüße,
Leader4. _________________ Ein richtiger Programmierer muss so richtig faul sein und sich den ganzen Tag mit der Frage beschäftigen, wie man mal wieder etwas einfacher machen kann. |
|
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.
|
|