source: trunk/Packages/bgrabitmap/bgrareadlzp.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 11.4 KB
Line 
1unit BGRAReadLzp;
2
3{$mode objfpc}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils, FPimage, BGRALzpCommon, BGRABitmapTypes, BGRABitmap;
9
10type
11
12 { TBGRAReaderLazPaint }
13
14 TBGRAReaderLazPaint = class(TFPCustomImageReader)
15 private
16 FHeight: integer;
17 FNbLayers: integer;
18 FWidth: integer;
19 FCaption: string;
20 FDimensionsAlreadyFetched: boolean;
21 protected
22 procedure InternalRead(Str: TStream; Img: TFPCustomImage); override;
23 procedure InternalReadLayers({%H-}str: TStream;{%H-}Img: TFPCustomImage); virtual;
24 procedure InternalReadCompressableBitmap(str: TStream; Img: TFPCustomImage); virtual;
25 function InternalCheck(Str: TStream): boolean; override;
26 public
27 WantThumbnail: boolean;
28 class procedure LoadRLEImage(Str: TStream; Img: TFPCustomImage; out ACaption: string);
29 property Width: integer read FWidth;
30 property Height: integer read FHeight;
31 property NbLayers: integer read FNbLayers;
32 property Caption: string read FCaption;
33 end;
34
35implementation
36
37uses BGRACompressableBitmap, BGRAReadPng;
38
39{ TBGRAReaderLazPaint }
40
41procedure TBGRAReaderLazPaint.InternalRead(Str: TStream; Img: TFPCustomImage);
42var
43 {%H-}header: TLazPaintImageHeader;
44 oldPos: int64;
45 png: TBGRAReaderPNG;
46
47begin
48 FCaption := '';
49 FWidth:= 0;
50 FHeight:= 0;
51 FNbLayers:= 0;
52 FDimensionsAlreadyFetched:= false;
53 oldPos := str.Position;
54 str.ReadBuffer({%H-}header.magic,sizeof(header.magic));
55 if header.magic = LAZPAINT_MAGIC_HEADER then
56 begin
57 str.ReadBuffer(header.zero1, sizeof(header)-sizeof(header.magic));
58 LazPaintImageHeader_SwapEndianIfNeeded(header);
59 if (header.zero1 <> 0) or (header.zero2 <> 0) or
60 (header.headerSize < $30) then raise exception.Create('Invalid file format');
61 FWidth:= header.width;
62 FHeight:= header.height;
63 FNbLayers:= header.nbLayers;
64 FDimensionsAlreadyFetched:= true;
65
66 if WantThumbnail and ((header.compressionMode and LAZPAINT_THUMBNAIL_PNG) <> 0) then
67 begin
68 str.Position:= oldPos+header.headerSize;
69 png := TBGRAReaderPNG.create;
70 try
71 png.ImageRead(Str,Img);
72 except
73 png.Free;
74 raise exception.Create('Invalid file format');
75 end;
76 png.free;
77 exit;
78 end;
79
80 if ((header.compressionMode and LAZPAINT_COMPRESSION_MASK) <> LAZPAINT_COMPRESSION_MODE_ZSTREAM) and
81 ((header.compressionMode and LAZPAINT_COMPRESSION_MASK) <> LAZPAINT_COMPRESSION_MODE_RLE) then raise exception.Create('Compression mode not supported');
82
83 str.Position:= oldPos+header.previewOffset;
84 if (header.compressionMode and LAZPAINT_COMPRESSION_MASK) = LAZPAINT_COMPRESSION_MODE_RLE then
85 LoadRLEImage(Str, Img, FCaption)
86 else
87 InternalReadCompressableBitmap(str,Img);
88
89 if header.layersOffset > 0 then
90 begin
91 Str.Position:= oldPos+header.layersOffset;
92 InternalReadLayers(Str,Img);
93 end;
94 end else
95 begin
96 str.Position:= oldPos;
97 InternalReadCompressableBitmap(str,Img);
98 if (Str.Position < Str.Size) and (FCaption = 'Preview') then InternalReadLayers(Str,Img);
99 end;
100end;
101
102procedure TBGRAReaderLazPaint.InternalReadLayers(str: TStream;
103 Img: TFPCustomImage);
104begin
105 //not implemented here
106end;
107
108procedure TBGRAReaderLazPaint.InternalReadCompressableBitmap(str: TStream;
109 Img: TFPCustomImage);
110var
111 compressed: TBGRACompressableBitmap;
112 bmp: TBGRABitmap;
113begin
114 compressed := TBGRACompressableBitmap.Create;
115 try
116 compressed.ReadFromStream(Str);
117 bmp := compressed.GetBitmap;
118 try
119 FCaption := compressed.Caption;
120 if (Img is TBGRACustomBitmap) then
121 TBGRACustomBitmap(Img).Assign(bmp)
122 else
123 Img.Assign(bmp);
124 if not FDimensionsAlreadyFetched then
125 begin
126 FDimensionsAlreadyFetched := true;
127 FWidth:= bmp.width;
128 FHeight:= bmp.height;
129 FNbLayers:= 1;
130 end;
131 finally
132 bmp.Free;
133 end;
134 finally
135 compressed.Free;
136 end;
137end;
138
139function TBGRAReaderLazPaint.InternalCheck(Str: TStream): boolean;
140var {%H-}magic: packed array[0..7] of byte;
141 magicAsText: string;
142 oldPos: int64;
143begin
144 oldPos := str.Position;
145 result := (str.Read({%H-}magic,sizeof(magic)) = sizeof(magic));
146 str.Position:= oldPos;
147 setlength(magicAsText, sizeof(magic));
148 move(magic[0], magicAsText[1], sizeof(magic));
149 result := (copy(magicAsText,1,8) = 'LazPaint') or
150 (((magic[0] <> 0) or (magic[1] <> 0)) and (magic[2] = 0) and (magic[3] = 0) and
151 ((magic[4] <> 0) or (magic[5] <> 0)) and (magic[6] = 0) and (magic[7] = 0));
152end;
153
154class procedure TBGRAReaderLazPaint.LoadRLEImage(Str: TStream; Img: TFPCustomImage; out ACaption: string);
155var channelFlags: byte;
156 w,h,NbPixels,nameLen,channelStreamSize: DWord;
157 nextPosition: int64;
158 PIndexed,PRed,PGreen,PBlue,PAlpha,
159 PCurRed, PCurGreen, PCurBlue, PCurAlpha: PByte;
160 PDest: PBGRAPixel;
161 x,y: DWord;
162 c: TFPColor;
163 n,NbNonTransp: DWord;
164 a,index: NativeInt;
165 ColorTab: packed array[0..256*3-1] of byte;
166begin
167 w := LEtoN(str.ReadDWord);
168 h := LEtoN(str.ReadDWord);
169 nameLen := LEtoN(str.ReadDWord);
170 setlength(ACaption, nameLen);
171 {$PUSH}{$RANGECHECKS OFF}
172 str.ReadBuffer(ACaption[1], nameLen);
173 {$POP}
174 channelFlags := str.ReadByte;
175 NbPixels := w*h;
176
177 PRed := nil;
178 PGreen := nil;
179 PBlue := nil;
180 PAlpha := nil;
181
182 try
183 if (channelFlags and LazpaintChannelNoAlpha) = 0 then
184 begin
185 Getmem(PAlpha, NbPixels);
186 channelStreamSize := LEtoN(str.ReadDWord);
187 nextPosition:= str.Position+channelStreamSize;
188 if (channelStreamSize > 0) and (NbPixels > 0) then DecodeLazRLE(Str, PAlpha^, NbPixels);
189 Str.Position:= nextPosition;
190
191 NbNonTransp := 0;
192 PCurAlpha := PAlpha;
193 for n := NbPixels-1 downto 0 do
194 begin
195 if PCurAlpha^ <> 0 then inc(NbNonTransp);
196 inc(PCurAlpha);
197 end;
198 end else
199 NbNonTransp:= NbPixels;
200
201 if NbNonTransp > 0 then
202 begin
203 if (channelFlags and LazpaintPalettedRGB) <> 0 then
204 begin
205 Getmem(PIndexed, NbNonTransp);
206 try
207 Getmem(PRed, NbNonTransp);
208 Getmem(PGreen, NbNonTransp);
209 Getmem(PBlue, NbNonTransp);
210 fillchar({%H-}ColorTab,sizeof(ColorTab),0);
211
212 channelStreamSize := LEtoN(str.ReadDWord);
213 nextPosition:= str.Position+channelStreamSize;
214 DecodeLazRLE(Str, colorTab[0], 256);
215 Str.Position:= nextPosition;
216
217 if (channelFlags and LazPaintChannelGreenFromRed) <> 0 then
218 move(ColorTab[0],colorTab[256], 256)
219 else
220 begin
221 channelStreamSize := LEtoN(str.ReadDWord);
222 nextPosition:= str.Position+channelStreamSize;
223 DecodeLazRLE(Str, colorTab[256], 256);
224 Str.Position:= nextPosition;
225 end;
226 if (channelFlags and LazPaintChannelBlueFromRed) <> 0 then
227 move(ColorTab[0],colorTab[512], 256)
228 else if (channelFlags and LazpaintChannelBlueFromGreen) <> 0 then
229 move(ColorTab[256],colorTab[512], 256)
230 else
231 begin
232 channelStreamSize := LEtoN(str.ReadDWord);
233 nextPosition:= str.Position+channelStreamSize;
234 DecodeLazRLE(Str, colorTab[512], 256);
235 Str.Position:= nextPosition;
236 end;
237
238 channelStreamSize := LEtoN(str.ReadDWord);
239 nextPosition:= str.Position+channelStreamSize;
240 DecodeLazRLE(Str, PIndexed^, NbNonTransp);
241 Str.Position:= nextPosition;
242
243 for n := 0 to NbNonTransp-1 do
244 begin
245 index := (PIndexed+n)^;
246 (PRed+n)^ := colorTab[index];
247 (PGreen+n)^ := colorTab[index+256];
248 (PBlue+n)^ := colorTab[index+512];
249 end;
250 finally
251 FreeMem(PIndexed);
252 end;
253 end else
254 begin
255 Getmem(PRed, NbNonTransp);
256 channelStreamSize := LEtoN(str.ReadDWord);
257 nextPosition:= str.Position+channelStreamSize;
258 DecodeLazRLE(Str, PRed^, NbNonTransp);
259 Str.Position:= nextPosition;
260
261 if (channelFlags and LazPaintChannelGreenFromRed) <> 0 then PGreen := PRed else
262 begin
263 Getmem(PGreen, NbNonTransp);
264 channelStreamSize := LEtoN(str.ReadDWord);
265 nextPosition:= str.Position+channelStreamSize;
266 DecodeLazRLE(Str, PGreen^, NbNonTransp);
267 Str.Position:= nextPosition;
268 end;
269
270 if (channelFlags and LazPaintChannelBlueFromRed) <> 0 then PBlue := PRed else
271 if (channelFlags and LazPaintChannelBlueFromGreen) <> 0 then PBlue := PGreen else
272 begin
273 Getmem(PBlue, NbNonTransp);
274 channelStreamSize := LEtoN(str.ReadDWord);
275 nextPosition:= str.Position+channelStreamSize;
276 DecodeLazRLE(Str, PBlue^, NbNonTransp);
277 Str.Position:= nextPosition;
278 end;
279 end;
280 end;
281
282 Img.SetSize(w,h);
283
284 if NbNonTransp > 0 then
285 begin
286 PCurRed := PRed;
287 PCurGreen := PGreen;
288 PCurBlue := PBlue;
289 PCurAlpha := PAlpha;
290
291 if Img is TBGRACustomBitmap then
292 begin
293 If PCurAlpha = nil then
294 begin
295 for y := 0 to h-1 do
296 begin
297 PDest := TBGRACustomBitmap(Img).ScanLine[y];
298 for x := w-1 downto 0 do
299 begin
300 PDest^ := BGRA(PCurRed^,PCurGreen^,PCurBlue^);
301 inc(PCurBlue);
302 inc(PCurGreen);
303 inc(PCurRed);
304 inc(PDest);
305 end;
306 end;
307 end else
308 for y := 0 to h-1 do
309 begin
310 PDest := TBGRACustomBitmap(Img).ScanLine[y];
311 for x := w-1 downto 0 do
312 begin
313 if PCurAlpha^ = 0 then
314 PDest^ := BGRAPixelTransparent
315 else
316 begin
317 PDest^ := BGRA(PCurRed^,PCurGreen^,PCurBlue^,PCurAlpha^);
318 inc(PCurBlue);
319 inc(PCurGreen);
320 inc(PCurRed);
321 end;
322 inc(PDest);
323 inc(PCurAlpha);
324 end;
325 end;
326 end else
327 begin
328 a := 255;
329 for y := 0 to h-1 do
330 for x := 0 to w-1 do
331 begin
332 if PCurAlpha <> nil then
333 begin
334 a := PCurAlpha^;
335 inc(PCurAlpha);
336 end;
337 if a = 0 then
338 begin
339 img.Colors[x,y] := colTransparent;
340 end else
341 begin
342 c.red := PCurRed^ + (PCurRed^ shl 8);
343 c.green := PCurGreen^ + (PCurGreen^ shl 8);
344 c.blue := PCurBlue^ + (PCurBlue^ shl 8);
345 c.alpha := a + (a shl 8);
346 Img.Colors[x,y] := c;
347 inc(PCurBlue);
348 inc(PCurGreen);
349 inc(PCurRed);
350 end;
351 end;
352 end;
353 end else
354 begin
355 if Img is TBGRACustomBitmap then
356 TBGRACustomBitmap(Img).FillTransparent else
357 begin
358 for y := 0 to h-1 do
359 for x := 0 to w-1 do
360 img.Colors[x,y] := colTransparent;
361 end;
362 end;
363 finally
364 If Assigned(PAlpha) then FreeMem(PAlpha);
365 if Assigned(PBlue) and (PBlue <> PGreen) and (PBlue <> PRed) then FreeMem(PBlue);
366 if Assigned(PGreen) and (PGreen <> PRed) then FreeMem(PGreen);
367 If Assigned(PRed) then FreeMem(PRed);
368 end;
369end;
370
371initialization
372
373 if DefaultBGRAImageReader[ifLazPaint] = nil then
374 DefaultBGRAImageReader[ifLazPaint] := TBGRAReaderLazPaint;
375
376end.
Note: See TracBrowser for help on using the repository browser.