Komponente ableiten

[hansklok]

So, ich stelle mal ein bisschen Source von der grafischen Ausgabe des Stammbaums rein. Vielleicht hilft das ja jmd. bei der Suche nach Lösungen weiter. Vielleicht ist mein Arbeitsansatz auch völlig falsch.

Gruße hansklok

Delphi-Quellcode:

type
  TPerson = class(TCustomControl)
    private
      fTag: Integer; 
      fID:  Integer; // Verweis auf die ID der Person, sie wird später aus TStammbaum.fGenealogie... zugewiesen
      fTyp: String;
      fVorname: String; // holt den Vornamen der Person auf Grundlage von fID später aus TStammbaum.fGenealogie...
      fNachname: String; // holt den Nachnamen der Person auf Grundlage von fID später aus TStammbaum.fGenealogie...

      fMarkiert: Boolean;
      fMouseOver: Boolean;

      procedure SetTyp(Bezeichnung: String);
    public
      constructor Create(AOwner: TComponent; Oben: Integer);

      procedure Paint; override;

      procedure Click;override;//(Sender: TObject); //overload;

      procedure MouseEnter; override;
      procedure MouseLeave; override;

      //property _OnDblClickForFamilyTree: TNotifyEvent read OnDblClickForFamilyTree write OnDblClickForFamilyTree;
      //procedure DblClick; override;

      property Tag: Integer read fTag write fTag;
      property ID: Integer read fID write fID;
      property Typ: String read fTyp write fTyp;
      property Markiert: Boolean read fMarkiert write fMarkiert;
      property Vorname: String read fVorname write fVorname;
      property Nachname: String read fNachname write fNachname;
    published
      property OnClick;
      property OnMouseEnter;
      property OnMouseLeave;
  end;

  TStammbaum = class(TCustomControl)
    private
      fGenealogie: TGenealogie; // hier werden die Daten zu den Personen geholt
      fPerson:     TObjectList;
      fProband:    Integer;
      fGeneration: Integer;
      fMarkiert:   Integer;

      procedure SetPersonen(Person, Y: Integer);
      procedure Markieren(Plus: Boolean; Person: Integer);
    public
      constructor Create(AOwner: TComponent);

      procedure Paint; override;

      procedure Click; override;//(Sender: TObject); overload;
      procedure MouseEnter; override;

      procedure PersonenUpdate(Proband_ID: Integer);

      property Genealogie: TGenealogie read fGenealogie write fGenealogie;
      property Person: TObjectList read fPerson write fPerson;
      property Proband: Integer read fProband write fProband;
      property Generation: Integer read fGeneration write fGeneration;
      property Markiert: Integer read fMarkiert write fMarkiert;
    published
     // property OnClick;
      property OnEnter;
  end;

implementation

constructor TPerson.Create(AOwner: TComponent; Oben: Integer);
begin
  inherited Create(AOwner);
  Self.fID:= -1; // keine Person verknüpft
  Self.Top:= Oben;
  Self.Left:= 30;
  Self.Height:= 24;  // 24 = einzeilig (nur Name), 36 = zweizeilig Textausgabe (Name & Geburts- & Todesdatum)
  Self.Width:= 200;
end;

procedure TPerson.SetTyp(Bezeichnung: String);
begin
  Self.fTyp:= Bezeichnung;
  Self.Hint:= Bezeichnung;
end;

procedure TPerson.Paint;
begin
  case Self.fMarkiert of
    True:  begin
             Self.Canvas.Font.Color:= clWhite;
             Self.Canvas.GradientFill(Self.ClientRect, $00D5BCAD, $0091522B, gdVertical);
           end;
    False: begin
             Self.Canvas.Font.Color:= clBlack;
             case Self.fMouseOver of
               True:  Self.Canvas.GradientFill(Self.ClientRect, $00F6F2EE, $00D9C2B5, gdVertical);
               False: Self.Canvas.GradientFill(Self.ClientRect, $00FAF8F6, $00E8DED6, gdVertical);
             end;
           end;
  end;

  Self.Canvas.TextRect(Self.ClientRect, 6, 5, IntToStr(Self.fTag) + ' ' +  Self.fTyp); // hier soll später der Name der Person ausgegeben werden 
  Self.Canvas.Pen.Color:= $00A09070;
  Self.Canvas.Brush.Style:= bsClear;
  Self.Canvas.Rectangle(Self.ClientRect);
end;

procedure TPerson.MouseEnter;
begin
  Self.fMouseOver:= True;
  Self.Repaint;
end;

procedure TPerson.MouseLeave;
begin
 Self.fMouseOver:= False;
 Self.Repaint;
end;

procedure TPerson.Click;
begin
  inherited;
  Self.fMarkiert:= not Self.fMarkiert;
  Self.Repaint;
end;

constructor TStammbaum.Create(AOwner: TComponent);
var
  i: Byte;
  Pers: TPerson;
begin
  inherited Create(AOwner);
  fGeneration:= 4; // Darstellung von 4 Generationen
  fPerson:= TObjectList.Create;
  for i:= 0 to 14 do
    begin
      // Positionierung ist nicht angepasst, muss noch gemacht werden
      case i of
        0:     Pers:= TPerson.Create(AOwner, 0); // Proband
        1:     Pers:= TPerson.Create(AOwner, 170);  // Vater
        2:     Pers:= TPerson.Create(AOwner, -170); // Mutter
        3..6:  Pers:= TPerson.Create(AOwner, 300); // Großeltern
        7..14: Pers:= TPerson.Create(AOwner, 540); // Urgroßeltern
      end;
      Pers.Parent:= Self;
      Pers.Tag:= i;
     { if i = 0 then Pers.Top:= 10 else
        Pers.Top:= TPerson(Person.Items[i-1]).Top + TPerson(Person.Items[i-1]).Height + 5;}
      case i of
        0:          Pers.SetTyp('Proband');
        1:          Pers.SetTyp('Vater');
        2:          Pers.SetTyp('Mutter');
        3,5:        Pers.SetTyp('Großvater');
        4,6:        Pers.SetTyp('Großmutter');
        7,9,11,13:  Pers.SetTyp('Urgroßvater');
        8,10,12,14: Pers.SetTyp('Urgroßmutter');
      end;
      Person.Add(Pers);
    end;

  Self.Width:= 750;
  Self.Height:= 600;

  fGenealogie:= TGenealogie.Create;
end;

procedure TStammbaum.SetPersonen(Person, Y: Integer);
begin
  case Person of
    1:  TPerson(Self.Person.Items[Person]).Left:= 176;
    2:  TPerson(Self.Person.Items[Person]).Left:= 176;
    3:  TPerson(Self.Person.Items[Person]).Left:= 176;
    4:  TPerson(Self.Person.Items[Person]).Left:= TPerson(Self.Person.Items[Person-3]).Left + Trunc(TPerson(Self.Person.Items[Person-3]).Width / 2) + 20;
    5:  TPerson(Self.Person.Items[Person]).Left:= TPerson(Self.Person.Items[Person-3]).Left + Trunc(TPerson(Self.Person.Items[Person-3]).Width / 2) + 20;
    6:  TPerson(Self.Person.Items[Person]).Left:= TPerson(Self.Person.Items[Person-4]).Left + Trunc(TPerson(Self.Person.Items[Person-4]).Width / 2) + 20;

    7:  TPerson(Self.Person.Items[Person]).Left:= TPerson(Self.Person.Items[Person-1]).Left + Trunc(TPerson(Self.Person.Items[Person-1]).Width) + 20;
    8:  TPerson(Self.Person.Items[Person]).Left:= TPerson(Self.Person.Items[Person-2]).Left + Trunc(TPerson(Self.Person.Items[Person-2]).Width) + 20;

    9:  TPerson(Self.Person.Items[Person]).Left:= TPerson(Self.Person.Items[Person-4]).Left + Trunc(TPerson(Self.Person.Items[Person-4]).Width) + 20;
    10: TPerson(Self.Person.Items[Person]).Left:= TPerson(Self.Person.Items[Person-5]).Left + Trunc(TPerson(Self.Person.Items[Person-5]).Width) + 20;

  end;
end;

procedure TStammbaum.Paint;
begin
  Self.Canvas.Pen.Color:= $00A09070;
  Self.Canvas.Brush.Style:= bsClear;
  Self.Canvas.Rectangle(Self.ClientRect);

  TPerson(Self.Person.Items[0]).Top:= Trunc((Self.Height - TPerson(Self.Person.Items[0]).Height) / 2); { Proband }
  SetPersonen(1, 110); { Vater }
  SetPersonen(2, 110); { Mutter }

  SetPersonen(3, 170); { Vater des Vaters }
  SetPersonen(4, -50); { Mutter des Vaters }
  SetPersonen(5, 50); { Vater der Mutter }
  SetPersonen(6, 170); { Mutter der Mutter }

  SetPersonen(7, 200); { Vater des Vaters }
  SetPersonen(8, -160); { Mutter des Vaters }

  SetPersonen(9, -160); { Vater des Vaters }
  SetPersonen(10, 200); { Mutter des Vaters }
end;

procedure TStammbaum.Click;//(Sender: TObject);
var
  i: Integer;
begin
  //TPerson(Self.Person.Items[1])._OnDblClickForFamilyTree:= PersonDblClicked;
  Self.Repaint;
end;

procedure TStammbaum.MouseEnter;
begin
  Self.SetFocus;
end;

procedure TStammbaum.Markieren(Plus: Boolean; Person: Integer);
begin
  case Plus of
    True:  begin
             TPerson(Self.Person.Items[Self.fMarkiert]).fMarkiert:= False;
             TPerson(Self.Person.Items[Self.fMarkiert+Person]).fMarkiert:= True;
             Self.fMarkiert:= Self.fMarkiert+Person;
           end;
    False: begin
             TPerson(Self.Person.Items[Self.fMarkiert]).fMarkiert:= False;
             TPerson(Self.Person.Items[Self.fMarkiert-Person]).fMarkiert:= True;
             Self.fMarkiert:= Self.fMarkiert-Person;
           end;
  end;
  Self.Repaint;
end;

procedure TStammbaum.PersonenUpdate(Proband_ID: Integer);
begin
  if Proband_ID > -1 then
    begin
      { Proband }
      if Proband_ID > -1 then begin
        Proband:= Proband_ID;
        TPerson(Person.Items[0]).ID:= Proband_ID;
        TPerson(Person.Items[0]).Vorname:= TINDI(Genealogie.INDI.Items[TPerson(Person.Items[0]).ID]).GIVN end else
        Exit;
      { Vater }
      if TINDI(Person.Items[0]).FATH >= 0 then begin
        TPerson(Person.Items[1]).ID:= TINDI(Person.Items[0]).FATH;
        TPerson(Person.Items[1]).Vorname:= TINDI(Genealogie.INDI.Items[TPerson(Person.Items[1]).ID]).GIVN; end else begin
        TPerson(Person.Items[1]).Vorname:= '(Vater)';
        end;
      { Mutter }
      if TINDI(Person.Items[0]).MOTH > -1 then
        TPerson(Person.Items[2]).ID:= TINDI(Person.Items[0]).MOTH else
        Exit;
      { Großvater I - Vater des Vaters }
      if TINDI(Person.Items[1]).FATH > -1 then
        TPerson(Person.Items[3]).ID:= TINDI(Person.Items[1]).FATH else
        Exit;
      { Großmutter I - Mutter des Vaters }
      if TINDI(Person.Items[1]).MOTH > -1 then
        TPerson(Person.Items[4]).ID:= TINDI(Person.Items[1]).MOTH else
        Exit;
      { Großvater II - Vater der Mutter }
      if TINDI(Person.Items[2]).FATH > -1 then
        TPerson(Person.Items[5]).ID:= TINDI(Person.Items[2]).FATH else
        Exit;
      { Großmutter II - Mutter der Mutter }
      if TINDI(Person.Items[2]).MOTH > -1 then
        TPerson(Person.Items[6]).ID:= TINDI(Person.Items[2]).MOTH else
        Exit;
    end;
end;

end.