Разработка программы "Генеалогическое дерево", страница 3

    function getChildrensOfMarriage(): TObjectList;

    //Обратное getChildrensOfMarriag();

    function getChildrensInMarriage(Suprug: TPeople): TObjectList;

    //Все прочие жены/мужья, с которыми нет общих детей

    function getProchieMarriage():TObjectList;

  protected

    Childrens: TObjectList; //Дети

    Marriages: TObjectList; //Браки

    constructor Create(RPeople: TRPeople);

  end;

  {Класс Менеджера по правам людей, :)}

  TManager = class

  private

    Peoples: TObjectList;

    Marriages: TObjectList; //Браки

    //Проверяет, нет ли у People детей(...) в роли Children

    function ValidateParent(People, Children: TPeople): Boolean; // Result:= true - значит есть

    function ValidateFilter(RFilter: TRFilter; People: TPeople): Boolean;

  public

    constructor Create();

    destructor Destroy(); override;

    //Удаление Всез людей и Браков, соответсвено

    procedure Clear();

    procedure Save(PFiles: string);

    procedure Load(PFiles: string);

    function AddPeople(RPeople: TRPeople): TPeople;

    procedure DeletePeople(People: TPeople);

    function AddMarriage(RMarriage: TRMarriage): TMarriage;

    procedure DeleteMarriage(Marriage: TMarriage);

    {

    //Глубина ветки по People

    function DepthPeopleTree(People: TPeople): Integer;

    }

    //Все люди. Если People <> nil, то кроме текущего

    procedure Process(Proc: TPPeople; RFilter: TRFilter; People: TPeople = nil);

    //Все возможные родители родители по People; Sex = true: д/м отца, иначе мать

    procedure ProcessParent(Proc: TPPeople; People: TPeople; Sex: Boolean = true);

    //Все дети по People

    procedure ProcessChildren(Proc: TPPeople; People: TPeople);

    //Все возможные дети по People

    procedure ProcessNotChildren(Proc: TPPeople; People: TPeople);

    //Все браки по People

    procedure ProcessMarriage(Proc: TPMarriage; People: TPeople);

    //Все возможные браки c People

    procedure ProcessSelectMarriage(Proc: TPPeople; People: TPeople);

    //Все Братья/Сестры

    procedure ProcessBrother(Proc: TPPeople; People: TPeople);

  end;

implementation

{ TPeople }

procedure TPeople.AddChildren(People: TPeople);

begin

  Childrens.Add(People);

  if Sex then

    People.Father:= Self

  else

    People.Mother:= Self;

end;

constructor TPeople.Create(RPeople: TRPeople);

begin

  inherited Create();

  Family:= RPeople.Family;

  FamilyFirst:= RPeople.FamilyFirst;

  Name:= RPeople.Name;

  Patronymic:= RPeople.Patronymic;

  Sex:= RPeople.Sex;

  DateOfBirth:= RPeople.DateOfBirth;

  PlaceOfBirth:= RPeople.PlaceOfBirth;

  DateOfDeath:= RPeople.DateOfDeath;

  PlaceOfDeath:= RPeople.PlaceOfDeath;

  Commentary:= RPeople.Commentary;

  Father:= RPeople.Father;

  Mother:= RPeople.Mother;

  Childrens:= TObjectList.Create(true);

  Marriages:= TObjectList.Create(true);

end;

procedure TPeople.DeleteChildren(People: TPeople);

begin

  if Sex then

    People.Father:= nil

  else

    People.Mother:= nil;

  Childrens.Extract(People);

end;

destructor TPeople.Destroy;

begin      

  if Father <> nil then

    Father.Childrens.Extract(self);

  if Mother <> nil then

    Mother.Childrens.Extract(self);

  while Marriages.Count > 0 do

  begin

    if (Marriages.First as TMarriage).Husband = self then

      (Marriages.First as TMarriage).Husband:= nil

    else

      (Marriages.First as TMarriage).Wife:= nil;

    Marriages.Extract(Marriages.First);

  end;

  while Childrens.Count > 0 do

  begin

    if (Childrens.First as TPeople).Father = self then

      (Childrens.First as TPeople).Father:= nil;

    if (Childrens.First as TPeople).Mother = self then

      (Childrens.First as TPeople).Mother:= nil;

    Childrens.Extract(Childrens.First);

  end;

  inherited Destroy;

end;

function TPeople.getBrothers: TObjectList;

var

  i: Integer;

begin

  Result:= TObjectList.Create(false);

  if Father <> nil then

    for i:= 0 to Father.Childrens.Count - 1 do

      if (self <> Father.Childrens.Items[i]) then

        Result.Add(Father.Childrens.Items[i]);

  if Mother <> nil then

    for i:= 0 to Mother.Childrens.Count - 1 do

      if (self <> Mother.Childrens.Items[i]) and (Result.IndexOf(Mother.Childrens.Items[i]) = -1) then

        Result.Add(Mother.Childrens.Items[i]);

end;

function TPeople.getChildrens: TObjectList;

var

  i: Integer;

begin

  Result:= TObjectList.Create(false);

  for i := 0 to Childrens.Count - 1 do

    Result.Add(Childrens.Items[i]);

end;

function TPeople.getChildrensInMarriage(Suprug: TPeople): TObjectList;

var

  i: Integer;

  People: TPeople;

begin

  Result:= TObjectList.Create(false);

  for i:= 0 to Childrens.Count - 1 do

  begin

    if sex then

      People:= (Childrens.Items[i] as TPeople).Mother

    else

      People:= (Childrens.Items[i] as TPeople).Father;

    if People = Suprug then

      Result.Add(Childrens.Items[i]);

  end;

end;

function TPeople.getChildrensNotParentOfSuprug: TObjectList;

var

  i, j: Integer;

  People: TPeople;

  Bool: Boolean;

begin

  Result:= TObjectList.Create(false);

  for i:= 0 to Childrens.Count - 1 do

  begin

    People:= Childrens.Items[i] as TPeople;

    if (People <> nil) or (People <> self) then

    begin

      if sex then

        People:= (Childrens.Items[i] as TPeople).Mother

      else

        People:= (Childrens.Items[i] as TPeople).Father;

      Bool:= true;

      for j:= 0 to Marriages.Count - 1 do

        if ((Marriages.Items[j] as TMarriage).Husband = People) or ((Marriages.Items[j] as TMarriage).Wife = People) then

        begin

          Bool:= false;

          break;

        end;

      if Bool then

        Result.Add(Childrens.Items[i]);

    end;

  end;

end;

function TPeople.getChildrensOfMarriage: TObjectList;

var