streamobjects.pas

一款RPG游戏的引擎可以自己制作一款RPG游戏的引擎可以自己制作

unit StreamObjects;

interface

USES
   Classes, Contnrs, Graphics;

TYPE
   TProgressEvent = PROCEDURE( Action : STRING; Current, Maximum : INTEGER ) OF OBJECT;
   TStreamObject = CLASS
   PRIVATE
      FStream : TStream;
      FID : WORD;
   PROTECTED
      FProgressEvent : TProgressEvent;
      PROCEDURE Write( Value : INTEGER ); OVERLOAD;
      PROCEDURE Write( Value : SINGLE ); OVERLOAD;
      PROCEDURE Write( Value : STRING ); OVERLOAD;
      PROCEDURE Write( Value : BOOLEAN ); OVERLOAD;
      PROCEDURE Write( Value : TBitmap ); OVERLOAD;
      PROCEDURE Write( Value : CARDINAL ); OVERLOAD;
      PROCEDURE Write( Value : DOUBLE ); OVERLOAD;
      PROCEDURE Write( Value : WORD ); OVERLOAD;
      PROCEDURE Write( Value : BYTE ); OVERLOAD;

      PROCEDURE Read( VAR Value : INTEGER ); OVERLOAD;
      PROCEDURE Read( VAR Value : SINGLE ); OVERLOAD;
      PROCEDURE Read( VAR Value : STRING ); OVERLOAD;
      PROCEDURE Read( VAR Value : BOOLEAN ); OVERLOAD;
      PROCEDURE Read( VAR Value : TBitmap ); OVERLOAD;
      PROCEDURE Read( VAR Value : CARDINAL ); OVERLOAD;
      PROCEDURE Read( VAR Value : DOUBLE ); OVERLOAD;
      PROCEDURE Read( VAR Value : WORD ); OVERLOAD;
      PROCEDURE Read( VAR Value : BYTE ); OVERLOAD;

      PROCEDURE WriteFields( Stream : TStream ); VIRTUAL;
      PROCEDURE ReadFields( Stream : TStream ); VIRTUAL;
   PUBLIC
      PROCEDURE Assign( Source : TStreamObject ); REINTRODUCE;
      PROCEDURE SaveToStream( Stream : TStream );
      PROCEDURE LoadFromStream( Stream : TStream );
      CONSTRUCTOR Create; VIRTUAL;
      DESTRUCTOR Destroy; OVERRIDE;
      PROPERTY ID : WORD READ FID WRITE FID;
      PROPERTY OnProgress : TProgressEvent READ FProgressEvent WRITE FProgressEvent;
   END;

   TStreamObjectClass = CLASS OF TStreamObject;

   TStreamObjectCollection = CLASS
   PRIVATE
      FObjects : TObjectList;
      FItemClass : TStreamObjectClass;
      FSeedID : INTEGER;
      FUNCTION GetCount : INTEGER;
      FUNCTION GetStreamObject( Index : INTEGER ) : TStreamObject;
   PUBLIC
      PROCEDURE LoadFromStream( Stream : TStream );
      PROCEDURE SaveToStream( Stream : TStream );
      CONSTRUCTOR Create( ItemClass : TStreamObjectClass );
      DESTRUCTOR Destroy; OVERRIDE;
      FUNCTION GetItemByID( ID : INTEGER ) : TStreamObject;
      FUNCTION Add : TStreamObject; OVERLOAD;
      PROCEDURE Add( NewObject : TStreamObject ); OVERLOAD;
      PROCEDURE Delete( Index : INTEGER );
      PROCEDURE Clear;
      PROPERTY Count : INTEGER READ GetCount;
      PROPERTY Items[ Index : INTEGER ] : TStreamObject READ GetStreamObject; DEFAULT;
   END;

implementation

USES
   SysUtils;

{ TStreamObjectCollection }

FUNCTION TStreamObjectCollection.GetItemByID( ID : INTEGER ) : TStreamObject;
VAR
   Counter : INTEGER;
BEGIN
   FOR Counter := 0 TO (FObjects.Count-1) DO
   BEGIN
      IF (TStreamObject(FObjects.Items[Counter]).ID = ID) THEN
      BEGIN
         Result := TStreamObject(FObjects.Items[Counter]);
         Exit;
      END;
   END;
   RAISE Exception.Create( ClassName + ' : Non-existant ID lookup.' );
END;

FUNCTION TStreamObjectCollection.GetStreamObject( Index : INTEGER ) : TStreamObject;
BEGIN
   IF (Index >= 0) AND (Index < FObjects.Count) THEN
      Result := TStreamObject( FObjects.Items[Index] )
    ELSE
      RAISE Exception.Create( ClassName + ' : Index out of bounds.' );
END;

PROCEDURE TStreamObjectCollection.LoadFromStream( Stream : TStream );
VAR
   ObjectCount, Counter : INTEGER;
   NewObject : TStreamObject;
BEGIN
   WHILE (FObjects.Count > 0) DO
      FObjects.Delete( 0 );
   Stream.Read( ObjectCount, SizeOf( ObjectCount ));
   FOR Counter := 0 TO (ObjectCount-1) DO
   BEGIN
      NewObject := FItemClass.Create;
      NewObject.LoadFromStream( Stream );
      FObjects.Add( NewObject );
   END;
   IF (FObjects.Count > 0) THEN
      FSeedID := TStreamObject(FObjects.Items[ FObjects.Count-1 ]).ID + 1
    ELSE
      FSeedID := 0;
END;

PROCEDURE TStreamObjectCollection.SaveToStream( Stream : TStream );
VAR
   Counter, ObjectCount : INTEGER;
BEGIN
   ObjectCount := FObjects.Count;
   Stream.Write( ObjectCount, SizeOf( ObjectCount ));
   FOR Counter := 0 TO (FObjects.Count-1) DO
      TStreamObject( FObjects.Items[Counter] ).SaveToStream( Stream );
END;

CONSTRUCTOR TStreamObjectCollection.Create( ItemClass : TStreamObjectClass );
BEGIN
   INHERITED Create;
   FObjects := TObjectList.Create;
   FObjects.OwnsObjects := TRUE;
   FItemClass := ItemClass;
END;

DESTRUCTOR TStreamObjectCollection.Destroy;
BEGIN
   WHILE (FObjects.Count > 0) DO
      FObjects.Delete( 0 );
   FObjects.Free;
   INHERITED;
END;

FUNCTION TStreamObjectCollection.Add : TStreamObject;
BEGIN
   Result := FItemClass.Create;
   Result.FID := FSeedID;
   INC(FSeedID);

   FObjects.Add( Result );
END;

PROCEDURE TStreamObjectCollection.Add( NewObject : TStreamObject );
BEGIN
   NewObject.FID := FSeedID;
   INC(FSeedID);
   FObjects.Add( NewObject );
END;

PROCEDURE TStreamObjectCollection.Delete( Index : INTEGER );
BEGIN
   FObjects.Delete( Index );
END;

PROCEDURE TStreamObjectCollection.Clear;
BEGIN
   FObjects.Clear;
END;

FUNCTION TStreamObjectCollection.GetCount : INTEGER;
BEGIN
   Result := FObjects.Count;
END;

{ TStreamObject }

PROCEDURE TStreamObject.WriteFields( Stream : TStream );
BEGIN
   Write( FID );
END;

PROCEDURE TStreamObject.ReadFields( Stream : TStream );
BEGIN
   Read( FID );
END;

CONSTRUCTOR TStreamObject.Create;
BEGIN
   INHERITED;
   FStream := NIL;
END;

DESTRUCTOR TStreamObject.Destroy;
BEGIN
   FStream.Free;
   INHERITED;
END;

PROCEDURE TStreamObject.Assign( Source : TStreamObject );
VAR
   TempStream : TMemoryStream;
BEGIN
   TempStream := TMemoryStream.Create;
   TStreamObject(Source).SaveToStream( TempStream );
   TempStream.Position := 0;
   LoadFromStream( TempStream );
   TempStream.Free;
END;

PROCEDURE TStreamObject.LoadFromStream( Stream : TStream );
BEGIN
   FStream := Stream;
   ReadFields( Stream );
   FStream := NIL;
END;

PROCEDURE TStreamObject.SaveToStream( Stream : TStream );
BEGIN
   FStream := Stream;
   WriteFields( Stream );
   FStream := NIL;
END;

PROCEDURE TStreamObject.Write( Value : INTEGER );
BEGIN
   FStream.Write( Value, SizeOf(Value) );
END;

PROCEDURE TStreamObject.Write( Value : CARDINAL );
BEGIN
   FStream.Write( Value, SizeOf(Value) );
END;

PROCEDURE TStreamObject.Write( Value : SINGLE );
BEGIN
   FStream.Write( Value, SizeOf(Value) );
END;

PROCEDURE TStreamObject.Write( Value : STRING );
VAR
   StringLength : INTEGER;
BEGIN
   StringLength := LENGTH(Value);
   FStream.Write( StringLength, SizeOf( StringLength ));
   FStream.Write( POINTER(Value)^, StringLength );
END;

PROCEDURE TStreamObject.Write( Value : BOOLEAN );
BEGIN
   FStream.Write( Value, SizeOf(Value) );
END;

PROCEDURE TStreamObject.Write( Value : DOUBLE );
BEGIN
   FStream.Write( Value, SizeOf(Value) );
END;

PROCEDURE TStreamObject.Write( Value : WORD );
BEGIN
   FStream.Write( Value, SizeOf(Value) );
END;

PROCEDURE TStreamObject.Write( Value : BYTE );
BEGIN
   FStream.Write( Value, SizeOf(Value) );
END;

PROCEDURE TStreamObject.Write( Value : TBitmap );
VAR
   MS : TMemoryStream;
   Size : INTEGER;
BEGIN
   MS := TMemoryStream.Create;
   Value.SaveToStream( MS );
   MS.Position := 0;
   Size := MS.Size;
   FStream.Write( Size, SizeOf( Size ));
   FStream.CopyFrom( MS, Size );
   MS.Free;
END;

PROCEDURE TStreamObject.Read( VAR Value : INTEGER );
BEGIN
   FStream.Read( Value, SizeOf(Value) );
END;

PROCEDURE TStreamObject.Read( VAR Value : CARDINAL );
BEGIN
   FStream.Read( Value, SizeOf(Value) );
END;

PROCEDURE TStreamObject.Read( VAR Value : SINGLE );
BEGIN
   FStream.Read( Value, SizeOf(Value) );
END;

PROCEDURE TStreamObject.Read( VAR Value : STRING );
VAR
   StringLength : INTEGER;
BEGIN
   FStream.Read( StringLength, SizeOf( StringLength ));
   SetLength( Value, StringLength );
   FStream.Read( POINTER(Value)^, StringLength );
END;

PROCEDURE TStreamObject.Read( VAR Value : BOOLEAN );
BEGIN
   FStream.Read( Value, SizeOf(Value) );
END;

PROCEDURE TStreamObject.Read( VAR Value : DOUBLE );
BEGIN
   FStream.Read( Value, SizeOf(Value) );
END;

PROCEDURE TStreamObject.Read( VAR Value : WORD );
BEGIN
   FStream.Read( Value, SizeOf(Value) );
END;

PROCEDURE TStreamObject.Read( VAR Value : BYTE );
BEGIN
   FStream.Read( Value, SizeOf(Value) );
END;

PROCEDURE TStreamObject.Read( VAR Value : TBitmap );
VAR
   MS : TMemoryStream;
   Size : INTEGER;
BEGIN
   FStream.Read( Size, SizeOf(Size) );
   MS := TMemoryStream.Create;
   MS.CopyFrom( FStream, Size );
   MS.Position := 0;
   Value.LoadFromStream( MS );
   MS.Free;
END;

end.