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;

    FHourFont: TFont;
    FDayFont: TFont;
    FMonthFont: TFont;
    FWeekFont: TFont;
    FEventFont: TFont;

    FScaledColWidth: Integer;
    FScaledFixedColWidth: Integer;
    FScaledTextMargin: Integer;
    FScaledTotalColHeaderHeight: Integer;
    FScaledRowHeight: Integer;

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

    function ScaleRect(ARect: TRect): TRect;

  protected
    procedure Clear;
    procedure DrawActiveDate;
    procedure DrawBorders;
    procedure DrawColHeader;
    procedure DrawDayColHeaders;
    procedure DrawEvents;
    procedure DrawGrid;
    procedure DrawHourColHeaders;
    procedure DrawMonthColHeaders;
    procedure DrawRowHeader;
    procedure DrawSpecialDays;
    procedure DrawWeekColHeaders;
    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,
  VpSR, 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.DrawActiveDate;
var
  R: TRect;
  dayRec: TVpGanttDayRec;
  eventRec: PVpGanttEventRec;
  dx, dy: Integer;
  bs: TBrushStyle;
  pw: Integer;
  c: Integer;
begin
  with FGanttView do
  begin
    if (ActiveRow < 0) or (ActiveRow >= RowCount) then
      exit;
    if (ActiveCol < 0) or (ActiveCol >= ColCount) then
      exit;

    c := ActiveCol;
    if HourMode then
      c := c div HoursPerDay;
    dayRec := DayRecords[c];
    eventRec := EventRecords[ActiveRow];

    dx := LeftCol * FScaledColWidth;
    dy := TopRow * FScaledRowHeight;
  end;

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

  if R.Right < FScaledFixedColWidth then
    exit;
  if R.Top < FScaledTotalColHeaderHeight then
    exit;

  if R.Left < FScaledFixedColWidth then
    R.Left := FScaledFixedColWidth;

  pw := RenderCanvas.Pen.Width;
  bs := RenderCanvas.Brush.Style;
  RenderCanvas.Pen.Width := 3;
  if FGanttView.Focused then
    RenderCanvas.Pen.Color := clBlack
  else
    RenderCanvas.Pen.Color := clGray;
  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);
  R := TPSRotateRectangle(Angle, RenderIn, R);
  case FGanttView.DrawingStyle of
    dsNoBorder:
      ;     // no border
    dsFlat: // Draw a simple rectangular border
      DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow);
    ds3D:   // Draw a 3d bevel (recessed)
      DrawBevelRect(RenderCanvas, R, BevelShadow, BevelHighlight);
  end;
end;

procedure TVpGanttViewPainter.DrawColHeader;
var
  R, R1: TRect;
begin
  RenderCanvas.Brush.Color := RealColHeadAttrColor;
  RenderCanvas.Pen.Color := RealLineColor;

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

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

  // Draw the month column headers
  DrawMonthColHeaders;

  // Draw the week column headers
  DrawWeekColHeaders;

  // Draw the day column headers
  DrawDayColHeaders;

  // Draw the hour column headers
  DrawHourColHeaders;
end;

procedure TVpGanttViewPainter.DrawDayColHeaders;
var
  dayRec: TVpGanttDayRec;
  dx: Integer;
  strH, strLen: Integer;
  fmt, str: String;
  i, n: Integer;
  yLineBottom: Integer;
  R, R1: TRect;
  P: TPoint;
begin
  if not (gchDay in FGanttView.ColHeaderAttributes.Visible) then
    exit;

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

  // 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 := ScaleRect(dayRec.Rect);
    OffsetRect(R, -dx, 0);
    if R.Left < RealLeft + FScaledFixedColWidth then
      Continue;

    // In sdmHeader SpecialDayMode we must repaint the background of the
    // day cells in the color of the special day (weekend/holiday)
    if (FGanttView.SpecialDayMode = sdmHeader) then
    begin
      R1 := R;
      if FGanttView.DrawingStyle = ds3D then
      begin
        inc(R1.Left, 2);
        dec(R1.Bottom);
      end else
        inc(R1.Left);
      if (gvoWeekends in FGanttView.Options) and IsWeekend(dayRec.Date) then
      begin;
        RenderCanvas.Brush.Color := FGanttView.Weekendcolor;
        TPSFillRect(RenderCanvas, Angle, RenderIn, R1);
      end else
      if (gvoHolidays in FGanttView.Options) and FGanttView.IsHoliday(dayRec.Date, str) then
      begin
        RenderCanvas.Brush.Color := FGanttView.HolidayColor;
        TPSFillRect(RenderCanvas, Angle, RenderIn, R1);
      end;
    end;

    // No dividing line at last day of month because it already has been
    // drawn as the month divider.
    if FGanttView.HourMode then
      yLineBottom := FScaledTotalColHeaderHeight
    else
      yLineBottom := R.Bottom;
    if (DayOf(dayRec.Date) <> DaysInMonth(dayRec.Date)) or
       ([gchWeek, gchDay] * FGanttView.ColHeaderAttributes.Visible = [gchWeek, gchDay]) then
    begin
      if FGanttView.DrawingStyle = ds3D then
        DrawBevelLine(
          RenderCanvas,
          TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Top)),
          TPSRotatePoint(Angle, RenderIn, Point(R.Right, yLineBottom)),
          BevelShadow,
          BevelHighlight
        )
      else
      begin
        TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top);
        TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, yLineBottom);
      end;
    end;

    // Paint day name
    if FGanttView.HourMode then
      fmt := FGanttView.Dayformat_HourMode
    else
      fmt := FGanttView.DayFormat;
    str := FormatDateTime(fmt, 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);

    // To do: replace above code for multi-line text, ie.
    //  strLen := GetCanvasTextWidth(RenderCanvas, FDayFont, str);
    //  TPSTextRect(RencerCanvas, Angle, RenderIn, R, P.X, P.Y, str);
    //    BUT: TPSTextRect does not yet exist...
  end;
end;

procedure TVpGanttViewPainter.DrawEvents;
var
  i: Integer;
  eventRec: PVpGanttEventRec;
  event: TVpEvent;
  cat: TVpCategoryInfo;
  R: TRect;
  dx, dy: Integer;
  top_margin, bottom_margin: Integer;
begin
  dx := FGanttView.LeftCol * FScaledColWidth;
  dy := FGanttView.TopRow * FScaledRowHeight;

  if DisplayOnly then
  begin
    top_margin := round(2*scale);
    bottom_margin := top_margin;
  end else
  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;
    if eventRec^.EndTime < FGanttView.FirstDate then
      Continue;
    if eventRec^.StartTime > FGanttView.LastDate + 1then
      exit;
    R := ScaleRect(eventRec^.EventRect);
    OffsetRect(R, -dx, -dy);
    inc(R.Top, top_margin);
    dec(R.Bottom, bottom_margin);
    if R.Top < FScaledTotalColHeaderHeight then
      Continue;
    if R.Right < FScaledFixedColWidth then
      Continue;
    if R.Left < FScaledFixedColWidth then
      R.Left := FScaledFixedColWidth;
    cat := FGanttView.DataStore.CategoryColorMap.GetCategory(event.Category);
    RenderCanvas.Pen.Color := cat.Color;
    RenderCanvas.Pen.Width := round(Scale);
    RenderCanvas.Brush.Color := cat.BackgroundColor;
    //RenderCanvas.Brush.Style := bsSolid;
    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: PVpGanttEventRec;
//  dayRec: TVpGanttDayRec;
  monthRec: TVpGanttMonthRec;
  R: TRect;
begin
  RenderCanvas.Pen.Color := RealLineColor;

  dx := FGanttView.LeftCol * FScaledColWidth;
  dy := FGanttView.TopRow * FScaledRowHeight;

  // Horizontal line terminating the col header block
  x1 := RealLeft + FScaledFixedColWidth;
  n := FGanttView.NumMonths;
  if n > 0 then
  begin
    monthRec := FGanttView.MonthRecords[n-1];
    R := ScaleRect(monthRec.Rect);
    x2 := R.Right - dx;
  end else
    x2 := RealRight;
  y0 := RealTop + FScaledTotalColHeaderHeight;
  if FGanttView.DrawingStyle = ds3D then dec(y0);
  TPSMoveTo(RenderCanvas, Angle, RenderIn, x1, y0);
  TPSLineTo(RenderCanvas, Angle, RenderIn, x2, y0);

  // Horizontal lines
  if (gvoHorizGrid in FGanttView.Options) then
  begin
    y0 := -dy;
    if FGanttView.DrawingStyle = ds3D then dec(y0);
    numEvents := FGanttView.NumEvents;
    for i := 0 to numEvents - 1 do
    begin
      eventRec := FGanttView.EventRecords[i];
      R := ScaleRect(eventRec^.EventRect);
      y1 := y0 + R.Bottom;
      if y1 >= FScaledTotalColHeaderHeight then
      begin
        TPSMoveTo(RenderCanvas, Angle, RenderIn, x1, y1);
        TPSLineTo(RenderCanvas, Angle, RenderIn, x2, y1);
      end;
    end;
  end;

  // Vertical lines
  RenderCanvas.Brush.Style := bsClear;
  if (gvoVertGrid in FGanttView.Options) then
  begin
    y1 := RealTop + FScaledTotalColHeaderHeight;
    if numEvents > 0 then
    begin
      eventRec := FGanttView.EventRecords[numEvents-1];
      R := ScaleRect(eventRec^.EventRect);
      y2 := R.Bottom - dy;
      n := FGanttView.ColCount;
      for i := 0 to n-1 do
      begin
        RenderCanvas.Pen.Style := psSolid;
        if FGanttView.HourMode then
        begin
          R := ScaleRect(FGanttView.HourRecords[i].Rect);
          if (i+1) mod FGanttView.HoursPerDay <> 0 then
            RenderCanvas.Pen.Style := psDot;
        end
        else
          R := ScaleRect(FGanttView.DayRecords[i].Rect);
//        dayRec := FGanttView.DayRecords[i];
//        R := ScaleRect(dayRec.Rect);
        x1 := R.Right - dx;
        if x1 >= FScaledFixedColWidth then
        begin
          TPSMoveTo(RenderCanvas, Angle, RenderIn, x1, y1);
          TPSLineTo(RenderCanvas, Angle, RenderIn, x1, y2)
        end;
      end;
    end;
  end;
end;

procedure TVpGanttViewPainter.DrawHourColHeaders;
var
  hourRec: TVpGanttHourRec;
  dx: Integer;
  strH, strLen: Integer;
  str: String;
  i, n: Integer;
  R, R1: TRect;
  P: TPoint;
begin
  if not (gchHour in FGanttView.ColHeaderAttributes.Visible) then
    exit;

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

  // Draw hour captions (always centered) and dividing lines (always at right side).
  RenderCanvas.Font.Assign(FHourFont);
  strH := RenderCanvas.TextHeight('Tg');
  n := FGanttView.NumHours;
  for i := 0 to n - 1 do
  begin
    hourRec := FGanttView.HourRecords[i];
    R := ScaleRect(hourRec.Rect);
    OffsetRect(R, -dx, 0);
    if R.Left < RealLeft + FScaledFixedColWidth then
      Continue;

    // In sdmHeader SpecialDayMode we must repaint the background of the
    // day cells in the color of the special day (weekend/holiday)
    if (FGanttView.SpecialDayMode = sdmHeader) then
    begin
      R1 := R;
      if FGanttView.DrawingStyle = ds3D then
      begin
        inc(R1.Left, 2);
        dec(R1.Bottom);
      end else
        inc(R1.Left);
      if (gvoWeekends in FGanttView.Options) and IsWeekend(hourRec.Date) then
      begin;
        RenderCanvas.Brush.Color := FGanttView.Weekendcolor;
        TPSFillRect(RenderCanvas, Angle, RenderIn, R1);
      end else
      if (gvoHolidays in FGanttView.Options) and FGanttView.IsHoliday(hourRec.Date, str) then
      begin
        RenderCanvas.Brush.Color := FGanttView.HolidayColor;
        TPSFillRect(RenderCanvas, Angle, RenderIn, R1);
      end;
    end;

    // No dividing line at last hour of day because it already has been
    // drawn as the day divider.
    if hourRec.Hour <> 23 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 hour value
    str := IntToStr(hourRec.Hour);
    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.DrawMonthColHeaders;
var
  dx: Integer;
  i, n: Integer;
  monthRec: TVpGanttMonthRec;
  R, R1: TRect;
  P: TPoint;
  str: String;
  strLen: Integer;
begin
  if not (gchMonth in FGanttView.ColHeaderAttributes.Visible) then
    exit;

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

  // 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;
    R := ScaleRect(R);
    OffsetRect(R, -dx , 0);

    if R.Right <= RealLeft + FScaledFixedColWidth then
      continue;

    // Clip at fixed col edge
    if R.Left < RealLeft + FScaledFixedColWidth then
      R.Left := RealLeft + FScaledFixedColWidth;

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

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

  if FGanttView.DrawingStyle = ds3d then begin
    R.Left := RealLeft + 1;
    R.Top := RealTop;
    R.Right := RealLeft + FScaledFixedColWidth - 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 + FScaledFixedColWidth, RealBottom);
    TPSFillRect(RenderCanvas, Angle, RenderIn, R);
    RenderCanvas.Pen.Color := RealLineColor;
    TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top);
    TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom);
  end;

  RenderCanvas.Font.Assign(FEventFont);
  strH := RenderCanvas.TextHeight('Tg');
  RenderCanvas.Pen.Color := RealLineColor;

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

  for i := 0 to FGanttView.NumEvents-1 do
  begin
    eventRec := FGanttView.EventRecords[i];
    R := ScaleRect(eventRec^.HeadRect);
    OffsetRect(R, 0, -dy);
    if R.Top < FScaledTotalColHeaderHeight 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
    begin
      TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Left, R.Bottom);
      TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom);
    end;

    // Paint event description as header.
    // Use clipping in case the text is too long
    RenderCanvas.Clipping := true;
    try
      RenderCanvas.ClipRect := R;
      inc(R.Left, FScaledTextMargin + 2);
      P := Point(R.Left, (R.Top + R.Bottom - strH) div 2);
      str := eventRec^.Caption;
      TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
    finally
      RenderCanvas.Clipping := false;
    end;
  end;
end;

procedure TVpGanttViewPainter.DrawSpecialDays;
var
  i, nDays, nEvents: Integer;
  x1, y1, x2, y2: Integer;
  dx, dy: Integer;
  clr: TColor;
  dayRec: TVpGanttDayRec;
  holiday: String;
  R: TRect;
begin
  with FGanttView do
  begin
    if (RealStartDate = NO_DATE) or (SpecialDayMode <> sdmColumn) then
      exit;

    nEvents := NumEvents;
    nDays := NumDays;
    dx := LeftCol * FScaledColWidth;
    dy := TopRow * FScaledRowHeight;

    y1 := RealTop + FScaledTotalColHeaderHeight;
    if nEvents > 0 then
    begin
      R := ScaleRect(EventRecords[nEvents-1]^.HeadRect);
      y2 := R.Bottom - dy;
    end else
      y2 := y1;

    RenderCanvas.Brush.style := bsSolid;
    for i := 0 to nDays-1 do
    begin
      dayRec := DayRecords[i];
      clr := clNone;
      if (gvoWeekends in Options) and IsWeekend(dayRec.Date) then
        clr := WeekendColor
      else
      if (gvoHolidays in Options) and IsHoliday(dayRec.Date, holiday) then
        clr := HolidayColor;
      if clr <> clNone then
      begin
        RenderCanvas.Brush.Color := clr;
        R := ScaleRect(dayRec.Rect);
        x1 := R.Left - dx;
        x2 := R.Right - dx;
        if x2 < FScaledFixedColWidth then
          Continue;
        if x1 < FScaledFixedColWidth then
          x1 := FScaledFixedColWidth;
        TPSFilLRect(RenderCanvas, Angle, RenderIn, Rect(x1, y1, x2, y2));
      end;
    end;
  end;
end;

procedure TVpGanttViewPainter.DrawWeekColHeaders;
var
  dx: Integer;
  i, n: Integer;
  weekRec: TVpGanttWeekRec;
  weekNo, yearNo: Integer;
  R, R1: TRect;
  P: TPoint;
  str: String;
  strLen: Integer;
begin
  if not (gchWeek in FGanttView.ColHeaderAttributes.Visible) then
    exit;

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

  // Draw week rectangles and week numbers as captions
  RenderCanvas.Font.Assign(FWeekFont);
  n := FGanttView.NumWeeks;
  for i := 0 to n-1 do
  begin
    weekRec := FGanttView.WeekRecords[i];
    R := weekRec.Rect;
    R := ScaleRect(R);
    OffsetRect(R, -dx , 0);

    if R.Right <= RealLeft + FScaledFixedColWidth then
      Continue;

    // Clip at fixed col edge
    if R.Left < RealLeft + FScaledFixedColWidth then
      R.Left := RealLeft + FScaledFixedColWidth;

    // Draw week box
    if FGanttView.DrawingStyle = ds3D then
    begin
      R1 := R;
//     if i > 0 then
        inc(R1.Left);
      dec(R1.Bottom);
      DrawBevelLine(
        RenderCanvas,
        TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Top)),
        TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Bottom)),
        BevelShadow,
        BevelHighlight
      )
    end else
    begin
      TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top);
      TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom);
    end;

    // Paint ISO week number.
    weekNo := WeekOfTheYear(weekRec.Date);
    yearNo := YearOf(weekRec.Date);
    str := Format('%s %d (%d)', [RSCalendarWeekAbbr, weekNo, yearNo]);
    strLen := RenderCanvas.TextWidth(str);
    if strLen > R.Width - 2 * FScaledTextMargin then
    begin
      str := Format('%s %d', [RSCalendarWeekAbbr, weekNo]);
      strLen := RenderCanvas.TextWidth(str);
    end;
    if strLen > R.Width - 2 * FScaledTextMargin then
    begin
      str := IntToStr(weekNo);
      strLen := RenderCanvas.TextWidth(str);
    end;
    if strLen > R.Width - 2 * FScaledTextMargin then
      str := '';
    if str <> '' then
    begin
      P := Point((R.Left + R.Right - strLen) div 2, R.Top + FScaledTextMargin);
      TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
    end;
  end;
end;

procedure TVpGanttViewPainter.FixFontHeights;
begin
  with FGanttView do begin
    ColHeaderAttributes.DayFont.Height := GetRealFontHeight(ColHeaderAttributes.DayFont);
    ColHeaderAttributes.WeekFont.Height := GetRealFontHeight(ColHeaderAttributes.WeekFont);
    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;

  FHourFont := FGanttView.ColHeaderAttributes.HourFont;
  FDayFont := FGanttView.ColHeaderAttributes.DayFont;
  FMonthFont := FGanttView.ColHeaderAttributes.MonthFont;
  FWeekFont := FGanttView.ColHeaderAttributes.WeekFont;
  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 weekends and holidays }
    DrawSpecialDays;

    { Draw grid }
    DrawGrid;

    { draw events }
    DrawEvents;

    { Draw active day rectangle }
    if (gvoActiveDate in FGanttView.Options) then
      DrawActiveDate;

    { Draw the borders }
    DrawBorders;

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

  { Restore canvas settings}
  RestorePenBrush;
end;

function TVpGanttViewPainter.ScaleRect(ARect: TRect): TRect;
begin
  Result.Left := RealLeft + round(ARect.Left * Scale);
  Result.Top := RealTop + round(ARect.Top * Scale);
  Result.Right := RealLeft + round(ARect.Right * Scale);
  Result.Bottom := RealTop + round(ARect.Bottom * Scale);
end;

procedure TVpGanttViewPainter.SetMeasurements;
begin
  inherited;

  FGanttView.Init;

  FScaledFixedColWidth := round(FGanttView.FixedColWidth * Scale);
  FScaledColWidth := round(FGanttView.ColWidth * Scale);
  FScaledTextMargin := round(FGanttView.TextMargin * Scale);
  FScaledTotalColHeaderHeight := round(FGanttView.TotalColHeaderHeight * Scale);
  FScaledRowHeight := round(FGanttView.RowHeight * Scale);

  FGanttView.VisibleCols := FGanttView.CalcVisibleCols(RealRight - RealLeft, FScaledFixedColWidth, FScaledColWidth);
  FGanttView.VisibleRows := FGanttView.CalcVisibleRows(RealBottom - RealTop, FScaledTotalColHeaderHeight, FScaledRowHeight);
end;

end.