Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
LZW für Bilder (Problem mit performance)
| Uploader: |  DonStevone |
| Datum/Zeit: | 24.08.2012 15:45:28 |
Declare Function SearchMustertabelle(Mustertabelle() as String, Text as String) as Integer
Declare Function Compress(Text as String) as String
Declare Function ImgToStr(Img as Any PTR) As String
Declare Function LoadImgFile(ByVal Dateiname as String) as Any PTR
Declare Sub GetSize(ByVal Dateiname as String, ByRef Breite as UInteger, ByRef Hoehe as UInteger)
ScreenRes 500, 500, 24
Dim as Any PTR Img
Dim as Integer a, b
Img = LoadImgFile("test.bmp")
Print Len(Compress(ImgToStr(Img)))
Print "OK"
Sleep
'###############################################################################
Function SearchMustertabelle(Mustertabelle() as String, Text as String) as Integer
Dim as Integer a
For a = 0 to Ubound(Mustertabelle)
If Instr(Mustertabelle(a), Text) = 1 then Return a
Next a
End Function
'###############################################################################
Function Compress(Text as String) as String
Dim as Integer a
ReDim as String MusterTabelle(0 to 255)
For a = 0 to 255
MusterTabelle(a) = CHR(a)
Next a
Dim as String zuKomprimieren = Text
Dim as String Muster
Dim as String Zeichen
Dim as String Ausgabe
For a = 1 to Len(zuKomprimieren)
Zeichen = MID(zuKomprimieren, a, 1)
If SearchMustertabelle(Mustertabelle(), Muster & Zeichen) > 0 then
Muster = Muster & Zeichen
Else
ReDim Preserve Mustertabelle(0 to UBound(Mustertabelle) + 1) as String
MusterTabelle(UBound(Mustertabelle)) = Muster & Zeichen
Ausgabe += CHR(SearchMustertabelle(Mustertabelle(), Muster))
Muster = Zeichen
Endif
Next a
Ausgabe += Muster
Return Ausgabe
End Function
'###############################################################################
Function ImgToStr(Img as Any PTR) As String
Dim as UInteger Breite, Hoehe, Farbe, a, b
Dim as String RetStr
ImageInfo Img, Breite, Hoehe
For a = 0 to Breite - 1
For b = 0 to Hoehe - 1
Farbe = Point(a, b, Img)
RetStr += CHR(LOBYTE(HIWORD(Farbe)))
RetStr += CHR(HIBYTE(LOWORD(Farbe)))
RetStr += CHR(LOBYTE(LOWORD(Farbe)))
Next b
Next a
Print Breite
Print Hoehe
Print Len(RetStr)
Return RetStr
End Function
'###############################################################################
Function LoadImgFile(ByVal Dateiname as String) as Any PTR
Dim as UInteger Breite, Hoehe
Dim as Any PTR Bild
GetSize(Dateiname, Breite, Hoehe)
Bild = Imagecreate(Breite, Hoehe)
BLoad Dateiname, Bild
Return Bild
End Function
'###############################################################################
Sub GetSize(ByVal Dateiname as String, ByRef Breite as UInteger, ByRef Hoehe as UInteger)
Dim as UByte B1, B2
Dim as Integer File = Freefile
Dim as UInteger B, H
Open Dateiname for Input as File
Get #File,, B1
Get #File,, B2
If B1 <> 66 and B2 <> 77 then
Hoehe = 0
Breite = 0
Else
Seek File, 19
Get #File,, B
Seek File, 23
Get #File,, H
Breite = B
Hoehe = H
Endif
End Sub