paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-18 07:29:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

TBitmap can now read form streams without knowing the size

Browse Source 
git-svn-id: trunk@5231 -
This commit is contained in:
mattias 2004-02-24 19:40:17 +00:00
parent 7c23a277f3
commit e43bcf45a3
5 changed files with 116 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
lcl/graphics.pp
View File

@ -995,7 +995,8 @@ type
procedure WriteData(Stream: TStream); override;
procedure StoreOriginalStream(Stream: TStream; Size: integer); virtual;
{$IFNDEF DisableFPImage}
procedure ReadStreamWithFPImage(Stream: TStream; Size: Longint;
procedure ReadStreamWithFPImage(Stream: TStream; UseSize: boolean;
Size: Longint;
ReaderClass: TFPCustomImageReaderClass); virtual;
procedure WriteStreamWithFPImage(Stream: TStream; WriteSize: boolean;
WriterClass: TFPCustomImageWriterClass); virtual;
@ -1022,7 +1023,7 @@ type
Procedure LoadFromXPMFile(const Filename : String);
procedure Mask(ATransparentColor: TColor);
procedure SaveToStream(Stream: TStream); override;
procedure ReadStream(Stream: TStream; Size: Longint); virtual;
procedure ReadStream(Stream: TStream; UseSize: boolean; Size: Longint); virtual;
procedure WriteStream(Stream: TStream; WriteSize: Boolean); virtual;
Function ReleaseHandle: HBITMAP;
function ReleasePalette: HPALETTE;
@ -1067,7 +1068,7 @@ type
const FileExtension: string): TFPCustomImageWriterClass; override;
{$ENDIF}
function LazarusResourceTypeValid(const ResourceType: string): boolean; override;
procedure ReadStream(Stream: TStream; Size: Longint); override;
procedure ReadStream(Stream: TStream; UseSize: boolean; Size: Longint); override;
procedure WriteStream(Stream: TStream; WriteSize: Boolean); override;
function GetDefaultMimeType: string; override;
end;
@ -1137,9 +1138,9 @@ var
OnLoadGraphicFromClipboardFormat: TOnLoadGraphicFromClipboardFormat;
OnSaveGraphicToClipboardFormat: TOnSaveGraphicToClipboardFormat;
function TestStreamBitmapNativeType(Stream: TMemoryStream): TBitmapNativeType;
function TestStreamIsBMP(Stream: TMemoryStream): boolean;
function TestStreamIsXPM(Stream: TMemoryStream): boolean;
function TestStreamBitmapNativeType(Stream: TCustomMemoryStream): TBitmapNativeType;
function TestStreamIsBMP(Stream: TCustomMemoryStream): boolean;
function TestStreamIsXPM(Stream: TCustomMemoryStream): boolean;
function XPMToPPChar(const XPM: string): PPChar;
function LazResourceXPMToPPChar(const ResourceName: string): PPChar;
function ReadXPMFromStream(Stream: TStream; Size: integer): PPChar;
@ -1451,6 +1452,9 @@ end.
{ =============================================================================
$Log$
Revision 1.120 2004/02/24 19:40:17 mattias
TBitmap can now read form streams without knowing the size
Revision 1.119 2004/02/23 08:19:04 micha
revert intf split

145
lcl/include/bitmap.inc
View File

@ -18,7 +18,8 @@
*****************************************************************************
}
function TestStreamBitmapNativeType(Stream: TMemoryStream): TBitmapNativeType;
function TestStreamBitmapNativeType(
Stream: TCustomMemoryStream): TBitmapNativeType;
begin
if TestStreamIsBMP(Stream) then
Result:=bnWinBitmap
@ -28,7 +29,7 @@ begin
Result:=bnNone;
end;
function TestStreamIsBMP(Stream: TMemoryStream): boolean;
function TestStreamIsBMP(Stream: TCustomMemoryStream): boolean;
var
BmpHeadbfType: word;
ReadSize: Integer;
@ -57,7 +58,7 @@ begin
// -> check if already shared
SrcBitmap:=TBitmap(Source);
if SrcBitmap.FImage=FImage then exit;
//writeln('TBitMap.Assign A RefCount=',FImage.RefCount);
// image is not shared => new image data
// -> free canvas (interface handles)
@ -156,6 +157,7 @@ end;
procedure TBitMap.FreeImage;
begin
UnshareImage(false);
Handle := 0;
end;
@ -307,7 +309,7 @@ end;
procedure TBitMap.LoadFromStream(Stream: TStream);
begin
ReadStream(Stream, Stream.Size - Stream.Position);
ReadStream(Stream, true, Stream.Size - Stream.Position);
end;
procedure TBitMap.LoadFromResourceName(Instance: THandle; const ResName: String);
@ -421,7 +423,7 @@ begin
FImage.SaveStreamType:=bnNone;
end;
procedure TBitmap.ReadStream(Stream: TStream; Size: Longint);
procedure TBitmap.ReadStream(Stream: TStream; UseSize: boolean; Size: Longint);
procedure RaiseInvalidBitmapHeader;
begin
@ -431,22 +433,29 @@ procedure TBitmap.ReadStream(Stream: TStream; Size: Longint);
{$IFNDEF DisableFPImage}
var
MemStream: TMemoryStream;
CacheStream: TStream;
StreamType: TBitmapNativeType;
ReaderClass: TFPCustomImageReaderClass;
begin
MemStream:=nil;
CacheStream:=nil;
try
// create mem stream if not already done (to read the image type)
if (Stream is TMemoryStream) then begin
MemStream:=TMemoryStream(Stream);
if (Stream is TCustomMemoryStream) then begin
CacheStream:=Stream;
end else if UseSize then begin
CacheStream:=TMemoryStream.Create;
CacheStream.CopyFrom(Stream,Size);
CacheStream.Position:=0;
end else begin
MemStream:=TMemoryStream.Create;
MemStream.CopyFrom(Stream,Size);
MemStream.Position:=0;
// size is unknown and type is not TMemoryStream
// ToDo: create cache stream from Stream
CacheStream:=Stream;
end;
// get image type
StreamType:=TestStreamBitmapNativeType(MemStream);
if CacheStream is TCustomMemoryStream then
StreamType:=TestStreamBitmapNativeType(TCustomMemoryStream(CacheStream))
else
StreamType:=bnWinBitmap;
ReaderClass:=nil;
case StreamType of
bnWinBitmap: ReaderClass:=TFPReaderBMP;
@ -454,10 +463,10 @@ begin
else
RaiseInvalidBitmapHeader;
end;
ReadStreamWithFPImage(MemStream,Size,ReaderClass);
ReadStreamWithFPImage(CacheStream,UseSize,Size,ReaderClass);
finally
if MemStream<>Stream then
MemStream.Free;
if CacheStream<>Stream then
CacheStream.Free;
end;
end;
{$ELSE if DisableFPImage}
@ -618,14 +627,14 @@ end;
procedure TBitmap.SetWidthHeight(NewWidth, NewHeight: integer);
begin
with FImage do
if (FDIB.dsbm.bmHeight <> NewHeight) or (FDIB.dsbm.bmWidth <> NewWidth) then
begin
FreeImage;
FDIB.dsbm.bmWidth := NewWidth;
FDIB.dsbm.bmHeight := NewHeight;
Changed(Self);
end;
if (FImage.FDIB.dsbm.bmHeight <> NewHeight)
or (FImage.FDIB.dsbm.bmWidth <> NewWidth) then
begin
FreeImage;
FImage.FDIB.dsbm.bmWidth := NewWidth;
FImage.FDIB.dsbm.bmHeight := NewHeight;
Changed(Self);
end;
end;
procedure TBitmap.WriteStream(Stream: TStream; WriteSize: Boolean);
@ -796,48 +805,85 @@ begin
MemStream.CopyFrom(Stream,Size);
FreeSaveStream;
FImage.FSaveStream:=MemStream;
end else
MemStream:=FImage.SaveStream;
end;
FImage.SaveStreamType:=bnNone;
FImage.SaveStream.Position:=0;
end;
{$IFNDEF DisableFPImage}
procedure TBitmap.ReadStreamWithFPImage(Stream: TStream; Size: Longint;
ReaderClass: TFPCustomImageReaderClass);
{------------------------------------------------------------------------------
procedure TBitmap.ReadStreamWithFPImage(Stream: TStream; UseSize: boolean;
Size: Longint; ReaderClass: TFPCustomImageReaderClass);
Clear old bitmap and read new bitmap form stream.
Stream: source stream. After reading Position will be at end of bitmap.
UseSize: if True, Size is used. If False then Size is calculated
automatically.
Size: Only used when UseSize=True. This amount of bytes are read.
------------------------------------------------------------------------------}
procedure TBitmap.ReadStreamWithFPImage(Stream: TStream; UseSize: boolean;
Size: Longint; ReaderClass: TFPCustomImageReaderClass);
var
IntfImg: TLazIntfImage;
ImgReader: TFPCustomImageReader;
ImgHandle, ImgMaskHandle: HBitmap;
NewSaveStream: TMemoryStream;
SrcStream: TStream;
OldStreamPosition: TStreamSeekType;
ImgSize: TStreamSeekType;
procedure StoreOriginal(OriginalStream: TStream; Size: integer);
begin
StoreOriginalStream(OriginalStream,Size);
NewSaveStream:=FImage.SaveStream;
NewSaveStream.Position:=0;
// hide SaveStream during reading (so that it won't be destroyed)
FImage.SaveStream:=nil;
end;
begin
UnshareImage(false);
if Size = 0 then begin
if UseSize and (Size = 0) then begin
Width:=0;
Height:=0;
exit;
end;
StoreOriginalStream(Stream,Size);
IntfImg:=nil;
ImgReader:=nil;
// hide SaveStream during reading (so that it won't be destroyed)
NewSaveStream:=FImage.SaveStream;
NewSaveStream:=nil;
if UseSize then begin
StoreOriginal(Stream,Size);
SrcStream:=NewSaveStream;
end else begin
FreeSaveStream;
SrcStream:=Stream;
end;
try
FImage.SaveStream:=nil;
// read image
IntfImg:=TLazIntfImage.Create(0,0);
IntfImg.GetDescriptionFromDevice(0);
ImgReader:=ReaderClass.Create;
InitFPImageReader(ImgReader);
NewSaveStream.Position:=0;
IntfImg.LoadFromStream(NewSaveStream,ImgReader);
OldStreamPosition:=SrcStream.Position;
IntfImg.LoadFromStream(SrcStream,ImgReader);
ImgSize:=SrcStream.Position-OldStreamPosition;
if not UseSize then begin
// now the size is known -> store stream
//writeln('TBitmap.ReadStreamWithFPImage SrcStream=',SrcStream.ClassName,' ImgSize=',ImgSize);
SrcStream.Position:=OldStreamPosition;
StoreOriginal(SrcStream,integer(ImgSize));
end else begin
// set position
if Size<>ImgSize then
SrcStream.Position:=OldStreamPosition+Size;
end;
FinalizeFPImageReader(ImgReader);
IntfImg.CreateBitmap(ImgHandle,ImgMaskHandle,false);
Handle:=ImgHandle;
MaskHandle:=ImgMaskHandle;
finally
// restore save stream
// set save stream
FImage.SaveStream:=NewSaveStream;
// clean up
IntfImg.Free;
@ -934,15 +980,13 @@ begin
// free old handles
FreeCanvasContext;
UnshareImage(false);
with FImage do begin
FreeHandle;
// get the properties from new bitmap
FHandle:=Value;
FillChar(FDIB, SizeOf(FDIB), 0);
if FHandle <> 0 then
GetObject(FHandle, SizeOf(FDIB), @FDIB);
Changed(Self);
end;
FImage.FreeHandle;
// get the properties from new bitmap
FImage.FHandle:=Value;
FillChar(FImage.FDIB, SizeOf(FImage.FDIB), 0);
if FImage.FHandle <> 0 then
GetObject(FImage.FHandle, SizeOf(FImage.FDIB), @FImage.FDIB);
Changed(Self);
end;
procedure TBitmap.SetMaskHandle(Value: HBITMAP);
@ -1011,8 +1055,7 @@ end;
function TBitmap.GetHeight: Integer;
begin
with FImage do
Result := FDIB.dsbm.bmHeight;
Result := FImage.FDIB.dsbm.bmHeight;
end;
function TBitmap.GetPalette: HPALETTE;
@ -1022,8 +1065,7 @@ end;
function TBitmap.GetWidth: Integer;
begin
with FImage do
Result := FDIB.dsbm.bmWidth;
Result := FImage.FDIB.dsbm.bmWidth;
end;
procedure TBitmap.ReadData(Stream: TStream);
@ -1031,7 +1073,7 @@ var
Size: Longint;
begin
Stream.Read(Size, SizeOf(Size));
ReadStream(Stream, Size);
ReadStream(Stream, true, Size);
end;
procedure TBitmap.WriteData(Stream: TStream);
@ -1066,6 +1108,9 @@ end;
{ =============================================================================
$Log$
Revision 1.72 2004/02/24 19:40:17 mattias
TBitmap can now read form streams without knowing the size
Revision 1.71 2004/02/23 08:19:04 micha
revert intf split

5
lcl/include/imglist.inc
View File

@ -652,7 +652,7 @@ begin
for i:=0 to NewCount-1 do begin
NewImage:=TBitMap.Create;
Stream.Read(CurSize, SizeOf(CurSize));
NewImage.ReadStream(Stream,CurSize);
NewImage.ReadStream(Stream,true,CurSize);
NewImage.Transparent:=True;
AddDirect(NewImage,nil);
end;
@ -1082,6 +1082,9 @@ end;
{
$Log$
Revision 1.24 2004/02/24 19:40:17 mattias
TBitmap can now read form streams without knowing the size
Revision 1.23 2004/02/22 10:43:20 mattias
added child-parent checks

5
lcl/include/pixmap.inc
View File

@ -17,7 +17,7 @@
*****************************************************************************
}
function TestStreamIsXPM(Stream: TMemoryStream): boolean;
function TestStreamIsXPM(Stream: TCustomMemoryStream): boolean;
type
TXPMRange = (xrCode,xrStaticKeyWord, xrCharKeyWord);
@ -286,6 +286,9 @@ end;
{ =============================================================================
$Log$
Revision 1.25 2004/02/24 19:40:17 mattias
TBitmap can now read form streams without knowing the size
Revision 1.24 2004/02/02 22:01:51 mattias
fpImage is now used as default, deactivate it with -dDisableFPImage

5
lcl/include/png.inc
View File

@ -40,10 +40,11 @@ begin
Result:=(ResourceType='PNG');
end;
procedure TPortableNetworkGraphic.ReadStream(Stream: TStream; Size: Longint);
procedure TPortableNetworkGraphic.ReadStream(Stream: TStream; UseSize: boolean;
Size: Longint);
begin
{$IFNDEF DisableFPImage}
ReadStreamWithFPImage(Stream,Size,TFPReaderPNG);
ReadStreamWithFPImage(Stream,UseSize,Size,TFPReaderPNG);
{$ELSE}
RaiseGDBException('TPortableNetworkGraphic.ReadStream needs FPImage');
{$ENDIF}