paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 17:39:20 +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 WriteData(Stream: TStream); override;
procedure StoreOriginalStream(Stream: TStream; Size: integer); virtual; procedure StoreOriginalStream(Stream: TStream; Size: integer); virtual;
{$IFNDEF DisableFPImage} {$IFNDEF DisableFPImage}
procedure ReadStreamWithFPImage(Stream: TStream; Size: Longint; procedure ReadStreamWithFPImage(Stream: TStream; UseSize: boolean;
Size: Longint;
ReaderClass: TFPCustomImageReaderClass); virtual; ReaderClass: TFPCustomImageReaderClass); virtual;
procedure WriteStreamWithFPImage(Stream: TStream; WriteSize: boolean; procedure WriteStreamWithFPImage(Stream: TStream; WriteSize: boolean;
WriterClass: TFPCustomImageWriterClass); virtual; WriterClass: TFPCustomImageWriterClass); virtual;
@ -1022,7 +1023,7 @@ type
Procedure LoadFromXPMFile(const Filename : String); Procedure LoadFromXPMFile(const Filename : String);
procedure Mask(ATransparentColor: TColor); procedure Mask(ATransparentColor: TColor);
procedure SaveToStream(Stream: TStream); override; 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; procedure WriteStream(Stream: TStream; WriteSize: Boolean); virtual;
Function ReleaseHandle: HBITMAP; Function ReleaseHandle: HBITMAP;
function ReleasePalette: HPALETTE; function ReleasePalette: HPALETTE;
@ -1067,7 +1068,7 @@ type
const FileExtension: string): TFPCustomImageWriterClass; override; const FileExtension: string): TFPCustomImageWriterClass; override;
{$ENDIF} {$ENDIF}
function LazarusResourceTypeValid(const ResourceType: string): boolean; override; 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; procedure WriteStream(Stream: TStream; WriteSize: Boolean); override;
function GetDefaultMimeType: string; override; function GetDefaultMimeType: string; override;
end; end;
@ -1137,9 +1138,9 @@ var
OnLoadGraphicFromClipboardFormat: TOnLoadGraphicFromClipboardFormat; OnLoadGraphicFromClipboardFormat: TOnLoadGraphicFromClipboardFormat;
OnSaveGraphicToClipboardFormat: TOnSaveGraphicToClipboardFormat; OnSaveGraphicToClipboardFormat: TOnSaveGraphicToClipboardFormat;
function TestStreamBitmapNativeType(Stream: TMemoryStream): TBitmapNativeType; function TestStreamBitmapNativeType(Stream: TCustomMemoryStream): TBitmapNativeType;
function TestStreamIsBMP(Stream: TMemoryStream): boolean; function TestStreamIsBMP(Stream: TCustomMemoryStream): boolean;
function TestStreamIsXPM(Stream: TMemoryStream): boolean; function TestStreamIsXPM(Stream: TCustomMemoryStream): boolean;
function XPMToPPChar(const XPM: string): PPChar; function XPMToPPChar(const XPM: string): PPChar;
function LazResourceXPMToPPChar(const ResourceName: string): PPChar; function LazResourceXPMToPPChar(const ResourceName: string): PPChar;
function ReadXPMFromStream(Stream: TStream; Size: integer): PPChar; function ReadXPMFromStream(Stream: TStream; Size: integer): PPChar;
@ -1451,6 +1452,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $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 Revision 1.119 2004/02/23 08:19:04 micha
revert intf split revert intf split

131
lcl/include/bitmap.inc
View File

@ -18,7 +18,8 @@
***************************************************************************** *****************************************************************************
} }
function TestStreamBitmapNativeType(Stream: TMemoryStream): TBitmapNativeType; function TestStreamBitmapNativeType(
Stream: TCustomMemoryStream): TBitmapNativeType;
begin begin
if TestStreamIsBMP(Stream) then if TestStreamIsBMP(Stream) then
Result:=bnWinBitmap Result:=bnWinBitmap
@ -28,7 +29,7 @@ begin
Result:=bnNone; Result:=bnNone;
end; end;
function TestStreamIsBMP(Stream: TMemoryStream): boolean; function TestStreamIsBMP(Stream: TCustomMemoryStream): boolean;
var var
BmpHeadbfType: word; BmpHeadbfType: word;
ReadSize: Integer; ReadSize: Integer;
@ -156,6 +157,7 @@ end;
procedure TBitMap.FreeImage; procedure TBitMap.FreeImage;
begin begin
UnshareImage(false);
Handle := 0; Handle := 0;
end; end;
@ -307,7 +309,7 @@ end;
procedure TBitMap.LoadFromStream(Stream: TStream); procedure TBitMap.LoadFromStream(Stream: TStream);
begin begin
ReadStream(Stream, Stream.Size - Stream.Position); ReadStream(Stream, true, Stream.Size - Stream.Position);
end; end;
procedure TBitMap.LoadFromResourceName(Instance: THandle; const ResName: String); procedure TBitMap.LoadFromResourceName(Instance: THandle; const ResName: String);
@ -421,7 +423,7 @@ begin
FImage.SaveStreamType:=bnNone; FImage.SaveStreamType:=bnNone;
end; end;
procedure TBitmap.ReadStream(Stream: TStream; Size: Longint); procedure TBitmap.ReadStream(Stream: TStream; UseSize: boolean; Size: Longint);
procedure RaiseInvalidBitmapHeader; procedure RaiseInvalidBitmapHeader;
begin begin
@ -431,22 +433,29 @@ procedure TBitmap.ReadStream(Stream: TStream; Size: Longint);
{$IFNDEF DisableFPImage} {$IFNDEF DisableFPImage}
var var
MemStream: TMemoryStream; CacheStream: TStream;
StreamType: TBitmapNativeType; StreamType: TBitmapNativeType;
ReaderClass: TFPCustomImageReaderClass; ReaderClass: TFPCustomImageReaderClass;
begin begin
MemStream:=nil; CacheStream:=nil;
try try
// create mem stream if not already done (to read the image type) // create mem stream if not already done (to read the image type)
if (Stream is TMemoryStream) then begin if (Stream is TCustomMemoryStream) then begin
MemStream:=TMemoryStream(Stream); CacheStream:=Stream;
end else if UseSize then begin
CacheStream:=TMemoryStream.Create;
CacheStream.CopyFrom(Stream,Size);
CacheStream.Position:=0;
end else begin end else begin
MemStream:=TMemoryStream.Create; // size is unknown and type is not TMemoryStream
MemStream.CopyFrom(Stream,Size); // ToDo: create cache stream from Stream
MemStream.Position:=0; CacheStream:=Stream;
end; end;
// get image type // get image type
StreamType:=TestStreamBitmapNativeType(MemStream); if CacheStream is TCustomMemoryStream then
StreamType:=TestStreamBitmapNativeType(TCustomMemoryStream(CacheStream))
else
StreamType:=bnWinBitmap;
ReaderClass:=nil; ReaderClass:=nil;
case StreamType of case StreamType of
bnWinBitmap: ReaderClass:=TFPReaderBMP; bnWinBitmap: ReaderClass:=TFPReaderBMP;
@ -454,10 +463,10 @@ begin
else else
RaiseInvalidBitmapHeader; RaiseInvalidBitmapHeader;
end; end;
ReadStreamWithFPImage(MemStream,Size,ReaderClass); ReadStreamWithFPImage(CacheStream,UseSize,Size,ReaderClass);
finally finally
if MemStream<>Stream then if CacheStream<>Stream then
MemStream.Free; CacheStream.Free;
end; end;
end; end;
{$ELSE if DisableFPImage} {$ELSE if DisableFPImage}
@ -618,12 +627,12 @@ end;
procedure TBitmap.SetWidthHeight(NewWidth, NewHeight: integer); procedure TBitmap.SetWidthHeight(NewWidth, NewHeight: integer);
begin begin
with FImage do if (FImage.FDIB.dsbm.bmHeight <> NewHeight)
if (FDIB.dsbm.bmHeight <> NewHeight) or (FDIB.dsbm.bmWidth <> NewWidth) then or (FImage.FDIB.dsbm.bmWidth <> NewWidth) then
begin begin
FreeImage; FreeImage;
FDIB.dsbm.bmWidth := NewWidth; FImage.FDIB.dsbm.bmWidth := NewWidth;
FDIB.dsbm.bmHeight := NewHeight; FImage.FDIB.dsbm.bmHeight := NewHeight;
Changed(Self); Changed(Self);
end; end;
end; end;
@ -796,48 +805,85 @@ begin
MemStream.CopyFrom(Stream,Size); MemStream.CopyFrom(Stream,Size);
FreeSaveStream; FreeSaveStream;
FImage.FSaveStream:=MemStream; FImage.FSaveStream:=MemStream;
end else end;
MemStream:=FImage.SaveStream;
FImage.SaveStreamType:=bnNone; FImage.SaveStreamType:=bnNone;
FImage.SaveStream.Position:=0; FImage.SaveStream.Position:=0;
end; end;
{$IFNDEF DisableFPImage} {$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 var
IntfImg: TLazIntfImage; IntfImg: TLazIntfImage;
ImgReader: TFPCustomImageReader; ImgReader: TFPCustomImageReader;
ImgHandle, ImgMaskHandle: HBitmap; ImgHandle, ImgMaskHandle: HBitmap;
NewSaveStream: TMemoryStream; 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 begin
UnshareImage(false); UnshareImage(false);
if Size = 0 then begin if UseSize and (Size = 0) then begin
Width:=0; Width:=0;
Height:=0; Height:=0;
exit; exit;
end; end;
StoreOriginalStream(Stream,Size);
IntfImg:=nil; IntfImg:=nil;
ImgReader:=nil; ImgReader:=nil;
// hide SaveStream during reading (so that it won't be destroyed) NewSaveStream:=nil;
NewSaveStream:=FImage.SaveStream; if UseSize then begin
StoreOriginal(Stream,Size);
SrcStream:=NewSaveStream;
end else begin
FreeSaveStream;
SrcStream:=Stream;
end;
try try
FImage.SaveStream:=nil;
// read image // read image
IntfImg:=TLazIntfImage.Create(0,0); IntfImg:=TLazIntfImage.Create(0,0);
IntfImg.GetDescriptionFromDevice(0); IntfImg.GetDescriptionFromDevice(0);
ImgReader:=ReaderClass.Create; ImgReader:=ReaderClass.Create;
InitFPImageReader(ImgReader); InitFPImageReader(ImgReader);
NewSaveStream.Position:=0; OldStreamPosition:=SrcStream.Position;
IntfImg.LoadFromStream(NewSaveStream,ImgReader); 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); FinalizeFPImageReader(ImgReader);
IntfImg.CreateBitmap(ImgHandle,ImgMaskHandle,false); IntfImg.CreateBitmap(ImgHandle,ImgMaskHandle,false);
Handle:=ImgHandle; Handle:=ImgHandle;
MaskHandle:=ImgMaskHandle; MaskHandle:=ImgMaskHandle;
finally finally
// restore save stream // set save stream
FImage.SaveStream:=NewSaveStream; FImage.SaveStream:=NewSaveStream;
// clean up // clean up
IntfImg.Free; IntfImg.Free;
@ -934,16 +980,14 @@ begin
// free old handles // free old handles
FreeCanvasContext; FreeCanvasContext;
UnshareImage(false); UnshareImage(false);
with FImage do begin FImage.FreeHandle;
FreeHandle;
// get the properties from new bitmap // get the properties from new bitmap
FHandle:=Value; FImage.FHandle:=Value;
FillChar(FDIB, SizeOf(FDIB), 0); FillChar(FImage.FDIB, SizeOf(FImage.FDIB), 0);
if FHandle <> 0 then if FImage.FHandle <> 0 then
GetObject(FHandle, SizeOf(FDIB), @FDIB); GetObject(FImage.FHandle, SizeOf(FImage.FDIB), @FImage.FDIB);
Changed(Self); Changed(Self);
end; end;
end;
procedure TBitmap.SetMaskHandle(Value: HBITMAP); procedure TBitmap.SetMaskHandle(Value: HBITMAP);
begin begin
@ -1011,8 +1055,7 @@ end;
function TBitmap.GetHeight: Integer; function TBitmap.GetHeight: Integer;
begin begin
with FImage do Result := FImage.FDIB.dsbm.bmHeight;
Result := FDIB.dsbm.bmHeight;
end; end;
function TBitmap.GetPalette: HPALETTE; function TBitmap.GetPalette: HPALETTE;
@ -1022,8 +1065,7 @@ end;
function TBitmap.GetWidth: Integer; function TBitmap.GetWidth: Integer;
begin begin
with FImage do Result := FImage.FDIB.dsbm.bmWidth;
Result := FDIB.dsbm.bmWidth;
end; end;
procedure TBitmap.ReadData(Stream: TStream); procedure TBitmap.ReadData(Stream: TStream);
@ -1031,7 +1073,7 @@ var
Size: Longint; Size: Longint;
begin begin
Stream.Read(Size, SizeOf(Size)); Stream.Read(Size, SizeOf(Size));
ReadStream(Stream, Size); ReadStream(Stream, true, Size);
end; end;
procedure TBitmap.WriteData(Stream: TStream); procedure TBitmap.WriteData(Stream: TStream);
@ -1066,6 +1108,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $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 Revision 1.71 2004/02/23 08:19:04 micha
revert intf split revert intf split

5
lcl/include/imglist.inc
View File

@ -652,7 +652,7 @@ begin
for i:=0 to NewCount-1 do begin for i:=0 to NewCount-1 do begin
NewImage:=TBitMap.Create; NewImage:=TBitMap.Create;
Stream.Read(CurSize, SizeOf(CurSize)); Stream.Read(CurSize, SizeOf(CurSize));
NewImage.ReadStream(Stream,CurSize); NewImage.ReadStream(Stream,true,CurSize);
NewImage.Transparent:=True; NewImage.Transparent:=True;
AddDirect(NewImage,nil); AddDirect(NewImage,nil);
end; end;
@ -1082,6 +1082,9 @@ end;
{ {
$Log$ $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 Revision 1.23 2004/02/22 10:43:20 mattias
added child-parent checks 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 type
TXPMRange = (xrCode,xrStaticKeyWord, xrCharKeyWord); TXPMRange = (xrCode,xrStaticKeyWord, xrCharKeyWord);
@ -286,6 +286,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $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 Revision 1.24 2004/02/02 22:01:51 mattias
fpImage is now used as default, deactivate it with -dDisableFPImage 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'); Result:=(ResourceType='PNG');
end; end;
procedure TPortableNetworkGraphic.ReadStream(Stream: TStream; Size: Longint); procedure TPortableNetworkGraphic.ReadStream(Stream: TStream; UseSize: boolean;
Size: Longint);
begin begin
{$IFNDEF DisableFPImage} {$IFNDEF DisableFPImage}
ReadStreamWithFPImage(Stream,Size,TFPReaderPNG); ReadStreamWithFPImage(Stream,UseSize,Size,TFPReaderPNG);
{$ELSE} {$ELSE}
RaiseGDBException('TPortableNetworkGraphic.ReadStream needs FPImage'); RaiseGDBException('TPortableNetworkGraphic.ReadStream needs FPImage');
{$ENDIF} {$ENDIF}