scanclasses.pas

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

begin
  Result := Count=ATypeList.Count;
  if Result then
  begin
    for Idx:=0 to Count-1 do
    begin
      Result := Items[Idx].EqualTo(ATypeList.Items[Idx]);
      if not Result then break;
    end;
  end;
end;

function TTypeList.Extract(Item: TType): TType;
begin
   Result := TType(inherited Extract(Item));
end;

function TTypeList.First: TType;
begin
  Result := TType(inherited First);
end;

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

function TTypeList.IndexOf(AType: TType): Integer;
begin
  Result := inherited IndexOf(AType);
end;

procedure TTypeList.Insert(Index: Integer; AType: TType);
begin
  inherited Insert(Index, AType);
end;

function TTypeList.Last: TType;
begin
  Result := TType(inherited Last);
end;

function TTypeList.New: TType;
begin
  Result := TType.Create;
  Add(Result);
end;

procedure TTypeList.ReadData(Reader: TReader);
var
  AType: TType;
  cName: string;
  TypesCount: integer;
begin
  // read TPageList signature
  Reader.ReadSignature;
  inherited;

  // clear all old items
  Clear;

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

      //ProcessWindowsMessageQueue;
    end;
  end;
end;

function TTypeList.Remove(AType: TType): Integer;
begin
  Result := inherited Remove(AType);
end;

procedure TTypeList.SetItem(Index: Integer; const AType: TType);
begin
  inherited Items[Index] := AType;
end;

procedure TTypeList.WriteData(Writer: TWriter);
var
  Idx: integer;
begin
  // write TPageList signature;
  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
      if TObject(Items[Idx]) is TType then
      begin
        WriteString(TType(Items[Idx]).ClassName);
        TType(Items[Idx]).WriteData(Writer);
      end;

      //ProcessWindowsMessageQueue;
    end;
  end;
end;

{ TParameter }

procedure TParameter.Assign(Source: TPersistent);
var
  Idx: integer;
  AParam: TParameter;
begin
  AParam := TParameter(Source);

  fIsList             := AParam.IsList;
  fID                 := AParam.ID;
  fDefaultValue       := AParam.DefaultValue;
  fType               := AParam.ParamType;
  fName               := AParam.Name;
  FIsShow             := AParam.IsShow;
  FStatus             := AParam.Status;
    
  if fIsList then
  begin
    fListValueParis.Clear;

    for Idx:=0 to AParam.ListValueParis.Count-1 do
    begin
      with fListValueParis.New do
        Assign(AParam.ListValueParis.Items[Idx]);
    end;
  end;
end;

constructor TParameter.Create;
begin
  inherited;

  fIsList       := false;
  fID           := '';
  fDefaultValue := '';
  fType         := '';
  fName         := '';
  FIsShow       := false;
  fListValueParis := TListValuePairList.Create;
end;

destructor TParameter.Destroy;
begin
  FreeAndNil(fListValueParis);
  inherited;
end;

function TParameter.EqualTo(AParameter: TParameter): boolean;
begin
//  with AParameter do
//  begin
  if (fID=AParameter.ID) and (fType=AParameter.ParamType) and (fName=AParameter.Name) then
    Result := (fIsList=AParameter.IsList) and (fDefaultValue=AParameter.DefaultValue) and
              (FIsShow=AParameter.IsShow) and (fStatus=AParameter.Status)
  else Result := false;

  if not Result then exit;
  
  if fIsList then
   Result := fListValueParis.EqualTo(AParameter.ListValueParis);
//  end;
end;

function TParameter.IsSystem: boolean;
begin
  Result := FStatus = ksSystem;
end;

procedure TParameter.ReadData(Reader: TReader);
begin
  inherited;
  with Reader do
  begin
    fIsList             := ReadBoolean;
    fID                 := ReadString;
    fDefaultValue       := ReadString;
    fType               := ReadString;
    fName               := ReadString;
    FIsShow             := ReadBoolean;
    FStatus             := TKeyStatus(ReadInteger);
    
    if fIsList then
      fListValueParis.ReadData(Reader);
  end;
end;

procedure TParameter.SetIsList(const Value: boolean);
begin
  if fIsList<>Value then
  begin
    fIsList := Value;
    if not fIsList then fListValueParis.Clear;
  end;
end;

procedure TParameter.SetStatus(const Value: TKeyStatus);
begin
  FStatus := Value;
end;

procedure TParameter.WriteData(Writer: TWriter);
begin
  inherited;
  with Writer do
  begin
    WriteBoolean(fIsList);
    WriteString(fID);
    WriteString(fDefaultValue);
    WriteString(fType);
    WriteString(fName);
    WriteBoolean(FIsShow);
    WriteInteger(Integer(FStatus));
     
    if fIsList then
      fListValueParis.WriteData(Writer);
  end;
end;

{ TParameterList }

function TParameterList.Add(AParam: TParameter): Integer;
begin
  Result := inherited Add(AParam);
end;

function TParameterList.EqualTo(AParameterList: TParameterList): boolean;
var
  Idx: integer;
begin
  Result := Count=AParameterList.Count;
  if Result then
  begin
    for Idx:=0 to Count-1 do
    begin
      Result := Items[Idx].EqualTo(AParameterList.Items[Idx]);
      if not Result then break;
    end;
  end;
end;

function TParameterList.Extract(Item: TParameter): TParameter;
begin
  Result := TParameter(inherited Extract(Item));
end;

function TParameterList.First: TParameter;
begin
  Result := TParameter(inherited First);
end;

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

function TParameterList.IndexOf(AParam: TParameter): Integer;
begin
  Result := inherited IndexOf(AParam);
end;

procedure TParameterList.Insert(Index: Integer; AParam: TParameter);
begin
  inherited Insert(Index, AParam);
end;

function TParameterList.Last: TParameter;
begin
  Result := TParameter(inherited Last);
end;

function TParameterList.New: TParameter;
begin
  Result := TParameter.Create;
  Add(Result);
end;

procedure TParameterList.ReadData(Reader: TReader);
var
  AParam: TParameter;
  cName: string;
  ParamsCount: integer;
begin
  Reader.ReadSignature;
  inherited;

  // clear all old items
  Clear;

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

      //ProcessWindowsMessageQueue;
    end;
  end;
end;

function TParameterList.Remove(AParam: TParameter): Integer;
begin
  Result := inherited Remove(AParam);
end;

procedure TParameterList.SetItem(Index: Integer; const AParam: TParameter);
begin
  inherited Items[Index] := AParam;
end;

procedure TParameterList.WriteData(Writer: TWriter);
var
  Idx: integer;
begin
  // write TPageList signature;
  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
      if TObject(Items[Idx]) is TParameter then
      begin
        WriteString(TParameter(Items[Idx]).ClassName);
        TParameter(Items[Idx]).WriteData(Writer);
      end;

      //ProcessWindowsMessageQueue;
    end;
  end;
end;
{ TListValuePair }

procedure TListValuePair.Assign(Source: TPersistent);
begin
  fID           := TListValuePair(Source).ID;
  fListValue    := TListValuePair(Source).ListValue;
  fListDisplay  := TListValuePair(Source).ListDisplay;
end;

constructor TListValuePair.Create;
begin
  inherited;

  fListDisplay  := '';
  fListValue    := '';
  fID           := '';
end;

function TListValuePair.EqualTo(AListValuePair: TListValuePair): boolean;
begin
  if (fID=AListValuePair.ID) and (fListValue=AListValuePair.ListValue) then
    Result := (fListDisplay=AListValuePair.ListDisplay)
  else Result := false;
end;

procedure TListValuePair.ReadData(Reader: TReader);
begin
  inherited;
  with Reader do
  begin
    fID                 := ReadString;
    fListDisplay        := ReadString;
    fListValue          := ReadString;
  end;
end;

procedure TListValuePair.WriteData(Writer: TWriter);
begin
  inherited;
  with Writer do
  begin
    WriteString(fID);
    WriteString(fListDisplay);
    WriteString(fListValue);
  end;
end;

{ TListValuePairList }

function TListValuePairList.Add(AListValuePair: TListValuePair): Integer;
begin
  Result := inherited Add(AListValuePair);
end;

function TListValuePairList.EqualTo(
  AListValuePairList: TListValuePairList): boolean;
var
  Idx: integer;
begin
  Result := Count=AListValuePairList.Count;
  if Result then
  begin
    for Idx:=0 to Count-1 do
    begin
      Result := Items[Idx].EqualTo(AListValuePairList.Items[Idx]);
      if not Result then break;
    end;
  end;
end;

function TListValuePairList.Extract(Item: TListValuePair): TListValuePair;
begin
  Result := TListValuePair(inherited Extract(Item));
end;

function TListValuePairList.First: TListValuePair;
begin
  Result := TListValuePair(inherited First);
end;

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

function TListValuePairList.IndexOf(
  AListValuePair: TListValuePair): Integer;
begin
  Result := inherited IndexOf(AListValuePair);
end;

procedure TListValuePairList.Insert(Index: Integer;
  AListValuePair: TListValuePair);
begin
  inherited Insert(Index, AListValuePair);
end;

function TListValuePairList.Last: TListValuePair;
begin
  Result := TListValuePair(inherited Last);
end;

function TListValuePairList.New: TListValuePair;
begin
  Result := TListValuePair.Create;
  Add(Result);
end;

procedure TListValuePairList.ReadData(Reader: TReader);
var
  ALvPair: TListValuePair;
  cName: string;
  lvPairCount: integer;
begin
  Reader.ReadSignature;
  inherited;

  // clear all old items
  Clear;

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

      //ProcessWindowsMessageQueue;
    end;
  end;
end;

function TListValuePairList.Remove(
  AListValuePair: TListValuePair): Integer;
begin
  Result := inherited Remove(AListValuePair);
end;

procedure TListValuePairList.SetItem(Index: Integer;
  const AListValuePair: TListValuePair);
begin
  inherited Items[Index] := AListValuePair;
end;

procedure TListValuePairList.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 TDocument objects
      if TObject(Items[Idx]) is TListValuePair then
      begin
        WriteString(TListValuePair(Items[Idx]).ClassName);
        //Call WriteData() for TFolder objects}
        TListValuePair(Items[Idx]).WriteData(Writer);
      end;

      //ProcessWindowsMessageQueue;
    end;
  end;
end;


end.