paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-09 15:36:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

added TLazReaderBMP to cacheable image readers, added smallint, shortint reader/writer functions, accelerated LRS writer by writing big chunks in one call

Browse Source 
git-svn-id: trunk@8825 -
This commit is contained in:
mattias 2006-02-25 22:48:47 +00:00
parent 7f9586348a
commit e8a5d48fbd
2 changed files with 51 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
lcl/include/bitmap.inc
View File

@ -519,7 +519,7 @@ procedure TBitmap.ReadStream(Stream: TStream; UseSize: boolean; Size: Longint);
end;
var
CacheStream: TStream;
WorkStream: TStream;
StreamType: TBitmapNativeType;
ReaderClass: TFPCustomImageReaderClass;
MemStream: TCustomMemoryStream;
@ -527,24 +527,24 @@ var
OldPosition: Int64;
begin
//debugln('TBitmap.ReadStream Stream=',DbgSName(Stream),' Stream.Size=',dbgs(Stream.Size),' Stream.Position=',dbgs(Stream.Position),' UseSize=',dbgs(UseSize),' Size=',dbgs(Size));
CacheStream:=nil;
WorkStream:=nil;
try
// create mem stream if not already done (to read the image type)
if (Stream is TCustomMemoryStream) then begin
CacheStream:=Stream;
WorkStream:=Stream;
end else if UseSize then begin
CacheStream:=TMemoryStream.Create;
TMemoryStream(CacheStream).SetSize(Size);
CacheStream.CopyFrom(Stream,Size);
CacheStream.Position:=0;
WorkStream:=TMemoryStream.Create;
TMemoryStream(WorkStream).SetSize(Size);
WorkStream.CopyFrom(Stream,Size);
WorkStream.Position:=0;
end else begin
// size is unknown and type is not TMemoryStream
// ToDo: create cache stream from Stream
CacheStream:=Stream;
WorkStream:=Stream;
end;
// get image type
if CacheStream is TCustomMemoryStream then begin
MemStream:=TCustomMemoryStream(CacheStream);
if WorkStream is TCustomMemoryStream then begin
MemStream:=TCustomMemoryStream(WorkStream);
OldPosition:=MemStream.Position;
GetSize:=MemStream.Size;
// workaround for TMemoryStream bug, reading Size sets Position to 0
@ -563,10 +563,10 @@ begin
else
RaiseInvalidBitmapHeader;
end;
ReadStreamWithFPImage(CacheStream,UseSize,Size,ReaderClass);
ReadStreamWithFPImage(WorkStream,UseSize,Size,ReaderClass);
finally
if CacheStream<>Stream then
CacheStream.Free;
if WorkStream<>Stream then
WorkStream.Free;
end;
end;
@ -704,13 +704,14 @@ begin
finally
// set save stream
FImage.SaveStream:=NewSaveStream;
if ReaderClass=TFPReaderBMP then begin
if (ReaderClass=TFPReaderBMP) or (ReaderClass=TLazReaderBMP) then begin
FImage.SaveStreamType:=bnWinBitmap;
FImage.SaveStreamClass:=TFPWriterBMP;
end else if ReaderClass=TLazReaderXPM then begin
FImage.SaveStreamType:=bnXPixmap;
FImage.SaveStreamClass:=TLazWriterXPM;
end;
//DebugLn('TBitmap.ReadStreamWithFPImage ',DbgSName(FImage.SaveStreamClass),' ',DbgSName(ReaderClass));
// clean up
IntfImg.Free;
ImgReader.Free;

57
lcl/lresources.pp
View File

@ -272,9 +272,10 @@ function ConvertLRSExtendedToDouble(p: Pointer): Double;
procedure ConvertEndianBigDoubleToLRSExtended(BigEndianDouble,
LRSExtended: Pointer);
function ReadLRSByte(s: TStream): byte;
function ReadLRSWord(s: TStream): word;
function ReadLRSShortInt(s: TStream): shortint;
function ReadLRSByte(s: TStream): byte;
function ReadLRSSmallInt(s: TStream): smallint;
function ReadLRSWord(s: TStream): word;
function ReadLRSInteger(s: TStream): integer;
function ReadLRSCardinal(s: TStream): cardinal;
function ReadLRSInt64(s: TStream): int64;
@ -287,7 +288,7 @@ function ReadLRSEndianLittleExtendedAsDouble(s: TStream): Double;
function ReadLRSValueType(s: TStream): TValueType;
function ReadLRSInt64MB(s: TStream): int64;// multibyte
procedure WriteLRSShortInt(s: TStream; const i: shortint);
procedure WriteLRSSmallInt(s: TStream; const i: smallint);
procedure WriteLRSWord(s: TStream; const w: word);
procedure WriteLRSInteger(s: TStream; const i: integer);
procedure WriteLRSCardinal(s: TStream; const c: cardinal);
@ -2455,6 +2456,12 @@ begin
end;
end;
function ReadLRSShortInt(s: TStream): shortint;
begin
Result:=0;
s.Read(Result,1);
end;
function ReadLRSByte(s: TStream): byte;
begin
Result:=0;
@ -2470,11 +2477,11 @@ begin
{$ENDIF}
end;
function ReadLRSShortInt(s: TStream): shortint;
function ReadLRSSmallInt(s: TStream): smallint;
begin
Result:=0;
{$IFDEF FPC_BIG_ENDIAN}
Result:=shortint(ReadLRSWord(s));
Result:=smallint(ReadLRSWord(s));
{$ELSE}
s.Read(Result,2);
{$ENDIF}
@ -2587,8 +2594,8 @@ var
begin
v:=ReadLRSValueType(s);
case v of
vaInt8: Result:=ReadLRSByte(s);
vaInt16: Result:=ReadLRSWord(s);
vaInt8: Result:=ReadLRSShortInt(s);
vaInt16: Result:=ReadLRSSmallInt(s);
vaInt32: Result:=ReadLRSInteger(s);
vaInt64: Result:=ReadLRSInt64(s);
else
@ -2693,12 +2700,12 @@ begin
s.Write(e[0],10);
end;
procedure WriteLRSShortInt(s: TStream; const i: shortint);
procedure WriteLRSSmallInt(s: TStream; const i: SmallInt);
begin
{$IFDEF FPC_LITTLE_ENDIAN}
s.Write(i,2);
{$ELSE}
WriteLRSReversedShortInt(s,Word(i));
WriteLRSReversedWord(s,Word(i));
{$ENDIF}
end;
@ -2806,7 +2813,7 @@ begin
begin
b:=byte(vaInt8);
s.Write(b, 1);
b:=Byte(Value);
b:=byte(Value);
s.Write(b, 1);
end else if (Value >= -32768) and (Value <= 32767) then
begin
@ -3243,18 +3250,26 @@ var
CopyNow: LongInt;
SourceBuf: PChar;
begin
SourceBuf:=@Buffer;
while Count > 0 do
begin
CopyNow := Count;
if CopyNow > FBufSize - FBufPos then
CopyNow := FBufSize - FBufPos;
Move(SourceBuf^, PChar(FBuffer)[FBufPos], CopyNow);
Dec(Count, CopyNow);
Inc(FBufPos, CopyNow);
SourceBuf:=SourceBuf+CopyNow;
if FBufPos = FBufSize then
if Count<2*FBufSize then begin
// write a small amount of data
SourceBuf:=@Buffer;
while Count > 0 do
begin
CopyNow := Count;
if CopyNow > FBufSize - FBufPos then
CopyNow := FBufSize - FBufPos;
Move(SourceBuf^, PChar(FBuffer)[FBufPos], CopyNow);
Dec(Count, CopyNow);
Inc(FBufPos, CopyNow);
SourceBuf:=SourceBuf+CopyNow;
if FBufPos = FBufSize then
FlushBuffer;
end;
end else begin
// write a big amount of data
if FBufPos>0 then
FlushBuffer;
FStream.WriteBuffer(Buffer, Count);
end;
end;