preximclasses.pas

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

  FIsShow := false;
end;

destructor TKey.Destroy;
begin
  inherited Destroy;
end;

{-------------------------------------------------------------------------------
  ProceName:  TKey.ReadData
  Purpose:    Read all properties value from a stream
  Author:     Licwing
  Date:       08-15-2003
-------------------------------------------------------------------------------}
procedure TKey.ReadData(Reader: TReader);
begin
  with Reader do
  begin
    FName  := ReadString;
    FValue := ReadString;
    FStatus := TKeyStatus(ReadInteger);
    FIsShow := ReadBoolean;
  end;
end;

{-------------------------------------------------------------------------------
  ProceName:  TKey.WriteData
  Purpose:    Save all properties value to a stream
  Author:     Licwing
  Date:       08-15-2003
-------------------------------------------------------------------------------}
procedure TKey.SetIsShow(const Value: boolean);
begin
  if FIsShow<>Value then
  begin
    FIsShow := Value;
    TKeys(Collection).NotifyChanged;
  end;
end;

procedure TKey.SetName(const Value: string);
begin
  if FName<>Value then
  begin
    FName := Value;
    TKeys(Collection).NotifyChanged;
  end;
end;

procedure TKey.SetStatus(const Value: TKeyStatus);
begin
  if FStatus<>Value then
  begin
    FStatus := Value;
    TKeys(Collection).NotifyChanged;
  end;
end;

procedure TKey.SetValue(const Value: string);
begin
  if FValue<>Value then
  begin
    FValue := Value;
    TKeys(Collection).NotifyChanged;
  end;
end;

procedure TKey.WriteData(Writer: TWriter);
begin
  with Writer do
  begin
    WriteString(FName);
    WriteString(FValue);
    WriteInteger(Integer(FStatus));
    WriteBoolean(FIsShow);
  end;
end;

{ TKeys }

function TKeys.Add: TKey;
begin
  Result := inherited Add as TKey;
end;

constructor TKeys.Create(AOwner: TCustomStorageObject);
begin
  inherited Create(AOwner, TKey);
  FCaseSensitiveKeynames := false;
  FSync := TCriticalSection.Create;
end;

function TKeys.GetByKeyName(const AKeyName: string): TKey;
var
  Idx: Integer;
begin
  Result := nil;
  FSync.Enter;
  try
    if CaseSensitiveKeynames then
    begin
      for Idx := 0 to Count - 1 do
      begin
        if AKeyName = Items[Idx].Name then
        begin
          Result := Items[Idx];
          Break;
        end;

        //ProcessWindowsMessageQueue;
      end;
    end
    else
    begin
      for Idx := 0 to Count - 1 do
      begin
        if AnsiSameText(AKeyName, Items[Idx].Name) then
        begin
          Result := Items[Idx];
          Break;
        end;

        //ProcessWindowsMessageQueue;
      end;
    end;
  finally
    FSync.Leave;
  end;
end;

function TKeys.GetKey(const AIndex: Integer): TKey;
begin
  Result := TKey(inherited Items[AIndex]);
end;

procedure TKeys.ReadData(Reader: TReader);
var
  AKey   : TKey;
  cName  : string;
begin
  // clear old data
  Clear;
  
  with Reader do
  begin
    // read beginning of file and beginning of object list markers
    ReadSignature;
    FCaseSensitiveKeynames := ReadBoolean;
    ReadListBegin;
    //loop through file list of objects
    while not EndOfList do
    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 = TKey.ClassName  then
      begin
        AKey := Add;
        AKey.ReadData(Reader);
      end;

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

procedure TKeys.WriteData(Writer: TWriter);
var
  Idx    : integer;
begin
  with Writer do
  begin
    // mark beginning of file and beginning of object list
    WriteSignature;
    WriteBoolean(FCaseSensitiveKeynames);
    WriteListBegin;
    for Idx := 0 to Count - 1 do
    begin
      //Store any TPersistent objects
      if TObject(Items[Idx]) is TCollectionItem then
      begin
        WriteString(TCollectionItem(Items[Idx]).ClassName);
        //Call WriteData() for TKey objects}
        if (TPersistent(Items[Idx]) is TKey) then
          TKey(Items[Idx]).WriteData(Writer);
      end;

      //ProcessWindowsMessageQueue;
    end;
    // mark end of object list
    WriteListEnd;
  end;
end;

procedure TKeys.SetKey(const AIndex: Integer; const Value: TKey);
begin
  inherited SetItem(AIndex, Value);
end;

{ TBaseStorageObject }
{
constructor TBaseStorageObject.Create;
begin
  FObjectLevel := solNone;
end;

procedure TBaseStorageObject.ReadData(Reader: TReader);
begin
  Reader.Read(FObjectLevel,Sizeof(TStorageObjectLevel));
end;

procedure TBaseStorageObject.WriteData(Writer: TWriter);
begin
  Writer.Write(FObjectLevel,Sizeof(TStorageObjectLevel));
end;
}
procedure TKeys.NotifyChanged;
var
  AOwner: TPersistent;
begin
  AOwner := Owner;
  if assigned(AOwner) then
    TCustomStorageObject(AOwner).ChangeOperateStatus;
end;

destructor TKeys.Destroy;
begin
  FreeAndNil(FSync);
  inherited;
end;

{ TCustomStorageObject }

procedure TCustomStorageObject.ChangeOperateStatus;
begin
  if (fOperateStatus<>opInsert) and (fOperateStatus<>opDelete) then
    fOperateStatus := opEdit;
end;

constructor TCustomStorageObject.Create;
begin
  inherited;
  FObjectLevel := solNone;
  FKeys := TKeys.Create(Self);
  FOperateStatus := opNone;
  FBusinessState := bsNone;
  FParent := nil;
  FKeepPageInStream := true;
end;

destructor TCustomStorageObject.Destroy;
begin
  FParent := nil;
  FreeAndNil(FKeys);
  inherited;
end;

function TCustomStorageObject.GetCaseSensitiveKeynames: Boolean;
begin
  Result := FKeys.CaseSensitiveKeynames;
end;

procedure TCustomStorageObject.LoadFromStream(Stream: TStream);
var
  Reader: TReader;
begin
  Reader := TReader.Create(Stream, $FF);
  try
    ReadData(Reader);
  finally
    FreeAndNil(Reader);
  end;
end;

function TCustomStorageObject.Modified: boolean;
begin
  Result := FOperateStatus<>opNone;    
end;

procedure TCustomStorageObject.ReadData(Reader: TReader);
begin
  inherited;
  with Reader do
  begin
    Read(FObjectLevel,Sizeof(TStorageObjectLevel));
    FOperateStatus := TOperateStatus(ReadInteger);
    FBusinessState := TBusinessState(ReadInteger);
    CaseSensitiveKeynames := ReadBoolean;
  end;

  FKeys.ReadData(Reader);
end;

procedure TCustomStorageObject.ResetOperateStatus;
begin
  FOperateStatus := opNone;
end;

procedure TCustomStorageObject.SaveToStream(Stream: TStream);
var
  Writer: TWriter;
begin
  Writer := TWriter.Create(Stream, $FF);
  try
    WriteData(Writer);
  finally
    FreeAndNil(Writer);
  end;
end;

procedure TCustomStorageObject.SetCaseSensitiveKeynames(
  const Value: Boolean);
begin
  FKeys.CaseSensitiveKeynames := Value;
end;

procedure TCustomStorageObject.SetKeepPageInStream(const Value: boolean);
begin
  fKeepPageInStream := Value;
end;

procedure TCustomStorageObject.SetKeys(const Value: TKeys);
begin
  FKeys.Assign(Value);
end;


procedure TCustomStorageObject.WriteData(Writer: TWriter);
begin
  inherited;
  with Writer do
  begin
    Write(FObjectLevel,Sizeof(TStorageObjectLevel));
    WriteInteger(Integer(FOperateStatus));
    WriteInteger(Integer(FBusinessState));
    WriteBoolean(CaseSensitiveKeynames);
  end;

  FKeys.WriteData(Writer);
end;

{ TFolder }

function TFolder.Add(ATransaction: TTransaction): Integer;
begin
  ATransaction.Parent := Self;
  Result := FTransactions.Add(ATransaction);
end;

procedure TFolder.Clear;
begin
  FTransactions.Clear;
end;

constructor TFolder.Create;
begin
  inherited;
  FObjectLevel := solFolder;
  FTransactions := TObjectList.Create(true);
end;

destructor TFolder.Destroy;
begin
  FreeAndNil(FTransactions);
  inherited;
end;

function TFolder.Extract(Item: TTransaction): TTransaction;
begin
  Result := TTransaction(FTransactions.Extract(Item));
  Result.Parent := nil;
end;

function TFolder.GetItem(Index: Integer): TTransaction;
begin
  Result := TTransaction(FTransactions.Items[Index]);
end;

function TFolder.IndexOf(ATransaction: TTransaction): Integer;
begin
  Result := FTransactions.IndexOf(ATransaction);
end;

procedure TFolder.Insert(Index: Integer; ATransaction: TTransaction);
begin
  FTransactions.Insert(Index, ATransaction);
end;

function TFolder.Modified: boolean;
var
  Idx: integer;
begin
  Result := inherited Modified;
  if Result then exit;

  for Idx:=0 to TransactionsCount-1 do
  begin
    Result := Items[Idx].Modified;
    if Result then break;
  end;
end;

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

procedure TFolder.ReadData(Reader: TReader);
var
  ATxn: TTransaction;
  cName: string;
  TxnsCount: integer;
begin
  // read TFolder signature
  Reader.ReadSignature;
  inherited;

  // clear all old items
  Clear;

  with Reader do
  begin
    // read beginning of file and beginning of object list markers
    TxnsCount := ReadInteger;
    //loop through file list of objects
    while TxnsCount > 0 do
    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.ReadData(Reader);
      end;
      Dec(TxnsCount);

      //ProcessWindowsMessageQueue;
    end;
  end;
end;

function TFolder.Remove(ATransaction: TTransaction): Integer;
begin
  Result := FTransactions.Remove(ATransaction);
end;

procedure TFolder.ResetOperateStatus;
var
  Idx: integer;
begin
  inherited;
  for Idx:=0 to TransactionsCount-1 do
  begin
    Items[Idx].ResetOperateStatus;

    //ProcessWindowsMessageQueue;
  end;
end;

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

procedure TFolder.SetKeepPageInStream(const Value: boolean);
var
  Idx: integer;
begin
  if KeepPageInStream <> Value then
  begin
    for Idx:=0 to FTransactions.Count-1 do
    begin
      with Items[Idx] do
       if (OperateStatus<>opMove) or (OperateStatus<>opMoveFax) or
          (OperateStatus<> opInsert) then
          KeepPageInStream := Value;

       //ProcessWindowsMessageQueue;
    end;
  end;
end;

function TFolder.TransactionsCount: integer;
begin
  Result := FTransactions.Count;
end;

procedure TFolder.WriteData(Writer: TWriter);
var
  Idx: integer;
begin
  // write TFolder signature;
  Writer.WriteSignature;
  inherited;

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

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