[JEDI.NET-commits] main/run Jedi.System.IO.pas,NONE,1.1 Jedi.Windows.Forms.Visual.pas,NONE,1.1
Status: Pre-Alpha
Brought to you by:
jedi_mbe
From: Marcel B. <jed...@us...> - 2004-07-29 09:36:12
|
Update of /cvsroot/jedidotnet/main/run In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2250/main/run Added Files: Jedi.System.IO.pas Jedi.Windows.Forms.Visual.pas Log Message: Donations by Andreas Hausladen --- NEW FILE: Jedi.Windows.Forms.Visual.pas --- {------------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License");you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1.1.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: Jedi.Windows.Forms.Visual.pas, released on 2004-07-23. The Initial Developer of the Original Code is Andreas Hausladen Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen All Rights Reserved. Contributor(s): You may retrieve the latest version of this file at the JEDI.NET home page, located at http://sourceforge.net/projects/jedidotnet Known Issues: -------------------------------------------------------------------------------} // $Id: Jedi.Windows.Forms.Visual.pas,v 1.1 2004/07/29 09:35:56 jedi_mbe Exp $ unit Jedi.Windows.Forms.Visual; interface {$REGION 'interface uses'} uses System.ComponentModel, System.Drawing, System.Drawing.Drawing2D, System.Windows.Forms; {$ENDREGION} {$REGION 'Shape control'} type Shape = class(Control) public type ShapeType = ( stCircle, stEllipse, stRectangle, stRoundRect, stRoundSquare, stSquare ); strict private FShape: Shape.ShapeType; FPen: System.Drawing.Pen; FBrush: System.Drawing.Brush; private const SShapeType = 'The type of the Shape.'; SShapePen = 'The pen for line drawing.'; SShapeBrush = 'The brush for filling.'; procedure SetShape(const Value: ShapeType); procedure SetPen(const Value: System.Drawing.Pen); procedure SetBrush(const Value: System.Drawing.Brush); strict protected procedure OnPaint(e: PaintEventArgs); override; procedure OnResize(e: EventArgs); override; public constructor Create; [Category('Appearance'), Description(SShapeType)] property Shape: ShapeType read FShape write SetShape default stRectangle; [Category('Appearance'), Description(SShapePen)] property Pen: System.Drawing.Pen read FPen write SetPen; [Category('Appearance'), Description(SShapeBrush)] property Brush: System.Drawing.Brush read FBrush write SetBrush; end; {$ENDREGION} implementation {$REGION 'implementation uses'} {$ENDREGION} {$REGION 'Shape control'} constructor Shape.Create; begin inherited Create; Width := 80; Height := 80; FShape := stRectangle; FPen := System.Drawing.Pen.Create(Color.Black); FBrush := System.Drawing.Brushes.White; end; procedure Shape.OnPaint(e: PaintEventArgs); var X, Y, W, H: Integer; Offset: Integer; begin { Calculate X, Y coordinates } X := 0; Y := 0; W := Width - 1; H := Height - 1; { Invalid size } if (W < 0) or (H < 0) then Exit; Offset := 4; if Width < Offset * 2 then Offset := Width div 2; case Shape of stCircle, stRoundSquare, stSquare: begin if Width > Height then begin W := Height - 1; X := (Width - Height) div 2; end else begin H := Width - 1; Y := (Height - Width) div 2; end; end; end; { Draw shape } case Shape of stCircle, stEllipse: begin e.Graphics.FillEllipse(FBrush, X, Y, W, H); e.Graphics.DrawEllipse(FPen, X, Y, W, H); end; stRectangle, stSquare: begin e.Graphics.FillRectangle(FBrush, X, Y, W, H); e.Graphics.DrawRectangle(FPen, X, Y, W, H); end; stRoundRect, stRoundSquare: begin e.Graphics.FillEllipse(FBrush, X, Y, Offset * 2, Offset * 2); e.Graphics.FillEllipse(FBrush, X, Y + H - Offset * 2, Offset * 2, Offset * 2); e.Graphics.FillEllipse(FBrush, X + W - Offset * 2, Y, Offset * 2, Offset * 2); e.Graphics.FillEllipse(FBrush, X + W - Offset * 2, Y + H - Offset * 2, Offset * 2, Offset * 2); e.Graphics.FillRectangle(FBrush, X, Y + Offset, W, H - Offset * 2); e.Graphics.FillRectangle(FBrush, X + Offset, Y, W - Offset * 2, Offset); e.Graphics.FillRectangle(FBrush, X + Offset, Y + H - Offset, W - Offset * 2, Offset); e.Graphics.DrawArc(FPen, X, Y, Offset * 2, Offset * 2, 180, 90); e.Graphics.DrawArc(FPen, X, Y + H - Offset * 2, Offset * 2, Offset * 2, 90, 90); e.Graphics.DrawArc(FPen, X + W - Offset * 2, Y, Offset * 2, Offset * 2, 270, 90); e.Graphics.DrawArc(FPen, X + W - Offset * 2, Y + H - Offset * 2, Offset * 2, Offset * 2, 0, 90); e.Graphics.DrawLine(FPen, X + Offset, Y, X + W - Offset, Y); e.Graphics.DrawLine(FPen, X + Offset, Y + H, X + W - Offset, Y + H); e.Graphics.DrawLine(FPen, X, Y + Offset, X, Y + H - Offset); e.Graphics.DrawLine(FPen, X + W, Y + Offset, X + W, Y + H - Offset); end; end; end; procedure Shape.OnResize(e: EventArgs); begin inherited OnResize(e); Refresh; end; procedure Shape.SetBrush(const Value: System.Drawing.Brush); begin if Value <> FBrush then begin FBrush := Value; Invalidate; end; end; procedure Shape.SetPen(const Value: System.Drawing.Pen); begin if Value <> FPen then begin FPen := Value; Invalidate; end; end; procedure Shape.SetShape(const Value: ShapeType); begin if Value <> FShape then begin FShape := Value; Invalidate; end; end; {$ENDREGION} end. --- NEW FILE: Jedi.System.IO.pas --- {--------------------------------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1.1.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: Jedi.Drawing.pas, released on 2004-07-23. The Initial Developer of the Original Code is Andreas Hausladen Portions created by Marcel Bestebroer are Copyright (C) 2004 Andreas Hausladen All Rights Reserved. Contributor(s): You may retrieve the latest version of this file at the JEDI.NET home page, located at http://sf.net/projects/jedidotnet Known Issues: ---------------------------------------------------------------------------------------------------} // $Id: Jedi.System.IO.pas,v 1.1 2004/07/29 09:35:56 jedi_mbe Exp $ unit Jedi.System.IO; interface {$REGION 'Interface uses'} uses System.IO, System.Reflection; {$ENDREGION} type {$REGION 'StoredExtended = record'} /// <summary> /// StoredExtended is a binary compatible type for the Delphi Win32 Extended /// type. It is only for storage usage. So use it only in records that should /// be written to disk. /// </summary> StoredExtended = record private Data: array[0..9] of Byte; public function ToString: string; override; class operator Implicit(const Value: StoredExtended): Extended; class operator Implicit(const Value: Extended): StoredExtended; class operator Add(const A: StoredExtended; const B: Extended): StoredExtended; class operator Subtract(const A: StoredExtended; const B: Extended): StoredExtended; class operator Multiply(const A: StoredExtended; const B: Extended): StoredExtended; class operator Divide(const A: StoredExtended; const B: Extended): StoredExtended; class operator Trunc(const Value: StoredExtended): StoredExtended; class operator Round(const Value: StoredExtended): StoredExtended; class operator Equal(const A: StoredExtended; const B: Extended): Boolean; class operator Equal(const A: StoredExtended; const B: StoredExtended): Boolean; class operator GreaterThan(const A: StoredExtended; const B: Extended): Boolean; class operator GreaterThan(const A: StoredExtended; const B: StoredExtended): Boolean; class operator GreaterThanOrEqual(const A: StoredExtended; const B: Extended): Boolean; class operator GreaterThanOrEqual(const A: StoredExtended; const B: StoredExtended): Boolean; class operator LessThan(const A: StoredExtended; const B: Extended): Boolean; class operator LessThan(const A: StoredExtended; const B: StoredExtended): Boolean; class operator LessThanOrEqual(const A: StoredExtended; const B: Extended): Boolean; class operator LessThanOrEqual(const A: StoredExtended; const B: StoredExtended): Boolean; end; {$ENDREGION} {$REGION 'FileOfRecord = class(System.Object)'} EFileOfRecordError = class(Exception); /// <summary> /// FileOfRecord implements the "file of type" for .NET. /// </summary> /// <limitation> /// Because Extended is declared as a Double under Delphi.NET the Extended /// type must be changed into StoredExtended. /// </limitation> FileOfRecord = class(System.Object) strict private FType: System.Type; FRecordSize: Cardinal; FStream: System.IO.Stream; FAutoClose: Boolean; FStartPosition: Int64; FRecInstance: System.ValueType; function get_FilePos: Int64; function get_FileSize: Int64; class function CreateRecInstance(AType: System.Type): System.ValueType; static; class procedure CheckValidField(FieldType: System.Type; Typ: System.Type); static; class function SizeOfObject(Obj: System.Object): Cardinal; static; class function SizeOfArray(A: System.Array; Obj: System.Object; const FieldName: string): Cardinal; static; function ProcessType(Obj: System.Object; DoWrite: Boolean): System.Object; procedure ProcessArrayType(A: System.Array; Obj: System.Object; DoWrite: Boolean); procedure WriteByte(const Value: Byte); function ReadByte: Byte; procedure WriteUInt16(const Value: UInt16); function ReadUInt16: UInt16; procedure WriteUInt32(const Value: UInt32); function ReadUInt32: UInt32; procedure WriteUInt64(const Value: UInt64); function ReadUInt64: UInt64; procedure WriteSingle(const Value: Single); function ReadSingle: Single; procedure WriteDouble(const Value: Double); function ReadDouble: Double; procedure WriteStoredExtended(const Value: StoredExtended); function ReadStoredExtended: StoredExtended; strict protected const STypeNotAllowed = 'Type {0} is not allowed in a FileOfRecord record type.'; STypeNotAllowedInRecord = 'Type {0} is not allowed in FileOfRecord record {1}.'; SUninitializedField = 'Field {0} is not initialized. It is null.'; SEmptyArrayNotAllowed = 'Empty array type is not allowed.'; SWrongRecordType = '{0} is a wrong record type for {1}'; public /// <summary> /// </summary> /// @AType is the record type that should be used. /// @AStream is the stream where the data is stored or should be written to. /// @AAutoClose specifies if the FileOfRecord instance should close the /// given stream when the instance is disposed. /// @AStartPosition specifies the zero position for the FileOfRecord in the /// stream. This could be used to offset the first record in the file. constructor Create(AType: System.Type; AStream: System.IO.Stream; AAutoClose: Boolean = True); overload; constructor Create(AType: System.Type; AStream: System.IO.Stream; AAutoClose: Boolean; AStartPosition: Int64); overload; /// <summary> /// Dispose() closes the stream if AutoClose is True. /// </summary> destructor Destroy; override; /// <summary> /// SizeOf() returns the record size in Bytes of the given record ValueType /// instance or ValueType type. /// </summary> class function SizeOf(AType: System.Type): Cardinal; overload; static; class function SizeOf(const Rec: System.ValueType): Cardinal; overload; static; /// <summary> /// Seek() sets the file pointer to the record with the number @RecNo. 0 is /// the first record. /// </summary> function Seek(RecNo: Int64): Int64; /// <summary> /// FilePos() returns the current record number. /// </summary> function FilePos: Int64; /// <summary> /// FileSize() returns the number of records in the stream. /// </summary> function FileSize: Int64; /// <summary> /// EoF() return True when the end of the stream is reached. /// </summary> function Eof: Boolean; /// <summary> /// Truncate() sets the stream size to the current record position. /// </summary> procedure Truncate; /// <summary> /// Write() stores one or more record in the stream and moves the file /// pointer to the next record. /// </summary> procedure Write(const Rec: System.ValueType); overload; procedure Write(const RecArray: array of System.ValueType); overload; procedure Write(const RecArray: array of System.ValueType; StartIndex, Len: Integer); overload; /// <summary> /// Read() reads one record from the stream and moves the file /// pointer to the next record. /// </summary> /// <example> /// C# : MyStruct st = MyFileOfRecord.Read() as MyStruct; /// Delphi: st := MyFileOfRecord.Read as MyStruct; /// </example> function Read: System.Object; overload; procedure Read(var Obj); overload; // not CLR compatible /// <summary> /// property Position, see FilePos() /// </summary> property Position: Int64 read get_FilePos; /// <summary> /// property RecordCount, see FileSize() /// </summary> property RecordCount: Int64 read get_FileSize; /// <summary> /// property RecordSize returns the size of the type of the FileOfRecord in /// Bytes. /// </summary> property RecordSize: Cardinal read FRecordSize; /// <summary> /// property AutoClose controls if the FileOfRecord instance should close /// the stream when it is disposed. /// </summary> property AutoClose: Boolean read FAutoClose write FAutoClose; end; {$ENDREGION} implementation {$REGION 'record StoredExtended operators'} { StoredExtended } function StoredExtended.ToString: string; begin Result := ExtendedAsBytesToDouble(Data).ToString; end; class operator StoredExtended.Implicit(const Value: StoredExtended): Extended; begin Result := ExtendedAsBytesToDouble(Value.Data); end; class operator StoredExtended.Implicit(const Value: Extended): StoredExtended; begin Result.Data := DoubleToExtendedAsBytes(Value); end; class operator StoredExtended.Add(const A: StoredExtended; const B: Extended): StoredExtended; begin Result := Extended(A) + B; end; class operator StoredExtended.Subtract(const A: StoredExtended; const B: Extended): StoredExtended; begin Result := Extended(A) - B; end; class operator StoredExtended.Multiply(const A: StoredExtended; const B: Extended): StoredExtended; begin Result := Extended(A) + B; end; class operator StoredExtended.Divide(const A: StoredExtended; const B: Extended): StoredExtended; begin Result := Extended(A) - B; end; class operator StoredExtended.Trunc(const Value: StoredExtended): StoredExtended; begin Result := Trunc(Extended(Value)); end; class operator StoredExtended.Round(const Value: StoredExtended): StoredExtended; begin Result := Round(Extended(Value)); end; class operator StoredExtended.Equal(const A: StoredExtended; const B: Extended): Boolean; begin Result := Extended(A) = B; end; class operator StoredExtended.Equal(const A: StoredExtended; const B: StoredExtended): Boolean; begin Result := Extended(A) = Extended(B); end; class operator StoredExtended.GreaterThan(const A: StoredExtended; const B: Extended): Boolean; begin Result := Extended(A) > B; end; class operator StoredExtended.GreaterThan(const A: StoredExtended; const B: StoredExtended): Boolean; begin Result := Extended(A) > Extended(B); end; class operator StoredExtended.GreaterThanOrEqual(const A: StoredExtended; const B: Extended): Boolean; begin Result := Extended(A) >= B; end; class operator StoredExtended.GreaterThanOrEqual(const A: StoredExtended; const B: StoredExtended): Boolean; begin Result := Extended(A) >= Extended(B); end; class operator StoredExtended.LessThan(const A: StoredExtended; const B: Extended): Boolean; begin Result := Extended(A) < B; end; class operator StoredExtended.LessThan(const A: StoredExtended; const B: StoredExtended): Boolean; begin Result := Extended(A) < Extended(B); end; class operator StoredExtended.LessThanOrEqual(const A: StoredExtended; const B: Extended): Boolean; begin Result := Extended(A) <= B; end; class operator StoredExtended.LessThanOrEqual(const A: StoredExtended; const B: StoredExtended): Boolean; begin Result := Extended(A) <= Extended(B); end; {$ENDREGION 'StoredExtended'} {$REGION 'FileOfRecord implementation'} { FileOfRecord } constructor FileOfRecord.Create(AType: System.Type; AStream: System.IO.Stream; AAutoClose: Boolean); begin Create(AType, AStream, AAutoClose, 0); end; constructor FileOfRecord.Create(AType: System.Type; AStream: System.IO.Stream; AAutoClose: Boolean; AStartPosition: Int64); begin inherited Create; FType := AType; FStream := AStream; FAutoClose := AAutoClose; FRecordSize := SizeOf(AType); FStartPosition := AStartPosition; FStream.Position := AStartPosition; end; destructor FileOfRecord.Destroy; begin FRecInstance := nil; if FAutoClose then FStream.Close; inherited Destroy; end; function FileOfRecord.FilePos: Int64; begin Result := (FStream.Position - FStartPosition) div FRecordSize; end; function FileOfRecord.FileSize: Int64; begin Result := (FStream.Length - FStartPosition) div FRecordSize; end; function FileOfRecord.Eof: Boolean; begin Result := FStream.Position >= FStream.Length; end; function FileOfRecord.Seek(RecNo: Int64): Int64; begin Result := FStream.Seek(FStartPosition + RecNo * FRecordSize, SeekOrigin.Begin); end; procedure FileOfRecord.Truncate; begin FStream.SetLength(FStream.Position); end; function FileOfRecord.Read: System.Object; begin if FRecInstance = nil then FRecInstance := CreateRecInstance(FType); Result := ProcessType(FRecInstance, False); end; procedure FileOfRecord.Write(const Rec: System.ValueType); begin if Rec.GetType <> FType then raise EFileOfRecordError.Create(System.String.Format(SWrongRecordType, Rec.GetType.Namespace + '.' + Rec.GetType.Name, FType.Namespace + '.' + FType.Name)); ProcessType(Rec, True); end; procedure FileOfRecord.Write(const RecArray: array of System.ValueType; StartIndex, Len: Integer); var i: Integer; begin for i := StartIndex to StartIndex + Len - 1 do Write(RecArray[i]); end; procedure FileOfRecord.Write(const RecArray: array of System.ValueType); begin Write(RecArray, 0, Length(RecArray)); end; procedure FileOfRecord.Read(var Obj); begin if System.Object(Obj).GetType <> FType then raise EFileOfRecordError.Create(System.String.Format(SWrongRecordType, System.Object(Obj).GetType.Namespace + '.' + System.Object(Obj).GetType.Name, FType.Namespace + '.' + FType.Name)); Obj := Read; end; function FileOfRecord.get_FilePos: Int64; begin Result := FilePos; end; function FileOfRecord.get_FileSize: Int64; begin Result := FileSize; end; class function FileOfRecord.CreateRecInstance(AType: System.Type): System.ValueType; var Method: MethodInfo; begin Result := System.ValueType(Activator.CreateInstance(AType)); { Execute Delphi record initialization code if available. } Method := AType.GetMethod('__Initialize__'); if Method <> nil then Method.Invoke(Result, BindingFlags.Instance or BindingFlags.Public or BindingFlags.InvokeMethod, nil, [], nil); end; class procedure FileOfRecord.CheckValidField(FieldType: System.Type; Typ: System.Type); begin if (FieldType.IsClass or FieldType.IsInterface or FieldType.IsPointer) and not FieldType.IsArray then raise EFileOfRecordError.Create(System.String.Format(STypeNotAllowedInRecord, FieldType.Namespace + '.' + FieldType.Name, Typ.Namespace + '.' + Typ.Name)); end; class function FileOfRecord.SizeOf(const Rec: System.ValueType): Cardinal; begin Result := SizeOfObject(Rec); end; class function FileOfRecord.SizeOf(AType: System.Type): Cardinal; begin Result := SizeOf(CreateRecInstance(AType)); end; class function FileOfRecord.SizeOfObject(Obj: System.Object): Cardinal; var Fields: array of FieldInfo; FieldIndex: Integer; Typ, FieldType: System.Type; Value: System.Object; begin Result := 0; Typ := Obj.GetType; if (Typ = TypeOf(SByte)) or (Typ = TypeOf(Byte)) or (Typ = TypeOf(ByteBool)) or (Typ = TypeOf(Boolean)) or (Typ = TypeOf(AnsiChar)) then Inc(Result, 1) else if (Typ = TypeOf(Int16)) or (Typ = TypeOf(UInt16)) or (Typ = TypeOf(WordBool)) or (Typ = TypeOf(WideChar)) then Inc(Result, 2) else if (Typ = TypeOf(Int32)) or (Typ = TypeOf(UInt32)) or (Typ = TypeOf(LongBool)) then Inc(Result, 4) else if (Typ = TypeOf(Int64)) or (Typ = TypeOf(UInt64)) then Inc(Result, 8) else if Typ = TypeOf(Single) then Inc(Result, 4) else if Typ = TypeOf(Double) then Inc(Result, 8) else if Typ = TypeOf(Currency) then Inc(Result, 8) { Extended is declared as Double. The StoredExtended record is processed by the TypeValue code. } else if Typ.IsArray then Inc(Result, SizeOfArray(System.Array(Obj), Obj, '')) else if Typ.IsValueType and (Typ.Namespace <> 'System') then begin Fields := Typ.GetFields(BindingFlags.Instance or BindingFlags.Public or BindingFlags.NonPublic); for FieldIndex := 0 to High(Fields) do begin FieldType := Fields[FieldIndex].FieldType; CheckValidField(FieldType, Typ); Value := Fields[FieldIndex].GetValue(Obj); if Value = nil then raise EFileOfRecordError.Create(System.String.Format(SUninitializedField, Fields[FieldIndex].Name)); if FieldType.IsArray then Inc(Result, SizeOfArray(System.Array(Value), Obj, Fields[FieldIndex].Name)) else Inc(Result, SizeOfObject(Value)); end; end else raise EFileOfRecordError.Create(System.String.Format(STypeNotAllowed, Typ.Namespace + '.' + Typ.Name, '')) end; class function FileOfRecord.SizeOfArray(A: System.Array; Obj: System.Object; const FieldName: string): Cardinal; var Value: System.Object; r: Integer; Indices: array of Integer; begin CheckValidField(A.GetType.GetElementType, Obj.GetType); SetLength(Indices, A.Rank); Value := A.GetValue(Indices); if Value = nil then raise EFileOfRecordError.Create(System.String.Format(SUninitializedField, FieldName)); Result := 0; for r := 0 to A.Rank - 1 do Inc(Result, Cardinal(A.GetLength(r))); Result := Result * SizeOfObject(Value); end; function FileOfRecord.ProcessType(Obj: System.Object; DoWrite: Boolean): System.Object; var Fields: array of FieldInfo; FieldIndex: Integer; Typ, FieldType: System.Type; Value: System.Object; begin Result := Obj; Typ := Obj.GetType; {$REGION 'R/W SByte, Byte, ByteBool, Boolean, AnsiChar'} if Typ = TypeOf(SByte) then begin if DoWrite then WriteByte(Byte(SByte(Obj))) else Result := System.Object(SByte(ReadByte)); end else if Typ = TypeOf(Byte) then begin if DoWrite then WriteByte(Byte(Obj)) else Result := System.Object(ReadByte); end else if Typ = TypeOf(ByteBool) then begin if DoWrite then WriteByte(Byte(ByteBool(Obj))) else Result := System.Object(ByteBool(ReadByte)); end else if Typ = TypeOf(Boolean) then begin if DoWrite then WriteByte(Byte(Boolean(Obj))) else Result := System.Object(Boolean(ReadByte)); end else if Typ = TypeOf(AnsiChar) then begin if DoWrite then WriteByte(Byte(AnsiChar(Obj))) else Result := System.Object(AnsiChar(ReadByte)); end else {$ENDREGION} {$REGION 'R/W Int16, UInt16, WordBool, WideChar'} if Typ = TypeOf(Int16) then begin if DoWrite then WriteUInt16(UInt16(Int16(Obj))) else Result := System.Object(Int16(ReadUInt16)); end else if Typ = TypeOf(UInt16) then begin if DoWrite then WriteUInt16(UInt16(Obj)) else Result := System.Object(ReadUInt16); end else if Typ = TypeOf(WordBool) then begin if DoWrite then WriteUInt16(UInt16(WordBool(Obj))) else Result := System.Object(WordBool(ReadUInt16)); end else if Typ = TypeOf(WideChar) then begin if DoWrite then WriteUInt16(UInt16(WideChar(Obj))) else Result := System.Object(WideChar(ReadUInt16)); end else {$ENDREGION} {$REGION 'R/W Int32, UInt32, LongBool'} if Typ = TypeOf(Int32) then begin if DoWrite then WriteUInt32(UInt32(Int32(Obj))) else Result := System.Object(Int32(ReadUInt32)); end else if Typ = TypeOf(UInt32) then begin if DoWrite then WriteUInt32(UInt32(Obj)) else Result := System.Object(ReadUInt32); end else if Typ = TypeOf(LongBool) then begin if DoWrite then WriteUInt32(UInt32(LongBool(Obj))) else Result := System.Object(LongBool(ReadUInt32)); end else {$ENDREGION} {$REGION 'R/W Int64, UInt64'} if Typ = TypeOf(Int64) then begin if DoWrite then WriteUInt64(UInt64(Int64(Obj))) else Result := System.Object(Int64(ReadUInt64)); end else if Typ = TypeOf(UInt64) then begin if DoWrite then WriteUInt64(UInt64(Obj)) else Result := System.Object(ReadUInt64); end else {$ENDREGION} {$REGION 'R/W Single, Double, StoredExtended, Currency'} if Typ = TypeOf(Single) then begin if DoWrite then WriteSingle(Single(Obj)) else Result := System.Object(Single(ReadSingle)); end else if Typ = TypeOf(Double) then begin if DoWrite then WriteDouble(Double(Obj)) else Result := System.Object(Double(ReadDouble)); end else if Typ = TypeOf(StoredExtended) then begin if DoWrite then WriteStoredExtended(StoredExtended(Obj)) else Result := System.Object(StoredExtended(ReadStoredExtended)); end else if Typ = TypeOf(Currency) then begin if DoWrite then WriteUInt64(Currency(Obj).ToOACurrency) else Result := System.Object(Currency.FromOACurrency(ReadUInt64)); end else {$ENDREGION} if Typ.IsArray then ProcessArrayType(System.Array(Obj), Obj, DoWrite) else if Typ.IsValueType and (Typ.Namespace <> 'System') then begin Fields := Typ.GetFields; for FieldIndex := 0 to High(Fields) do begin FieldType := Fields[FieldIndex].FieldType; Value := Fields[FieldIndex].GetValue(Obj); if FieldType.IsArray then ProcessArrayType(System.Array(Value), Obj, DoWrite) else begin Value := ProcessType(Value, DoWrite); if not DoWrite then Fields[FieldIndex].SetValue(Obj, Value); end; end; end end; procedure FileOfRecord.ProcessArrayType(A: System.Array; Obj: System.Object; DoWrite: Boolean); var Value: System.Object; r, FlatIndex, FlatIndexCount, Idx: Integer; Indices, ItemsCount: array of Integer; begin SetLength(Indices, A.Rank); SetLength(ItemsCount, A.Rank); FlatIndexCount := 0; for r := A.Rank - 1 downto 0 do begin FlatIndexCount := FlatIndexCount + A.GetLength(r); ItemsCount[r] := FlatIndexCount; end; for FlatIndex := 0 to FlatIndexCount - 1 do begin Idx := FlatIndex; for r := 0 to A.Rank - 2 do begin Indices[r] := A.GetLowerBound(r) + (Idx div ItemsCount[r + 1]); Idx := Idx mod ItemsCount[r + 1]; end; Indices[A.Rank - 1] := A.GetLowerBound(A.Rank - 1) + Idx; Value := A.GetValue(Indices); Value := ProcessType(Value, DoWrite); if not DoWrite then A.SetValue(Value, Indices); end; end; {$REGION 'Write/Read Datatype'} procedure FileOfRecord.WriteByte(const Value: Byte); begin FStream.WriteByte(Value); end; function FileOfRecord.ReadByte: Byte; var Data: array[0..0] of Byte; begin FStream.Read(Data, 0, Length(Data)); Result := Data[0]; end; procedure FileOfRecord.WriteUInt16(const Value: UInt16); var Data: array[0..1] of Byte; begin Data[0] := Value and $FF; Data[1] := Value shr 8; FStream.Write(Data, 0, Length(Data)); end; function FileOfRecord.ReadUInt16: UInt16; var Data: array[0..1] of Byte; begin FStream.Read(Data, 0, Length(Data)); Result := (UInt16(Data[1]) shl 8) or Data[0]; end; procedure FileOfRecord.WriteUInt32(const Value: UInt32); var Data: array[0..3] of Byte; begin Data[0] := Value and $FF; Data[1] := (Value shr 8) and $FF; Data[2] := (Value shr 16) and $FF; Data[3] := (Value shr 24) and $FF; FStream.Write(Data, 0, Length(Data)); end; function FileOfRecord.ReadUInt32: UInt32; var Data: array[0..3] of Byte; begin FStream.Read(Data, 0, Length(Data)); Result := (UInt32(Data[3]) shl 24) or (UInt32(Data[2]) shl 16) or (UInt32(Data[1]) shl 8) or Data[0]; end; procedure FileOfRecord.WriteUInt64(const Value: UInt64); var Data: array[0..7] of Byte; begin Data[0] := Value and $FF; Data[1] := (Value shr 8) and $FF; Data[2] := (Value shr 16) and $FF; Data[3] := (Value shr 24) and $FF; Data[4] := (Value shr 32) and $FF; Data[5] := (Value shr 40) and $FF; Data[6] := (Value shr 48) and $FF; Data[7] := (Value shr 56) and $FF; FStream.Write(Data, 0, Length(Data)); end; function FileOfRecord.ReadUInt64: UInt64; var Data: array[0..7] of Byte; begin Result := (UInt64(Data[7]) shl 56) or (UInt64(Data[6]) shl 48) or (UInt64(Data[5]) shl 40) or (UInt64(Data[4]) shl 32) or (UInt64(Data[3]) shl 24) or (UInt64(Data[2]) shl 16) or (UInt64(Data[1]) shl 8) or Data[0]; end; procedure FileOfRecord.WriteSingle(const Value: Single); begin FStream.Write(BitConverter.GetBytes(Value), 0, 4); end; function FileOfRecord.ReadSingle: Single; var Data: array[0..3] of Byte; begin FStream.Read(Data, 0, Length(Data)); Result := BitConverter.ToSingle(Data, 0); end; procedure FileOfRecord.WriteDouble(const Value: Double); begin FStream.Write(BitConverter.GetBytes(Value), 0, 8); end; function FileOfRecord.ReadDouble: Double; var Data: array[0..7] of Byte; begin FStream.Read(Data, 0, Length(Data)); Result := BitConverter.ToDouble(Data, 0); end; procedure FileOfRecord.WriteStoredExtended(const Value: StoredExtended); begin FStream.Write(Value.Data, 0, 10); end; function FileOfRecord.ReadStoredExtended: StoredExtended; begin FStream.Read(Result.Data, 0, 10); end; {$ENDREGION} {$ENDREGION 'FileOfRecord Implemenation'} end. |