[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    unit UBitmap;
    {
    Extented TBitmap object for Delphi 1.0
    Added methods to load and save a compressed bitmap.
    Copyright © 1997 by Herbert J.Beemster.

    Questions, positive remarks, improvements etc. : herbertjb@compuserve.com

    Credits goes to:
    - Kurt Haenen for the LZRW1KH unit.
    - Dan English for the trick with the streams.
    - Danny Heijl for sample of using LZRW1KH.

    This piece of source is hereby donated to the public domain. Enjoy!
    }

    interface

    uses WinTypes, WinProcs, SysUtils, Classes, Graphics;

    type
     TLZRBitmap = class(TBitmap)
     public
       procedure LZRLoadFromFile(
         const Filename : string
       ); virtual;
       procedure LZRSaveToFile(
         const Filename : string
       ); virtual;
     end; {TLZRBitmap}

    implementation

    uses
      LZRW1KH; {Credits : Kurt Haenen}  { unit can be in ARCHIVES.SWG !! }

    const
      ChunkSize = 32768;
      IOBufSize = (ChunkSize + 16);
      LZRWIdentifier : LONGINT =
      ((((((ORD('L') SHL 8)+ORD('Z')) SHL 8)+ORD('R')) SHL 8)+ORD('W'));

    var
      InStream   : TMemoryStream;
      OutStream  : TMemoryStream;

    procedure TLZRBitmap.LZRLoadFromFile(
      const Filename : string
    );
    var
      Tmp,
      Identifier,
      OrigSize,
      SrcSize,
      DstSize    : LongInt;
      SrcBuf,
      DstBuf     : BufferPtr;
    begin
      try
      {Create InStream & OutStream}
        InStream  := TMemoryStream.Create;
        OutStream := TMemoryStream.Create;
      {Create buffers for LZWR1KH}
        Getmem(SrcBuf, IOBufSize);
        Getmem(DstBuf, IOBufSize);

      {Load the compressed bitmap}
        InStream.LoadFromFile( Filename);
        InStream.Seek(0,0);

      {Decompress the lot...}
      {Read compression ID }
        InStream.Read( Identifier, SizeOf( LongInt));

      {Read in uncompressed filesize }
        InStream.Read( OrigSize, SizeOf( LongInt));

        DstSize := ChunkSize;
        SrcSize := 0;
        while (DstSize = ChunkSize)
        do
        begin
        {Read size of compressed block }
          Tmp := InStream.Read( SrcSize, SizeOf( Word));
        {Read compressed block }
          InStream.Read( SrcBuf^, SrcSize);
        {Decompress block }
          DstSize := Decompression( SrcBuf, DstBuf, SrcSize);
        {Write decompressed block out to OutStream }
          OutStream.Write( DstBuf^, DstSize);
        end;

      {TBitmap thinks its loading from a file!}
        OutStream.Seek(0,0);
        LoadfromStream( OutStream);

      finally
      {Clean Up Memory}
        InStream.Free;
        OutStream.Free;
        Freemem( SrcBuf, IOBufSize);
        Freemem( DstBuf, IOBufSize);

      end; {try}

    end; {LZRLoadFromFile}

    procedure TLZRBitmap.LZRSaveToFile(
      const Filename : string
    );
    var
      Size,
      CompIdentifier,
      SrcSize,
      DstSize    : LongInt;
      SrcBuf,
      DstBuf     : BufferPtr;

    begin
      try
      {Create InStream & OutStream}
        InStream  := TMemoryStream.Create;
        OutStream := TMemoryStream.Create;
      {Create buffers for LZWR1KH}
        Getmem(SrcBuf, IOBufSize);
        Getmem(DstBuf, IOBufSize);

      {Save the bitmap to InStream}
        SaveToStream( InStream);
        InStream.Seek(0,0);

      {Compress the lot...}
      {Write out compression ID }
        CompIdentifier := LZRWIdentifier;
        OutStream.Write( CompIdentifier, SizeOf( LongInt));

      {Write out uncompressed filesize }
        Size := InStream.Size;
        OutStream.Write( Size, SizeOf( LongInt));

        SrcSize := ChunkSize;
        while (SRCSize = ChunkSize)
        do
        begin
        {Read a block of data }
          SrcSize := InStream.Read( SrcBuf^, ChunkSize);
        {Compress it }
          DstSize := Compression( SrcBuf, DstBuf, SrcSize);
        {Write out compressed size }
          OutStream.Write( DstSize, SizeOf( Word));
        {Write out compressed data }
          OutStream.Write( DstBuf^, DstSize);
        end; {while}

      {Save compressed OutStream to file}
        OutStream.SaveToFile( Filename);

      finally
      {Clean Up Memory}
        InStream.Free;
        OutStream.Free;
        Freemem( SrcBuf, IOBufSize);
        Freemem( DstBuf, IOBufSize);

      end; {try}

    end; {LZRSaveToFile}

    end.

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]