Login Register
Frontpage Code library Pastebin

GIF-tallennin

Author: aXu
Added: 27. kesäkuuta 2012 kello 20.27
Edited: 27. kesäkuuta 2012 kello 20.32
Category: Tiedostot

Description

Funktio, joka tallentaa kuvan GIF-muodossa. Myös animointia tuetaan. Kuvassa ei saa olla enempää kuin 256 väriä (GIF:n rajoitus jota en jaksanut alkaa kiertämään lisäämällä ditheröintiä). Käyttö: SaveGIF(Img, Path$ [, MaskRed, MaskGreen, MaskBlue, AnimWidth, AnimHeight, AnimFrames, AnimSpeed, Compression]) Img on kuvamuuttuja, joka tallennetaan Path on tiedoston nimi Mask***** on maskiväri. Jos ei ilmoitettu, ei käytetä läpinäkyvyyttä (ensimmäinen arvo -1) AnimWidth on animaatioframen leveys (jätä nollaksi jos et animoi) AnimHeight on animaatioframen korkeus (jätä nollaksi jos et animoi) AnimFrames on animaatioframejen määrä (still-kuva = 1) AnimSpeed on animaation päivitysnopeus. 1/100 sekunteja, pienempi nopeampi Compression kertoo pakkauksen laadun. Arvo väliltä 1-4096, suurempi tehokkaampi (vie enemmän muistia, hyötyä vasta suurilla kuvilla) Esimerkkikoodi on aika bloatti ja omahyväinen, mutta ajaa asiansa. Varsinainen funktio (alkukommentteineen) on riviltä 60 eteenpäin :) Tämä koodi olisi tietty voinut mennä myös Grafiikka-osioon, mutta varsinaisestihan tämä ei grafiikkaan liity, vain sen pakkaamiseen ja tallentamiseen. Jos olisi ollut Kuvat-osio vielä erikseen, olisin ehkä sinne laittanut.

Code

Select all 
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
img = MakeImage(1000, 100)
DrawToImage img
	Color 32, 32, 32
	For i = 0 To 9
		Offset = 50 + i * 100
		
		For b = -9 To 9 Step 2 
			g = 255 - Abs(b) * 3
			Color g, g, g
			Box Offset + b * 5 - 5, 40, 20, 60
		Next b
		
		Color 32, 32, 32
		For s = 1 To 36
			r1 = 22 + (s Mod 2) * 5
			a1 = s * 10 + i * 2
			r2 = 22 + ((s-1) Mod 2) * 5
			a2 = (s-1) * 10 + i * 2
			Line Offset + Cos(a1) * r1, 70 + Sin(a1) * r1, Offset + Cos(a2) * r1, 70 + Sin(a2) * r1
			Line Offset + Cos(a2) * r1, 70 + Sin(a2) * r1, Offset + Cos(a2) * r2, 70 + Sin(a2) * r2
		Next s
		
		Line Offset - 50, 40, Offset + 49, 40
		Line Offset - 50, 99, Offset + 49, 99
		For b = -6 To 6
			X = b * 10 + i
			W = 5
			If X < -50 Then W = Max(0, 5 - (-50 - X))
			If X > 45 Then W = Max(0, 5 - (X - 45))
			X = Max(-50, Min(50, X))
			Box Offset + X, 40, W, 5
			
			X = b * 10 - i + 5
			W = 5
			If X < -50 Then W = Max(0, 5 - (-50 - X))
			If X > 45 Then W = Max(0, 5 - (X - 45))
			X = Max(-50, Min(50, X))
			Box Offset + X, 95, W, 5
		Next b
		
		Color 128, 128, 255
		CenterText Offset, -8 - Max(1, Min(4, Abs(i - 4))), "CB-powered", 2
		CenterText Offset, -22 - Max(1, Min(4, Abs(i - 4))), "ANIMATION", 2
		g = 50 - Abs(i - 4) * 10
		Color g + 100, g, g
		CenterText Offset + 1, -70, "AXU", 2
		CenterText Offset, -70, "AXU", 2
	Next i
DrawToScreen
DrawImage img, 0, 0
Color 255, 255, 255
Text 0, 100, "Press any key to save this to TestiGIF.gif."
Text 0, 120, "Or you can always press ESC if you're coward."
DrawScreen
WaitKey
SaveGIF(img, "TestiGIF.gif", -1, 0, 0, 100, 100, 10, 5)
Execute "TestiGIF.gif"



//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
EndFunction

Comments

No comments. You can be first!

Leave a comment

You must be logged in to comment.