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;

    FDayFont: TFont;
    FMonthFont: TFont;
    FEventFont: TFont;

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

  protected
    procedure Clear;
    procedure DrawActiveDay;
    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;

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

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

procedure TVpGanttViewPainter.DrawActiveDay;
var
  R: TRect;
  dayRec: TVpGanttDayRec;
  eventRec: TVpGanttEventRec;
  dx, dy: Integer;
  bs: TBrushStyle;
  pw: Integer;
begin
  with FGanttView do
  begin
    if (ActiveRow < 0) or (ActiveRow >= RowCount) then
      exit;
    if (ActiveCol < 0) or (ActiveCol >= ColCount) then
      exit;

    dayRec := DayRecords[ActiveCol];
    eventRec := EventRecords[ActiveRow];

    dx := LeftCol * ColWidth;
    dy := TopRow * RowHeight;
  end;

  R := Rect(
    dayRec.Rect.Left, eventRec.EventRect.Top, dayRec.Rect.Right, eventRec.EventRect.Bottom
  );
  OffsetRect(R, -dx, -dy);

  pw := RenderCanvas.Pen.Width;
  bs := RenderCanvas.Brush.Style;
  RenderCanvas.Pen.Width := 3;
  RenderCanvas.Pen.Color := clBlack;
  RenderCanvas.Brush.Style := bsClear;
  TPSRectangle(RenderCanvas, Angle, RenderIn, R);
  RenderCanvas.Pen.Width := pw;
  RenderCanvas.Brush.Style := bs;
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, n: 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, FGanttView.TotalColHeaderHeight);
  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;

  // Offset due to scrolling
  dx := FGanttView.LeftCol * FGanttView.ColWidth;

  // Draw month rectangles and month captions
  RenderCanvas.Font.Assign(FMonthFont);
  n := FGanttView.NumMonths;
  for i := 0 to n-1 do
  begin
    monthRec := FGanttView.MonthRecords[i];
    R := monthRec.Rect;
    OffsetRect(R, -dx , 0);

    // Clip at fixed col edge
    if R.Left < FGanttView.FixedColWidth then
      R.Left := FGanttView.FixedColWidth;

    // Draw month box
    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;

    // Paint month name. Use short format if space is too small for long format.
    str := FormatDateTime(FGanttView.MonthFormat, monthRec.Date);
    strLen := RenderCanvas.TextWidth(str);
    if strLen > R.Width - 2 * FGanttView.TextMargin then
    begin
      str := FormatDateTime(FGanttView.MonthFormat_short, monthRec.Date);
      strLen := RenderCanvas.TextWidth(str);
    end;
    if strLen > R.Width - 2 * FGanttView.TextMargin then
      str := '';
    if str <> '' then
    begin
      P := Point((R.Left + R.Right - strLen) div 2, R.Top + FGanttView.TextMargin);
      TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
    end;
  end;

  // Draw day captions (always centered) and dividing lines (always at right side).
  RenderCanvas.Font.Assign(FDayFont);
  strH := RenderCanvas.TextHeight('Tg');
  n := FGanttView.NumDays;
  for i := 0 to n - 1 do
  begin
    dayRec := FGanttView.DayRecords[i];
    R := dayRec.Rect;
    OffsetRect(R, -dx, 0);
    if R.Left < FGanttView.FixedColWidth then
      Continue;

    // No dividing line at last day of month because it already has been
    // drawn as the month divider.
    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;

    // Paint day name
    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;
  top_margin, bottom_margin: Integer;
begin
  dx := FGanttView.LeftCol * FGanttView.ColWidth;
  dy := FGanttView.TopRow * FGanttView.RowHeight;

  if FGanttView.DrawingStyle = ds3D then
  begin
    top_margin := 1;
    bottom_margin := 2;
  end else
  begin
    top_margin := 2;
    bottom_margin := 1;
  end;
  RenderCanvas.Font.Assign(FEventFont);
  for i := 0 to FGanttView.NumEvents-1 do
  begin
    eventRec := FGanttView.EventRecords[i];
    event := eventRec.Event;
    R := eventRec.EventRect;
    OffsetRect(R, -dx, -dy);
    inc(R.Top, top_margin);
    dec(R.Bottom, bottom_margin);
    if R.Top < FGanttView.TotalColHeaderHeight then
      Continue;
    if R.Left < FGanttView.FixedColWidth then
      Continue;
    cat := FGanttView.DataStore.CategoryColorMap.GetCategory(event.Category);
    RenderCanvas.Pen.Color := cat.Color;
    RenderCanvas.Brush.Color := cat.BackgroundColor;
    TPSRectangle(RenderCanvas, Angle, RenderIn, R);
  end;
end;

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

  // Horizontal lines
  x1 := RealLeft + FGanttView.FixedColWidth;
  dx := FGanttView.LeftCol * FGanttView.ColWidth;
  n := FGanttView.NumMonths;
  if n > 0 then
  begin
    monthRec := FGanttView.MonthRecords[n-1];
    x2 := monthRec.Rect.Right - dx;
  end else
    x2 := RealRight;
  y0 := FGanttView.TotalColHeaderHeight;
  if FGanttView.DrawingStyle = ds3D then dec(y0);
  RenderCanvas.Line(x1, y0, x2, y0);

  y0 := 0;
  if FGanttView.DrawingStyle = ds3D then dec(y0);
  numEvents := FGanttView.NumEvents;
  for i := 0 to numEvents - 1 do
  begin
    eventRec := FGanttView.EventRecords[i];
    y1 := y0 + eventRec.EventRect.Bottom;
    RenderCanvas.Line(x1, y1, x2, y1);
  end;

  // Vertical lines
  y1 := RealTop + FGanttView.TotalColHeaderHeight;
  dy := FGanttView.TopRow * FGanttView.RowHeight;
  if numEvents > 0 then
  begin
    eventRec := FGanttView.EventRecords[numEvents-1];
    y2 := eventRec.EventRect.Bottom - dy;
  end else
    y2 := RealBottom;
  n := FGanttView.NumDays;
  for i := 0 to n-1 do
  begin
    dayRec := FGanttView.DayRecords[i];
    x1 := dayRec.Rect.Right - dx;
    x2 := x1;
    if x1 >= FGanttView.FixedColWidth then
      RenderCanvas.Line(x1, y1, x2, y2);
  end;
end;

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

  if FGanttView.DrawingStyle = ds3d then begin
    R.Left := RealLeft + 1;
    R.Top := RealTop;
    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 + 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(FEventFont);
  strH := RenderCanvas.TextHeight('Tg');
  RenderCanvas.Pen.Color := RealLineColor;

  // Offset due to scrolling
  dy := FGanttView.TopRow * FGanttView.RowHeight;

  for i := 0 to FGanttView.NumEvents-1 do
  begin
    eventRec := FGanttView.EventRecords[i];
    str := eventRec.Caption;
    R := eventRec.HeadRect;
    OffsetRect(R, 0, -dy);
    if R.Top < FGanttView.TotalColHeaderHeight 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 + FGanttView.TextMargin, (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;

  FDayFont := FGanttView.ColHeaderAttributes.DayFont;
  FMonthFont := FGanttView.ColHeaderAttributes.MonthFont;
  FEventFont := FGanttView.RowHeaderAttributes.EventFont;
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 }
    DrawRowHeader;
    DrawColHeader;

    { Draw grid }
    DrawGrid;

    { draw events }
    DrawEvents;

    { Draw active day rectangle }
    DrawActiveDay;

    { 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;
begin
  inherited;
  FGanttView.Init;
  FGanttView.VisibleCols := FGanttView.CalcVisibleCols(RealRight - RealLeft);
  FGanttView.VisibleRows := FGanttView.CalcVisibleRows(RealBottom - RealTop);
end;

end.