lazarus-ccr/components/tvplanit/source/vpganttviewpainter.pas

unit VpGanttViewPainter;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics, LCLType, LCLIntf, Types,
  VpBase, VpBasePainter, VpGanttView;

type
  TVpGanttViewPainter = class(TVpBasePainter)
  private
    FGanttView: TVpGanttView;

    BevelHighlight: TColor;
    BevelShadow: TColor;
    BevelDarkShadow: TColor;
    BevelFace: TColor;
    RealColHeadAttrColor: TColor;
    RealColor: TColor;
    RealLineColor: TColor;
    RealRowHeadAttrColor: TColor;

    FColHeadHeightTotal: Integer;
    FColHeadRowHeightMonth: Integer;
    FColHeadRowHeightDay: Integer;
    FRowHeight: Integer;
    FTextMargin: Integer;

    function CountMonths(ADate1, ADate2: TDateTime): Integer;

  protected
    procedure Clear;
    procedure DrawBorders;
    procedure DrawColHeader;
    procedure DrawEvents;
    procedure DrawGrid;
    procedure DrawRowHeader;
    procedure FixFontHeights;
    procedure InitColors;
    procedure SetMeasurements; override;

  public
    constructor Create(AGanttView: TVpGanttView; ARenderCanvas: TCanvas);
    procedure RenderToCanvas(ARenderIn: TRect; AAngle: TVpRotationAngle;
      AScale: Extended; ARenderDate: TDateTime; AStartLine, AStopLine: Integer;
      AUseGran: TVpGranularity; ADisplayOnly: Boolean); override;

  end;


implementation

uses
  DateUtils,
  VpConst, VpMisc, VpCanvasUtils, VpData;

type
  TVpGanttViewOpener = class(TVpGanttView);

constructor TVpGanttViewPainter.Create(AGanttView: TVpGanttView;
  ARenderCanvas: TCanvas);
begin
  inherited Create(ARenderCanvas);
  FGanttView := AGanttView;
  FTextMargin := 2;
end;

procedure TVpGanttViewPainter.Clear;
begin
  RenderCanvas.Brush.Color := RealColor;
  RenderCanvas.FillRect(RenderIn);
end;

function TVpGanttViewPainter.CountMonths(ADate1, ADate2: TDateTime): Integer;
var
  dt: TDateTime;
begin
  if ADate1 > ADate2 then
    exit;
//    raise Exception.Create('[TVpGanttViewPainter.CountMonts] Dates not in order.');

  Result := 0;
  dt := ADate1;
  while dt <= ADate2 do
  begin
    inc(Result);
    dt := StartOfTheMonth(IncMonth(dt));
  end;
end;

procedure TVpGanttViewPainter.DrawBorders;
var
  R: TRect;
begin
  R := Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1);

  case FGanttView.DrawingStyle of
    dsNoBorder:
      ;  // no border
    dsFlat: // Draw a simple rectangular border
      DrawBevelRect(
        RenderCanvas,
        TPSRotateRectangle(Angle, RenderIn, R),
        BevelShadow,
        BevelShadow
      );
    ds3D: // Draw a 3d bevel
      begin
        DrawBevelRect(
          RenderCanvas,
          TPSRotateRectangle(Angle, RenderIn, R),
          BevelShadow,
          BevelHighlight
        );
        (*
        InflateRect(R, -1, -1);
        DrawBevelRect(
          RenderCanvas,
          TPSRotateRectangle(Angle, RenderIn, R),
          BevelDarkShadow,
          clRed //BevelFace
        );
        *)
      end;
  end;
end;

procedure TVpGanttViewPainter.DrawColHeader;
var
  i: Integer;
  R, R1: TRect;
  P: TPoint;
  monthRec: TVpGanttMonthRec;
  dayRec: TVpGanttDayRec;
  str: String;
  strLen, strH: Integer;
  dx: Integer;
begin
  RenderCanvas.Brush.Color := RealColHeadAttrColor;
  RenderCanvas.Pen.Color := RealLineColor;

  R := Rect(RealLeft, RealTop, RealRight, FColHeadHeightTotal);
  TPSFillRect(RenderCanvas, Angle, RenderIn, R);

  if FGanttView.DrawingStyle = ds3D then
  begin
    R1 := R;
    InflateRect(R1, -1, -1);
    R1.Right := FGanttView.FixedColWidth-1;
    DrawBevelRect(
      RenderCanvas,
      TPSRotateRectangle(Angle, RenderIn, R1),
      BevelHighlight,
      BevelShadow
    );
    R1.Left := FGanttView.FixedColWidth;
    R1.Right := RealRight-2;
    DrawBevelRect(
      RenderCanvas,
      TPSRotateRectangle(Angle, RenderIn, R1),
      BevelHighlight,
      BevelShadow
    );
  end else
  begin
    TPSMoveTo(RenderCanvas, Angle, RenderIn, FGanttView.FixedColWidth, R.Top);
    TPSLineTo(RenderCanvas, Angle, RenderIn, FGanttView.FixedColWidth, R.Bottom);
    TPSMoveTo(RenderCanvas, Angle, RenderIn, RealLeft, R.Bottom);
    TPSLineTo(RenderCanvas, Angle, RenderIn, RealRight, R.Bottom);
  end;

  dx := FGanttView.FixedColWidth - FGanttView.LeftCol * FGanttView.ColWidth;

  // Draw month rectangles and month captions
  for i := 0 to High(TVpGanttViewOpener(FGanttView).FMonthRecords) do
  begin
    monthRec := TVpGanttViewOpener(FGanttView).FMonthRecords[i];
    R := monthRec.Rect;
    OffsetRect(R, dx , 0);
    if R.Left < FGanttView.FixedColWidth then
      R.Left := FGanttView.FixedColWidth;
    if FGanttView.DrawingStyle = ds3D then
    begin
      R1 := R;
      if i > 0 then
        inc(R1.Left);
      dec(R1.Bottom);
      DrawBevelRect(
        RenderCanvas,
        TPSRotateRectangle(Angle, RenderIn, R1),
        BevelHighlight,
        BevelShadow
      )
    end else
    begin
      TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top);
      TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom);
    end;

    str := FormatDateTime(FGanttView.MonthFormat, monthRec.Date);
    strLen := RenderCanvas.TextWidth(str);
    if strLen > R.Width - 2 * FTextMargin then
    begin
      str := FormatDateTime(FGanttView.MonthFormat_short, monthRec.Date);
      strLen := RenderCanvas.TextWidth(str);
    end;
    if strLen > R.Width - 2 * FTextMargin then
      str := '';
    if str <> '' then
    begin
      P := Point((R.Left + R.Right - strLen) div 2, R.Top + FTextMargin);
      TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
    end;
  end;

  // Draw day dividing lines and day captions. Always at right side.
  RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.DayFont);
  strH := RenderCanvas.TextHeight('Tg');
  for dayRec in TVpGanttViewOpener(FGanttView).FDayRecords do
  begin
    R := dayRec.Rect;
    OffsetRect(R, dx, 0);
    if R.Left < FGanttView.FixedColWidth then
      Continue;
    if (DayOf(dayRec.Date) <> DaysInMonth(dayRec.Date)) then
    begin
      if FGanttView.DrawingStyle = ds3D then
        DrawBevelLine(
          RenderCanvas,
          TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Top)),
          TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Bottom)),
          BevelShadow,
          BevelHighlight
        )
      else
      begin
        TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top);
        TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom);
      end;
    end;
    str := FormatDateTime(FGanttView.DayFormat, dayRec.Date);
    strLen := RenderCanvas.TextWidth(str);
    P := Point((R.Left + R.Right - strLen) div 2, (R.Top + R.Bottom - strH) div 2);
    TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
  end;
end;

procedure TVpGanttViewPainter.DrawEvents;
var
  i: Integer;
  eventRec: TVpGanttEventRec;
  event: TVpEvent;
  cat: TVpCategoryInfo;
  R: TRect;
  dx, dy: Integer;
begin
  dx := FGanttView.FixedColWidth - FGanttView.LeftCol * FGanttView.ColWidth;
  dy := FColHeadHeightTotal - FGanttView.TopRow * FRowHeight;
  for i := 0 to High(TVpGanttViewOpener(FGanttView).FEventRecords) do
  begin
    eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[i];
    event := eventRec.Event;
    cat := FGanttView.DataStore.CategoryColorMap.GetCategory(event.Category);
    RenderCanvas.Pen.Color := cat.Color;
    RenderCanvas.Brush.Color := cat.BackgroundColor;
    R := eventRec.EventRect;
    if R.Left = R.Right then R.Right := R.Left + 1;
    OffsetRect(R, dx, dy);
    InflateRect(R, 0, -2);
    if (R.Top < FColHeadHeightTotal) or (R.Left < FGanttView.FixedColWidth) then
      Continue;
    TPSRectangle(RenderCanvas, Angle, RenderIn, R);
  end;
end;

procedure TVpGanttViewPainter.DrawGrid;
var
  x1, x2, y0, y1, y2: Integer;
  i: Integer;
  eventRec: TVpGanttEventRec;
  dayRec: TVpGanttDayRec;
  monthRec: TVpGanttMonthRec;
  numDays, numMonths, numEvents: Integer;
begin
  RenderCanvas.Pen.Color := RealLineColor;

  numDays := Length(TVpGanttViewOpener(FGanttView).FDayRecords);
  numMonths := Length(TVpGanttViewOpener(FGanttView).FMonthRecords);
  numEvents := Length(TVpGanttViewOpener(FGanttView).FEventRecords);

  // Horizontal lines
  x1 := RealLeft + FGanttView.FixedColWidth;
  if numMonths > 0 then
  begin
    monthRec := TVpGanttViewOpener(FGanttView).FMonthRecords[numMonths-1];
    x2 := monthRec.Rect.Right + FGanttView.FixedColWidth;
  end else
    x2 := RealRight;

  y0 := FColHeadHeightTotal;
  if FGanttView.DrawingStyle = ds3D then dec(y0);

  RenderCanvas.Line(x1, y0, x2, y0);

  for i := 0 to numEvents-1 do
  begin
    eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[i];
    y1 := y0 + eventRec.EventRect.Bottom;
    RenderCanvas.Line(x1, y1, x2, y1);
  end;

  // Vertical lines
  y1 := RealTop + FColHeadHeightTotal;
  if numEvents > 0 then
  begin
    eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[numEvents-1];
    y2 := eventRec.EventRect.Bottom + FColHeadHeightTotal;
  end else
    y2 := RealBottom;
  for i := 0 to numDays-1 do
  begin
    dayRec := TVpGanttViewOpener(FGanttView).FDayRecords[i];
    x1 := dayRec.Rect.Right + FGanttView.FixedColWidth;
    x2 := x1;
    RenderCanvas.Line(x1, y1, x2, y2);
  end;
end;

procedure TVpGanttViewPainter.DrawRowHeader;
var
  R: TRect;
  P: TPoint;
  strH: Integer;
  str: String;
  i: Integer;
  dy: Integer;
begin
  RenderCanvas.Brush.Color := RealRowHeadAttrColor;

  if FGanttView.DrawingStyle = ds3d then begin
    R.Left := RealLeft + 1;
    R.Top := RealTop + FColHeadHeightTotal;
    R.Right := RealLeft + FGanttView.FixedColWidth-1;
    R.Bottom := RealBottom - 1;
    TPSFillRect(RenderCanvas, Angle, RenderIn, R);
    DrawBevelRect(
      RenderCanvas,
      TPSRotateRectangle(Angle, RenderIn, R),
      BevelHighlight,
      BevelShadow
    );
  end else begin
    R := Rect(RealLeft, RealTop + FColHeadHeightTotal + 1, RealLeft + FGanttView.FixedColWidth, RealBottom);
    TPSFillRect(RenderCanvas, Angle, RenderIn, R);
    RenderCanvas.Pen.Color := RealLineColor;
    RenderCanvas.Line(R.Right, R.Top, R.Right, R.Bottom);
  end;

  RenderCanvas.Font.Assign(FGanttView.RowHeaderAttributes.EventFont);
  strH := RenderCanvas.TextHeight('Tg');
  RenderCanvas.Pen.Color := RealLineColor;
  dy := FColHeadHeightTotal - FGanttView.TopRow * FRowHeight;
  for i := 0 to High(TVpGanttViewOpener(FGanttView).FEventRecords) do
  begin
    str := TVpGanttViewOpener(FGanttView).FEventRecords[i].Caption;
    R := TVpGanttViewOpener(FGanttView).FEventRecords[i].HeadRect;
    OffsetRect(R, 0, dy);
    if R.Top < FColHeadHeightTotal then
      Continue;
    if FGanttView.DrawingStyle = ds3D then
    begin
      R.BottomRight := R.BottomRight - Point(1, 1);
      DrawBevelRect(
        RenderCanvas,
        TPSRotateRectangle(Angle, RenderIn, R),
        BevelHighlight,
        BevelShadow
      );
    end else
      RenderCanvas.Line(R.Left, R.Bottom, R.Right, R.Bottom);

    // Paint event description as header
    P := Point(R.Left + FTextMargin, (R.Top + R.Bottom - strH) div 2);
    TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, Str);
  end;
end;

procedure TVpGanttViewPainter.FixFontHeights;
begin
  with FGanttView do begin
    ColHeaderAttributes.DayFont.Height := GetRealFontHeight(ColHeaderAttributes.DayFont);
    ColHeaderAttributes.MonthFont.Height := GetRealFontHeight(ColHeaderAttributes.MonthFont);
    RowHeaderAttributes.EventFont.Height := GetRealFontHeight(RowHeaderAttributes.EventFont);
  end;
end;

procedure TVpGanttViewPainter.InitColors;
begin
  if DisplayOnly then begin
    BevelShadow := clBlack;
    BevelDarkShadow := clBlack;
    BevelFace := clBlack;
    RealColHeadAttrColor := clSilver;
    RealRowHeadAttrColor := clSilver;
    RealColor := clWhite;
    RealLineColor := clSilver;
  end else
  begin
    BevelHighlight := clBtnHighlight;
    BevelShadow := clBtnShadow;
    BevelDarkShadow := cl3DDkShadow;
    BevelFace := clBtnFace;
    RealColHeadAttrColor := ColorToRGB(FGanttView.ColHeaderAttributes.Color);
    RealRowHeadAttrColor := ColorToRGB(FGanttView.RowHeaderAttributes.Color);
    RealColor := ColorToRGB(FGanttView.Color);
    RealLineColor := ColorToRGB(FGanttView.LineColor);
  end;
end;

procedure TVpGanttViewPainter.RenderToCanvas(ARenderIn: TRect;
  AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime;
  AStartLine, AStopLine: Integer; AUseGran: TVpGranularity;
  ADisplayOnly: Boolean);
begin
  inherited;

  InitColors;
  SavePenBrush;
  InitPenBrush;
  if ADisplayOnly then
    FixFontHeights;

  Rgn := CreateRectRgn(RenderIn.Left, RenderIn.Top, RenderIn.Right, RenderIn.Bottom);
  try
    SelectClipRgn(RenderCanvas.Handle, Rgn);

    { Clear client area }
    Clear;

    { Measure the row heights }
    SetMeasurements;

    { Draw headers }
    DrawColHeader;
    DrawRowHeader;

    { Draw grid }
    DrawGrid;

    { draw events }
    DrawEvents;

    { Draw the borders }
    DrawBorders;

  finally
    SelectClipRgn(RenderCanvas.Handle, 0);
    DeleteObject(Rgn);
  end;

  { Restore canvas settings}
  RestorePenBrush;

  //RenderCanvas.Textout(0, 0, FormatDateTime('c', ARenderDate));
  //RenderCanvas.TextOut(0, 20,  FormatDateTime('c', FGanttView.Date));
end;

procedure TVpGanttViewPainter.SetMeasurements;
var
  firstEvent: TVpEvent;
  firstDay, lastDay: TDateTime;
  firstMonth, lastMonth: TDateTime;
  eventCount, numDays, numMonths: Integer;
  x1, x2, y1, y2: Integer;
  i: Integer;
  dt, t1, t2: TDateTime;
  totalWidth: double;
  event: TVpEvent;
begin
  inherited;

  // Height of the event rows
  RenderCanvas.Font.Assign(FGanttView.RowHeaderAttributes.EventFont);
  FRowHeight := RenderCanvas.TextHeight('Tg') + 2 * FTextMargin;

  // Height of the month part in the column header
  RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.MonthFont);
  FColHeadRowHeightMonth := RenderCanvas.TextHeight('Tg') + FTextMargin;

  // Height of the day part in the column header
  RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.DayFont);
  FColHeadRowHeightDay := RenderCanvas.TextHeight('Tg') + 2 * FTextMargin;

  // total height of header: month row + day row
  FColHeadHeightTotal := FColHeadRowHeightMonth + FColHeadRowHeightDay;

  // Determine range of dates as well as the rectangles containing the day,
  // column and event headers and the event data.
  if (FGanttView.Datastore = nil) or (FGanttView.Datastore.Resource = nil) or
     (FGanttView.Datastore.Resource.Schedule.EventCount = 0) then
  begin
    eventCount := 0;
    FGanttView.StartDate := NO_DATE;
    FGanttView.EndDate := NO_DATE;
    SetLength(TVpGanttViewOpener(FGanttView).FEventRecords, 0);
    SetLength(TVpGanttViewOpener(FGanttView).FDayRecords, 0);
    SetLength(TVpGanttViewOpener(FGanttView).FMonthRecords, 0);
    FGanttView.VisibleRows := 0;
    FGanttView.VisibleCols := 0;
  end else
  begin
    eventCount := FGanttView.Datastore.Resource.Schedule.EventCount;
    firstEvent := FGanttView.DataStore.Resource.Schedule.GetEvent(0);

    // Find date range needed for the GanttView
    firstDay := trunc(firstEvent.StartTime);
    lastDay := trunc(firstEvent.EndTime);
    if frac(lastDay) = 0.0 then lastDay := lastDay + 1;
    for i := 1 to FGanttView.Datastore.Resource.Schedule.EventCount-1 do
    begin
      event := FGanttView.Datastore.Resource.Schedule.GetEvent(i);
      if event.AllDayEvent then begin
        t1 := trunc(event.StartTime);
        t2 := trunc(event.EndTime);
      end else
      begin
        t1 := event.StartTime;
        t2 := event.EndTime;
      end;
      if t1 < firstDay then
        firstDay := trunc(t1);
      if t2 > lastDay then
        lastDay := trunc(t2);
    end;
    lastDay := lastDay + 1;

    FGanttView.StartDate := firstDay;
    FGanttView.EndDate := lastDay;

    // Prepare the event, day and month records for painting the cells
    numdays := DaysBetween(FGanttView.StartDate, FGanttView.EndDate);
    totalWidth := numdays * FGanttView.ColWidth;

    // Populate event records
    SetLength(TVpGanttViewOpener(FGanttView).FEventRecords, eventCount);
    y1 := 0;   // this dimension is scrollable
    for i := 0 to eventCount-1 do
    begin
      event := FGanttView.DataStore.Resource.Schedule.GetEvent(i);
      if event.AllDayEvent then
      begin
        t1 := trunc(event.StartTime);
        t2 := trunc(event.EndTime);
        if frac(t2) = 0 then t2 := t2 + 1;
      end else
      begin
        t1 := event.StartTime;
        t2 := event.EndTime;
      end;
      x1 := round((t1 - FGanttView.StartDate) / numDays * totalWidth);
      x2 := round((t2 - FGanttView.StartDate) / numDays * totalWidth);
      y2 := y1 + FRowHeight;
      with TVpGanttViewOpener(FGanttView) do
      begin
        FEventRecords[i].Event := event;
        FEventRecords[i].Caption := event.Description;
        FEventRecords[i].HeadRect := Rect(RealLeft, y1, RealLeft + FixedColWidth, y2);
        FEventRecords[i].EventRect := Rect(x1, y1, x2, y2);
      end;
      y1 := y2;
    end;

    // Populate day records
    SetLength(TVpGanttViewOpener(FGanttView).FDayRecords, numDays);
    x1 := 0;  // Scrollable dimension
    y1 := RealTop + FColHeadRowHeightMonth;
    y2 := RealTop + FColHeadHeightTotal;
    dt := trunc(FGanttView.StartDate);
    for i := 0 to numDays-1 do
    begin
      x2 := x1 + FGanttView.ColWidth;
      with TVpGanttViewOpener(FGanttView) do
      begin
        FDayRecords[i].Date := dt;
        FDayRecords[i].Rect := Rect(x1, y1, x2, y2);
      end;
      dt := IncDay(dt, 1);
      x1 := x2;
    end;

    // Populate month records
    firstMonth := FGanttView.StartDate;
    lastMonth := FGanttView.EndDate;
    numMonths := CountMonths(firstMonth, lastMonth);
    SetLength(TVpGanttViewOpener(FGanttView).FMonthRecords, numMonths);
    dt := firstMonth;
    x1 := 0;    // Scrollable dimension;
    y1 := RealTop;
    y2 := RealTop + FColHeadHeightTotal;
    for i := 0 to numMonths - 1do
    begin
      numDays := DaysInMonth(dt);
      if i = 0 then
        // partial first month
        numDays := numDays - DayOf(dt) + 1
      else
      if i = numMonths-1 then
        numDays := DayOf(lastMonth) - 1;
      x2 := x1 + numDays * FGanttView.ColWidth;
      with TVpGanttViewOpener(FGanttView) do
      begin
        FMonthRecords[i].Date := dt;
        FMonthRecords[i].Rect := Rect(x1, y1, x2, y2);
      end;
      dt := IncMonth(dt, 1);
      x1 := x2;
    end;

    FGanttView.VisibleCols := (RealRight - RealLeft + FGanttView.FixedColWidth) div FGanttView.ColWidth;
    FGanttView.VisibleRows := (RealBottom - RealTop + FColHeadHeightTotal) div FRowHeight;
    FGanttView.RowCount := eventCount;
    FGanttView.ColCount := numdays;
  end;
end;

end.