/[pngwrite]/trunk/pngwritetbitmap.pas
ViewVC logotype

Contents of /trunk/pngwritetbitmap.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (show annotations)
Thu Jan 29 23:10:29 2009 UTC (8 years, 10 months ago) by plugwash
File size: 2134 byte(s)
license header and line ending fixups
1 {unit to write tbitmaps to a png using plugwashes png code}
2
3 { Copyright (C) 2008 Peter Green
4 For conditions of distribution and use, see copyright notice in zlib_license.txt
5 which is included in the package
6 ----------------------------------------------------------------------------- }
7
8
9 unit pngwritetbitmap;
10
11 interface
12 uses
13 pngwrite,
14 sysutils,
15 classes,
16 {$ifdef win32}
17 windows,
18 {$endif}
19 {$ifndef fpc}
20
21 Graphics;
22
23 {$else}
24 pgtbitmap;
25 {$endif}
26
27 procedure savetbitmaptopng(image:tbitmap;destination : tstream);
28 implementation
29 procedure savetbitmaptopng(image:tbitmap;destination : tstream);
30 var
31 paletteentrieswin : array[0..255] of TPaletteEntry;
32 paletteentriespng : array[0..768] of byte;
33 f:tpngwrite;
34 i : integer;
35 colortype : tcolortype;
36 begin
37 if (image.PixelFormat <> pf8bit) and (image.pixelformat <> pf24bit) then raise exception.create('unsupported image format, only 8 bit and 24 bit per pixel are currently supported.');
38 if image.PixelFormat = pf24bit then begin
39 colortype := ctbgr;
40 end else begin
41 colortype := ctpallette;
42 end;
43 pngstart(f,destination,8,colortype,image.Height,image.Width);
44
45 if image.pixelformat = pf8bit then begin
46 GetPaletteEntries(image.Palette,0,256,paletteEntrieswin);
47
48 //writeln('about to start png write');
49 //writeln('about to prepare pallette');
50 for i := 0 to 255 do begin
51 paletteentriespng[(i*3) ] := paletteEntrieswin[i].pered;
52 paletteentriespng[(i*3)+1] := paletteEntrieswin[i].pegreen;
53 paletteentriespng[(i*3)+2] := paletteEntrieswin[i].peblue;
54 end;
55 //writeln('about to write pallette');
56 pngwritepal(f,@paletteentriespng,256 );
57 end;
58
59 pngstartdata(f);
60 {$O-}
61 for i := 0 to Image.Height -1 do begin;
62 //writeln('about to write scanline ',i,'image.height=',image.height,'image.ScanLine[i]',longint(image.ScanLine[i]));
63 pngwritescanline(f,image.ScanLine[i]);
64 end;
65 //writeln('about to close main data block');
66 pngfinishdata(f);
67 //writeln('about to close png');
68 pngfinish(f);
69
70 end;
71 end.

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.5