preximclasses.pas

一个很好的学习例子,有需要的请下载研究,

    begin
      //Load ClassName and use it to get ClassType
      cName := ReadString;

      // If a ClassType was found create an instance and
      // add object to this list
      if cName = TTransaction.ClassName  then
      begin
        ATxn := New;
        ATxn.PageStoredPath := fPageStoredPath;
        ATxn.ReadData(Reader);
      end;
      Dec(TxnsCount);

      //ProcessWindowsMessageQueue;
    end;
  end;
end;


function TTransactionList.Remove(ATransaction: TTransaction): Integer;
begin
  Result := inherited Remove(ATransaction);
end;

procedure TTransactionList.SetItem(Index: Integer;
  const Value: TTransaction);
begin
  inherited Items[Index] := Value;
end;

procedure TTransactionList.WriteData(Writer: TWriter);
var
  Idx: integer;
begin
  Writer.WriteSignature;
  inherited;

  with Writer do
  begin
    // mark beginning of file and beginning of object list
    WriteInteger(Count);

    for Idx := 0 to Count - 1 do
    begin
      //Store any TTransaction objects
      if TObject(Items[Idx]) is TTransaction then
      begin
        WriteString(TTransaction(Items[Idx]).ClassName);
        //Call WriteData() for TTransaction objects}
        TTransaction(Items[Idx]).WriteData(Writer);
      end;

      //ProcessWindowsMessageQueue;
    end;
  end;
end;


{ TNotes }

function TNotes.Add: TNote;
begin
  Result := inherited Add as TNote;
  if assigned(Result) then
    Result.OperateStatus := opInsert;
end;

constructor TNotes.Create(AOwner: TCustomStorageObject);
begin
  inherited Create(AOwner, TNote);
end;

function TNotes.GetNote(const AIndex: Integer): TNote;
begin
  Result := TNote(inherited Items[AIndex]);
end;

procedure TNotes.NotifyChanged;
var
  AOwner: TPersistent;
begin
  AOwner := Owner;
  if assigned(AOwner) then
    TCustomStorageObject(AOwner).ChangeOperateStatus;
end;

procedure TNotes.ReadData(Reader: TReader);
var
  ANote: TNote;
  cName: string;
begin
  Clear;

  with Reader do
  begin
    ReadSignature;

    ReadListBegin;
    while not EndOfList do
    begin
      cName := ReadString;

      if cName = TNote.ClassName  then
      begin
        ANote := Add;
        ANote.ReadData(Reader);
      end;

      //ProcessWindowsMessageQueue;
    end;
    ReadListEnd;
  end;
end;


procedure TNotes.ResetOperateStatus;
var
  Idx: integer;
begin
  for Idx:=0 to Count-1 do
    Items[Idx].FOperateStatus := opNone;
end;

procedure TNotes.SetNote(const AIndex: Integer; const Value: TNote);
begin
  inherited SetItem(AIndex, Value);
end;

procedure TNotes.WriteData(Writer: TWriter);
var
  Idx: integer;
begin
  with Writer do
  begin
    WriteSignature;

    WriteListBegin;
    for Idx := 0 to Count - 1 do
    begin
      if TObject(Items[Idx]) is TCollectionItem then
      begin
        WriteString(TCollectionItem(Items[Idx]).ClassName);

        if (TPersistent(Items[Idx]) is TNote) then
          TNote(Items[Idx]).WriteData(Writer);
      end;

      //ProcessWindowsMessageQueue;
    end;
    WriteListEnd;
  end;
end;

{ TNote }

constructor TNote.Create(ACollection: TCollection);
begin
  inherited Create(ACollection);

  FAuthor   := '';
  FLocation := '';
  FNote     := '';
  FWhen     := Now;
  FOperateStatus := opNone;
end;

destructor TNote.Destroy;
begin
  inherited Destroy;
end;

procedure TNote.ReadData(Reader: TReader);
begin
  with Reader do
  begin
    FAuthor     := ReadString;
    FLocation   := ReadString;
    FNote       := ReadString;
    FWhen       := ReadDate;
    FOperateStatus := TOperateStatus(ReadInteger);
  end;
end;

procedure TNote.SetAuthor(const Value: string);
begin
  if FAuthor<>Value then
  begin
    FAuthor := Value;
    TNotes(Collection).NotifyChanged;
  end;
end;

procedure TNote.SetLocation(const Value: string);
begin
  if FLocation<>Value then
  begin
    FLocation := Value;
    TNotes(Collection).NotifyChanged;
  end;
end;

procedure TNote.SetNote(const Value: string);
begin
  if FNote<>Value then
  begin
    FNote := Value;
    TNotes(Collection).NotifyChanged;
  end;
end;

procedure TNote.SetOperateStatus(const Value: TOperateStatus);
begin
  if (FOperateStatus<>opInsert) and (FOperateStatus<>opNone) then
    Raise Exception.Create('Invaild operate state on this object');

  if FOperateStatus<>Value then
  begin
    FOperateStatus := Value;
    TNotes(Collection).NotifyChanged;
  end;
end;

procedure TNote.SetWhen(const Value: TDateTime);
begin
  if FWhen<>Value then
  begin
    FWhen := Value;
    TNotes(Collection).NotifyChanged;
  end;
end;

procedure TNote.WriteData(Writer: TWriter);
begin
  with Writer do
  begin
    WriteString(FAuthor);
    WriteString(FLocation);
    WriteString(FNote);
    WriteDate(FWhen);
    WriteInteger(Integer(FOperateStatus));
  end;
end;

{ THistory }

constructor THistory.Create(ACollection: TCollection);
begin
  inherited Create(ACollection);

  FLog          := '';
  FOperator     := '';
  FLocation     := '';
  FWhen         := Now;
end;

destructor THistory.Destroy;
begin
  inherited Destroy;
end;

procedure THistory.ReadData(Reader: TReader);
begin
  with Reader do
  begin
    FLog          := ReadString;
    FOperator     := ReadString;
    FLocation     := ReadString;
    FWhen         := ReadDate;
  end;
end;

procedure THistory.SetLocation(const Value: string);
begin
  if FLocation<>Value then
  begin
    FLocation := Value;
    THistorys(Collection).NotifyChanged;
  end;
end;

procedure THistory.SetLog(const Value: string);
begin
  if FLog<>Value then
  begin
    FLog := Value;
    THistorys(Collection).NotifyChanged;
  end;
end;

procedure THistory.SetOperator(const Value: string);
begin
  if FOperator<>Value then
  begin
    FOperator := Value;
    THistorys(Collection).NotifyChanged;
  end;
end;

procedure THistory.SetWhen(const Value: TDateTime);
begin
  if FWhen<>Value then
  begin
    FWhen := Value;
    THistorys(Collection).NotifyChanged;
  end;
end;

procedure THistory.WriteData(Writer: TWriter);
begin
  with Writer do
  begin
    WriteString(FLog);
    WriteString(FOperator);
    WriteString(FLocation);
    WriteDate(FWhen);
  end;
end;

{ THistorys }

function THistorys.Add: THistory;
begin
  Result := inherited Add as THistory;
end;

constructor THistorys.Create(AOwner: TCustomStorageObject);
begin
  inherited Create(AOwner, THistory);
end;

function THistorys.GetHistory(const AIndex: Integer): THistory;
begin
  Result := THistory(inherited Items[AIndex]);
end;

procedure THistorys.NotifyChanged;
var
  AOwner: TPersistent;
begin
  AOwner := Owner;
  if assigned(AOwner) then
    TCustomStorageObject(AOwner).ChangeOperateStatus;
end;

procedure THistorys.ReadData(Reader: TReader);
var
  AHistory: THistory;
  cName: string;
begin
  Clear;

  with Reader do
  begin
    ReadSignature;

    ReadListBegin;
    while not EndOfList do
    begin
      cName := ReadString;

      if cName = THistory.ClassName  then
      begin
        AHistory := Add;
        AHistory.ReadData(Reader);
      end;

      //ProcessWindowsMessageQueue;
    end;
    ReadListEnd;
  end;
end;

procedure THistorys.SetHistory(const AIndex: Integer;
  const Value: THistory);
begin
  inherited SetItem(AIndex, Value);
end;

procedure THistorys.WriteData(Writer: TWriter);
var
  Idx: integer;
begin
  with Writer do
  begin
    WriteSignature;

    WriteListBegin;
    for Idx := 0 to Count - 1 do
    begin
      if TObject(Items[Idx]) is TCollectionItem then
      begin
        WriteString(TCollectionItem(Items[Idx]).ClassName);

        if (TPersistent(Items[Idx]) is THistory) then
          TNote(Items[Idx]).WriteData(Writer);
      end;

      //ProcessWindowsMessageQueue;
    end;
    WriteListEnd;
  end;
end;

{ TDocumentList }

function TDocumentList.Add(ADocument: TDocument): Integer;
begin
  Result := inherited Add(ADocument);
end;

function TDocumentList.Extract(Item: TDocument): TDocument;
begin
  Result := TDocument(inherited Extract(Item));
end;

function TDocumentList.First: TDocument;
begin
  Result := TDocument(inherited First);
end;

function TDocumentList.GetItem(Index: Integer): TDocument;
begin
  Result := TDocument(inherited Items[Index]);
end;

function TDocumentList.IndexOf(ADocument: TDocument): Integer;
begin
  Result := inherited IndexOf(ADocument);
end;

procedure TDocumentList.Insert(Index: Integer; ADocument: TDocument);
begin
  inherited Insert(Index, ADocument);
end;

function TDocumentList.Last: TDocument;
begin
  Result := TDocument(inherited Last);
end;

function TDocumentList.New: TDocument;
begin
  Result := TDocument.Create;
  Result.PageStoredPath := PageStoredPath;
  Result.OperateStatus := opInsert;
  Add(Result);
end;

procedure TDocumentList.ReadData(Reader: TReader);
var
  ADoc: TDocument;
  cName: string;
  DocsCount: integer;
begin
  Reader.ReadSignature;
  inherited;

  Clear;

  with Reader do
  begin
    DocsCount := ReadInteger;
    while DocsCount > 0 do
    begin
      cName := ReadString;

      if cName = TDocument.ClassName  then
      begin
        ADoc := New;
        ADoc.PageStoredPath := fPageStoredPath;
        ADoc.ReadData(Reader);
      end;
      Dec(DocsCount);
    end;
  end;
end;

function TDocumentList.Remove(ADocument: TDocument): Integer;
begin
  Result := inherited Remove(ADocument);
end;

procedure TDocumentList.SetItem(Index: Integer; const Value: TDocument);
begin
  inherited Items[Index] := Value;
end;

procedure TDocumentList.WriteData(Writer: TWriter);
var
  Idx: integer;
begin
  Writer.WriteSignature;
  inherited;

  with Writer do
  begin
    WriteInteger(Count);

    for Idx := 0 to Count - 1 do
    begin
      if TObject(Items[Idx]) is TDocument then
      begin
        WriteString(TDocument(Items[Idx]).ClassName);
        TDocument(Items[Idx]).WriteData(Writer);
      end;
    end;
  end;
end;

end.