source: cprs/branches/tmg-cprs/TPNGGraphics/pngzlib.pas@ 1742

Last change on this file since 1742 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 5.1 KB
RevLine 
[453]1{Portable Network Graphics Delphi ZLIB linking (16 May 2002) }
2
3{This unit links ZLIB to pngimage unit in order to implement }
4{the library. It's now using the new ZLIB version, 1.1.4 }
5{Note: The .obj files must be located in the subdirectory \obj}
6
7unit pngzlib;
8
9interface
10
11type
12
13 TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer;
14 TFree = procedure (AppData, Block: Pointer);
15
16 // Internal structure. Ignore.
17 TZStreamRec = packed record
18 next_in: PChar; // next input byte
19 avail_in: Integer; // number of bytes available at next_in
20 total_in: Integer; // total nb of input bytes read so far
21
22 next_out: PChar; // next output byte should be put here
23 avail_out: Integer; // remaining free space at next_out
24 total_out: Integer; // total nb of bytes output so far
25
26 msg: PChar; // last error message, NULL if no error
27 internal: Pointer; // not visible by applications
28
29 zalloc: TAlloc; // used to allocate the internal state
30 zfree: TFree; // used to free the internal state
31 AppData: Pointer; // private data object passed to zalloc and zfree
32
33 data_type: Integer; // best guess about the data type: ascii or binary
34 adler: Integer; // adler32 value of the uncompressed data
35 reserved: Integer; // reserved for future use
36 end;
37
38function inflateInit_(var strm: TZStreamRec; version: PChar;
39 recsize: Integer): Integer; forward;
40function inflate(var strm: TZStreamRec; flush: Integer): Integer; forward;
41function inflateEnd(var strm: TZStreamRec): Integer; forward;
42function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
43 recsize: Integer): Integer; forward;
44function deflate(var strm: TZStreamRec; flush: Integer): Integer; forward;
45function deflateEnd(var strm: TZStreamRec): Integer; forward;
46
47const
48 zlib_version = '1.1.4';
49
50function adler32(adler: Integer; buf: PChar; len: Integer): Integer;
51
52
53const
54 Z_NO_FLUSH = 0;
55 Z_PARTIAL_FLUSH = 1;
56 Z_SYNC_FLUSH = 2;
57 Z_FULL_FLUSH = 3;
58 Z_FINISH = 4;
59
60 Z_OK = 0;
61 Z_STREAM_END = 1;
62 Z_NEED_DICT = 2;
63 Z_ERRNO = (-1);
64 Z_STREAM_ERROR = (-2);
65 Z_DATA_ERROR = (-3);
66 Z_MEM_ERROR = (-4);
67 Z_BUF_ERROR = (-5);
68 Z_VERSION_ERROR = (-6);
69
70 Z_NO_COMPRESSION = 0;
71 Z_BEST_SPEED = 1;
72 Z_BEST_COMPRESSION = 9;
73 Z_DEFAULT_COMPRESSION = (-1);
74
75 Z_FILTERED = 1;
76 Z_HUFFMAN_ONLY = 2;
77 Z_DEFAULT_STRATEGY = 0;
78
79 Z_BINARY = 0;
80 Z_ASCII = 1;
81 Z_UNKNOWN = 2;
82
83 Z_DEFLATED = 8;
84
85 _z_errmsg: array[0..9] of PChar = (
86 'need dictionary', // Z_NEED_DICT (2)
87 'stream end', // Z_STREAM_END (1)
88 '', // Z_OK (0)
89 'file error', // Z_ERRNO (-1)
90 'stream error', // Z_STREAM_ERROR (-2)
91 'data error', // Z_DATA_ERROR (-3)
92 'insufficient memory', // Z_MEM_ERROR (-4)
93 'buffer error', // Z_BUF_ERROR (-5)
94 'incompatible version', // Z_VERSION_ERROR (-6)
95 ''
96 );
97
98implementation
99
100{$L obj\deflate.obj}
101{$L obj\trees.obj}
102{$L obj\inflate.obj}
103{$L obj\inftrees.obj}
104{$L obj\adler32.obj}
105{$L obj\infblock.obj}
106{$L obj\infcodes.obj}
107{$L obj\infutil.obj}
108{$L obj\inffast.obj}
109
110procedure _tr_init; external;
111procedure _tr_tally; external;
112procedure _tr_flush_block; external;
113procedure _tr_align; external;
114procedure _tr_stored_block; external;
115function adler32; external;
116procedure inflate_blocks_new; external;
117procedure inflate_blocks; external;
118procedure inflate_blocks_reset; external;
119procedure inflate_blocks_free; external;
120procedure inflate_set_dictionary; external;
121procedure inflate_trees_bits; external;
122procedure inflate_trees_dynamic; external;
123procedure inflate_trees_fixed; external;
124procedure inflate_codes_new; external;
125procedure inflate_codes; external;
126procedure inflate_codes_free; external;
127procedure _inflate_mask; external;
128procedure inflate_flush; external;
129procedure inflate_fast; external;
130
131procedure _memset(P: Pointer; B: Byte; count: Integer);cdecl;
132begin
133 FillChar(P^, count, B);
134end;
135
136procedure _memcpy(dest, source: Pointer; count: Integer);cdecl;
137begin
138 Move(source^, dest^, count);
139end;
140
141
142// deflate compresses data
143function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
144 recsize: Integer): Integer; external;
145function deflate(var strm: TZStreamRec; flush: Integer): Integer; external;
146function deflateEnd(var strm: TZStreamRec): Integer; external;
147
148// inflate decompresses data
149function inflateInit_(var strm: TZStreamRec; version: PChar;
150 recsize: Integer): Integer; external;
151function inflate(var strm: TZStreamRec; flush: Integer): Integer; external;
152function inflateEnd(var strm: TZStreamRec): Integer; external;
153function inflateReset(var strm: TZStreamRec): Integer; external;
154
155
156function zcalloc(AppData: Pointer; Items, Size: Integer): Pointer;
157begin
158 GetMem(Result, Items*Size);
159end;
160
161procedure zcfree(AppData, Block: Pointer);
162begin
163 FreeMem(Block);
164end;
165
166end.
167
168
169
Note: See TracBrowser for help on using the repository browser.