mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-01 06:52:35 +02:00
improved DefineProperties to read/write endian independent
git-svn-id: trunk@5790 -
This commit is contained in:
mattias
parent
05cae27203
commit
2d80b0247f
@ -37,9 +37,10 @@ unit ComCtrls;
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Math, FPCAdds, LCLStrConsts, LCLIntf, LCLType, LCLProc,
|
||||
AvgLvlTree, vclGlobals, LMessages, ImgList, ActnList, GraphType, Graphics,
|
||||
Menus, Controls, Forms, StdCtrls, ExtCtrls, ToolWin, CommCtrl, Buttons;
|
||||
SysUtils, Classes, Math, FPCAdds, LCLStrConsts, LResources, LCLIntf, LCLType,
|
||||
LCLProc, AvgLvlTree, vclGlobals, LMessages, ImgList, ActnList, GraphType,
|
||||
Graphics, Menus, Controls, Forms, StdCtrls, ExtCtrls, ToolWin, CommCtrl,
|
||||
Buttons;
|
||||
|
||||
type
|
||||
TStatusPanelStyle = (psText, psOwnerDraw);
|
||||
@ -2306,6 +2307,9 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.142 2004/08/15 17:00:58 mattias
|
||||
improved DefineProperties to read/write endian independent
|
||||
|
||||
Revision 1.141 2004/08/04 09:35:38 mattias
|
||||
implemented setting TTabSheet.TabIndex
|
||||
|
||||
|
||||
@ -45,8 +45,8 @@ interface
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
SysUtils, Classes, LCLStrConsts, LCLProc, Controls, Forms, StdCtrls,
|
||||
vclGlobals, lMessages, GraphType, Graphics, LCLIntf, CustomTimer;
|
||||
SysUtils, Classes, LCLStrConsts, LCLProc, LResources, Controls, Forms,
|
||||
StdCtrls, vclGlobals, lMessages, GraphType, Graphics, LCLIntf, CustomTimer;
|
||||
|
||||
type
|
||||
{ workaround problem with fcl }
|
||||
@ -967,6 +967,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.114 2004/08/15 17:00:58 mattias
|
||||
improved DefineProperties to read/write endian independent
|
||||
|
||||
Revision 1.113 2004/08/04 09:57:17 mattias
|
||||
TStaticText.CanTab=false
|
||||
|
||||
|
||||
@ -35,7 +35,7 @@ History
|
||||
- Add TCustomImageList.Assign()
|
||||
- Add TCustomImageList.WriteData()
|
||||
- Add TCustomImageList.ReadData()
|
||||
- Add overrite TCustomImageList.DefineProperties()
|
||||
- Add override TCustomImageList.DefineProperties()
|
||||
Warning : the delphi or kylix format of datas is not compatible.
|
||||
- Modify Delete and Clear for preserve memory
|
||||
}
|
||||
@ -219,6 +219,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.23 2004/08/15 17:00:58 mattias
|
||||
improved DefineProperties to read/write endian independent
|
||||
|
||||
Revision 1.22 2004/04/29 18:08:17 mattias
|
||||
fixed 1.0.10 compilation
|
||||
|
||||
|
||||
@ -221,7 +221,7 @@ var
|
||||
i: Integer;
|
||||
v: Integer;
|
||||
begin
|
||||
Stream.ReadBuffer(ChecksCount, SizeOf(Integer));
|
||||
ChecksCount:=ReadLRSInteger(Stream);
|
||||
if ChecksCount>0 then begin
|
||||
SetLength(Checks,ChecksCount);
|
||||
Stream.ReadBuffer(Checks[1], ChecksCount);
|
||||
@ -241,7 +241,7 @@ var
|
||||
v: Integer;
|
||||
begin
|
||||
ChecksCount:=FItems.Count;
|
||||
Stream.WriteBuffer(ChecksCount, SizeOf(Integer));
|
||||
WriteLRSInteger(Stream,ChecksCount);
|
||||
if ChecksCount>0 then begin
|
||||
SetLength(Checks,ChecksCount);
|
||||
for i:=0 to ChecksCount-1 do begin
|
||||
@ -278,6 +278,9 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 2004/08/15 17:00:58 mattias
|
||||
improved DefineProperties to read/write endian independent
|
||||
|
||||
Revision 1.8 2004/07/16 21:49:00 mattias
|
||||
added RTTI controls
|
||||
|
||||
|
||||
@ -792,7 +792,7 @@ begin
|
||||
AStream.Write(Signature,SizeOf(Signature));
|
||||
|
||||
//Count of image
|
||||
AStream.WriteWord(Count);
|
||||
WriteLRSWord(AStream,Count);
|
||||
|
||||
for i:=0 to Count-1 do
|
||||
begin
|
||||
@ -805,9 +805,9 @@ begin
|
||||
AStream.Write(Signature,SizeOf(Signature));
|
||||
|
||||
//Count of image
|
||||
AStream.WriteDWord(Count);
|
||||
AStream.WriteDWord(Width);
|
||||
AStream.WriteDWord(Height);
|
||||
WriteLRSInteger(AStream,Count);
|
||||
WriteLRSInteger(AStream,Width);
|
||||
WriteLRSInteger(AStream,Height);
|
||||
|
||||
for i:=0 to Count-1 do
|
||||
begin
|
||||
@ -842,7 +842,7 @@ var
|
||||
for i := 0 to NewCount - 1 do
|
||||
begin
|
||||
bmp := TBitMap.Create;
|
||||
AStream.Read(Size, SizeOf(Size));
|
||||
Size:=ReadLRSInteger(AStream);
|
||||
bmp.ReadStream(AStream, True, Size);
|
||||
bmp.Transparent := True;
|
||||
AddDirect(bmp, nil);
|
||||
@ -855,15 +855,15 @@ var
|
||||
bmp: TBitmap;
|
||||
begin
|
||||
//DebugLn('TCustomImageList.ReadData DoReadLaz2');
|
||||
NewCount := AStream.ReadDWord;
|
||||
Width := AStream.ReadDWord;
|
||||
Height := AStream.ReadDWord;
|
||||
NewCount := ReadLRSCardinal(AStream);
|
||||
Width := ReadLRSCardinal(AStream);
|
||||
Height := ReadLRSCardinal(AStream);
|
||||
//DebugLn('TCustomImageList.ReadData DoReadLaz2 NewCount=',NewCount,' Width=',Width,' Height=',Height);
|
||||
for i := 0 to NewCount - 1 do
|
||||
begin
|
||||
bmp := TBitMap.Create;
|
||||
//DebugLn('TCustomImageList.ReadData DoReadLaz2 i=',i,' ',AStream.Position);
|
||||
AStream.Read(Size, SizeOf(Size));
|
||||
Size:=ReadLRSCardinal(AStream);
|
||||
//DebugLn('TCustomImageList.ReadData DoReadLaz2 Size=',Size,' ',AStream.Position);
|
||||
bmp.ReadStream(AStream, True, Size);
|
||||
AddDirect(bmp, nil);
|
||||
@ -1004,17 +1004,17 @@ begin
|
||||
if Signature = SIG_D3
|
||||
then begin
|
||||
AStream.ReadWord; //Skip ?
|
||||
NewCount := AStream.ReadWord;
|
||||
NewCount := ReadLRSWord(AStream);
|
||||
//DebugLn('NewCount=',NewCount);
|
||||
AStream.ReadWord; //Skip Capacity
|
||||
AStream.ReadWord; //Skip Grow
|
||||
FWidth := AStream.ReadWord;
|
||||
FWidth := ReadLRSWord(AStream);
|
||||
//DebugLn('NewWidth=',FWidth);
|
||||
FHeight := AStream.ReadWord;
|
||||
FHeight := ReadLRSWord(AStream);
|
||||
//DebugLn('NewHeight=',FHeight);
|
||||
FBKColor := TColor(AStream.ReadDWord);
|
||||
FBKColor := TColor(ReadLRSInteger(AStream));
|
||||
{$IFNDEF DisableFPImage}
|
||||
HasMask := (AStream.ReadWord and 1) = 1;
|
||||
HasMask := (ReadLRSWord(AStream) and 1) = 1;
|
||||
AStream.ReadDWord; //Skip ?
|
||||
AStream.ReadDWord; //Skip ?
|
||||
|
||||
@ -1024,12 +1024,13 @@ begin
|
||||
else begin
|
||||
// D2 has no signature, so restore original position
|
||||
AStream.Position := StreamPos;
|
||||
AStream.ReadBuffer(Size, SizeOf(Size));
|
||||
AStream.ReadBuffer(NewCount, SizeOf(NewCount));
|
||||
Size:=ReadLRSInteger(AStream);
|
||||
NewCount:=ReadLRSInteger(AStream);
|
||||
|
||||
{$IFNDEF DisableFPImage}
|
||||
ReadDelphiImageAndMask(false,NewCount);
|
||||
{$ENDIF}
|
||||
AStream.Position := StreamPos+Size;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1261,6 +1262,9 @@ end;
|
||||
{
|
||||
|
||||
$Log$
|
||||
Revision 1.40 2004/08/15 17:00:58 mattias
|
||||
improved DefineProperties to read/write endian independent
|
||||
|
||||
Revision 1.39 2004/05/11 11:42:27 mattias
|
||||
replaced writeln by debugln
|
||||
|
||||
|
||||
@ -278,17 +278,25 @@ var
|
||||
begin
|
||||
Clear;
|
||||
//Flag:=False;
|
||||
Stream.ReadBuffer(Size, SizeOf(Integer));
|
||||
Size:=ReadLRSInteger(Stream);
|
||||
ItemHeader := AllocMem(Size);
|
||||
Owner.BeginUpdate;
|
||||
try
|
||||
Stream.ReadBuffer(ItemHeader^.Count, Size - SizeOf(Integer));
|
||||
ItemHeader^.Count:=ReadLRSInteger(Stream);
|
||||
Stream.ReadBuffer(ItemHeader^.Items, Size - 8);
|
||||
ItemInfo := @ItemHeader^.Items;
|
||||
PStr := nil;
|
||||
for I := 0 to ItemHeader^.Count - 1 do
|
||||
begin
|
||||
with Add do
|
||||
begin
|
||||
{$IFDEF Endian_BIG}
|
||||
ReverseBytes(@ItemInfo^.ImageIndex,4);
|
||||
ReverseBytes(@ItemInfo^.StateIndex,4);
|
||||
ReverseBytes(@ItemInfo^.OverlayIndex,4);
|
||||
ReverseBytes(@ItemInfo^.SubItemCount,4);
|
||||
ReverseBytes(@ItemInfo^.Data,4);
|
||||
{$ENDIF}
|
||||
//Flag:=True;
|
||||
Caption := ItemInfo^.Caption;
|
||||
ImageIndex := ItemInfo^.ImageIndex;
|
||||
@ -317,6 +325,9 @@ begin
|
||||
then begin
|
||||
for J := 0 to Item[I].SubItems.Count - 1 do
|
||||
begin
|
||||
{$ifdef Endian_Little}
|
||||
ReverseBytes(@PInt,4);
|
||||
{$endif}
|
||||
Item[I].SubItemImages[J] := PInt^;
|
||||
Inc(PInt);
|
||||
end;
|
||||
@ -364,6 +375,10 @@ begin
|
||||
try
|
||||
ItemHeader^.Size := Size;
|
||||
ItemHeader^.Count := Count;
|
||||
{$ifdef Endian_Little}
|
||||
ReverseBytes(@ItemHeader^.Size,4);
|
||||
ReverseBytes(@ItemHeader^.Count,4);
|
||||
{$endif}
|
||||
ItemInfo := @ItemHeader^.Items;
|
||||
PStr := nil;
|
||||
for I := 0 to Count - 1 do
|
||||
@ -372,10 +387,17 @@ begin
|
||||
begin
|
||||
ItemInfo^.Caption := Caption;
|
||||
ItemInfo^.ImageIndex := ImageIndex;
|
||||
ItemInfo^.OverlayIndex := -1 {OverlayIndex};
|
||||
ItemInfo^.StateIndex := -1 {StateIndex};
|
||||
ItemInfo^.Data := Data;
|
||||
ItemInfo^.OverlayIndex := -1 {OverlayIndex};
|
||||
ItemInfo^.SubItemCount := SubItems.Count;
|
||||
ItemInfo^.Data := Data;
|
||||
{$IFDEF Endian_BIG}
|
||||
ReverseBytes(@ItemInfo^.ImageIndex,4);
|
||||
ReverseBytes(@ItemInfo^.StateIndex,4);
|
||||
ReverseBytes(@ItemInfo^.OverlayIndex,4);
|
||||
ReverseBytes(@ItemInfo^.SubItemCount,4);
|
||||
ReverseBytes(@ItemInfo^.Data,4);
|
||||
{$ENDIF}
|
||||
PStr := @ItemInfo^.Caption;
|
||||
Inc(Integer(PStr), Length(ItemInfo^.Caption) + 1);
|
||||
Len := 0;
|
||||
@ -397,8 +419,11 @@ begin
|
||||
begin
|
||||
for J := 0 to Item[I].SubItems.Count - 1 do
|
||||
begin
|
||||
PInt^ := Item[I].SubItemImages[J];
|
||||
Inc(PInt);
|
||||
PInt^ := Item[I].SubItemImages[J];
|
||||
{$ifdef Endian_Little}
|
||||
ReverseBytes(@PInt,4);
|
||||
{$endif}
|
||||
Inc(PInt);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -411,6 +436,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.24 2004/08/15 17:00:58 mattias
|
||||
improved DefineProperties to read/write endian independent
|
||||
|
||||
Revision 1.23 2004/07/11 17:20:47 marc
|
||||
* Implemented most of TListColoum/Item in the Ws for gtk and win32
|
||||
|
||||
|
||||
@ -192,22 +192,59 @@ function FindLFMClassName(LFMStream: TStream):AnsiString;
|
||||
function CreateLFMFile(AComponent: TComponent; LFMStream: TStream): integer;
|
||||
|
||||
type
|
||||
TDelphiStreamOriginalFormat = (sofUnknown, sofBinary, sofText);
|
||||
TLRSStreamOriginalFormat = (sofUnknown, sofBinary, sofText);
|
||||
|
||||
procedure DelphiObjectBinaryToText(Input, Output: TStream);
|
||||
procedure DelphiObjectToText(Input, Output: TStream;
|
||||
var OriginalFormat: TDelphiStreamOriginalFormat);
|
||||
procedure LRSObjectBinaryToText(Input, Output: TStream);
|
||||
procedure LRSObjectToText(Input, Output: TStream;
|
||||
var OriginalFormat: TLRSStreamOriginalFormat);
|
||||
|
||||
procedure DelphiObjectResourceToText(Input, Output: TStream);
|
||||
procedure DelphiObjectResToText(Input, Output: TStream;
|
||||
var OriginalFormat: TDelphiStreamOriginalFormat);
|
||||
procedure LRSObjectResourceToText(Input, Output: TStream);
|
||||
procedure LRSObjectResToText(Input, Output: TStream;
|
||||
var OriginalFormat: TLRSStreamOriginalFormat);
|
||||
|
||||
function TestFormStreamFormat(Stream: TStream): TDelphiStreamOriginalFormat;
|
||||
function TestFormStreamFormat(Stream: TStream): TLRSStreamOriginalFormat;
|
||||
procedure FormDataToText(FormStream, TextStream: TStream);
|
||||
|
||||
|
||||
procedure ReverseBytes(p: Pointer; Count: integer);
|
||||
procedure ReverseByteOrderInWords(p: PWord; Count: integer);
|
||||
|
||||
function ReadLRSWord(s: TStream): word;
|
||||
function ReadLRSInteger(s: TStream): integer;
|
||||
function ReadLRSCardinal(s: TStream): cardinal;
|
||||
function ReadLRSInt64(s: TStream): int64;
|
||||
function ReadLRSSingle(s: TStream): Single;
|
||||
function ReadLRSDouble(s: TStream): Double;
|
||||
function ReadLRSExtended(s: TStream): Extended;
|
||||
{$ifdef HASCURRENCY}
|
||||
function ReadLRSCurrency(s: TStream): Currency;
|
||||
{$endif HASCURRENCY}
|
||||
{$ifdef HASWIDESTRING}
|
||||
function ReadLRSWideString(s: TStream): WideString;
|
||||
{$endif HASWIDESTRING}
|
||||
|
||||
procedure WriteLRSWord(s: TStream; const w: word);
|
||||
procedure WriteLRSInteger(s: TStream; const i: integer);
|
||||
procedure WriteLRSCardinal(s: TStream; const c: cardinal);
|
||||
procedure WriteLRSSingle(s: TStream; const si: Single);
|
||||
procedure WriteLRSDouble(s: TStream; const d: Double);
|
||||
procedure WriteLRSExtended(s: TStream; const e: extended);
|
||||
procedure WriteLRSInt64(s: TStream; const i: int64);
|
||||
{$ifdef HASCURRENCY}
|
||||
procedure WriteLRSCurrency(s: TStream; const c: Currency);
|
||||
{$endif HASCURRENCY}
|
||||
{$ifdef HASWIDESTRING}
|
||||
procedure WriteLRSWideStringContent(s: TStream; const w: WideString);
|
||||
{$endif HASWIDESTRING}
|
||||
|
||||
procedure WriteLRSReversedWord(s: TStream; w: word);
|
||||
procedure WriteLRS4BytesReversed(s: TStream; p: Pointer);
|
||||
procedure WriteLRS8BytesReversed(s: TStream; p: Pointer);
|
||||
procedure WriteLRS10BytesReversed(s: TStream; p: Pointer);
|
||||
procedure WriteLRSNull(s: TStream; Count: integer);
|
||||
procedure WriteLRSEndianBigDoubleAsEndianLittleExtended(s: TStream;
|
||||
PPCDouble: PByte);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
@ -1114,7 +1151,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DelphiObjectBinaryToText(Input, Output: TStream);
|
||||
procedure LRSObjectBinaryToText(Input, Output: TStream);
|
||||
var
|
||||
NestingLevel: Integer;
|
||||
SaveSeparator: Char;
|
||||
@ -1449,7 +1486,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TestFormStreamFormat(Stream: TStream): TDelphiStreamOriginalFormat;
|
||||
function TestFormStreamFormat(Stream: TStream): TLRSStreamOriginalFormat;
|
||||
var
|
||||
Pos: TStreamSeekType;
|
||||
Signature: Integer;
|
||||
@ -1470,8 +1507,8 @@ end;
|
||||
type
|
||||
TObjectTextConvertProc = procedure (Input, Output: TStream);
|
||||
|
||||
procedure InternalDelphiBinaryToText(Input, Output: TStream;
|
||||
var OriginalFormat: TDelphiStreamOriginalFormat;
|
||||
procedure InternalLRSBinaryToText(Input, Output: TStream;
|
||||
var OriginalFormat: TLRSStreamOriginalFormat;
|
||||
ConvertProc: TObjectTextConvertProc;
|
||||
BinarySignature: Integer; SignatureLength: Byte);
|
||||
var
|
||||
@ -1517,31 +1554,31 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DelphiObjectToText(Input, Output: TStream;
|
||||
var OriginalFormat: TDelphiStreamOriginalFormat);
|
||||
procedure LRSObjectToText(Input, Output: TStream;
|
||||
var OriginalFormat: TLRSStreamOriginalFormat);
|
||||
begin
|
||||
InternalDelphiBinaryToText(Input, Output, OriginalFormat,
|
||||
@DelphiObjectBinaryToText, Integer(FilerSignature), sizeof(Integer));
|
||||
InternalLRSBinaryToText(Input, Output, OriginalFormat,
|
||||
@LRSObjectBinaryToText, Integer(FilerSignature), sizeof(Integer));
|
||||
end;
|
||||
|
||||
procedure DelphiObjectResToText(Input, Output: TStream;
|
||||
var OriginalFormat: TDelphiStreamOriginalFormat);
|
||||
procedure LRSObjectResToText(Input, Output: TStream;
|
||||
var OriginalFormat: TLRSStreamOriginalFormat);
|
||||
begin
|
||||
InternalDelphiBinaryToText(Input, Output, OriginalFormat,
|
||||
@DelphiObjectResourceToText, $FF, 1);
|
||||
InternalLRSBinaryToText(Input, Output, OriginalFormat,
|
||||
@LRSObjectResourceToText, $FF, 1);
|
||||
end;
|
||||
|
||||
procedure DelphiObjectResourceToText(Input, Output: TStream);
|
||||
procedure LRSObjectResourceToText(Input, Output: TStream);
|
||||
begin
|
||||
Input.ReadResHeader;
|
||||
DelphiObjectBinaryToText(Input, Output);
|
||||
LRSObjectBinaryToText(Input, Output);
|
||||
end;
|
||||
|
||||
procedure FormDataToText(FormStream, TextStream: TStream);
|
||||
begin
|
||||
case TestFormStreamFormat(FormStream) of
|
||||
sofBinary:
|
||||
DelphiObjectResourceToText(FormStream, TextStream);
|
||||
LRSObjectResourceToText(FormStream, TextStream);
|
||||
|
||||
sofText:
|
||||
TextStream.CopyFrom(FormStream,FormStream.Size);
|
||||
@ -1663,6 +1700,261 @@ begin
|
||||
Result:=TWriter.Create(Driver);
|
||||
end;
|
||||
|
||||
function ReadLRSWord(s: TStream): word;
|
||||
begin
|
||||
s.Read(Result,2);
|
||||
{$IFDEF Endian_BIG}
|
||||
Result:=((Result and $ff) shl 8) or (Result shr 8);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function ReadLRSInteger(s: TStream): integer;
|
||||
begin
|
||||
s.Read(Result,4);
|
||||
{$IFDEF Endian_BIG}
|
||||
ReverseBytes(@Result,4);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function ReadLRSCardinal(s: TStream): cardinal;
|
||||
begin
|
||||
s.Read(Result,4);
|
||||
{$IFDEF Endian_BIG}
|
||||
ReverseBytes(@Result,4);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function ReadLRSInt64(s: TStream): int64;
|
||||
begin
|
||||
s.Read(Result,8);
|
||||
{$IFDEF Endian_BIG}
|
||||
ReverseBytes(@Result,8);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function ReadLRSSingle(s: TStream): Single;
|
||||
begin
|
||||
s.Read(Result,4);
|
||||
{$IFDEF Endian_BIG}
|
||||
ReverseBytes(@Result,4);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function ReadLRSDouble(s: TStream): Double;
|
||||
begin
|
||||
s.Read(Result,8);
|
||||
{$IFDEF Endian_BIG}
|
||||
ReverseBytes(@Result,8);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{$IFDEF CPUPowerPC}
|
||||
function ReadLRSExtentedAndConvertToExtended(s: TStream): Extended;
|
||||
// TODO - does not work
|
||||
const
|
||||
F: extended = 1.0/65536.0 ;
|
||||
var
|
||||
le: array [1..5] of word;
|
||||
begin { Ignores NaN & Inf }
|
||||
s.Read(le[1],10);
|
||||
ReverseBytes(@le[1],10);
|
||||
Result := 2.0 * (((le[2]*F+le[3])*F+le[4])*F+le[5])*F;
|
||||
if le[1]>32767 then Result := -Result ;
|
||||
Result:=intpower(2,integer(le[1] and $7fff)-$4000);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
function ReadLRSExtended(s: TStream): Extended;
|
||||
begin
|
||||
{$IFDEF CPUi386}
|
||||
s.Read(Result,10);
|
||||
{$ENDIF}
|
||||
{$IFDEF CPUPowerPC}
|
||||
Result:=ReadLRSExtentedAndConvertToExtended(s);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{$ifdef HASCURRENCY}
|
||||
function ReadLRSCurrency(s: TStream): Currency;
|
||||
begin
|
||||
s.Read(Result,8);
|
||||
{$IFDEF Endian_BIG}
|
||||
ReverseBytes(@Result,8);
|
||||
{$ENDIF}
|
||||
end;
|
||||
{$endif HASCURRENCY}
|
||||
|
||||
{$ifdef HASWIDESTRING}
|
||||
function ReadLRSWideString(s: TStream): WideString;
|
||||
var
|
||||
Len: LongInt;
|
||||
begin
|
||||
Len:=ReadLRSInteger(s);
|
||||
SetLength(Result,Len);
|
||||
if Len>0 then begin
|
||||
s.Read(Result[1],Len*2);
|
||||
{$IFDEF Endian_BIG}
|
||||
ReverseByteOrderInWords(PWord(@Result[1]),Len);
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
{$endif HASWIDESTRING}
|
||||
|
||||
procedure WriteLRSReversedWord(s: TStream; w: word);
|
||||
begin
|
||||
w:=(w shr 8) or ((w and $ff) shl 8);
|
||||
s.Write(w,2);
|
||||
end;
|
||||
|
||||
procedure WriteLRS4BytesReversed(s: TStream; p: Pointer);
|
||||
var
|
||||
a: array[0..3] of char;
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to 3 do
|
||||
a[i]:=PChar(p)[3-i];
|
||||
s.Write(a[0],4);
|
||||
end;
|
||||
|
||||
procedure WriteLRS8BytesReversed(s: TStream; p: Pointer);
|
||||
var
|
||||
a: array[0..7] of char;
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to 7 do
|
||||
a[i]:=PChar(p)[7-i];
|
||||
s.Write(a[0],8);
|
||||
end;
|
||||
|
||||
procedure WriteLRS10BytesReversed(s: TStream; p: Pointer);
|
||||
var
|
||||
a: array[0..9] of char;
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to 9 do
|
||||
a[i]:=PChar(p)[9-i];
|
||||
s.Write(a[0],10);
|
||||
end;
|
||||
|
||||
procedure WriteLRSNull(s: TStream; Count: integer);
|
||||
var
|
||||
c: char;
|
||||
i: Integer;
|
||||
begin
|
||||
c:=#0;
|
||||
for i:=0 to Count-1 do
|
||||
s.Write(c,1);
|
||||
end;
|
||||
|
||||
procedure WriteLRSEndianBigDoubleAsEndianLittleExtended(s: TStream;
|
||||
PPCDouble: PByte);
|
||||
// TODO
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
i:=0;
|
||||
s.Write(i,4);
|
||||
s.Write(i,4);
|
||||
s.Write(i,2);
|
||||
end;
|
||||
|
||||
procedure WriteLRSWord(s: TStream; const w: word);
|
||||
begin
|
||||
{$IFDEF Endian_Little}
|
||||
s.Write(w,2);
|
||||
{$ELSE}
|
||||
WriteLRSReversedWord(s,w);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure WriteLRSInteger(s: TStream; const i: integer);
|
||||
begin
|
||||
{$IFDEF Endian_Little}
|
||||
s.Write(i,4);
|
||||
{$ELSE}
|
||||
WriteLRS4BytesReversed(s,@i);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure WriteLRSCardinal(s: TStream; const c: cardinal);
|
||||
begin
|
||||
{$IFDEF Endian_Little}
|
||||
s.Write(c,4);
|
||||
{$ELSE}
|
||||
WriteLRS4BytesReversed(s,@c);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure WriteLRSSingle(s: TStream; const si: Single);
|
||||
begin
|
||||
{$IFDEF Endian_Little}
|
||||
s.Write(si,4);
|
||||
{$ELSE}
|
||||
WriteLRS4BytesReversed(s,@si);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure WriteLRSDouble(s: TStream; const d: Double);
|
||||
begin
|
||||
{$IFDEF Endian_Little}
|
||||
s.Write(d,8);
|
||||
{$ELSE}
|
||||
WriteLRS8BytesReversed(s,@d);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure WriteLRSExtended(s: TStream; const e: extended);
|
||||
begin
|
||||
{$IFDEF CPUi386}
|
||||
s.Write(e,10);
|
||||
{$ENDIF}
|
||||
{$IFDEF CPUPowerPC}
|
||||
if SizeOf(e)=10 then
|
||||
WriteLRS10BytesReversed(s,@e)
|
||||
else if SizeOf(e)=8 then
|
||||
WriteLRSEndianBigDoubleAsEndianLittleExtended(s,@e)
|
||||
else begin
|
||||
debugln('WARNING: WriteLRSExtended not implemented yet for PowerPC');
|
||||
WriteLRSNull(s,10);
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure WriteLRSInt64(s: TStream; const i: int64);
|
||||
begin
|
||||
{$IFDEF Endian_Little}
|
||||
s.Write(i,8);
|
||||
{$ELSE}
|
||||
WriteLRS8BytesReversed(s,@i);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{$ifdef HASCURRENCY}
|
||||
procedure WriteLRSCurrency(s: TStream; const c: Currency);
|
||||
begin
|
||||
{$IFDEF Endian_Little}
|
||||
s.Write(c,8);
|
||||
{$ELSE}
|
||||
WriteLRS8BytesReversed(s,@c);
|
||||
{$ENDIF}
|
||||
end;
|
||||
{$endif HASCURRENCY}
|
||||
|
||||
{$ifdef HASWIDESTRING}
|
||||
procedure WriteLRSWideStringContent(s: TStream; const w: WideString);
|
||||
var
|
||||
Size: Integer;
|
||||
begin
|
||||
Size:=length(w);
|
||||
if Size=0 then exit;
|
||||
{$IFDEF Endian_Little}
|
||||
s.Write(w[1], Size * 2);
|
||||
{$ELSE}
|
||||
WriteLRSReversedWords(s,@w[1],Size);
|
||||
{$ENDIF}
|
||||
end;
|
||||
{$endif HASWIDESTRING}
|
||||
|
||||
{ TLRSObjectReader }
|
||||
|
||||
procedure TLRSObjectReader.Read(var Buf; Count: LongInt);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user