Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!Code-Beispiel
GIF Load
| Lizenz: | Erster Autor: | Letzte Bearbeitung: |
| k. A. |  Eternal_Pain |  26.02.2010 |
/'
[FUNCTION]GIFLoad:
Programmierer: [Michael [Eternal [Black-Heart] Pain] Ahlborn]
Unterstuetzt:
- Alle Farbtiefen bis 8 BIT
- Interlaced
- Liest GCM/LCM, wenn keins von beidem vorhanden, Standardpalette
Nicht Unterstuetzt:
- PAR (mangels moeglichkeit zum testen weil ich kein Grafikprogramm
zur verfuegung hatte das diese option anbietet)
- Transparenz
ToDo:
"- Speicher und Geschwindigkeitsoptimierung"
+Ueberlaeufe beseitigt, Reallocates weitgehend vermieden,
geschwindigkeit mit memcopy, trotz zusaetzlicher optionen
und abfragen ~20% verbessert
"- Moeglichkeiten zur Optimierung der LZW Dekodierung finden"
LZWDecoder als eigene Funktion geschrieben, statt kompliziertes
erstellen und hin und herkopieren aus einer Tabelle wird einfach
ein Zeiger gesetzt und von dort aus gelesen/geschrieben
"- Auslesen/Nutzen der Informationsbloecke"
+ausprobiert und fuer unsinnig befunden
(Wird erst beim Speichern von GIFs interessant)
-GCEs auslesen und verarbeiten um Transparenz zu nutzen
"- Moeglichkeit zum laden weiterer Bilder innerhalb der Gif einbauen"
" evtl. Ganze Animationen auslesen"
+In einem Gif mit mehreren Bildern kannn nun jedes Bild ausgelesen werden.
Ohne Angabe wird das erste Bild ausgegeben, liegt die Angabe ausserhalb des
Bereichs wird das zuletzt gefundene Bild zurueck gegeben.
- Die PAR (Pixel-Aspekt-Ratio) unterstuetzung noch mit einbinden
"- Aufgabensplitting (Header,IBlock,PBlock,LZWDecode)"
Funktion auf das wesentliche gekuerzt, Decoder als eigenstaendige Funktion
"!" ---------------------------------- "!"
Bisher wird ohne weitere Ueberpruefungen in ein Image geschrieben,
davon ausgehend das es ein 24/32BPP Buffer ist.
'/
#IfNDef MemCopy
Declare sub MemCopy cdecl alias "memcpy" (dest As Any Ptr, src As Any Ptr, length As ushort)
#EndIf
Declare Function GIFLoad (Byval FileName as String, Byval Entry as Integer=0) as any ptr
Declare Function MyLZWDecode(Byval LZWData as Ubyte ptr, Byval ByteSize as UInteger, Byval CodeSize as Integer, Byref OutSize as UInteger) as UByte ptr
Declare Function GetStandardPal as Uinteger ptr
Public Function GIFLoad (Byval FileName as String, Byval Entry as Integer=0) as any ptr
Dim FF as Integer = FreeFile
Dim ReadByte as UByte
'-----------------------------------------'
Open FileName for Binary access Read as #FF
'GIFWidth (0-16000)
Dim GIFWidth as Integer
Get #FF, 7,ReadByte
GIFWidth = ReadByte
Get #FF, 8,ReadByte
GIFWidth += ReadByte SHL 8
'GIFHeight (0-16000)
Dim GIFHeight as Integer
Get #FF, 9,ReadByte
GIFHeight = ReadByte
Get #FF,10,ReadByte
GIFHeight += ReadByte SHL 8
'GCM and BGColor
Dim ColorFlag as UByte
Dim ColorCount as Integer
Dim Backgroundcol as UByte
Dim GIFGCMPal as UInteger ptr
Dim RGBEntry as UByte PTR
Get #FF,11,ColorFlag
Get #FF,12,BackgroundCol
If Bit(ColorFlag,7) Then
ColorCount=2^((ColorFlag and &b00000111)+1)
GIFGCMPal=Callocate(ColorCount*4)
RGBEntry=Callocate(4)
'Dummy
Get #FF,13,ReadByte
For C as Integer=0 to ColorCount-1
Get #FF,,*RGBEntry,3
GIFGCMPal[C]=RGB(RGBEntry[0],RGBEntry[1],RGBEntry[2])
Next C
Deallocate (RGBEntry)
End If
'SeperatorSearch
Dim Seperator as UByte
Dim InfCount as Integer
Dim InfPos as UInteger
Dim NextPos as Integer
Get #FF,13+(ColorCount*3),ReadByte 'Dummy zur Positions bestimmtung
while not EOF(FF)
Get #FF,,Seperator
If Seperator=0 or Seperator=&h3B Then
Exit while
End If
Select Case Seperator
Case &h2C
'Image
'---------------------------------'
If Seperator=&h2C Then
InfPos=Loc(FF)
InfCount+=1
If Entry=IIF(Entry=0,(InfCount-1),InfCount) Then Exit While
End If
'Block ueberspringen
Get #FF,Loc(FF)+9,ReadByte
'Lokale Farbtabelle
If Bit(ReadByte,7) Then
ColorCount=2^((ReadByte and &b00000111)+1)
Get #FF,Loc(FF)+(ColorCount*3),ReadByte
End If
'Image Daten
Get #FF,Loc(FF)+2,ReadByte
NextPos=ReadByte
Do
Get #FF,Loc(FF)+NextPos+1,ReadByte
NextPos=ReadByte
Loop While ReadByte>0
Case &h21
'Informationsblock
'---------------------------------'
Get #FF,,ReadByte 'BlockType
'Block ueberspringen
GET #FF,LOC(FF)+1,ReadByte
DO
GET #FF,LOC(FF)+ReadByte+1,ReadByte
LOOP UNTIL ReadByte=0
'---------------------------------'
Case Else
InfPos=0
Exit While
End Select
Wend
'-----------------------'
Dim CodeSize as UByte
Dim GIFLeft as Integer
Dim GIFTop as Integer
Dim Interlaced as Integer
Get #FF,InfPos,ReadByte
If InfPos=0 or ReadByte<>&h2C Then
Close #FF
If GIFGCMPal Then Deallocate (GIFGCMPal)
Return 0
End If
'Left
Get #FF,,ReadByte
GIFLeft = ReadByte
Get #FF,,ReadByte
GIFLeft += ReadByte SHL 8
'Top
Get #FF,,ReadByte
GIFTop = ReadByte
Get #FF,,ReadByte
GIFTop += ReadByte SHL 8
'Width
Get #FF,,ReadByte
GIFWidth = ReadByte
Get #FF,,ReadByte
GIFWidth += ReadByte SHL 8
'Height
Get #FF,,ReadByte
GIFHeight = ReadByte
Get #FF,,ReadByte
GIFHeight += ReadByte SHL 8
'LCM
Get #FF,,ColorFlag
If Bit(ColorFlag,6) Then Interlaced=1
If Bit(ColorFlag,7) Then
ColorCount=2^((ColorFlag and &b00000111)+1)
If GIFGCMPal Then
Deallocate (GIFGCMPal)
GIFGCMPal=0
End If
GIFGCMPal=Callocate(ColorCount*4)
RGBEntry=Callocate(3)
For C as Integer=0 to ColorCount-1
Get #FF,,*RGBEntry,3
GIFGCMPal[C]=RGB(RGBEntry[0],RGBEntry[1],RGBEntry[2])
Next C
Deallocate (RGBEntry)
End If
'CodeSize
GET #FF,,ReadByte
CodeSize=ReadByte
'-----------------------'
Dim BlockLen as UByte
Dim Block as Ubyte PTR
Dim LZWPos as UInteger
Dim LZWBuffer as UByte PTR
'Temporal ausreichend speicher reservieren um
'Reallocate sowenig wie noetig zu nutzen
Dim TempSize as UInteger=(GIFWidth*GIFHeight)
Dim TempMem as any ptr
LZWBuffer=Callocate(TempSize)
'gesmmte LZW Daten vom angefragten/gefundenen Block auslesen
WHILE Not Eof(FF)
Get #FF,,BlockLen
IF BlockLen=0 THEN EXIT WHILE
Block=Callocate(256)
GET #FF,,*Block,BlockLen
'Falls Temporal reservierter speicher nicht ausreichen sollte
If LZWPos+BlockLen > TempSize-1 Then
TempMem=Reallocate(LZWBuffer,TempSize*2)
TempSize=TempSize*2
End If
MemCopy (@LZWBuffer[LZWPos],Block,255)
Deallocate (Block)
Block = 0
LZWPos+=BlockLen
WEND
If Block Then Deallocate (Block)
Close #FF
Dim LZWData as UByte PTR
LZWData=Reallocate(LZWBuffer,LZWPos)
Dim DecodeBytes as UByte PTR
Dim DB as UInteger
DecodeBytes=MyLZWDecode(LZWData,LZWPos,CodeSize,DB)
Deallocate LZWData
'Decodierten Daten verarbeiten....
Dim GIFImage as any ptr
Dim ImagePitch as UInteger
Dim ILStep as Integer
Dim RY as Integer
If GIFGCMPal=0 Then GIFGCMPal=GetStandardPal
GIFImage=ImageCreate(GIFWidth,GIFHeight,GIFGCMPal[BackgroundCol])
ImagePitch=Peek (Uinteger,GIFImage+16)
For Y as Integer=GIFTop to GIFHeight-1
For X as Integer=GIFLeft to GIFWidth-1
If (X+(Y*GIFWidth))>DB-1 Then Exit For,For
Poke UInteger,GIFImage+32+(X*4)+(RY*ImagePitch),GIFGCMPal[DecodeBytes[X+(Y*GIFWidth)]]
Next X
If Interlaced Then
Select Case ILStep
Case 0,1
RY+=8
Case 2
RY+=4
Case 3,4
RY+=2
End Select
If RY>GIFHeight-1 Then
ILStep+=1
Select Case ILStep
Case 0,1
RY=GIFTop+4
Case 2
RY=GIFTop+2
Case 3,4
RY=GIFTop+1
End Select
End If
Else
RY=Y
End If
next Y
Deallocate (DecodeBytes)
Deallocate (GIFGCMPal)
Return GIFImage
End Function
Function MyLZWDecode(Byval LZWData as Ubyte ptr, Byval ByteSize as UInteger, Byval CodeSize as Integer, Byref OutSize as UInteger) as UByte ptr
Dim Tempmem as any ptr
Dim TempSize as UInteger = (ByteSize*4)
Dim Temp as ubyte ptr = Callocate(TempSize)
Dim LastPos as UInteger Ptr=Callocate((&hFFE-(2^CodeSize))*4)
Dim Bytes as UInteger Ptr=Callocate((&hFFE-(2^CodeSize))*4)
Dim BytePos as UInteger
Dim BitValue as Integer
Dim nByte as UInteger
Dim nBit as UByte
Dim BitPos as UByte
Dim E as UInteger
nBit = CodeSize
E = ((2^CodeSize)+2)
Do
For LZWDecode as Integer=E to &hFFF
'Start' -- BitRead --'
BitValue=0
For BitRead as Integer=0 to nBit
If Bit(LZWData[nByte],BitPos) Then BitValue += (1 Shl BitRead)
BitPos+=1
If BitPos=8 Then
BitPos=0
nByte+=1
If nByte=ByteSize Then Exit For
End If
Next BitRead
'End' -- BitRead --'
'Decode
Select Case BitValue
Case IS < (2^CodeSize)
LastPos[LZWDecode-E]=BytePos
Bytes[LZWDecode-E]=1
Temp[BytePos]=BitValue
BytePos+=1
Case IS = (2^CodeSize)
nBit=CodeSize
Exit For
Case Is = ((2^CodeSize)+1)
Exit Do
Case Is > ((2^CodeSize)+1)
LastPos[LZWDecode-E]=BytePos
Bytes[LZWDecode-E]=Bytes[BitValue-E]+1
For ByteWrite as Integer=0 to Bytes[LZWDecode-E]-1
If BytePos=TempSize Then
TempSize=TempSize*2
Tempmem=Reallocate(Temp,TempSize)
Temp=Tempmem
End If
Temp[BytePos]=Temp[LastPos[BitValue-E]+ByteWrite]
BytePos+=1
Next ByteWrite
End Select
If (LZWDecode)=(2^(nBit+1)) Then nBit+=1
If nByte=ByteSize Then Exit Do
Next LZWDecode
Loop
Deallocate LastPos
Deallocate Bytes
Tempmem=Reallocate(Temp,BytePos)
Temp=Tempmem
OutSize = BytePos
Return Temp
End Function
Private Function GetStandardPal as Uinteger ptr
Dim GSP as UInteger PTR=Callocate(256*4)
GSP[&h00]=&hFF000000
GSP[&h01]=&hFF0000AA
GSP[&h02]=&hFF00AA00
GSP[&h03]=&hFF00AAAA
GSP[&h04]=&hFFAA0000
GSP[&h05]=&hFFAA00AA
GSP[&h06]=&hFFAA5500
GSP[&h07]=&hFFAAAAAA
GSP[&h08]=&hFF555555
GSP[&h09]=&hFF5555FF
GSP[&h0A]=&hFF55FF55
GSP[&h0B]=&hFF55FFFF
GSP[&h0C]=&hFFFF5555
GSP[&h0D]=&hFFFF55FF
GSP[&h0E]=&hFFFFFF55
GSP[&h0F]=&hFFFFFFFF
GSP[&h10]=&hFF000000
GSP[&h11]=&hFF141414
GSP[&h12]=&hFF202020
GSP[&h13]=&hFF2C2C2C
GSP[&h14]=&hFF383838
GSP[&h15]=&hFF444444
GSP[&h16]=&hFF505050
GSP[&h17]=&hFF616161
GSP[&h18]=&hFF717171
GSP[&h19]=&hFF818181
GSP[&h1A]=&hFF919191
GSP[&h1B]=&hFFA1A1A1
GSP[&h1C]=&hFFB6B6B6
GSP[&h1D]=&hFFCACACA
GSP[&h1E]=&hFFE2E2E2
GSP[&h1F]=&hFFFFFFFF
GSP[&h20]=&hFF0000FF
GSP[&h21]=&hFF4000FF
GSP[&h22]=&hFF7D00FF
GSP[&h23]=&hFFBE00FF
GSP[&h24]=&hFFFF00FF
GSP[&h25]=&hFFFF00BE
GSP[&h26]=&hFFFF007D
GSP[&h27]=&hFFFF0040
GSP[&h28]=&hFFFF0000
GSP[&h29]=&hFFFF4000
GSP[&h2A]=&hFFFF7D00
GSP[&h2B]=&hFFFFBE00
GSP[&h2C]=&hFFFFFF00
GSP[&h2D]=&hFFBEFF00
GSP[&h2E]=&hFF7DFF00
GSP[&h2F]=&hFF40FF00
GSP[&h30]=&hFF00FF00
GSP[&h31]=&hFF00FF40
GSP[&h32]=&hFF00FF7D
GSP[&h33]=&hFF00FFBE
GSP[&h34]=&hFF00FFFF
GSP[&h35]=&hFF00BEFF
GSP[&h36]=&hFF007DFF
GSP[&h37]=&hFF0040FF
GSP[&h38]=&hFF7D7DFF
GSP[&h39]=&hFF9D7DFF
GSP[&h3A]=&hFFBE7DFF
GSP[&h3B]=&hFFDE7DFF
GSP[&h3C]=&hFFFF7DFF
GSP[&h3D]=&hFFFF7DDE
GSP[&h3E]=&hFFFF7DBE
GSP[&h3F]=&hFFFF7D9D
GSP[&h40]=&hFFFF7D7D
GSP[&h41]=&hFFFF9D7D
GSP[&h42]=&hFFFFBE7D
GSP[&h43]=&hFFFFDE7D
GSP[&h44]=&hFFFFFF7D
GSP[&h45]=&hFFDEFF7D
GSP[&h46]=&hFFBEFF7D
GSP[&h47]=&hFF9DFF7D
GSP[&h48]=&hFF7DFF7D
GSP[&h49]=&hFF7DFF9D
GSP[&h4A]=&hFF7DFFBE
GSP[&h4B]=&hFF7DFFDE
GSP[&h4C]=&hFF7DFFFF
GSP[&h4D]=&hFF7DDEFF
GSP[&h4E]=&hFF7DBEFF
GSP[&h4F]=&hFF7D9DFF
GSP[&h50]=&hFFB6B6FF
GSP[&h51]=&hFFC6B6FF
GSP[&h52]=&hFFDAB6FF
GSP[&h53]=&hFFEAB6FF
GSP[&h54]=&hFFFFB6FF
GSP[&h55]=&hFFFFB6EA
GSP[&h56]=&hFFFFB6DA
GSP[&h57]=&hFFFFB6C6
GSP[&h58]=&hFFFFB6B6
GSP[&h59]=&hFFFFC6B6
GSP[&h5A]=&hFFFFDAB6
GSP[&h5B]=&hFFFFEAB6
GSP[&h5C]=&hFFFFFFB6
GSP[&h5D]=&hFFEAFFB6
GSP[&h5E]=&hFFDAFFB6
GSP[&h5F]=&hFFC6FFB6
GSP[&h60]=&hFFB6FFB6
GSP[&h61]=&hFFB6FFC6
GSP[&h62]=&hFFB6FFDA
GSP[&h63]=&hFFB6FFEA
GSP[&h64]=&hFFB6FFFF
GSP[&h65]=&hFFB6EAFF
GSP[&h66]=&hFFB6DAFF
GSP[&h67]=&hFFB6C6FF
GSP[&h68]=&hFF000071
GSP[&h69]=&hFF1C0071
GSP[&h6A]=&hFF380071
GSP[&h6B]=&hFF550071
GSP[&h6C]=&hFF710071
GSP[&h6D]=&hFF710055
GSP[&h6E]=&hFF710038
GSP[&h6F]=&hFF71001C
GSP[&h70]=&hFF710000
GSP[&h71]=&hFF711C00
GSP[&h72]=&hFF713800
GSP[&h73]=&hFF715500
GSP[&h74]=&hFF717100
GSP[&h75]=&hFF557100
GSP[&h76]=&hFF387100
GSP[&h77]=&hFF1C7100
GSP[&h78]=&hFF007100
GSP[&h79]=&hFF00711C
GSP[&h7A]=&hFF007138
GSP[&h7B]=&hFF007155
GSP[&h7C]=&hFF007171
GSP[&h7D]=&hFF005571
GSP[&h7E]=&hFF003871
GSP[&h7F]=&hFF001C71
GSP[&h80]=&hFF383871
GSP[&h81]=&hFF443871
GSP[&h82]=&hFF553871
GSP[&h83]=&hFF613871
GSP[&h84]=&hFF713871
GSP[&h85]=&hFF713861
GSP[&h86]=&hFF713855
GSP[&h87]=&hFF713844
GSP[&h88]=&hFF713838
GSP[&h89]=&hFF714438
GSP[&h8A]=&hFF715538
GSP[&h8B]=&hFF716138
GSP[&h8C]=&hFF717138
GSP[&h8D]=&hFF617138
GSP[&h8E]=&hFF557138
GSP[&h8F]=&hFF447138
GSP[&h90]=&hFF387138
GSP[&h91]=&hFF387144
GSP[&h92]=&hFF387155
GSP[&h93]=&hFF387161
GSP[&h94]=&hFF387171
GSP[&h95]=&hFF386171
GSP[&h96]=&hFF385571
GSP[&h97]=&hFF384471
GSP[&h98]=&hFF505071
GSP[&h99]=&hFF595071
GSP[&h9A]=&hFF615071
GSP[&h9B]=&hFF695071
GSP[&h9C]=&hFF715071
GSP[&h9D]=&hFF715069
GSP[&h9E]=&hFF715061
GSP[&h9F]=&hFF715059
GSP[&hA0]=&hFF715050
GSP[&hA1]=&hFF715950
GSP[&hA2]=&hFF716150
GSP[&hA3]=&hFF716950
GSP[&hA4]=&hFF717150
GSP[&hA5]=&hFF697150
GSP[&hA6]=&hFF617150
GSP[&hA7]=&hFF597150
GSP[&hA8]=&hFF507150
GSP[&hA9]=&hFF507159
GSP[&hAA]=&hFF507161
GSP[&hAB]=&hFF507169
GSP[&hAC]=&hFF507171
GSP[&hAD]=&hFF506971
GSP[&hAE]=&hFF506171
GSP[&hAF]=&hFF505971
GSP[&hB0]=&hFF000040
GSP[&hB1]=&hFF100040
GSP[&hB2]=&hFF200040
GSP[&hB3]=&hFF300040
GSP[&hB4]=&hFF400040
GSP[&hB5]=&hFF400030
GSP[&hB6]=&hFF400020
GSP[&hB7]=&hFF400010
GSP[&hB8]=&hFF400000
GSP[&hB9]=&hFF401000
GSP[&hBA]=&hFF402000
GSP[&hBB]=&hFF403000
GSP[&hBC]=&hFF404000
GSP[&hBD]=&hFF304000
GSP[&hBE]=&hFF204000
GSP[&hBF]=&hFF104000
GSP[&hC0]=&hFF004000
GSP[&hC1]=&hFF004010
GSP[&hC2]=&hFF004020
GSP[&hC3]=&hFF004030
GSP[&hC4]=&hFF004040
GSP[&hC5]=&hFF003040
GSP[&hC6]=&hFF002040
GSP[&hC7]=&hFF001040
GSP[&hC8]=&hFF202040
GSP[&hC9]=&hFF282040
GSP[&hCA]=&hFF302040
GSP[&hCB]=&hFF382040
GSP[&hCC]=&hFF402040
GSP[&hCD]=&hFF402038
GSP[&hCE]=&hFF402030
GSP[&hCF]=&hFF402028
GSP[&hD0]=&hFF402020
GSP[&hD1]=&hFF402820
GSP[&hD2]=&hFF403020
GSP[&hD3]=&hFF403820
GSP[&hD4]=&hFF404020
GSP[&hD5]=&hFF384020
GSP[&hD6]=&hFF304020
GSP[&hD7]=&hFF284020
GSP[&hD8]=&hFF204020
GSP[&hD9]=&hFF204028
GSP[&hDA]=&hFF204030
GSP[&hDB]=&hFF204038
GSP[&hDC]=&hFF204040
GSP[&hDD]=&hFF203840
GSP[&hDE]=&hFF203040
GSP[&hDF]=&hFF202840
GSP[&hE0]=&hFF2C2C40
GSP[&hE1]=&hFF302C40
GSP[&hE2]=&hFF342C40
GSP[&hE3]=&hFF3C2C40
GSP[&hE4]=&hFF402C40
GSP[&hE5]=&hFF402C3C
GSP[&hE6]=&hFF402C34
GSP[&hE7]=&hFF402C30
GSP[&hE8]=&hFF402C2C
GSP[&hE9]=&hFF40302C
GSP[&hEA]=&hFF40342C
GSP[&hEB]=&hFF403C2C
GSP[&hEC]=&hFF40402C
GSP[&hED]=&hFF3C402C
GSP[&hEE]=&hFF34402C
GSP[&hEF]=&hFF30402C
GSP[&hF0]=&hFF2C402C
GSP[&hF1]=&hFF2C4030
GSP[&hF2]=&hFF2C4034
GSP[&hF3]=&hFF2C403C
GSP[&hF4]=&hFF2C4040
GSP[&hF5]=&hFF2C3C40
GSP[&hF6]=&hFF2C3440
GSP[&hF7]=&hFF2C3040
GSP[&hF8]=&hFF000000
GSP[&hF9]=&hFF000000
GSP[&hFA]=&hFF000000
GSP[&hFB]=&hFF000000
GSP[&hFC]=&hFF000000
GSP[&hFD]=&hFF000000
GSP[&hFE]=&hFF000000
GSP[&hFF]=&hFF000000
Return GSP
End Function
| Zusätzliche Informationen und Funktionen | |||||||
|---|---|---|---|---|---|---|---|
|
|
||||||
Bearbeiten
Versionen