ZLIB Compressed Bitmaps

Problem/Question/Abstract:

Delphi provides native support for Windows Bitmaps and JPEG (since Delphi 3). While Windows Bitmaps are so big due to its old fashioned RLE compression schema, JPEG's are a small but lousy (you loose quality) option. Using ZLIB Bmp you still get the goods of the Bitmap format without the odds, and still save space and reduce the overall size of your Delphi executables noticeably.

Answer:

Introduction

In this article we will discuss (and implement) the use of powerful data compression algorithms and filters to store bitmap images on Delphi form files. The simplicity of the implementation will certainly shake you with surprise and I hope it will open the doors for other possibilities (data encryption, etc.). You'll find numerous techniques inside this article that will prove useful in many situations. There's a thing for everyone here (not only graphics people).

This article will develop around the following subjects:

ZLIB compression with Delphi (using T(De)CompressionStream)
Image filtering (same algorithms used in the PNG format)
Delphi streaming system and capabilities
Extending Delphi graphics capabilities (new file formats)
Advanced use of the TBitmap class


Overview

Delphi uses the TBitmap class to handle Windows Bitmap files (hereafter called bitmaps). This class encapsulates all the steps necessary to read a bitmap from a file or stream, display it onscreen, manipulate its contents, manage its palette, etc.

The TBitmap class, which inherits from TGraphic, overrides two inherited methods used for streaming to and from a form file: ReadData and WriteData. Every TGraphic descendant must provide its own implementation for these methods or an "Abstract Error" exception will be raised whenever Delphi tries to write or read the image data.

The TBitmap implementation of ReadData and WriteData calls the ReadStream and WriteStream private methods to do the actual reading and writing process respectively. These methods are also used by SaveToStream and LoadFromStream (public methods), so application developers can use them to read/write a bitmap file.

When called from within WriteData, the WriteStream method writes the size of the bitmap just before the data itself, so ReadData can retrieve this value and know how many bytes to read from the form file later. When called from SaveToStream, the WriteStream method writes the bitmap data to the stream with no additional information.

Windows bitmaps are at best RLE compressed, which is a very poor compression method. Your Delphi form files are going to get very big as more and more bitmaps are used in the design of your application interface. What we are going to do is to create a TBitmap derived class reimplementing the WriteData and ReadData methods so the data will be compressed when writting to the form file and decompressed when reading from it. This way you could still use bitmaps when creating the graphics for your forms not bothering to convert them to JPG (wich will loose quality, or GIF, whose support is not native to delphi, or other non-native format). Your bitmaps will be compressed before saved to the form file automaticly.

We'll use the ZLIB's deflate method for compression, since it offers very good compression rates at reasonable speed, its free and its already integrated with Delphi (ZLIB.PAS provides the TCompressionStream and TDecompressionStream classes we will be using here).

This new class will be called TZLIBBitmap, and its full implementation can be found later on this article.

To achieve better compression rates we'll use image filters. These filters are be the same filters used in the famous PNG file format, and will provide to our simple class compression rates comparable to those attained by this format.

We will also provide a method to save the data to any stream or file, so the application developer will have the option to write it to storage mediums other than the Delphi form file. We'll standardize the file extension for this format as ".ZBM" (Zlib compressed BitMap), and will register this file format within Delphi so you can use it at design time.

The stream created with this class can be easily identified and the class itself will be able to handle ordinary bitmap streams also.

ZLIB Compression

ZLIB is a free C library created by the folks who created the PNG file format. It implements the Deflate compression method which was popularized in the ZIP (PKWare products and many others). Borland made it easy for us to use the ZLIB library by creating the ZLIB.PAS unit, which links to the compiled OBJ files of the ZLIB Library. You'll find procedures to compress and decompress data, and also some specialized classes to do compression and decompression for you:

TCompressionStream: which compresses data to another stream while data is written to it
TDecompressionStream: which decompresses data from another stream when data is read from it

The use of these classes will be self-explaining in the code: we'll use TDecompressionStream in the ReadData method, and TCompressionStream in the WriteData method

Filtering

You should have noticed already that "zipping" a true-color bitmap isn't as good as converting it to PNG (or other compressed image format). This happens because you are using a compression program which isn't aware of what it is compressing. When we know what we're compressing, we can try to find better methods to compress the data. If changing the compression method isn't possible (which is our case because the ZLIB Bmp will use Deflate all the time) we should start to think in ways to change an otherwise low-compressive stream into a highly-compressive one. We can do that be means of filter algorithms which takes into account the nature of the data (Text files, for example, can be filtered taking into account that there is some repetitive aspects in every written language). Of course, the filter has to be reversible, or it will be impossible to extract the original data from the compressed stream!

In the case of images, we take into account that the pixels in pictures have surrounding pixels which are very near to each other in terms of color (Red, Green and Blue components). The compression of images is done on a row by row basis, and, if you didn't take into account the surrounding pixels we would not compress the image vertically (this happens to the GIF format!). That means that if you get an image 256 pixels wide and 256 pixels tall, and each collumn of pixels is one gray level above the previous with the first pixel being black (RGB=0), this picture  will not compress much if we didn't apply a filter to it. This picture in question is a very good example:

     pixels   0  1  2  3    ...   255
row 0        00 01 02 03 .. .. .. FF
row 1        00 01 02 03 .. .. .. FF
...
row 255      00 01 02 03 .. .. .. FF

The data of each row is the same, but each pixel in the row is different from the other. Compression algorithms use repetitive patterns of data to compress it, finding these patterns is the key to better compression (deflate is very good in that, while the old shrink method of pkzip is not as good). In the above example, there isn't any pattern in each row alone. Since the compression is done in each row independently it makes every row a very low-compressive (or even non-compressive) data stream.

But think a little! Every pixel in this example is exactly the previous plus one! If we stored only the difference beetween pixels (which is 1 in this example) we would create an ultra-highly-compressive stream. By applying the reverse of the algorithm we would be able to reconstruct the original data! Example:

Row 1 is made of the pixels 00 01 02 .. FF, storing the first pixel, and then storing the next by subtracting its value from the previous original value we will end up with a stream like: 00 01 01 01 .. 01, wich can be compressed to two or three bytes!!! The first byte is 0 (just store the first one), the second is 01 - 00 (previous) which gives 1. The fourth byte is 03 - 02 (third byte original value) which gives 1. Thats how we get to that filtered stream. To retrieve the original data we simply do the opposite: get the first byte (00), store it. Get the seconde filtered byte (01) and sum with the unfiltered previous (00) to get 01 (see the original stream data, it matches!), store it. Get the third compressed byte (01) and sum with the unfiltered previous (01) to get 02, store it... Get the tenth filtered byte (01) and the previous unfiltered one (08), sum them to get 09. Store it. Do that untill the 256th filtered byte (01) and sum with the unfiltered 255th (254) to get 255. Store it. Now you retrieved the original stream.

The filters used in this class are the same filters created by the creators of the PNG format (why in hell will you reinvent the wheel?). They work very well. There are four filter types: Sub, Up, Average, Paeth and None. Sub is the one we've been talking about before. Up is the same but stores the difference from the pixel with the pixel in the previous row (in our case it wouldn't make any difference). Average stores the arithmetic average of the sum of the pixel with its predecessor, and Paeth stores the average with the predecessor in the same row or the pixel just above or the previous from this pixel (up/left), whichever is near (in terms of colors). This filters are better explained in the png documentation. If you want to read it just point to the PNG home-page: http://www.libpng.org/pub/png/png.html and download it! By reading it and taking a look at the source here (in Pascal, which is better than C :-)

However there's a slight difference from the png filters and the ZBM filters. In the png file you can use a different filter for every row, in the ZBM, once a filter is selected it must be applied to all the rows in the image. This is mainly for simplicity, an the gain of addaptive filtering is not that big (but is noticeable!)

File Signature

When reading from a stream it is necessary to recognize right form the start if this is a valid ZLib stream. By means of a well chosen signature we can easily tell if a file is or not a ZLIB bitmap (without having to see it signature). In our case we have another use for it: since the ZLIB bmp will read the file from the form stream, and it will handle both ordinary bitmaps and ZBM bitmaps it is necessary to separate one from another. The signature test will do that: if we fail to read it we will read the stream as if it were a ordinary bitmap. That simple!

The signature choses is 6 bytes long and the rationales for the bytes are pretty much the same for the png signature (which I really liked).

The ZBM signature is: #213'ZMB'#13#10#26#10 (pascal string)

The character #213 was chosen to catch transmission errors from protocols which clears the 7th bit.
'ZBM' identifies the stream in a visual way.
The #13#10 is used to catch transmission errors from protocols who changes CRLF into CR or LF alone (unix/MAC text file style)
The #26 character tells MS-DOS to stop listing the file if you did a Type (DOS command) on it.
The last #10 character is used to catch transmission erros from protocols with expands individual LF's int CR/LF (MS-DOS text file style)

Streaming To Form Files (and etc.)

We will play with the LoadFromStream and SaveToStream, so we'll be able to read both windows bitmaps and ZLIB bitmaps from any file or stream. We will aso override the WriteData and ReadData method to be able to stream this highly-compressed data to a Delphi form file and to retrieve it accordingly later. If we didn't used filters this class would be that simple: only four overriden methods and we're done. But filtering is very very important. Without filter a 2.8 MB photo from Saturn will compress to 1.5MB. If we use a filter it will compress to 420 KB. This improvement is so big that I couldn't avoid the additional complexity added. The gains are worth the toll!!!

Additional Information

Many techniques used here (Scanline access, bitmap structure and information, etc.) aren't explained above. If you want more information you could read my other articles about these subjects:

Optimized Bitmap to Region (HRGN) Conversion - # 944
BitmapToRegion (Delphi-like version - very fast) (UPDATE: Bug fix!) - # 1009
Graying Bitmaps and Graphics - # 1465

I'm preparing an article about the TGraphic (something like TGraphic Unleashed!). And I plan to discuss every aspect of working with it and extending its functionallities (adding new file formats, creating effects, etc.). After that I will post a pascal PNG Implementation of my own and a TGA TGraphic descendant to show the use of TGraphic in Delphi. Stay tuned.

Using and Installing the ZLIB Bitmap

Just add this unit to one of your packages and add zLibBmp to the uses clause of the form you'll be using ZLib Bitmaps.

I didn't post any sample code here but I will upload a sample project soon. Just waits.

I hope you liked this article. See you soon.

Code starts here

unit zlibBmp;

{ ----------------------------------------------------------------------------
    TZLIBBitmap
    ---
    The TZLIBBitmap is a replacement for Delphi's TBitmap. It implements a
    powerful data compression schema using filters and zlib's deflate
    method to achieve compression rates as good as those attained by converting
    your bitmaps to PNG image format. Only data streamed down to the DFM
    file gets compressed (i.e.: SaveToStream/File saves an ordinary Windows
    Bitmap). That makes the use of ZLIBBitmap completely transparent to the
    application, to the developer and to Delphi IDE.

    TZLIBBitmap can read .BMP files since it is actually a TBitmap and can also
    handle ZLib Compressed Bitmaps (see SaveMethod bellow). The default
    extension for ZLib Compressed Bitmaps is .ZBM.

    TZLIBBitmap inherits from TBitmap all its properties and methods,
    introducing the following methods and properties:

    - SavingMode: TSavingMode
      - Tells which file format to use when streaming down the bitmap data to
      mediums other than the DFM file:
         . fmBitmap -> Unmodified bitmap data (Windows Bitmap)
         . fmZBM    -> ZLib Compressed Bitmap data. If saved to a file the .ZBM
                       extension should be used.
      When streaming to the Delphi form file the class writes a ZBM formatted
      stream regardless of the SavingMode property.
      Defaults to fmBitmap for full compatibility with TBitmap.

    SaveToStream (overriden)
      - Depends on the value of the SavingMode property. If it is fmZBM it
      writes a ZBM formatted stream (This is the actual compressed stream that
      is written to the DFM). This can later be read by LoadFromStream because
      the TZLIBBitmap.LoadFromStream can handle both Windows Bitmaps and ZLIB
      Compressed Bitmaps transparently. This option is provided for
      developers that need to store the ZBM stream in mediums other than the
      DFM file (database blobs, communication streams, etc.)
      If SavingMode is fmBitmap, it will call the inherited TBitmap.SaveToStream
      which will save an ordinary bitmap stream.

    LoadFromStream (overriden)
      - Loads a ZBM or Bitmap formatted stream. It first tries to recognize the
      stream as a ZBM stream calling ReadData if successfull, otherwise it calls
      the inherited LoadFromStream, which will try to load a bitmap stream.

    FilterMethod: TFilterMethod
      - This property tells which filter method to apply when writting the
      ZBM stream. The default method (fmPaeth) works better with the vast
      majority of images, so there's little if any reason to change this, but
      some images can compress better with other filters. It is up to the
      developer to choose which filter to apply or let the default.

    FUTURE OPTIMIZATIONS
    --------------------
    I don't need to compress the data again if it hasn't changed. I only need
    to hold the compressed data and then stream it down when needed. If the
    bitmap gets changed, I will need to recompress it. All I have to do is to
    create a memory stream with the compressed data, releasing it if the bitmap
    changes. When writting data, if the compressed data is available, I write it
    straight, otherwise I make the compression procedure again.

    License
    -------
    This code is freeware and its use in free or commercial products is granted.
    The code is provided as is and no warranty is supplied. USE IT AT YOUR OWN
    RISK. Although free this code is copyrighted 2000 by Felipe Machado, you
    can't claim authorship of it for any reason.
    If you use this component please send me an e-mail. I'll be glad to know
    your impressions, suggestions and critics (see contact below)

    Contact (Bug reports, etc.)
    ---------------------------
    Questions, bug reports, comments, they are all welcome. Please send then to

    felipe.machado@mail.com

    I will try to respond as soon as possible to every request. Thanks for the
    interest.

    ---
    (C) 2000, Felipe Rocha Machado
---------------------------------------------------------------------------- }

interface

uses
  SysUtils, Windows, Classes, Graphics, ZLIB;

type
  { redefined here so you won't be required to add ZLIB to the uses clause }
  TCompressionLevel = ZLIB.TCompressionLevel;

  { signature for ZBM file format }
  { #213 Z B M #13 #10 #26 #10 }
  TZBMSignature = array[0..7] of char;

  { filtering methods }
  TFilterMethod = (fmNone, fmPaeth, fmSub, fmUp, fmAverage);

  { Saving Mode - standard bitmap stream or ZLIB compressed stream }
  TSavingMode = (smBitmap, smZBM);

  { small header used to control encoding/decoding }
  TZBMHeader = packed record
    Signature: TZBMSignature;
    FilterMethod: TFilterMethod; // filter applied to the bitmap scanlines
    TotalSize: Cardinal; // uncompressed size
  end;

  { Defaults for every newly created ZLIB bitmap }
  TZBMDefaults = record
    SavingMode: TSavingMode;
    FilterMethod: TFilterMethod;
    CompressionLevel: TCompressionLevel; { clNone, clFastest, clDefault, clMax }
  end;

  { ZLIBBitmap class declaration }
  TZLIBBitmap = class(TBitmap)
  private
    FSavingMode: TSavingMode;
    function GetBpp: Byte;
  protected
    Header: TZBMHeader;
    procedure EncodeFilter(Dest: TBitmap);
    procedure DecodeFilter;
    procedure ReadData(Stream: TStream); override;
    procedure WriteData(Stream: TStream); override;
  public
    constructor Create; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    property FilterMethod: TFilterMethod read Header.FilterMethod
      write Header.FilterMethod;
    property SavingMode: TSavingMode read FSavingMode write FSavingMode;
  end;

var
  { Default behavior for ZLIB Bitmaps - mimics a class variable }
  ZBMDefaults: TZBMDefaults = (SavingMode: smBitmap;
    FilterMethod: fmPaeth;
    CompressionLevel: clMax); // this line was missing

implementation

type
  { array used to access memory by index }
  PHugeArray = ^THugeArray;
  THugeArray = array[0..MaxLongInt div SizeOf(Byte) div 8 - 1] of Byte;

const
  ZBMSignature: TZBMSignature = #213'ZBM'#13#10#26#10;

  { TZLIBBitmap }

constructor TZLIBBitmap.Create;
begin
  inherited Create;
  FilterMethod := ZBMDefaults.FilterMethod;
  FSavingMode := ZBMDefaults.SavingMode;
end;

procedure TZLIBBitmap.DecodeFilter;
var
  src, prev: PHugeArray;
  srcdif, size: Cardinal;
  bpp: Byte;
  zerobuffer: Pointer;
  { --- Local procedures for speed/readability --- }
  procedure DecNone; // should never be called since no change is done to scanlines
  begin
    // nothing to do - already decoded
  end;
  procedure DecPaeth;
  var
    x, y: Integer;
    a, b, c, pa, pb, pc, p: Integer;
  begin
    for y := 0 to Height - 1 do
    begin
      { first pixel is special case }
      for x := 0 to bpp - 1 do
        src[x] := (src[x] + prev[x]) and $FF;
      { now do paeth for every other byte }
      for x := bpp to size - 1 do
      begin
        a := src[x - bpp];
        b := prev[x];
        c := prev[x - bpp];
        p := b - c;
        pc := a - c;
        pa := Abs(p);
        pb := Abs(pc);
        pc := Abs(p + pc);
        if (pa <= pb) and (pa <= pc) then
          p := a
        else if (pb <= pc) then
          p := b
        else
          p := c;
        src[x] := (src[x] + p) and $FF;
      end;
      prev := src;
      Inc(Integer(src), srcdif);
    end;
  end;
  procedure DecSub;
  var
    y, x: Integer;
  begin
    for y := 0 to Height - 1 do
    begin
      for x := bpp to size - 1 do
        src[x] := (src[x] + src[x - bpp]) and $FF;
      prev := src;
      Inc(Integer(src), srcdif);
    end;
  end;
  procedure DecUp;
  var
    y, x: Integer;
  begin
    for y := 0 to Height - 1 do
    begin
      for x := 0 to size - 1 do
        src[x] := (src[x] + prev[x]) and $FF;
      prev := src;
      Inc(Integer(src), srcdif);
    end;
  end;
  procedure DecAverage;
  var
    y, x: Integer;
  begin
    for y := 0 to Height - 1 do
    begin
      { first pixel is special case }
      for x := 0 to bpp - 1 do
        src[x] := (src[x] + prev[x] div 2) and $FF;
      for x := Bpp to size - 1 do
        src[x] := (src[x] + (src[x - bpp] + prev[x]) div 2) and $FF;
      prev := src;
      Inc(Integer(src), srcdif);
    end;
  end;

begin
  bpp := GetBpp;
  size := bpp * Width;
  if bpp = 1 then
    case PixelFormat of
      pf1bit: size := size div 8;
      pf4bit: size := size div 2;
    end;
  src := ScanLine[0];
  if Height > 1 then
    srcdif := Integer(ScanLine[1]) - Integer(src)
  else
    srcdif := 0;
  GetMem(zerobuffer, size);
  try
    FillChar(zerobuffer^, size, 0);
    prev := zerobuffer;
    case Header.FilterMethod of
      fmNone: DecNone;
      fmPaeth: DecPaeth;
      fmSub: DecSub;
      fmUp: DecUp;
      fmAverage: DecAverage;
    end;
  finally
    FreeMem(zerobuffer);
  end;
end;

procedure TZLIBBitmap.EncodeFilter(Dest: TBitmap);
var
  src, dst, prev: PHugeArray;
  srcdif, dstdif: Cardinal;
  size: Cardinal;
  bpp: Byte;
  zerobuffer: Pointer;
  //  a, b, c, pa, pb, pc: Byte;
    { local functions for speed and readability }
  procedure DoNone; // should never be called since no change is done to scanlines
  var
    y: Integer;
  begin
    for y := 0 to Height - 1 do
    begin
      Move(src^, dst^, size);
      prev := src;
      Inc(Integer(src), srcdif);
      Inc(Integer(dst), dstdif);
    end;
  end;
  procedure DoPaeth;
  var
    y, x: Integer;
    a, b, c, p, pa, pb, pc: Integer;
  begin
    for y := 0 to Height - 1 do
    begin
      { first pixel is special case }
      for x := 0 to bpp - 1 do
        dst[x] := (src[x] - prev[x]) and $FF;
      (* Paeth(x) = Raw(x) - PaethPredictor(Raw(x-bpp), Prior(x), Prior(x-bpp)) *)
      // a = left, b = above, c = upper left
      for x := bpp to size - 1 do
      begin
        a := src[x - bpp];
        b := prev[x];
        c := prev[x - bpp];
        p := a + b - c; // initial estimate
        pa := abs(p - a); // distances to a, b, c
        pb := abs(p - b);
        pc := abs(p - c);
        { return nearest of a,b,c,
          breaking ties in order a,b,c. }
        if (pa <= pb) and (pa <= pc) then
          p := a
        else if (pb <= pc) then
          p := b
        else
          p := c;
        dst[x] := (src[x] - p) and $FF;
      end;
      prev := src;
      Inc(Integer(src), srcdif);
      Inc(Integer(dst), dstdif);
    end;
  end;
  procedure DoSub;
  var
    y, x: Integer;
  begin
    for y := 0 to Height - 1 do
    begin
      for x := bpp to size - 1 do
        dst[x] := (src[x] - src[x - bpp]) and $FF;
      prev := src;
      Inc(Integer(src), srcdif);
      Inc(Integer(dst), dstdif);
    end;
  end;
  procedure DoUp;
  var
    y, x: Integer;
  begin
    for y := 0 to Height - 1 do
    begin
      for x := 0 to size - 1 do
        dst[x] := (src[x] - prev[x]) and $FF;
      prev := src;
      Inc(Integer(src), srcdif);
      Inc(Integer(dst), dstdif);
    end;
  end;
  procedure DoAverage;
  var
    y, x: Integer;
  begin
    for y := 0 to Height - 1 do
    begin
      { first pixel is special case }
      for x := 0 to bpp - 1 do
        dst[x] := (src[x] - prev[x] div 2) and $FF;
      for x := Bpp to size - 1 do
        dst[x] := (src[x] - (src[x - bpp] + prev[x]) div 2) and $FF;
      prev := src;
      Inc(Integer(src), srcdif);
      Inc(Integer(dst), dstdif);
    end;
  end;

begin
  bpp := GetBpp;
  size := bpp * Width;
  if bpp = 1 then
    case PixelFormat of
      pf1bit: size := size div 8;
      pf4bit: size := size div 2;
    end;
  src := ScanLine[0];
  dst := Dest.ScanLine[0];
  if Height > 1 then
  begin
    srcdif := Integer(ScanLine[1]) - Integer(src);
    dstdif := Integer(Dest.ScanLine[1]) - Integer(dst);
  end
  else
  begin
    srcdif := 0;
    dstdif := 0;
  end;
  GetMem(zerobuffer, size);
  try
    FillChar(zerobuffer^, size, 0);
    prev := zerobuffer;
    case Header.FilterMethod of
      fmNone: DoNone;
      fmPaeth: DoPaeth;
      fmSub: DoSub;
      fmUp: DoUp;
      fmAverage: DoAverage;
    end;
  finally
    FreeMem(zerobuffer);
  end;
end;

function TZLIBBitmap.GetBpp: Byte;
begin
  case PixelFormat of
    pf15bit,
      pf16bit: Result := 2;
    pf24bit: Result := 3;
    pf32bit: Result := 4;
  else
    Result := 1;
  end;
end;

procedure TZLIBBitmap.LoadFromStream(Stream: TStream);
var
  p: Integer;
begin
  p := Stream.Position;
  Stream.Read(Header, SizeOf(Header));
  Stream.Position := p;
  if Header.Signature <> ZBMSignature then // not a ZBM stream ...
    inherited LoadFromStream(Stream) // ... try reading a Bitmap stream
  else
    ReadData(Stream); // it's a ZBM stream. Read it.
  FilterMethod := ZBMDefaults.FilterMethod;
end;

procedure TZLIBBitmap.ReadData(Stream: TStream);
var
  DecStream: TDecompressionStream;
  tmpStream: TMemoryStream;
begin
  tmpStream := TMemoryStream.Create;
  try
    Stream.Read(Header, SizeOf(Header));
    if Header.Signature <> ZBMSignature then
      raise EInvalidGraphic.Create('Invalid ZBM signature!');
    DecStream := TDecompressionStream.Create(Stream);
    try
      tmpStream.CopyFrom(DecStream, Header.TotalSize);
    finally
      DecStream.Free;
    end;
    tmpStream.Position := 0;
    inherited LoadFromStream(tmpStream);
    if Header.FilterMethod <> fmNone then
      DecodeFilter;
  finally
    tmpStream.Free;
  end;
end;

procedure TZLIBBitmap.SaveToStream(Stream: TStream);
begin
  if SavingMode = smBitmap then
    inherited SaveToStream(Stream)
  else
    WriteData(Stream);
end;

procedure TZLIBBitmap.WriteData(Stream: TStream);
var
  CmpStream: TCompressionStream;
  tmpStream: TMemoryStream;
  bmp: TBitmap;
begin
  tmpStream := TMemoryStream.Create;
  try
    CmpStream := TCompressionStream.Create(ZBMDefaults.CompressionLevel, tmpStream);
    try
      if Header.FilterMethod = fmNone then
        inherited SaveToStream(CmpStream) // compresses unmodified bitmap
      else
      begin
        bmp := TBitmap.Create;
        try
          bmp.Assign(Self);
          EncodeFilter(bmp);
          bmp.SaveToStream(CmpStream); // compresses filtered bitmap
        finally
          bmp.Free;
        end;
      end;
      Header.TotalSize := CmpStream.Position;
    finally
      CmpStream.Free; // this will flush pending data to tmpStream
    end;
    tmpStream.Position := 0;
    Header.Signature := ZBMSignature;
    Stream.Write(Header, SizeOf(Header)); // writes ZBM header
    Stream.WriteBuffer(tmpStream.Memory^, tmpStream.Size);
  finally
    tmpStream.Free;
  end;
end;

initialization
  TPicture.UnregisterGraphicClass(TBitmap);
  TPicture.RegisterFileFormat('bmp', 'Windows Bitmaps (TZLIBBitmap)', TZLIBBitmap);
  TPicture.RegisterFileFormat('zbm', 'ZLIB Compressed Bitmap', TZLIBBitmap);
finalization
  TPicture.UnregisterGraphicClass(TZLIBBitmap);
  TPicture.RegisterFileFormat('bmp', 'Windows Bitmaps', TBitmap);
end.