UNIBMP.PAS
unit UniBmp;
{
More Extended TBitmap object for Delphi 1.0 and Delphi 3.0
made by Endre I. Simay, Hungary.
UniBMP Unit was made according to Herbert J.Beemster's UBitmap
one with Kurt Haenen's LZRW1KH unit.
However the override its LZRWIdentifier constant will serve
a "LZRW" identifier in the compressed file instead of "WRZL".
Another suggestion is the ".BLZ" extension for the compressed
bitmap files, because of this unit can compress bitmaps with
BitmapHeader structures like the standard Windows' DIBs.
Classes2 Unit for Loading Compressed Bitmaps from
Resource's RCDATA is also needed.
Classes2 Unit was implemented from source given
with Borland's Delphi 3.0.
}
{
unit UniBmp Copyright © 1998 by Endre I. Simay.
Further Credits goes to:
- Herbert J.Beemster for TLZRBitmap, including
- 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
{$IFNDEF WIN32}
, Classes2
{$ENDIF};
type
TbmpType=(bmpClassic, bmpFullLZR, bmpBMPLZR);
type
PLZRBitmapFileHeader = ^TLZRBitmapFileHeader;
{$IFNDEF WIN32}
TLZRBitmapFileHeader = record
bfType: Word;
bfSize: Longint;
bfLZRReserved: Longint;
bfOffBits: Longint;
end;
{$ELSE}
TLZRBitmapFileHeader = packed record
bfType: Word;
bfSize: DWORD;
bfLZRReserved: DWORD;
bfOffBits: DWORD;
end;
{$ENDIF}
PLZRBitmapInfoHeader = ^TLZRBitmapInfoHeader;
{$IFNDEF WIN32}
TLZRBitmapInfoHeader = record
biSize: Longint;
biWidth: Longint;
biHeight: Longint;
biPlanes: Word;
biBitCount: Word;
biCompression: Longint;
biSizeImage: Longint;
biXPelsPerMeter: Longint;
biYPelsPerMeter: Longint;
biClrUsed: Longint;
biClrImportant: Longint;
biOrigCompression: Longint;
end;
{$ELSE}
TLZRBitmapInfoHeader = packed record
biSize: DWORD;
biWidth: Longint;
biHeight: Longint;
biPlanes: Word;
biBitCount: Word;
biCompression: DWORD;
biSizeImage: DWORD;
biXPelsPerMeter: Longint;
biYPelsPerMeter: Longint;
biClrUsed: DWORD;
biClrImportant: DWORD;
biOrigCompression: DWORD;
end;
{$ENDIF}
type
TUniBitmap = class(TBitmap)
private
FBmpRect:TRect;
function GetRect:TRect;
public
procedure LZRLoadFromFile(const Filename : string
); virtual;
procedure LZRSaveToStream(OutStream : TStream
); virtual;
procedure LZRSaveToFile(const Filename : string
); virtual;
procedure BMPLZRLoadFromFile(const Filename: string
); virtual;
procedure BMPLZRSaveToFile(const Filename: string
); virtual;
procedure LoadFromStream(InStream: TStream); override;
procedure BMPLZRSaveToStream(OutStream: TStream
); virtual;
procedure LZRLoadFromStream(InStream: TStream
); virtual;
procedure BMPLZRLoadFromStream(InStream: TStream
); virtual;
procedure BMPLZRLoadFromResourceName(Instance: THandle;const ResName: string
); virtual;
procedure BMPLZRLoadFromResourceID(Instance: THandle; ResID: LongInt
); virtual;
procedure LZRLoadFromResourceName(Instance: THandle;const ResName: string
); virtual;
procedure LZRLoadFromResourceID(Instance: THandle;ResID: LongInt
); virtual;
procedure LoadFromRCDATAName(Instance: THandle;const ResName: string
); virtual;
procedure LoadFromRCDATAID(Instance: THandle;const ResID: LongInt
); virtual;
{$IFNDEF WIN32}
procedure LoadFromResourceName(Instance: THandle;const ResName: string
); virtual;
procedure LoadFromResourceID(Instance: THandle;const ResID: LongInt
); virtual;
{$ENDIF WIN32}
procedure LoadFromHIcon(Icon: HIcon); virtual;
procedure LoadFromHBitmap(Bitmp: HBitmap); virtual;
procedure LoadFromPicture(Picture: TPicture); virtual;
function _LoadFromFile(const Filename: string):TBitmap; virtual;
function _LoadFromStream(InStream: TStream):TBitmap; virtual;
function _BMPLZRLoadFromResourceName(Instance: THandle;const ResName: string
):TBitmap; virtual;
function _BMPLZRLoadFromResourceID(Instance: THandle;ResID: LongInt
):TBitmap; virtual;
function _LZRLoadFromResourceName(Instance: THandle;const ResName: string
):TBitmap; virtual;
function _LZRLoadFromResourceID(Instance: THandle;ResID: LongInt
):TBitmap; virtual;
function _LoadFromRCDATAName(Instance: THandle;const ResName: string
):TBitmap; virtual;
function _LoadFromRCDATAID(Instance: THandle;const ResID: LongInt
):TBitmap; virtual;
function _LoadFromResourceName(Instance: THandle;const ResName: string
):TBitmap; virtual;
function _LoadFromResourceID(Instance: THandle;const ResID: LongInt
):TBitmap; virtual;
function _LoadFromHBitmap(Bitmp: HBitmap):TBitmap; virtual;
function _LoadFromHIcon(Icon: HIcon):TBitmap; virtual;
function _LoadFromPicture(Picture: TPicture):TBitmap; virtual;
function Bitmap:TBitmap;
function SetRect(AWidth,AHeight:Integer):TRect;
property BmpRect:TRect read GetRect;
end; {TUniBitmap}
var
UniBitmap:TUniBitmap;
implementation
uses
LZRW1KH; {Credits : Kurt Haenen} { unit can be in ARCHIVES.SWG !! }
const
Instance:Integer=0;
const
ChunkSize = 32768;
IOBufSize = (ChunkSize + 16);
LZRWIdentifier : LONGINT =
((((((ORD('W') SHL 8)+ORD('R')) SHL 8)+ORD('Z')) SHL 8)+ORD('L'));
OldIdentifier : LONGINT =
((((((ORD('L') SHL 8)+ORD('Z')) SHL 8)+ORD('R')) SHL 8)+ORD('W'));
function TUniBitmap._LoadFromFile(const Filename: string
):TBitmap;
begin
LoadFromFile(Filename);
Result:=Bitmap;
end;
function TUniBitmap._LoadFromStream(InStream: TStream):TBitmap;
begin
LoadFromStream(InStream);
Result:=Bitmap;
end;
procedure TUniBitmap.LoadFromStream(InStream: TStream);
var
bmpType : TbmpType;
InnStream :TMemoryStream;
Identifier : Longint;
BmpHead : TLZRBitMapFileHeader;
BmpInfo : TLZRBitMapInfoHeader;
begin
try
bmpType:=bmpClassic;
Identifier :=0;
FillChar(BmpHead,SizeOf(TLZRBitMapFileHeader),0);
FillChar(BmpInfo,SizeOf(TLZRBitMapInfoHeader),0);
try
{Create InStream}
InnStream := TMemoryStream.Create;
TMemoryStream(InStream).Seek(0,0);
InnStream.LoadFromStream(InStream);
InnStream.Seek(0,0);
InnStream.Read(Identifier, SizeOf(LongInt));
if (Identifier=LZRWIdentifier)or(Identifier=OldIdentifier) then
bmpType:=bmpFullLZR
else
begin
InnStream.Seek(0,0);
InnStream.Read( BmpHead , SizeOf(TLZRBitMapFileHeader));
InnStream.Read( BmpInfo , SizeOf(TLZRBitMapInfoHeader));
if (BmpInfo.biCompression=LZRWIdentifier)
or(BmpInfo.biCompression=OldIdentifier) then
begin
bmpType:=bmpBMPLZR;
end;
end;
finally
InnStream.free;
end;
finally
TMemoryStream(InStream).Seek(0,0);
case bmpType of
bmpClassic:Inherited LoadFromStream(InStream);
bmpFullLZR:LZRLoadFromStream(InStream);
bmpBMPLZR :BMPLZRLoadFromStream(InStream);
end;
end;
end;
procedure TUniBitmap.LZRLoadFromStream(InStream: TStream
);
var
InnStream : TMemoryStream;
OutStream : TMemoryStream;
Tmp,
Identifier,
OrigSize,
SrcSize,
DstSize : LongInt;
SrcBuf,
DstBuf : BufferPtr;
begin
try
{Create InnStream & OutStream}
InnStream := TMemoryStream.Create;
OutStream := TMemoryStream.Create;
{Create buffers for LZWR1KH}
Getmem(SrcBuf, IOBufSize);
Getmem(DstBuf, IOBufSize);
{Load the compressed bitmap}
TMemoryStream(InStream).Seek(0,0);
InnStream.LoadFromStream(InStream);
InnStream.Seek(0,0);
{Decompress the lot...}
{Read compression ID }
InnStream.Read( Identifier, SizeOf( LongInt));
{Read in uncompressed filesize }
InnStream.Read( OrigSize, SizeOf( LongInt));
DstSize := ChunkSize;
SrcSize := 0;
while (DstSize = ChunkSize)
do
begin
{Read size of compressed block }
Tmp := InnStream.Read( SrcSize, SizeOf( Word));
{Read compressed block }
InnStream.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);
Inherited LoadfromStream( OutStream);
finally
{Clean Up Memory}
InnStream.Free;
OutStream.Free;
Freemem( SrcBuf, IOBufSize);
Freemem( DstBuf, IOBufSize);
end; {try}
end; {LZRLoadFromStream}
procedure TUniBitmap.LZRLoadFromFile(const Filename : string
);
begin
LoadfromFile(Filename);
end; {LZRLoadFromFile}
procedure TUniBitmap.LZRSaveToStream(OutStream : TStream
);
var
Size,
CompIdentifier,
SrcSize,
DstSize : LongInt;
SrcBuf,
DstBuf : BufferPtr;
InStream : TMemoryStream;
begin
try
{Create InStream & OutStream}
InStream := TMemoryStream.Create;
{Create buffers for LZWR1KH}
Getmem(SrcBuf, IOBufSize);
Getmem(DstBuf, IOBufSize);
{Save the bitmap to InStream}
inherited 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}
finally
{Clean Up Memory}
InStream.Free;
Freemem( SrcBuf, IOBufSize);
Freemem( DstBuf, IOBufSize);
end; {try}
end; {LZRSaveToStream}
procedure TUniBitmap.LZRSaveToFile(const Filename : string
);
var
Stream: TStream;
begin
Stream := TFileStream.Create(Filename, fmCreate);
try
LZRSaveToStream(Stream);
finally
Stream.Free;
end;
end;
procedure TUniBitmap.BMPLZRLoadFromFile(const Filename : string
);
begin
LoadFromFile(Filename);
end; {BMPLZRLoadFromFile}
procedure TUniBitmap.BMPLZRLoadFromStream(InStream: TStream
);
var
InnStream : TMemoryStream;
OutStream : TMemoryStream;
Tmp,
OrigSize,
SrcSize,
DstSize : LongInt;
SrcBuf,
DstBuf : BufferPtr;
BmpHead : TLZRBitMapFileHeader;
BmpInfo : TLZRBitMapInfoHeader;
BmpOrigInfo: TBitMapInfoHeader;
begin
try
{Create InnStream & OutStream}
InnStream := TMemoryStream.Create;
OutStream := TMemoryStream.Create;
{Create buffers for LZWR1KH}
Getmem(SrcBuf, IOBufSize);
Getmem(DstBuf, IOBufSize);
{Load the compressed bitmap}
TMemoryStream(InStream).Seek(0,0);
InnStream.LoadFromStream(InStream);
InnStream.Seek(0,0);
InnStream.Read( BmpHead , SizeOf(TLZRBitMapFileHeader));
InnStream.Read( BmpInfo , SizeOf(TLZRBitMapInfoHeader));
if (BmpInfo.biCompression=LZRWIdentifier)
or (BmpInfo.biCompression=OldIdentifier) then
begin
OrigSize:=BmpHead.bfLZRReserved;
if OrigSize>0 then
begin
DstSize := ChunkSize;
SrcSize := 0;
BmpHead.bfLZRReserved:=0;
with BmpInfo do
begin
BmpOrigInfo. biSize:=biSize;
BmpOrigInfo. biWidth:=biWidth;
BmpOrigInfo. biHeight:=biHeight;
BmpOrigInfo. biPlanes:=biPlanes;
BmpOrigInfo. biBitCount:=biBitCount;
BmpOrigInfo. biCompression:=biOrigCompression;
BmpOrigInfo. biSizeImage:=biSizeImage;
BmpOrigInfo. biXPelsPerMeter:=biXPelsPerMeter;
BmpOrigInfo. biYPelsPerMeter:=biYPelsPerMeter;
BmpOrigInfo. biClrUsed:=biClrUsed;
BmpOrigInfo. biClrImportant:=biClrImportant;
end;
OutStream.Write(BmpHead , SizeOf(TLZRBitMapFileHeader));
OutStream.Write(BmpOrigInfo,SizeOf(TBitMapInfoHeader));
while (DstSize = ChunkSize) do
begin
{Read size of compressed block }
Tmp := InnStream.Read( SrcSize, SizeOf( Word));
{Read compressed block }
InnStream.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);
inherited LoadfromStream(OutStream);
end;
end;
finally
{Clean Up Memory}
InnStream.Free;
OutStream.Free;
Freemem( SrcBuf, IOBufSize);
Freemem( DstBuf, IOBufSize);
end; {try}
end; {BMPLZRLoadFromStream}
procedure TUniBitmap.BMPLZRSaveToStream(OutStream: TStream
);
var
InStream : TMemoryStream;
Size,
CompIdentifier :LongInt;
SrcSize,
DstSize : LongInt;
SrcBuf,
DstBuf : BufferPtr;
BmpHead : TLZRBitMapFileHeader;
BmpInfo : TLZRBitMapInfoHeader;
BmpOrigInfo: TBitMapInfoHeader;
begin
try
{Create InStream & OutStream}
InStream := TMemoryStream.Create;
{Create buffers for LZWR1KH}
Getmem(SrcBuf, IOBufSize);
Getmem(DstBuf, IOBufSize);
{Save the bitmap to InStream}
Inherited SaveToStream(InStream);
InStream.Seek(0,0);
Size:=InStream.Size;
InStream.Read( BmpHead , SizeOf(TLZRBitMapFileHeader));
InStream.Read( BmpOrigInfo , SizeOf(TBitMapInfoHeader));
BmpHead.bfLZRReserved:=Size;
with BmpInfo do
begin
biSize:=BmpOrigInfo.biSize;
biWidth:=BmpOrigInfo.biWidth;
biHeight:=BmpOrigInfo.biHeight;
biPlanes:=BmpOrigInfo.biPlanes;
biBitCount:=BmpOrigInfo.biBitCount;
biCompression:=LZRWIdentifier;
biSizeImage:=BmpOrigInfo.biSizeImage;
biXPelsPerMeter:=BmpOrigInfo.biXPelsPerMeter;
biYPelsPerMeter:=BmpOrigInfo.biYPelsPerMeter;
biClrUsed:=BmpOrigInfo.biClrUsed;
biClrImportant:=BmpOrigInfo.biClrImportant;
biOrigCompression:=BmpOrigInfo.biCompression
end;
OutStream.Write(BmpHead,SizeOf(TLZRBitMapFileHeader));
OutStream.Write(BmpInfo,SizeOf(TLZRBitMapInfoHeader));
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}
finally
{Clean Up Memory}
InStream.Free;
Freemem( SrcBuf, IOBufSize);
Freemem( DstBuf, IOBufSize);
end; {try}
end; {BMPLZRSaveToStream}
procedure TUniBitmap.BMPLZRSaveToFile(const Filename : string
);
var
OutStream : TStream;
begin
try
{Create File OutStream}
OutStream := TFileStream.Create(Filename, fmCreate);
{Save to Stream}
BMPLZRSaveToStream(OutStream);
finally
{Clean Up Memory}
OutStream.Free;
end; {try}
end; {BMPLZRSaveToFile}
procedure TUniBitmap.BMPLZRLoadFromResourceName(
Instance: THandle;const ResName: string
);
var
Tmp,
OrigSize,
SrcSize,
DstSize : LongInt;
SrcBuf,
DstBuf : BufferPtr;
Instream : TResourceStream;
OutStream : TMemoryStream;
BmpHead : TLZRBitMapFileHeader;
BmpInfo : TLZRBitMapInfoHeader;
BmpOrigInfo: TBitMapInfoHeader;
begin
try
{Create InStream & OutStream}
InStream := TResourceStream.Create(Instance,Resname,RT_RCDATA);
OutStream := TMemoryStream.Create;
{Create buffers for LZWR1KH}
Getmem(SrcBuf, IOBufSize);
Getmem(DstBuf, IOBufSize);
{Load the compressed bitmap}
InStream.Seek(0,0);
InStream.Read( BmpHead , SizeOf(TLZRBitMapFileHeader));
InStream.Read( BmpInfo , SizeOf(TLZRBitMapInfoHeader));
if (BmpInfo.biCompression=LZRWIdentifier)
or(BmpInfo.biCompression=OldIdentifier)then
begin
OrigSize:=BmpHead.bfLZRReserved;
if OrigSize>0 then
begin
DstSize := ChunkSize;
SrcSize := 0;
BmpHead.bfLZRReserved:=0;
with BmpInfo do
begin
BmpOrigInfo. biSize:=biSize;
BmpOrigInfo. biWidth:=biWidth;
BmpOrigInfo. biHeight:=biHeight;
BmpOrigInfo. biPlanes:=biPlanes;
BmpOrigInfo. biBitCount:=biBitCount;
BmpOrigInfo. biCompression:=biOrigCompression;
BmpOrigInfo. biSizeImage:=biSizeImage;
BmpOrigInfo. biXPelsPerMeter:=biXPelsPerMeter;
BmpOrigInfo. biYPelsPerMeter:=biYPelsPerMeter;
BmpOrigInfo. biClrUsed:=biClrUsed;
BmpOrigInfo. biClrImportant:=biClrImportant;
end;
OutStream.Write(BmpHead , SizeOf(TLZRBitMapFileHeader));
OutStream.Write(BmpOrigInfo,SizeOf(TBitMapInfoHeader));
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);
end;
end;
finally
{Clean Up Memory}
InStream.Free;
OutStream.Free;
Freemem( SrcBuf, IOBufSize);
Freemem( DstBuf, IOBufSize);
end; {try}
end; {BMPLZRLoadFromResource}
procedure TUniBitmap.BMPLZRLoadFromResourceID(
Instance: THandle;ResID: LongInt
);
var
Tmp,
Identifier,
OrigSize,
SrcSize,
DstSize : LongInt;
SrcBuf,
DstBuf : BufferPtr;
Instream : TResourceStream;
OutStream : TMemoryStream;
BmpHead : TLZRBitMapFileHeader;
BmpInfo : TLZRBitMapInfoHeader;
BmpOrigInfo: TBitMapInfoHeader;
begin
try
{Create InStream & OutStream}
InStream := TResourceStream.CreateFromID(Instance,ResID,RT_RCDATA);
OutStream := TMemoryStream.Create;
{Create buffers for LZWR1KH}
Getmem(SrcBuf, IOBufSize);
Getmem(DstBuf, IOBufSize);
{Load the compressed bitmap}
InStream.Seek(0,0);
InStream.Read( BmpHead , SizeOf(TLZRBitMapFileHeader));
InStream.Read( BmpInfo , SizeOf(TLZRBitMapInfoHeader));
if (BmpInfo.biCompression=LZRWIdentifier)
or(BmpInfo.biCompression=OldIdentifier)then
begin
OrigSize:=BmpHead.bfLZRReserved;
if OrigSize>0 then
begin
DstSize := ChunkSize;
SrcSize := 0;
BmpHead.bfLZRReserved:=0;
with BmpInfo do
begin
BmpOrigInfo. biSize:=biSize;
BmpOrigInfo. biWidth:=biWidth;
BmpOrigInfo. biHeight:=biHeight;
BmpOrigInfo. biPlanes:=biPlanes;
BmpOrigInfo. biBitCount:=biBitCount;
BmpOrigInfo. biCompression:=biOrigCompression;
BmpOrigInfo. biSizeImage:=biSizeImage;
BmpOrigInfo. biXPelsPerMeter:=biXPelsPerMeter;
BmpOrigInfo. biYPelsPerMeter:=biYPelsPerMeter;
BmpOrigInfo. biClrUsed:=biClrUsed;
BmpOrigInfo. biClrImportant:=biClrImportant;
end;
OutStream.Write(BmpHead , SizeOf(TLZRBitMapFileHeader));
OutStream.Write(BmpOrigInfo,SizeOf(TBitMapInfoHeader));
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);
end;
end;
finally
{Clean Up Memory}
InStream.Free;
OutStream.Free;
Freemem( SrcBuf, IOBufSize);
Freemem( DstBuf, IOBufSize);
end; {try}
end; {BMPLZRLoadFromResourceID}
function TUniBitmap._BMPLZRLoadFromResourceName(
Instance: THandle;const ResName: string
):TBitmap;
begin
BMPLZRLoadFromResourceName(Instance,ResName);
Result:=Bitmap;
end;
function TUniBitmap._BMPLZRLoadFromResourceID(
Instance: THandle;ResID: LongInt
):TBitmap;
begin
BMPLZRLoadFromResourceID(Instance,ResID);
Result:=Bitmap;
end;
procedure TUniBitmap.LZRLoadFromResourceName(
Instance: THandle;const ResName: string
);
var
Tmp,
Identifier,
OrigSize,
SrcSize,
DstSize : LongInt;
SrcBuf,
DstBuf : BufferPtr;
Instream : TResourceStream;
OutStream : TMemoryStream;
begin
try
{Create InStream & OutStream}
InStream := TResourceStream.Create(Instance,Resname,RT_RCDATA);
OutStream := TMemoryStream.Create;
{Create buffers for LZWR1KH}
Getmem(SrcBuf, IOBufSize);
Getmem(DstBuf, IOBufSize);
{Load the compressed bitmap}
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; {LZRLoadFromResource}
procedure TUniBitmap.LZRLoadFromResourceID(
Instance: THandle;ResID: LongInt
);
var
Tmp,
Identifier,
OrigSize,
SrcSize,
DstSize : LongInt;
SrcBuf,
DstBuf : BufferPtr;
Instream : TResourceStream;
OutStream : TMemoryStream;
begin
try
{Create InStream & OutStream}
InStream := TResourceStream.CreateFromID(Instance,ResID,RT_RCDATA);
OutStream := TMemoryStream.Create;
{Create buffers for LZWR1KH}
Getmem(SrcBuf, IOBufSize);
Getmem(DstBuf, IOBufSize);
{Load the compressed bitmap}
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; {LZRLoadFromResourceID}
{$IFNDEF WIN32}
procedure TUniBitmap.LoadFromResourceName(Instance: THandle; const ResName:
string);
var
S:String;
begin
s:=ResName+#0;
Handle:=LoadBitmap(Instance,@S[1]);
end; {LoadFromResourceName}
procedure TUniBitmap.LoadFromResourceID(
Instance: THandle;const ResID: LongInt);
begin
Handle:=LoadBitmap(Instance,PChar(ResID));
end; {LoadFromResourceID}
{$ENDIF}
procedure TUniBitmap.LoadFromRCDATAName(
Instance: THandle;const ResName: string
);
var
Instream : TResourceStream;
begin
try
{Create InStream & OutStream}
InStream := TResourceStream.Create(Instance,Resname,RT_RCDATA);
LoadfromStream(InStream);
finally
{Clean Up Memory}
InStream.Free;
end; {try}
end; {LoadFromRCDATAName}
procedure TUniBitmap.LoadFromRCDATAID(
Instance: THandle;const ResID: LongInt
);
var
Instream : TResourceStream;
begin
try
{Create InStream & OutStream}
InStream := TResourceStream.CreateFromID(Instance,ResID,RT_RCDATA);
LoadFromStream(InStream);
finally
{Clean Up Memory}
InStream.Free;
end; {try}
end; {LoadFromRCDATAID}
function TUniBitmap._LZRLoadFromResourceName(
Instance: THandle;const ResName: string
):TBitmap;
begin
LZRLoadFromResourceName(Instance,ResName);
Result:=Bitmap;
end;
function TUniBitmap._LZRLoadFromResourceID(
Instance: THandle; ResID: LongInt
):TBitmap;
begin
LZRLoadFromResourceID(Instance,ResID);
Result:=Bitmap;
end;
function TUniBitmap._LoadFromRCDATAName(
Instance: THandle;const ResName: string
):TBitmap;
begin
LoadFromRCDATAName(Instance,ResName);
Result:=Bitmap;
end;
function TUniBitmap._LoadFromRCDATAID(
Instance: THandle;const ResID: LongInt
):TBitmap;
begin
LoadFromRCDATAID(Instance,ResID);
Result:=Bitmap;
end;
function TUniBitmap._LoadFromResourceName(
Instance: THandle;const ResName: string
):TBitmap;
begin
LoadFromResourceName(Instance,ResName);
Result:=Bitmap;
end;
function TUniBitmap._LoadFromResourceID(
Instance: THandle;const ResID: LongInt
):TBitmap;
begin
LoadFromResourceID(Instance,ResID);
Result:=Bitmap;
end;
procedure TUniBitmap.LoadFromHBitmap(Bitmp: HBitmap);
var
Picture:TPicture;
begin
try
Picture:=TPicture.Create;
Picture.Bitmap.Handle:=Bitmp;
Width:=Picture.Width;
Height:=Picture.Height;
Canvas.StretchDraw(GetRect,Picture.Graphic);
finally
Picture.Free;
end;
end;
procedure TUniBitmap.LoadFromHIcon(Icon: HIcon);
var
Picture:TPicture;
begin
try
Picture:=TPicture.Create;
Picture.Icon.Handle:=Icon;
Width:=Picture.Width;
Height:=Picture.Height;
Canvas.StretchDraw(GetRect,Picture.Graphic);
finally
Picture.Free;
end;
end;
function TUniBitmap._LoadFromHBitmap(Bitmp: HBitmap):TBitmap;
begin
LoadFromHBitmap(Bitmp);
Result:=Bitmap;
end;
function TUniBitmap._LoadFromHIcon(Icon: HIcon
):TBitmap;
begin
LoadFromHIcon(Icon);
Result:=Bitmap;
end;
procedure TUniBitmap.LoadFromPicture(Picture: TPicture);
begin
Width:=Picture.Width;
Height:=Picture.Height;
Canvas.StretchDraw(GetRect,Picture.Graphic);
end;
function TUniBitmap._LoadFromPicture(Picture: TPicture
):TBitmap;
begin
LoadFromPicture(Picture);
Result:=Bitmap;
end;
function TUniBitmap.Bitmap:TBitmap;
begin
Result:=TBitmap(Self);
end; {Bitmap}
function TUniBitmap.GetRect:TRect;
begin
Result:=Rect(0,0,Width,Height);
end; {GetRect}
function TUniBitmap.SetRect(AWidth,AHeight:Integer):TRect;
begin
Width:=AWidth;
Height:=AHeight;
FBmpRect:=Rect(0,0,AWidth,AHeight);
Result:=FBmpRect;
end; {SetRect}
procedure UniFree; far;
begin
UniBitmap.Free;
end;
begin
TPicture.RegisterFileFormat('bmp','BMP-Format', TUniBitmap);
TPicture.RegisterFileFormat('blz','BLZ-Format', TUniBitmap);
TPicture.RegisterFileFormat('dib','DIB-Format', TUniBitmap);
if Instance=0 then
begin
UniBitmap:=TUniBitmap.Create;
Instance:=Instance+1;
end;
AddExitProc(UniFree);
end.