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

Annotation of /trunk/pngwritetbitmap.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (hide annotations)
Thu Jan 29 23:10:29 2009 UTC (10 years, 7 months ago) by plugwash
File size: 2134 byte(s)
license header and line ending fixups

1 plugwash 1 {unit to write tbitmaps to a png using plugwashes png code}
2    
3 plugwash 2 { 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 plugwash 1 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.22