pngwrite/trunk/pngwrite.pas

{pngwrite.pas}
{plugwashes png write code}

{ Copyright (C) 2005 Bas Steendijk and Peter Green
  For conditions of distribution and use, see copyright notice in zlib_license.txt
    which is included in the package
      ----------------------------------------------------------------------------- }

unit pngwrite;

interface
uses
  zlib,zdeflate,zutil,classes,sysutils,pgtypes,
  {$ifdef win32}
    winsock;
  {$else}
    sockets;
  {$endif}
{$i uint32.inc}

type

  tcolortype=(ctgreyscale,ctpallette,ctbgr,ctrgb,ct8bp);

// There are two types of color types
//
// native types result in direct output of the apps data to the png file
// theese are
// ctgreyscale : grey scale data all png supported depths should work
// ctpallette : palletted data all png supported depths should work
// ctrgb : currently 24 bit only
//
// Processed types are processed before data is output to the png file
// ctbgr : truecolor data in bgr order usefull with tbitmap.
// ct8bp : data from app is 8 bits per sample palletted but data is saved as
//         a lower depth palletted format (the app MUST only use the first
//         2^bitdepth pallette entries

  tpngwrite=record
    destination : tstream;
    lines : integer;
    cols : integer;
    deflatestream : z_stream;
    chunkstart : integer; //used to fill in chunk length later
    chunkbytes : integer;
    chunkcrc   : uint32;
    crc_table : array[byte] of uint32;
    colortype:tcolortype;
    colordepth        : byte;
    bufferingchunkdata : boolean;
    bufferedchunkdata : tstringlist;
  end;

procedure pngstart(var f : tpngwrite;destination : tstream;colordepth : integer;colortype:tcolortype;lines : integer;cols : integer);
procedure pngwritescanline(var f : tpngwrite;scanline: pointer);


procedure pngwritepal(var f : tpngwrite;p:pointer;entrys : integer);
procedure pngstartdata(var f : tpngwrite);
procedure pngfinishdata(var f : tpngwrite);
procedure pngfinish(var f : tpngwrite);


implementation


procedure make_crc_table(var f:tpngwrite);
var
  c: uint32;
  n,k : integer;
begin
  with f do begin

//        unsigned long c;
//        int n, k;
//        for (n = 0; n < 256; n++)
    for n := 0 to 255 do begin
//          c = (unsigned long) n;
      c := n;
//          for (k = 0; k < 8; k++)
      for k := 0 to 7 do begin
//            if (c & 1)
        if (c and 1) <> 0 then begin
//              c = 0xedb88320L ^ (c >> 1);
          c := $edb88320 xor (c shr 1);
//            else
        end else begin
//              c = c >> 1;
          c := c shr 1;
//
        end;
      end;
//          crc_table[n] = c;
      crc_table[n] := c;
//
    end;
//        crc_table_computed = 1;
  end;
end;
(*
   unsigned long update_crc(unsigned long crc, unsigned char *buf,
                               int len)
      {
        unsigned long c = crc;
        int n;

        if (!crc_table_computed)
          make_crc_table();
        for (n = 0; n < len; n++) {
          c = crc_table[(c ^ buf[n]) & 0xff] ^ (c >> 8);
        }
        return c;
      }
*)
procedure update_crc(var f : tpngwrite;buf : string);

var
  n : integer;
begin
  with f do begin
    for n := 1 to length(buf) do begin
      chunkcrc := crc_table[(chunkcrc xor byte(buf[n])) and $ff] xor (chunkcrc shr 8);
    end;
  end;
end;

procedure writetochunk(var f : tpngwrite;buf : string);
begin
  if length(buf)=0 then raise exception.create('attempt to write zero length block to chunk');
  
  with f do begin
    if bufferingchunkdata then begin
      bufferedchunkdata.Add(buf);
    end else begin
      destination.Write(buf[1],length(buf));
    end;
    update_crc(f,buf);
    inc(chunkbytes,length(buf));
  end;
end;


procedure startchunk(var f : tpngwrite;chunktype : string);
var
  outputdata : string;
begin
  with f do begin
    try
      chunkstart := destination.Position;
      // 4 btye dummy for length we will insert this later.
      outputdata := '    ';
      destination.WriteBuffer(pchar(outputdata)^,4);
    except
      bufferingchunkdata := true;
      bufferedchunkdata := tstringlist.create;
    end;
    chunkbytes := -4;
    chunkcrc := $FFFFFFFF;

    writetochunk(f,chunktype);


  end;
end;


procedure stopchunk(var f:tpngwrite);
var
  currentpos : integer;
  i : integer;
begin
  with f do begin
    if not bufferingchunkdata then begin

      currentpos := destination.Position;
      destination.position := chunkstart;
    end;
    chunkbytes := htonl(chunkbytes);
    destination.WriteBuffer(chunkbytes,4);
    if bufferingchunkdata then begin
//      writeln('begin write of buffered chunk data');
      for i := 0 to bufferedchunkdata.Count-1 do begin
        destination.Write(bufferedchunkdata[i][1],length(bufferedchunkdata[i]));
      end;
      bufferedchunkdata.Free;
//      writeln('end write of buffered chunk data');
    end else begin
      destination.position := currentpos;
    end;
    chunkcrc := htonl(chunkcrc)     ;
    chunkcrc := chunkcrc xor $FFFFFFFF;
    destination.WriteBuffer(chunkcrc,4);

  end;
end;

type
  tihdr=packed record
    width             : uint32;
    height            : uint32;
    Bitdepth          : byte;
    Colortype         : byte;
    Compressionmethod : byte;
    Filtermethod      : byte;
    Interlacemethod   : byte;
  end;
  pihdr=^tihdr;
procedure pngstart(var f : tpngwrite;destination : tstream;colordepth : integer;colortype:tcolortype;lines : integer;cols : integer);
var
  tempstring : string;
  ihdr : pihdr;
begin
  fillchar(f,sizeof(f),#0);
  f.destination := destination;
  f.lines := lines;
  f.cols := cols;
  f.colortype := colortype;
  f.colordepth := colordepth;
  make_crc_table(f);
  with f do begin
    //file header
    destination.Write(pchar(#137'PNG'#13#10#26#10)^,8);

    startchunk(f,'IHDR');
    setlength(tempstring,sizeof(tihdr));
    ihdr := pihdr(tempstring);
    ihdr.width := htonl(cols);
    ihdr.height := htonl(lines);
    case colortype of
      ctgreyscale : begin
        ihdr.Bitdepth := colordepth;
        ihdr.Colortype := 0;
      end;
      ctpallette,ct8bp : begin
        ihdr.Bitdepth := colordepth;
        ihdr.Colortype := 3;
      end;

      ctrgb,ctbgr : begin
        ihdr.Bitdepth := 8;
        ihdr.Colortype := 2;
      end;
    end;

    ihdr.Compressionmethod := 0;
    ihdr.Filtermethod := 0;
    ihdr.Interlacemethod := 0;
    writetochunk(f,tempstring);
    stopchunk(f);

  end;
end;

procedure pngwritepal(var f : tpngwrite;p:pointer;entrys : integer);
var
  tempstring : string;
begin
  with f do begin
    startchunk(f,'PLTE');
    setlength(tempstring,entrys*3);
    move(p^,tempstring[1],entrys*3);
    writetochunk(f,tempstring);
    stopchunk(f);
  end;
end;

procedure pngstartdata(var f : tpngwrite);
begin
  with f do begin
    startchunk(f,'IDAT');
    deflateInit(deflatestream,9);
    //writeln('test');

  end;
end;


type
  tlinedata = array[0..0] of byte;
  plinedata = ^tlinedata;
function divup(a,b:integer):integer;
begin
  result := (a div b)+ord((a mod b)<>0);
end;


procedure pngwritescanline(var f : tpngwrite;scanline: pointer);
var
  outputstr : string;
  nullchar : char;
  scanlineb : plinedata absolute scanline;
  rearrangebuf : plinedata;
  counter : integer;
  pixelsperbyte : integer;
  samplevalue : byte;
begin
  with f do begin
    //writeln('about to write starter byte');
    if cols > 127 then begin
      setlength(outputstr,cols*6);
    end else begin
      setlength(outputstr,768);
    end;
    deflatestream.next_out := pbytef(outputstr);
    deflatestream.avail_out := length(outputstr);
//    writeln(deflatestream.avail_out,' ',deflatestream.avail_in);
    nullchar := #0;
    deflatestream.next_in := @nullchar;
    deflatestream.avail_in :=1;
    //writeln('about to start deflation');
    deflate(deflatestream,0);
    //writeln('deflation complete deflatestream.avail_out=',deflatestream.avail_out);
//    writeln(deflatestream.avail_out,' ',deflatestream.avail_in);
    while deflatestream.avail_out = 0 do begin
      deflatestream.next_out := pbytef(taddrint(deflatestream.next_out) - taddrint(outputstr));
      deflatestream.avail_out := length(outputstr);
      setlength(outputstr,length(outputstr)*2);
      deflatestream.next_out := pbytef(taddrint(deflatestream.next_out) + taddrint(outputstr));
      deflate(deflatestream,0);
    end;
    //writeln('extra deflation done');
    if deflatestream.avail_in <> 0 then raise exception.create('compression problem');
    //writeln('about to write main data');
    case colortype of

      ctbgr : begin
        getmem(rearrangebuf,cols*3);

        for counter := 0 to cols-1 do begin
          rearrangebuf[(counter*3)  ] := scanlineb[(counter*3)+2];
          rearrangebuf[(counter*3)+1] := scanlineb[(counter*3)+1];
          rearrangebuf[(counter*3)+2] := scanlineb[(counter*3)  ];
        end;
        deflatestream.next_in := pointer(rearrangebuf);
        deflatestream.avail_in := cols*3;
        deflate(deflatestream,0);
        if deflatestream.avail_in <> 0 then raise exception.create('compression problem');
        freemem(rearrangebuf);

      end;
      ct8bp : begin
        rearrangebuf := allocmem(divup(cols* colordepth,  8));
        pixelsperbyte := 8 div colordepth;
        for counter := 0 to cols-1 do begin
          //shift sample value into most significant bits (which has the nice side effect of removing any garbage bits)
          samplevalue := scanlineb[counter] shl (8-colordepth);
          //shift sample value into correct place for pixel in question.
          samplevalue := samplevalue shr ((counter mod pixelsperbyte)*colordepth);
          rearrangebuf[counter div pixelsperbyte] := rearrangebuf[counter div pixelsperbyte] or samplevalue;
        end;
        deflatestream.next_in := pointer(rearrangebuf);
        deflatestream.avail_in := divup(cols* colordepth,  8);
        deflate(deflatestream,0);
        if deflatestream.avail_in <> 0 then raise exception.create('compression problem');
        freemem(rearrangebuf);
      end;

      else begin
        deflatestream.next_in := scanline;

        deflatestream.avail_in := divup(cols* colordepth,  8);

        deflate(deflatestream,0);
        while deflatestream.avail_out = 0 do begin
          deflatestream.next_out := pbytef(taddrint(deflatestream.next_out) - taddrint(outputstr));
          deflatestream.avail_out := length(outputstr);
          setlength(outputstr,length(outputstr)*2);
          deflatestream.next_out := pbytef(taddrint(deflatestream.next_out) + taddrint(outputstr));
          deflate(deflatestream,0);
        end;
        if deflatestream.avail_in <> 0 then raise exception.create('compression problem');
      end;
    end;

    setlength(outputstr,length(outputstr)-deflatestream.avail_out);
    //deflate doesn't always produce output when its given input, if this is the case no point pushing it any further
    if length(outputstr) > 0 then writetochunk(f,outputstr);
//    writeln;
  end;
end;

procedure pngfinishdata(var f : tpngwrite);
var
  outputstr : string;
  deflateresult : integer;
begin
  with f do begin
    repeat
      setlength(outputstr,512);
      deflatestream.next_out := pbytef(outputstr);
      deflatestream.avail_out := length(outputstr);
      deflateresult := deflate(deflatestream,Z_FINISH);
      setlength(outputstr,length(outputstr)-deflatestream.avail_out);
      writetochunk(f,outputstr);

    until deflateresult=Z_STREAM_END;
    deflateEnd(deflatestream);
    stopchunk(f);

  end;
end;


procedure pngfinish(var f : tpngwrite);

begin
  with f do begin
    //setlength(outputstr,512);
    startchunk(f,'IEND');

    stopchunk(f);
  end;

end;


end.
1	plugwash	1	{pngwrite.pas}
2			{plugwashes png write code}
3
4			{ Copyright (C) 2005 Bas Steendijk and Peter Green
5			For conditions of distribution and use, see copyright notice in zlib_license.txt
6			which is included in the package
7			----------------------------------------------------------------------------- }
8
9			unit pngwrite;
10
11			interface
12			uses
13			zlib,zdeflate,zutil,classes,sysutils,pgtypes,
14			{$ifdef win32}
15			winsock;
16			{$else}
17			sockets;
18			{$endif}
19			{$i uint32.inc}
20
21			type
22
23			tcolortype=(ctgreyscale,ctpallette,ctbgr,ctrgb,ct8bp);
24
25			// There are two types of color types
26			//
27			// native types result in direct output of the apps data to the png file
28			// theese are
29			// ctgreyscale : grey scale data all png supported depths should work
30			// ctpallette : palletted data all png supported depths should work
31			// ctrgb : currently 24 bit only
32			//
33			// Processed types are processed before data is output to the png file
34			// ctbgr : truecolor data in bgr order usefull with tbitmap.
35			// ct8bp : data from app is 8 bits per sample palletted but data is saved as
36			// a lower depth palletted format (the app MUST only use the first
37			// 2^bitdepth pallette entries
38
39			tpngwrite=record
40			destination : tstream;
41			lines : integer;
42			cols : integer;
43			deflatestream : z_stream;
44			chunkstart : integer; //used to fill in chunk length later
45			chunkbytes : integer;
46			chunkcrc : uint32;
47			crc_table : array[byte] of uint32;
48			colortype:tcolortype;
49			colordepth : byte;
50			bufferingchunkdata : boolean;
51			bufferedchunkdata : tstringlist;
52			end;
53
54			procedure pngstart(var f : tpngwrite;destination : tstream;colordepth : integer;colortype:tcolortype;lines : integer;cols : integer);
55			procedure pngwritescanline(var f : tpngwrite;scanline: pointer);
56
57
58			procedure pngwritepal(var f : tpngwrite;p:pointer;entrys : integer);
59			procedure pngstartdata(var f : tpngwrite);
60			procedure pngfinishdata(var f : tpngwrite);
61			procedure pngfinish(var f : tpngwrite);
62
63
64
65			implementation
66
67
68			procedure make_crc_table(var f:tpngwrite);
69			var
70			c: uint32;
71			n,k : integer;
72			begin
73			with f do begin
74
75			// unsigned long c;
76			// int n, k;
77			// for (n = 0; n < 256; n++)
78			for n := 0 to 255 do begin
79			// c = (unsigned long) n;
80			c := n;
81			// for (k = 0; k < 8; k++)
82			for k := 0 to 7 do begin
83			// if (c & 1)
84			if (c and 1) <> 0 then begin
85			// c = 0xedb88320L ^ (c >> 1);
86			c := $edb88320 xor (c shr 1);
87			// else
88			end else begin
89			// c = c >> 1;
90			c := c shr 1;
91			//
92			end;
93			end;
94			// crc_table[n] = c;
95			crc_table[n] := c;
96			//
97			end;
98			// crc_table_computed = 1;
99			end;
100			end;
101			(*
102			unsigned long update_crc(unsigned long crc, unsigned char *buf,
103			int len)
104			{
105			unsigned long c = crc;
106			int n;
107
108			if (!crc_table_computed)
109			make_crc_table();
110			for (n = 0; n < len; n++) {
111			c = crc_table[(c ^ buf[n]) & 0xff] ^ (c >> 8);
112			}
113			return c;
114			}
115			*)
116			procedure update_crc(var f : tpngwrite;buf : string);
117
118			var
119			n : integer;
120			begin
121			with f do begin
122			for n := 1 to length(buf) do begin
123			chunkcrc := crc_table[(chunkcrc xor byte(buf[n])) and $ff] xor (chunkcrc shr 8);
124			end;
125			end;
126			end;
127
128			procedure writetochunk(var f : tpngwrite;buf : string);
129			begin
130			if length(buf)=0 then raise exception.create('attempt to write zero length block to chunk');
131
132			with f do begin
133			if bufferingchunkdata then begin
134			bufferedchunkdata.Add(buf);
135			end else begin
136			destination.Write(buf[1],length(buf));
137			end;
138			update_crc(f,buf);
139			inc(chunkbytes,length(buf));
140			end;
141			end;
142
143
144			procedure startchunk(var f : tpngwrite;chunktype : string);
145			var
146			outputdata : string;
147			begin
148			with f do begin
149			try
150			chunkstart := destination.Position;
151			// 4 btye dummy for length we will insert this later.
152			outputdata := ' ';
153			destination.WriteBuffer(pchar(outputdata)^,4);
154			except
155			bufferingchunkdata := true;
156			bufferedchunkdata := tstringlist.create;
157			end;
158			chunkbytes := -4;
159			chunkcrc := $FFFFFFFF;
160
161			writetochunk(f,chunktype);
162
163
164			end;
165			end;
166
167
168
169
170			procedure stopchunk(var f:tpngwrite);
171			var
172			currentpos : integer;
173			i : integer;
174			begin
175			with f do begin
176			if not bufferingchunkdata then begin
177
178			currentpos := destination.Position;
179			destination.position := chunkstart;
180			end;
181			chunkbytes := htonl(chunkbytes);
182			destination.WriteBuffer(chunkbytes,4);
183			if bufferingchunkdata then begin
184			// writeln('begin write of buffered chunk data');
185			for i := 0 to bufferedchunkdata.Count-1 do begin
186			destination.Write(bufferedchunkdata[i][1],length(bufferedchunkdata[i]));
187			end;
188			bufferedchunkdata.Free;
189			// writeln('end write of buffered chunk data');
190			end else begin
191			destination.position := currentpos;
192			end;
193			chunkcrc := htonl(chunkcrc) ;
194			chunkcrc := chunkcrc xor $FFFFFFFF;
195			destination.WriteBuffer(chunkcrc,4);
196
197			end;
198			end;
199
200			type
201			tihdr=packed record
202			width : uint32;
203			height : uint32;
204			Bitdepth : byte;
205			Colortype : byte;
206			Compressionmethod : byte;
207			Filtermethod : byte;
208			Interlacemethod : byte;
209			end;
210			pihdr=^tihdr;
211			procedure pngstart(var f : tpngwrite;destination : tstream;colordepth : integer;colortype:tcolortype;lines : integer;cols : integer);
212			var
213			tempstring : string;
214			ihdr : pihdr;
215			begin
216			fillchar(f,sizeof(f),#0);
217			f.destination := destination;
218			f.lines := lines;
219			f.cols := cols;
220			f.colortype := colortype;
221			f.colordepth := colordepth;
222			make_crc_table(f);
223			with f do begin
224			//file header
225			destination.Write(pchar(#137'PNG'#13#10#26#10)^,8);
226
227			startchunk(f,'IHDR');
228			setlength(tempstring,sizeof(tihdr));
229			ihdr := pihdr(tempstring);
230			ihdr.width := htonl(cols);
231			ihdr.height := htonl(lines);
232			case colortype of
233			ctgreyscale : begin
234			ihdr.Bitdepth := colordepth;
235			ihdr.Colortype := 0;
236			end;
237			ctpallette,ct8bp : begin
238			ihdr.Bitdepth := colordepth;
239			ihdr.Colortype := 3;
240			end;
241
242			ctrgb,ctbgr : begin
243			ihdr.Bitdepth := 8;
244			ihdr.Colortype := 2;
245			end;
246			end;
247
248			ihdr.Compressionmethod := 0;
249			ihdr.Filtermethod := 0;
250			ihdr.Interlacemethod := 0;
251			writetochunk(f,tempstring);
252			stopchunk(f);
253
254			end;
255			end;
256
257			procedure pngwritepal(var f : tpngwrite;p:pointer;entrys : integer);
258			var
259			tempstring : string;
260			begin
261			with f do begin
262			startchunk(f,'PLTE');
263			setlength(tempstring,entrys*3);
264			move(p^,tempstring[1],entrys*3);
265			writetochunk(f,tempstring);
266			stopchunk(f);
267			end;
268			end;
269
270			procedure pngstartdata(var f : tpngwrite);
271			begin
272			with f do begin
273			startchunk(f,'IDAT');
274			deflateInit(deflatestream,9);
275			//writeln('test');
276
277			end;
278			end;
279
280
281
282			type
283			tlinedata = array[0..0] of byte;
284			plinedata = ^tlinedata;
285			function divup(a,b:integer):integer;
286			begin
287			result := (a div b)+ord((a mod b)<>0);
288			end;
289
290
291			procedure pngwritescanline(var f : tpngwrite;scanline: pointer);
292			var
293			outputstr : string;
294			nullchar : char;
295			scanlineb : plinedata absolute scanline;
296			rearrangebuf : plinedata;
297			counter : integer;
298			pixelsperbyte : integer;
299			samplevalue : byte;
300			begin
301			with f do begin
302			//writeln('about to write starter byte');
303			if cols > 127 then begin
304			setlength(outputstr,cols*6);
305			end else begin
306			setlength(outputstr,768);
307			end;
308			deflatestream.next_out := pbytef(outputstr);
309			deflatestream.avail_out := length(outputstr);
310			// writeln(deflatestream.avail_out,' ',deflatestream.avail_in);
311			nullchar := #0;
312			deflatestream.next_in := @nullchar;
313			deflatestream.avail_in :=1;
314			//writeln('about to start deflation');
315			deflate(deflatestream,0);
316			//writeln('deflation complete deflatestream.avail_out=',deflatestream.avail_out);
317			// writeln(deflatestream.avail_out,' ',deflatestream.avail_in);
318			while deflatestream.avail_out = 0 do begin
319			deflatestream.next_out := pbytef(taddrint(deflatestream.next_out) - taddrint(outputstr));
320			deflatestream.avail_out := length(outputstr);
321			setlength(outputstr,length(outputstr)*2);
322			deflatestream.next_out := pbytef(taddrint(deflatestream.next_out) + taddrint(outputstr));
323			deflate(deflatestream,0);
324			end;
325			//writeln('extra deflation done');
326			if deflatestream.avail_in <> 0 then raise exception.create('compression problem');
327			//writeln('about to write main data');
328			case colortype of
329
330			ctbgr : begin
331			getmem(rearrangebuf,cols*3);
332
333			for counter := 0 to cols-1 do begin
334			rearrangebuf[(counter3) ] := scanlineb[(counter3)+2];
335			rearrangebuf[(counter3)+1] := scanlineb[(counter3)+1];
336			rearrangebuf[(counter3)+2] := scanlineb[(counter3) ];
337			end;
338			deflatestream.next_in := pointer(rearrangebuf);
339			deflatestream.avail_in := cols*3;
340			deflate(deflatestream,0);
341			if deflatestream.avail_in <> 0 then raise exception.create('compression problem');
342			freemem(rearrangebuf);
343
344			end;
345			ct8bp : begin
346			rearrangebuf := allocmem(divup(cols* colordepth, 8));
347			pixelsperbyte := 8 div colordepth;
348			for counter := 0 to cols-1 do begin
349			//shift sample value into most significant bits (which has the nice side effect of removing any garbage bits)
350			samplevalue := scanlineb[counter] shl (8-colordepth);
351			//shift sample value into correct place for pixel in question.
352			samplevalue := samplevalue shr ((counter mod pixelsperbyte)*colordepth);
353			rearrangebuf[counter div pixelsperbyte] := rearrangebuf[counter div pixelsperbyte] or samplevalue;
354			end;
355			deflatestream.next_in := pointer(rearrangebuf);
356			deflatestream.avail_in := divup(cols* colordepth, 8);
357			deflate(deflatestream,0);
358			if deflatestream.avail_in <> 0 then raise exception.create('compression problem');
359			freemem(rearrangebuf);
360			end;
361
362			else begin
363			deflatestream.next_in := scanline;
364
365			deflatestream.avail_in := divup(cols* colordepth, 8);
366
367			deflate(deflatestream,0);
368			while deflatestream.avail_out = 0 do begin
369			deflatestream.next_out := pbytef(taddrint(deflatestream.next_out) - taddrint(outputstr));
370			deflatestream.avail_out := length(outputstr);
371			setlength(outputstr,length(outputstr)*2);
372			deflatestream.next_out := pbytef(taddrint(deflatestream.next_out) + taddrint(outputstr));
373			deflate(deflatestream,0);
374			end;
375			if deflatestream.avail_in <> 0 then raise exception.create('compression problem');
376			end;
377			end;
378
379			setlength(outputstr,length(outputstr)-deflatestream.avail_out);
380			//deflate doesn't always produce output when its given input, if this is the case no point pushing it any further
381			if length(outputstr) > 0 then writetochunk(f,outputstr);
382			// writeln;
383			end;
384			end;
385
386			procedure pngfinishdata(var f : tpngwrite);
387			var
388			outputstr : string;
389			deflateresult : integer;
390			begin
391			with f do begin
392			repeat
393			setlength(outputstr,512);
394			deflatestream.next_out := pbytef(outputstr);
395			deflatestream.avail_out := length(outputstr);
396			deflateresult := deflate(deflatestream,Z_FINISH);
397			setlength(outputstr,length(outputstr)-deflatestream.avail_out);
398			writetochunk(f,outputstr);
399
400			until deflateresult=Z_STREAM_END;
401			deflateEnd(deflatestream);
402			stopchunk(f);
403
404			end;
405			end;
406
407
408			procedure pngfinish(var f : tpngwrite);
409
410			begin
411			with f do begin
412			//setlength(outputstr,512);
413			startchunk(f,'IEND');
414
415			stopchunk(f);
416			end;
417
418			end;
419
420
421
422
423			end.
No admin address has been configured">No admin address has been configured	ViewVC Help
Powered by ViewVC 1.1.26