TAChart: Refactor Gantt chart demo project (data separate from series). Integrate "milestone" symbol for TStateSeries Gantt usage.

This commit is contained in:
wp_xyz 2025-03-02 01:33:54 +01:00
parent 955ddfa0bb
commit 1bcb76a36c
6 changed files with 274 additions and 93 deletions

View File

@ -48,6 +48,7 @@
<Filename Value="uganttframe.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="GanttFrame"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Frame"/>
<UnitName Value="uGanttFrame"/>
</Unit>
@ -55,9 +56,15 @@
<Filename Value="umachinestateframe.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MachineStateFrame"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Frame"/>
<UnitName Value="uMachineStateFrame"/>
</Unit>
<Unit>
<Filename Value="uganttdata.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uGanttData"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -74,7 +81,17 @@
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx6058="True"/>
</CompilerMessages>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions>

View File

@ -10,11 +10,13 @@ object GanttFrame: TGanttFrame
DesignTop = 307
object GanttChart: TChart
Left = 0
Height = 381
Height = 350
Top = 0
Width = 935
AxisList = <
item
Grid.Color = clSilver
Grid.Style = psSolid
Grid.Visible = False
Marks.LabelBrush.Style = bsClear
Minors = <>
@ -46,26 +48,52 @@ object GanttFrame: TGanttFrame
BarBrush.Color = clSilver
BarHeight = 0.7
BarPen.Color = clMedGray
OnBarHeightChanged = GanttSeriesBarHeightChanged
end
object MilestoneSeries: TLineSeries
LinePen.Color = clBlue
LineType = ltNone
Pointer.Brush.Color = clBlue
Pointer.HorizSize = 12
Pointer.Style = psDiamond
Pointer.VertSize = 12
Pointer.Visible = True
ShowPoints = True
end
object GanttCompletedSeries: TStateSeries
BarBrush.Color = clGreen
BarHeight = 0.7
Source = Completed_ChartSource
end
end
object TasksChartSource: TListChartSource
Left = 120
Top = 40
object Panel1: TPanel
Left = 0
Height = 31
Top = 350
Width = 935
Align = alBottom
AutoSize = True
BevelOuter = bvNone
ClientHeight = 31
ClientWidth = 935
TabOrder = 1
object cbShowCompleteness: TCheckBox
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
Left = 6
Height = 19
Top = 6
Width = 147
BorderSpacing.Around = 6
Caption = 'Show task completeness'
Checked = True
State = cbChecked
TabOrder = 0
OnChange = cbShowCompletenessChange
end
object cbRotated: TCheckBox
AnchorSideLeft.Control = cbShowCompleteness
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
Left = 165
Height = 19
Top = 6
Width = 59
BorderSpacing.Left = 6
BorderSpacing.Around = 6
Caption = 'Rotated'
TabOrder = 1
OnChange = cbRotatedChange
end
end
object GanttChartToolset: TChartToolset
Left = 120
@ -86,4 +114,16 @@ object GanttFrame: TGanttFrame
Left = 120
Top = 104
end
object Tasks_ChartSource: TUserDefinedChartSource
OnGetChartDataItem = Tasks_ChartSourceGetChartDataItem
XCount = 2
Left = 120
Top = 32
end
object Completed_ChartSource: TUserDefinedChartSource
OnGetChartDataItem = Tasks_ChartSourceGetChartDataItem
XCount = 2
Left = 248
Top = 32
end
end

View File

@ -5,12 +5,16 @@ unit uGanttFrame;
interface
uses
Classes, SysUtils, Graphics, Forms, Controls,
TAGraph, TAChartUtils, TAIntervalSources, TASources, TATools,
TACustomSeries, TASeries, TAMultiSeries;
SysUtils, Classes, Math,
Graphics, Forms, Controls, StdCtrls, ExtCtrls,
TAGraph, TAChartUtils, TACustomSource, TAIntervalSources, TASources,
TACustomSeries, TASeries, TAMultiSeries, TATools,
uGanttData;
type
TGanttFrame = class(TFrame)
cbShowCompleteness: TCheckBox;
cbRotated: TCheckBox;
DateTimeIntervalChartSource: TDateTimeIntervalChartSource;
GanttChart: TChart;
GanttChartToolset: TChartToolset;
@ -19,16 +23,22 @@ type
GanttPanDragTool: TPanDragTool;
GanttSeries: TStateSeries;
GanttZoomDragTool: TZoomDragTool;
MilestoneSeries: TLineSeries;
TasksChartSource: TListChartSource;
procedure GanttSeriesBarHeightChanged(Sender: TObject);
procedure GanttSeriesGetMarkText(ASeries: TChartSeries; APointIndex, AXIndex
, AYIndex: Integer; var AFormattedMark: String);
Panel1: TPanel;
Tasks_ChartSource: TUserDefinedChartSource;
Completed_ChartSource: TUserDefinedChartSource;
procedure cbRotatedChange(Sender: TObject);
procedure cbShowCompletenessChange(Sender: TObject);
procedure GanttSeriesGetMarkText({%H-}ASeries: TChartSeries;
APointIndex, {%H-}AXIndex, {%H-}AYIndex: Integer; var AFormattedMark: String);
procedure Tasks_ChartSourceGetChartDataItem(ASource: TUserDefinedChartSource;
AIndex: Integer; var AItem: TChartDataItem);
private
FTasks: TGanttTaskList;
procedure PrepareData;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
@ -39,73 +49,161 @@ implementation
constructor TGanttFrame.Create(AOwner: TComponent);
begin
inherited;
FTasks := TGanttTaskList.Create;
FTasks.AddTask('Kick-off', EncodeDate(2024,2,3), 1, 100);
FTasks.AddTask('Activity 1', EncodeDate(2024,2,4), 4, 100);
FTasks.AddTask('Activity 2', EncodeDate(2024,2,8), 3, 100);
FTasks.AddTask('Activity 3', EncodeDate(2024,2,11), 10, 100);
FTasks.AddMilestone('Intermediate Milestone', EncodeDate(2024,2,21), true);
FTasks.AddTask('Activity 4', EncodeDate(2024,2,21), 7, 80);
FTasks.AddTask('Activity 5', EncodeDate(2024,2,28), 8, 10);
FTasks.AddMilestone('Final Milestone', EncodeDate(2024,3,7), false);
PrepareData;
end;
procedure TGanttFrame.GanttSeriesGetMarkText(ASeries: TChartSeries;
APointIndex, AXIndex, AYIndex: Integer; var AFormattedMark: String);
var
tPlan1, tPlan2: Double;
tComplete1, tComplete2: Double;
txt: String;
destructor TGanttFrame.Destroy;
begin
txt := GanttSeries.Source.Item[APointIndex]^.Text;
tPlan1 := GanttSeries.XValues[APointIndex, 0];
tPlan2 := GanttSeries.XValues[APointIndex, 1];
tComplete1 := GanttCompletedSeries.XValues[APointIndex, 0];
tComplete2 := GanttCompletedSeries.XValues[APointIndex, 1];
AFormattedMark := Format('Task "%s": %.0f %% complete', [txt, (tComplete2 - tComplete1)/(tPlan2 - tPlan1)*100]);
FTasks.Free;
inherited Destroy;
end;
procedure TGanttFrame.GanttSeriesBarHeightChanged(Sender: TObject);
var
h: Integer;
// Checkbox clicked to toggle between "normal" and "rotated" state series
// (horizontal or vertical orientation)
procedure TGanttFrame.cbRotatedChange(Sender: TObject);
begin
if GanttChart.ScalingValid then
if cbRotated.Checked then
begin
h := round(GanttSeries.GetImgBarHeight * 0.66);
MilestoneSeries.Pointer.HorizSize := h;
MilestoneSeries.Pointer.VertSize := h;
GanttSeries.AxisIndexX := 0;
GanttSeries.AxisIndexY := 1;
GanttCompletedSeries.AxisIndexX := 0;
GanttCompletedSeries.AxisIndexY := 1;
// Bottom axis marks
GanttChart.BottomAxis.Marks.Source := Tasks_ChartSource;
GanttChart.BottomAxis.Marks.Style := smsLabel;
GanttChart.BottomAxis.Marks.SourceExchangeXY := true;
GanttChart.BottomAxis.Marks.LabelFont.Orientation := 900;
GanttChart.BottomAxis.Grid.Visible := false;
// Left axis marks
GanttChart.LeftAxis.Marks.Source := DateTimeIntervalChartSource;
GanttChart.LeftAxis.Marks.Style := smsLabel;
GanttChart.LeftAxis.Grid.Visible := true;
GanttChart.Margins.Top := 0;
GanttChart.Margins.Left := 10;
end else
begin
GanttSeries.AxisIndexX := 1;
GanttSeries.AxisIndexY := 0;
GanttCompletedSeries.AxisIndexX := 1;
GanttCompletedSeries.AxisIndexY := 0;
// Left axis marks
GanttChart.LeftAxis.Marks.Source := Tasks_ChartSource;
GanttChart.LeftAxis.Marks.Style := smsLabel;
GanttChart.LeftAxis.Grid.Visible := false;
// Bottom axis marks
GanttChart.BottomAxis.Marks.Source := DateTimeIntervalChartSource;
GanttChart.BottomAxis.Marks.Style := smsLabel;
GanttChart.BottomAxis.Marks.SourceExchangeXY := false;
GanttChart.BottomAxis.Marks.LabelFont.Orientation := 0;
GanttChart.BottomAxis.Grid.Visible := true;
GanttChart.Margins.Left := 0;
GanttChart.Margins.Top := 10;
end;
end;
procedure TGanttFrame.cbShowCompletenessChange(Sender: TObject);
begin
GanttCompletedSeries.Active := cbShowCompleteness.Checked;
end;
{ Constructs the Mark text to be used in the popup hint. }
procedure TGanttFrame.GanttSeriesGetMarkText(ASeries: TChartSeries;
APointIndex, AXIndex, AYIndex: Integer; var AFormattedMark: String);
const
NO_Yes: array[boolean] of string = ('not ', '');
var
t, tPlan1, tPlan2: Double;
completeness: Double;
txt: String;
item: TBasicGanttItem;
begin
item := FTasks[APointIndex];
txt := item.Title;
if item is TGanttTask then
begin
tPlan1 := TGanttTask(item).StartDate;
tPlan2 := TGanttTask(item).EndDate;
completeness := TGanttTask(item).PercentageComplete;
AFormattedMark := Format(
'Task "%s":' + LineEnding +
'⯄ %s - %s' + LineEnding +
'⯄ %.0f%% complete', [
txt, DateToStr(tPlan1), DateToStr(tPlan2), completeness
]);
end
else
if item is TGanttMilestone then
begin
t := TGanttMileStone(item).DateDue;
AFormattedMark := Format(
'"%s":' + LineEnding +
'⯄ due %s' + LineEnding +
'⯄ %scomplete', [
txt, DateToStr(t), NO_YES[TGanttMilestone(item).Complete]
]);
end;
end;
{ Extracts the data for the data point at index AIndex and transfers them
to the chartdataitem AItem needed by the series. }
procedure TGanttFrame.Tasks_ChartSourceGetChartDataItem(ASource:
TUserDefinedChartSource; AIndex: Integer; var AItem: TChartDataItem);
var
dt1, dt2: TDateTime;
begin
if FTasks[AIndex] is TGanttTask then
begin
dt1 := TGanttTask(FTasks[AIndex]).StartDate;
dt2 := TGanttTask(FTasks[AIndex]).EndDate;
if ASource = Completed_ChartSource then
dt2 := dt1 + TGanttTask(FTasks[AIndex]).PercentageComplete/100 * (dt2 - dt1);
end else
if FTasks[AIndex] is TGanttMilestone then
begin
if TGanttMilestone(FTasks[AIndex]).Complete or (ASource = Tasks_ChartSource) then
dt1 := TGanttMilestone(FTasks[AIndex]).DateDue
else
dt1 := NaN;
dt2 := dt1;
end;
AItem.Text := FTasks[AIndex].Title;
AItem.SetX(0, dt1);
AItem.SetX(1, dt2);
AItem.SetY(AIndex);
end;
procedure TGanttFrame.PrepareData;
begin
TasksChartSource.Add(0, 0, 'Kick-off');
TasksChartSource.Add(1, 1, 'Activity 1');
TasksChartSource.Add(2, 2, 'Activity 2');
TasksChartSource.Add(3, 3, 'Activity 3');
TasksChartSource.Add(4, 4, 'Intermediate Milestone');
TasksChartSource.Add(5, 5, 'Activity 4');
TasksChartSource.Add(6, 6, 'Activity 5');
TasksChartSource.Add(7, 7, 'Final Milestone');
// Series with planned tasks
Tasks_ChartSource.XCount := 2;
Tasks_ChartSource.PointsNumber := FTasks.Count;
GanttSeries.Source := Tasks_ChartSource;
// The x/y values in the TasksChartSource are the y values for the
// GanttSeries data.
// Series showing to which percentage the planned tasks are completed
Completed_ChartSource.XCount := 2;
Completed_ChartSource.PointsNumber := FTasks.Count;
GanttCompletedSeries.Source := Completed_ChartSource;
GanttCompletedSeries.ZPosition := 1; // Draw it before GanttSeries
// GanttSeries represents the project plan
GanttSeries.AddXY(EncodeDate(2024,2,3), EncodeDate(2024,2,4), 0, TasksChartSource.Item[0]^.Text);
GanttSeries.AddXY(EncodeDate(2024,2,4), EncodeDate(2024,2,8), 1, TasksChartSource.Item[1]^.Text);
GanttSeries.AddXY(EncodeDate(2024,2,8), EncodeDate(2024,2,11), 2, TasksChartSource.Item[2]^.Text);
GanttSeries.AddXY(EncodeDate(2024,2,11), EncodeDate(2024,2,21), 3, TasksChartSource.Item[3]^.Text);
GanttSeries.AddXY(EncodeDate(2024,2,21), EncodeDate(2024,2,28), 5, TasksChartSource.Item[5]^.Text);
GanttSeries.AddXY(EncodeDate(2024,2,28), EncodeDate(2024,3,7), 6, TasksChartSource.Item[6]^.Text);
// GanttCompletedSeries contains only the activities from GanttSeries which
// are completed to some extent
GanttCompletedSeries.AddXY(GanttSeries.XValues[0,0], GanttSeries.XValues[0,1], 0); // Kick-off is 100% finished
GanttCompletedSeries.AddXY(GanttSeries.XValues[1,0], GanttSeries.XValues[1,1], 1); // Activity 1 is 100% finished
GanttCompletedSeries.AddXY(GanttSeries.XValues[2,0], GanttSeries.XValues[2,1], 2); // Activity 2 is 100% finished
GanttCompletedSeries.AddXY(GanttSeries.XValues[3,0], GanttSeries.XValues[3,1], 3); // Activity 3 is 100% finished
GanttCompletedSeries.AddXY(GanttSeries.XValues[4,0], GanttSeries.XValues[4,0]+6, 5); // Activity 4 is almost finished
GanttCompletedSeries.AddXY(GanttSeries.XValues[5,0], GanttSeries.XValues[5,0]+1, 6); // Activity 6 has a lot left to be done
GanttCompletedSeries.ZPosition := 1; // draw this series over the GanttSeries
// Milestones
Milestoneseries.AddXY(EncodeDate(2024,2,21), 4, '', clGreen); // Milestone 1 reached
Milestoneseries.AddXY(EncodeDate(2024,3,7), 7, '', clSilver); // Milestone 2 open
GanttChart.LeftAxis.Marks.Source := TasksChartSource;
// Show the task titles as y axis labels
GanttChart.LeftAxis.Marks.Source := Tasks_ChartSource;
GanttChart.LeftAxis.Marks.Style := smsLabel;
GanttChart.LeftAxis.Inverted := true;
end;

View File

@ -6,8 +6,8 @@ object MachineStateFrame: TMachineStateFrame
ClientHeight = 343
ClientWidth = 988
TabOrder = 0
DesignLeft = 587
DesignTop = 331
DesignLeft = 594
DesignTop = 432
object Chart: TChart
Left = 0
Height = 287

View File

@ -691,7 +691,7 @@ var
end;
const
MAX_COUNT = 1000; // Arbitraty limit to prevent OOM in case of a bug.
MAX_COUNT = 1000; // Arbitrary limit to prevent OOM in case of a bug.
var
i, cnt: Integer;
x, start, stepLen: Double;

View File

@ -2702,11 +2702,9 @@ var
pointIndex: Integer;
scaledDepth: Integer;
procedure DrawBar(const ARect: TRect);
procedure PrepareDrawer;
var
sz: TSize;
c: TColor;
// ic: IChartTCanvasDrawer; -- maybe later...
begin
ADrawer.Pen := FBarPen;
if FBarPen.Color = clDefault then
@ -2722,23 +2720,43 @@ var
c := Source[pointIndex]^.Color;
if c <> clTAColor then
ADrawer.BrushColor := c;
end;
procedure DrawDiamond(const ARect: TRect);
var
P: array of TPoint = nil;
sz: Integer;
ctr: TPoint;
begin
PrepareDrawer;
ctr := Point((ARect.Left + ARect.Right) div 2, (ARect.Top + ARect.Bottom) div 2);
if IsRotated then
sz := (ARect.Right - ARect.Left) div 2
else
sz := (ARect.Bottom - ARect.Top) div 2;
SetLength(P, 4);
P[0] := Point(ctr.X - sz, ctr.Y);
P[1] := Point(ctr.X, ctr.Y - sz);
P[2] := Point(ctr.X + sz, ctr.Y);
P[3] := Point(ctr.X, ctr.Y + sz);
ADrawer.Polygon(P, 0, 4);
end;
procedure DrawBar(const ARect: TRect);
var
c: TColor;
sz: TSize;
begin
PrepareDrawer;
sz := Size(ARect);
if (sz.cx <= 2*FBarPen.Width) or (sz.cy <= 2*FBarPen.Width) then begin
// Bars are too small to distinguish the border from the interior.
ADrawer.SetPenParams(psSolid, ADrawer.BrushColor);
end;
(* todo --- add me
if Assigned(FOnCustomDrawBar) then begin
FOnCustomDrawBar(Self, ADrawer, AR, pointIndex, stackIndex);
exit;
end;
if Supports(ADrawer, IChartTCanvasDrawer, ic) and Assigned(OnBeforeDrawBar) then
OnBeforeDrawBar(Self, ic.Canvas, AR, pointIndex, stackIndex, defaultDrawing);
if not defaultDrawing then exit; *)
ADrawer.Rectangle(ARect);
if scaledDepth > 0 then begin
c := ADrawer.BrushColor;
ADrawer.BrushColor := GetDepthColor(c, true);
@ -2753,6 +2771,7 @@ var
var
ext2: TDoubleRect;
p: TDoublePoint;
ctr: TPoint;
procedure BuildBar(x1, x2, y, barH: Double);
var
@ -2778,7 +2797,10 @@ var
if (Left = Right) and IsRotated then Dec(Left);
if (Bottom = Top) and not IsRotated then Inc(Bottom);
end;
DrawBar(imageBar);
if x1 <> x2 then
DrawBar(imageBar)
else
DrawDiamond(imageBar);
end;
var
@ -2812,8 +2834,12 @@ begin
with Source[pointIndex]^ do
begin
x1 := AxisToGraphX(GetX(0));
x2 := AxisToGraphX(GetX(1));
x1 := GetX(0);
x2 := GetX(1);
if IsNaN(x1) then
Continue;
x1 := AxisToGraphX(x1);
x2 := AxisToGraphX(x2);
end;
BuildBar(x1, x2, p.Y, h);