Alla olevassa esimerkkikoodissa ladataan "Note.bmp" ja tallennetaan se "TestiGIF.gif"-tiedostoon animaatioksi.
Code: Select all
img = LoadImage("Media/Note.bmp")
DrawImage img, 0, 0
Text 0, 40, "Press key to save this animation to TestiGIF.gif"
Text 0, 60, "Folder containing this file will then open."
Text 0, 280, "If you're coward, press ESC!"
DrawScreen
WaitKey
SaveGIF(img, "TestiGIF.gif", 255, 0, 255, 32, 32, 8, 20)
Execute "."
//SaveGIF(Img, Path$, [MaskRed, MaskGreen, MaskBlue, AnimWidth, AnimHeight, AnimFrames, AnimSpeed, Compression])
//Tallentaa kuvan GIF-muodossa.
//Img - Kuvamuuttuja, joka tallennetaan
//Path - Tiedostopolku
//Mask***** - Läpinäkyvä väri. Jos ei ilmoitettu, ei käytetä läpinäkyvyyttä (ensimmäinen arvo -1)
//AnimWidth - Animaatioframen leveys (jätä nollaksi jos et animoi)
//AnimHeight - Animaatioframen korkeus (jätä nollaksi jos et animoi)
//AnimFrames - Animaatioframejen määrä (still-kuva = 1)
//AnimSpeed - Animaation päivitysnopeus. 1/100 sekunteja, pienempi nopeampi
//Compression - Pakkauksen laatu. Arvo väliltä 1-4096, suurempi tehokkaampi (vie enemmän muistia, hyötyä vasta suurilla kuvilla)
Function SaveGIF(Img, Path$, MaskRed = -1, MaskGreen = 0, MaskBlue = 0, AnimWidth = 0, AnimHeight = 0, AnimFrames = 1, AnimSpeed = 0, Compression = 2048)
AnimFrames = AnimFrames - 1
Width = ImageWidth(Img)
Height = ImageHeight(Img)
If AnimWidth = 0 Then
AnimWidth = Width
AnimHeight = Height
EndIf
Fra_Size = AnimWidth * AnimHeight
Img_Size = Width * Height
Img_MEM = MakeMEMBlock(Img_Size) //Tähän tallennetaan kuva pakkaamattomassa GIF-muodossa (jono viittauksia palettiin)
Palette = MakeMEMBlock(8 * 3)
////////////PALETIN LUONTI (huom. olettaa, että kuva on max. 256-värinen)
Lock Image(Img)
Pixel = 0
PaletteCount = 0
If MaskRed > -1 Then //Jos maskiväri on määritelty,
PokeByte Palette, PaletteCount * 3, MaskRed //asetetaan se paletin ensimmäiseksi.
PokeByte Palette, PaletteCount * 3 + 1, MaskGreen
PokeByte Palette, PaletteCount * 3 + 2, MaskBlue
PaletteCount + 1
EndIf
For Frame = 0 To AnimFrames
XStart = (Frame Mod (Width / AnimWidth)) * AnimWidth
YStart = (Frame / (Width / AnimWidth)) * AnimHeight
For y = YStart To YStart + AnimHeight - 1
For x = XStart To XStart + AnimWidth - 1
PickImageColor2 Img, x, y
r = getRGB(RED) : g = getRGB(GREEN) : b = getRGB(BLUE)
NewCol = True
For i = 0 To PaletteCount - 1 //Tutkitaan löytyykö väri paletista
If r = PeekByte(Palette, i * 3) And g = PeekByte(Palette, i * 3 + 1) And b = PeekByte(Palette, i * 3 + 2) Then
NewCol = False
PokeByte Img_MEM, Pixel, i //Tallennetaan indeksi muistipalaan
Exit
EndIf
Next i
If NewCol = True And PaletteCount < 256 Then//Lisätään väri palettiin
If PaletteCount * 3 => MEMBlockSize(Palette) Then ResizeMEMBlock Palette, MEMBlockSize(Palette) * 2
PokeByte Palette, PaletteCount * 3, r
PokeByte Palette, PaletteCount * 3 + 1, g
PokeByte Palette, PaletteCount * 3 + 2, b
PokeByte Img_MEM, Pixel, PaletteCount
PaletteCount + 1
End If
Pixel = Pixel + 1
Next x
Next y
Next Frame
Unlock Image(Img)
For i = 2 To 8 //Optimoidaan paletin koko
If PaletteCount <= 2^i Then PaletteSize = 2^i : PaletteBits = i : Exit
Next i
If FileExists(Path) Then DeleteFile Path
f = OpenToEdit(Path) //Avataan muokattavaksi, jotta SeekFile toimii
////////////HEADER
WriteByte f, 71 //G Formaatti, täytyy olla GIF
WriteByte f, 73 //I
WriteByte f, 70 //F
WriteByte f, 56 //8 Versio
If MaskRed > -1 Or AnimFrames > 0 Then
WriteByte f, 57 //9 Tarvitaan uudempi 89a versio
Else
WriteByte f, 55 //7 Suuremman yhteensopivuuden vuoksi käytetään 87a versiota (ei tarvetta 89a:lle)
EndIf
WriteByte f, 97 //a
////////////LOOGISEN KUVAN TIEDOT
WriteShort f, AnimWidth //GIF-kuvan koko. Yhtä kuvaa tallennettaessa sama kuin kuvan koko
WriteShort f, AnimHeight
WriteByte f, 127 + PaletteBits //Bitteinä 1000 0XXX, luettuna oikealta vasemmalle:
//Ensimmäiset 3 (XXX): Paletin koko kahden potenssina (lukuun lisätään 1)
//Seuraava 1 (0) : Onko paletti järjestetty tärkeysjärjestykseen; version ollessa 87a tämä on aina "0"
//Seuraavat 3 (000): Alkuperäisen paletin koko? dunno.
//Viimeinen 1 (1) : Käytetäänkö globaalia palettia?
WriteByte f, 0 //Taustavärin indeksi (jos koko loogista kuvaa ei täytetä)
WriteByte f, 0 //Pikselin leveyden ja korkeuden suhde. "0" = Ei käytössä
////////////GLOBAALI PALETTI
For i1 = 0 To PaletteSize - 1 //Paletti, sarja tavuja "Punainen", "Vihreä", "Sininen", "Punainen" jne.
For i2 = 0 To 2
WriteByte f, PeekByte(Palette, i1 * 3 + i2) 'Palette(i1, i2)
Next i2
Next i1
////////////ANIMOINTI
If AnimFrames > 0 Then
WriteByte f, 33 //Ilmoitetaan annettevaksi ylimääräisiä tietoja
WriteByte f, 255 //"Application Extension"
WriteByte f, 11 //Seuraavat 11 merkkiä:
WriteByte f, 78 //N
WriteByte f, 69 //E
WriteByte f, 84 //T
WriteByte f, 83 //S
WriteByte f, 67 //C
WriteByte f, 65 //A
WriteByte f, 80 //P
WriteByte f, 69 //E
WriteByte f, 50 //2
WriteByte f, 46 //.
WriteByte f, 48 //0
WriteByte f, 3 //Blockin koko
WriteByte f, 1
WriteShort f, 0 //Kuinka monta kertaa animaatio toistetaan, 0 = loputon
WriteByte f, 0
EndIf
For Frame = 0 To AnimFrames
////////////KUVAN LISÄTIEDOT (vain 89a, pitää tulla ennen itse kuvaa)
If MaskRed > -1 Or AnimFrames > 0 Then
WriteByte f, 33 //Ilmoitetaan, että annetaan kuvalle ylimääräisiä tietoja
WriteByte f, 249 //"Graphic Control Extension"
WriteByte f, 4 //Palikan koko tavuina
WriteByte f, 8 + (MaskRed > -1) //Bitteinä 0000 0001, luettuna oikealta vasemmalle:
//Ensimmäinen 1 (1) : Käytetäänkö läpinäkyvää väriä
//Seuraava 1 (0) : Halutaanko ohjelman odottavan käyttäjän toimintaa?
//Seuraavat 3 (000): Mitä tapahtuu kuvan piirtämisen jälkeen: "000" = ei oteta kantaa, "001" = jätä kuva pyyhkimättä, "010" = tyhjennä taustavärillä, "011" = palauta edellinen kuva
//Viimeiset 3 (000): Ei käytössä
WriteShort f, AnimSpeed //Animaation viivästysaika (2 tavua), 1/100 sekunteja
WriteByte f, 0 //Läpinäkyvän värin indeksi
WriteByte f, 0 //Lopetustavu
EndIf
////////////KUVAN TIEDOT
WriteByte f, 44 //Erotin, tästä eteenpäin itse kuvan tiedot:
WriteShort f, 0 //Kuvan sijainti X (2 tavua)
WriteShort f, 0 //Y (2 tavua)
WriteShort f, AnimWidth //Leveys (2 tavua)
WriteShort f, AnimHeight //Korkeus (2 tavua)
WriteByte f, 0 //Bitteinä 0000 0000, luettuna oikealta vasemmalle:
//Ensimmäinen 1 (0) : Käytetäänkö paikallista palettia?
//Toinen 1 (0) : Onko kuva lomitettu?
//Kolmas 1 (0) : Onko paikallinen paletti järjestetty tärkeysjärjestykseen; version ollessa 87a tämä on aina "0"
//Seuraavat 3 (000): Ei käytössä
//Viimeiset 3 (000): Paikallisen paletin koko.
////////////KUVA
LZW_MEM = MakeMEMBlock((Compression * PaletteSize) * 2) //Luodaan muistipala, jossa on varattu tilaa jokaisen koodin + merkin yhdistelmälle 2 tavua (Short)
CurIndex = PaletteSize + 2 //Indeksit ovat tästä ylöspäin (0-(PaletteSize-1) ovat paletin indeksejä, (PaletteSize) on tyhjennyskäsky ja (PaletteSize + 1) on EOF-merkki)
CodeBits = PaletteBits + 1 //Kuinka monta bittiä tulee koodia kohden aluksi
Output = PaletteSize //Annetaan aluksi tyhjennyskäsky
OutBits = CodeBits
If Frame = 0 Then
Pixel = 0 //Monesko pikseli on meneillään
Else
Pixel = Pixel + 1
End If
WriteByte f, CodeBits - 1 //Kuinka monen bitin koodeilla aloitetaan.
BlockSize = 0
LastIndex = PeekByte(Img_MEM, Pixel) //Luetaan ensimmäinen pikseli
While Pixel < (Frame * Fra_Size) + Fra_Size - 1
Pixel = Pixel + 1
NextIndex = PeekByte(Img_MEM, Pixel) //Luetaan seuraava pikseli
Found = PeekShort(LZW_MEM, (LastIndex * PaletteSize + NextIndex) * 2)
If Found > 0 Then //Jos uusi yhdistelmä löytyy, niin asetetaan se nykyisen tilalle
LastIndex = Found
Else
Output = Output + LastIndex Shl OutBits //Lisätään aina uusi koodi vanhan päälle (vanhat bitit LSB, uudet MSB)
OutBits = OutBits + CodeBits //Pidetään kirjaa siitä, kuinka monta bittiä on tallennettu Output-muuttujaan
While OutBits > 8 //Löytyykö kokonaisia tavuja kirjoitettavaksi
If BlockSize = 0 Then
WriteByte f, 255 //Merkataan seuraavaksi kirjoitettavan palikan koko
BlockSize = 255
EndIf
WriteByte f, Output //Kirjoitetaan tavu (CB leikkaa automaattisesti ylimääräiset bitit pois, ts. Output Mod 256)
BlockSize = BlockSize - 1
Output = Output / 256 //Siirretään bitit alkuun (LSB:tä kohti, ts. Output Shr 8)
OutBits = OutBits - 8
Wend
If CurIndex < 4096 Then
If CurIndex < Compression Then
PokeShort LZW_MEM, (LastIndex * PaletteSize + NextIndex) * 2, CurIndex
EndIf
CurIndex = CurIndex + 1
If CurIndex > 2^CodeBits Then CodeBits = CodeBits + 1 //Jos tarvitaan lisää bittejä seuraavaa koodia varten, lisätään yksi bitti
EndIf
//Aloitetaan uusi jono
LastIndex = NextIndex
EndIf
Wend
Output = Output + LastIndex Shl OutBits //Merkataan viimeinenkin koodi
OutBits = OutBits + CodeBits
While OutBits > 0
If BlockSize = 0 Then
WriteByte f, 255 //Merkataan seuraavaksi kirjoitettavan palikan koko
BlockSize = 255
EndIf
WriteByte f, Output
BlockSize = BlockSize - 1
Output = Output Shr 8
OutBits = OutBits - 8
Wend
SeekFile f, FileOffset(f) - (255 - BlockSize) - 1
WriteByte f, 255 - BlockSize //Palataan ja merkataan viimeisen blockin oikea koko
SeekFile f, FileOffset(f) + (255 - BlockSize)
WriteByte f, 0 //Merkataan kuva päättyneeksi (nollan kokoinen blocki)
DeleteMEMBlock LZW_MEM
Next Frame
////////////LOPETUSMERKKI
WriteByte f, 59 //Lopetusmerkki
CloseFile f
DeleteMEMBlock Img_MEM //Siivotaan jäljet
DeleteMEMBlock Palette
End Function