unit uGenealogyFamilyTree;
{$mode objfpc}{$H+}
interface
uses
Classes, Controls, Graphics, SysUtils, uGenealogyFile;
const
ControlCol = $0099887F;
LineCol = $00E2E2E2;
PersBorderColor = $00606060;
PersHoverCol = $00746155;
NormalPersonColStart = $00F2F2F3;
NormalPersonColEnd = $00C5C5C5;
NormalPersonFontCol = clBlack;
NormalPersonHoverColorStart = $00F5F1EE;
NormalPersonHoverColorEnd = $00E0CEC3;
SelectedPersonColStart = $00D3C3B3;
SelectedPersonColEnd = $00B39B83;
SelectedPersonFontCol = clWhite;
PersonWidth = 210;
PersonHeight = 60;
type
TTreePerson =
class(TObject)
private
fName:
String;
fSelected,
fMouseOver: Boolean;
public
property Name:
String read fName
write fName;
property Selected: Boolean
read fSelected
write fSelected;
property MouseOver: Boolean
read fMouseOver
write fMouseOver;
procedure Draw(AName:
String; ACanvas: TCanvas; ATop, ALeft: Integer);
end;
TFamilyTree =
class(TCustomControl)
private
fGeneration,
fProband,
// erste Person eines Stammbaums
fSelectedPerson: Integer;
// ausgewählte Person
fGenealogyFile: TGenealogyFile;
fTreePerson:
array[1..15]
of TTreePerson;
// erstmal werden nur 15 dargestellt
public
constructor Create(AOwner: TComponent);
destructor Destroy;
property Generation: Integer
read fGeneration
write fGeneration;
property Proband: Integer
read fproband
write fProband;
property SelectedPerson: Integer
read fSelectedPerson
write fSelectedPerson;
property GenealogyFile: TGenealogyFile
read fGenealogyFile
write fGenealogyFile;
procedure Paint;
override;
end;
implementation
var
i: Integer;
PersonRect, PersonOverRect: TRect;
Style: TTextStyle;
procedure TTreePerson.Draw(AName:
String; ACanvas: TCanvas; ATop, ALeft: Integer);
begin
ACanvas.Pen.Width:= 1;
ACanvas.Pen.Color:= PersBorderColor;
ACanvas.Font.Size:= 10;
Style.Layout:= tlCenter;
Style.Alignment:= taCenter;
Style.SystemFont:= False;
PersonRect:= Rect(ATop, ALeft, PersonWidth, PersonHeight);
PersonOverRect:= Rect(ATop-5, ALeft-5, PersonWidth+5, PersonHeight+60);
if fSelected
and fMouseOver
then
begin
ACanvas.Brush.Style:= bsSolid;
ACanvas.Pen.Width:= 0;
ACanvas.Brush.Color:= PersHoverCol;
ACanvas.RoundRect(PersonOverRect, 5, 5);
ACanvas.GradientFill(PersonRect, SelectedPersonColStart, SelectedPersonColEnd, gdVertical);
ACanvas.Font.Color:= SelectedPersonFontCol;
end
else
if not fSelected
and fMouseOver
then
begin
ACanvas.Brush.Style:= bsSolid;
ACanvas.Pen.Width:= 0;
ACanvas.Brush.Color:= PersHoverCol;
ACanvas.RoundRect(PersonOverRect, 5, 5);
ACanvas.GradientFill(PersonRect, NormalPersonHoverColorStart, NormalPersonHoverColorEnd, gdVertical);
ACanvas.Font.Color:= NormalPersonFontCol;
end
else
if not fSelected
and not fMouseOver
then
begin
ACanvas.GradientFill(PersonRect, NormalPersonColStart, NormalPersonColEnd, gdVertical);
ACanvas.Font.Color:= NormalPersonFontCol;
end
else
if fSelected
and not fMouseOver
then
begin
ACanvas.Brush.Style:= bsSolid;
ACanvas.GradientFill(PersonRect, SelectedPersonColStart, SelectedPersonColEnd, gdVertical);
ACanvas.Font.Color:= SelectedPersonFontCol;
end;
ACanvas.Brush.Style:= bsClear;
ACanvas.TextRect(Rect(ATop + 5, ALeft + 5, PersonWidth - 5, PersonHeight - 5), 1, 1, AName, Style);
ACanvas.Rectangle(PersonRect);
end;
constructor TFamilyTree.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Color:= ControlCol;
fGenealogyFile:= TGenealogyFile.Create;
fProband:= fGenealogyFile.Proband;
fSelectedPerson:= fProband;
for i:= 1
to 15
do
fTreePerson[i]:= TTreePerson.Create;
end;
destructor TFamilyTree.Destroy;
begin
inherited Destroy;
for i:= 1
to 15
do
fTreePerson[i].Free;
fGenealogyFile.Free;
end;
procedure TFamilyTree.Paint;
begin
if fProband = -1
then
fTreePerson[1].
Name:= '
Proband hinzufügen'
else
fTreePerson[1].
Name:= fGenealogyFile.Persons[fSelectedPerson].FirstName + '
' +
fGenealogyFile.Persons[fSelectedPerson].LastName;
fTreePerson[1].Draw(fTreePerson[1].
Name, Canvas, 20, 20);
inherited Paint;
end;
end.