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

components/tachart/demo/stateseries/stateseries_demo.lpi

@@ -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>

components/tachart/demo/stateseries/uganttframe.lfm

@@ -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
+  object Panel1: TPanel
-    Left = 120
+    Left = 0
-    Top = 40
+    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

components/tachart/demo/stateseries/uganttframe.pas

@@ -5,12 +5,16 @@ unit uGanttFrame;
 interface
 
 uses
-  Classes, SysUtils, Graphics, Forms, Controls,
+  SysUtils, Classes, Math,
-  TAGraph, TAChartUtils, TAIntervalSources, TASources, TATools,
+  Graphics, Forms, Controls, StdCtrls, ExtCtrls,
-  TACustomSeries, TASeries, TAMultiSeries;
+  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;
+    Panel1: TPanel;
-    TasksChartSource: TListChartSource;
+    Tasks_ChartSource: TUserDefinedChartSource;
-    procedure GanttSeriesBarHeightChanged(Sender: TObject);
+    Completed_ChartSource: TUserDefinedChartSource;
-    procedure GanttSeriesGetMarkText(ASeries: TChartSeries; APointIndex, AXIndex
+    procedure cbRotatedChange(Sender: TObject);
-      , AYIndex: Integer; var AFormattedMark: String);
+    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;
+destructor TGanttFrame.Destroy;
-  APointIndex, AXIndex, AYIndex: Integer; var AFormattedMark: String);
-var
-  tPlan1, tPlan2: Double;
-  tComplete1, tComplete2: Double;
-  txt: String;
 begin
-  txt := GanttSeries.Source.Item[APointIndex]^.Text;
+  FTasks.Free;
-  tPlan1 := GanttSeries.XValues[APointIndex, 0];
+  inherited Destroy;
-  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]);
 end;
 
-procedure TGanttFrame.GanttSeriesBarHeightChanged(Sender: TObject);
+// Checkbox clicked to toggle between "normal" and "rotated" state series
-var
+// (horizontal or vertical orientation)
-  h: Integer;
+procedure TGanttFrame.cbRotatedChange(Sender: TObject);
 begin
-  if GanttChart.ScalingValid then
+  if cbRotated.Checked then
   begin
-    h := round(GanttSeries.GetImgBarHeight * 0.66);
+    GanttSeries.AxisIndexX := 0;
-    MilestoneSeries.Pointer.HorizSize := h;
+    GanttSeries.AxisIndexY := 1;
-    MilestoneSeries.Pointer.VertSize := h;
+    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');
+  // Series with planned tasks
-  TasksChartSource.Add(1, 1, 'Activity 1');
+  Tasks_ChartSource.XCount := 2;
-  TasksChartSource.Add(2, 2, 'Activity 2');
+  Tasks_ChartSource.PointsNumber := FTasks.Count;
-  TasksChartSource.Add(3, 3, 'Activity 3');
+  GanttSeries.Source := Tasks_ChartSource;
-  TasksChartSource.Add(4, 4, 'Intermediate Milestone');
-  TasksChartSource.Add(5, 5, 'Activity 4');
-  TasksChartSource.Add(6, 6, 'Activity 5');
-  TasksChartSource.Add(7, 7, 'Final Milestone');
 
-  // The x/y values in the TasksChartSource are the y values for the
+  // Series showing to which percentage the planned tasks are completed
-  // GanttSeries data.
+  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
+  // Show the task titles as y axis labels
-  GanttSeries.AddXY(EncodeDate(2024,2,3), EncodeDate(2024,2,4), 0, TasksChartSource.Item[0]^.Text);
+  GanttChart.LeftAxis.Marks.Source := Tasks_ChartSource;
-  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;
   GanttChart.LeftAxis.Marks.Style := smsLabel;
   GanttChart.LeftAxis.Inverted := true;
 end;

components/tachart/demo/stateseries/umachinestateframe.lfm

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

components/tachart/taintervalsources.pas

@@ -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;

components/tachart/tamultiseries.pas

@@ -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));
+      x1 := GetX(0);
-      x2 := AxisToGraphX(GetX(1));
+      x2 := GetX(1);
+      if IsNaN(x1) then
+        Continue;
+      x1 := AxisToGraphX(x1);
+      x2 := AxisToGraphX(x2);
     end;
 
     BuildBar(x1, x2, p.Y, h);