{$I vp.inc}

unit VpMonthViewPainter;

interface

uses
  SysUtils, LCLType, LCLIntf, Types, Classes, Graphics,
  VpConst, VPBase, VpData, VpMonthView, VpBasePainter;

type
  TVpMonthViewPainter = class(TVpBasePainter)
  private
    FMonthView: TVpMonthView;
    FDisplayDate: TDateTime;
    FScaledMonthMargin: Integer;
    FScaledDaysMargin: Integer;
    
    // local parameters of the old TVpMonthView method
    DisplayMonth: Word;
    RealColor: TColor;
    BevelHighlight: TColor;
    BevelShadow: TColor;
    BevelDarkShadow: TColor;
    BevelFace: TColor;
    DayHeadAttrColor: TColor;
    HeadAttrColor: TColor;
    RealLineColor: TColor;
    RealOffDayColor: TColor;
    RealSelDayColor: TColor;
    EventFontColor: TColor;
    TodayFontColor: TColor;
    TodayAttrColor: TColor;
    DotDotDotColor: TColor;

    FCurrHoliday: String;
    FDayHeadHeight: Integer;
    FMonthHeadHeight: Integer;
    FTodayRect: TRect;
    FTodayStr: String;

    // These variables were protected in the original monthview, but are needed only for painting
    mvEventTextHeight: Integer;
    mvDayNumberHeight: Integer;
    mvRowHeight: Integer;
    mvColWidth: Integer;
    mvLineHeight: Integer;

  protected
    procedure Clear;
    procedure DrawBorders;
    procedure DrawDayCell(ADate: TDate; ACol, ARow: Integer;
      var AIndex, ADayNumber: Integer; var ATextRect: TRect);
    procedure DrawDayHead;
    procedure DrawDays;
    procedure DrawEvents;
    procedure DrawFocusRect(ARect: TRect; FixRight: Boolean = false);
    procedure DrawHeader;
    procedure DrawTodayRect;
    procedure FixFontHeights;
    procedure InitColors;
    procedure SetMeasurements; override;

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

implementation

uses
  LazUtf8, Math,
  VpCanvasUtils, VpMisc;

type
  TVpMonthViewOpener = class(TVpMonthView);

constructor TVpMonthViewPainter.Create(AMonthView: TVpMonthView;
  ARenderCanvas: TCanvas);
begin
  inherited Create(ARenderCanvas);
  FMonthView := AMonthView;
end;

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

procedure TVpMonthViewPainter.DrawBorders;
var
  R: TRect;
begin
  R := TPSRotateRectangle(Angle, RenderIn, Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1));
  RenderCanvas.Pen.Width := 1;
  case FMonthView.DrawingStyle of
    dsNoBorder: ;
    dsFlat: DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow);
    ds3D: DrawBevelRect(RenderCanvas, R, BevelShadow, BevelHighlight);
  end;
end;

procedure TVpMonthViewPainter.DrawDayCell(ADate: TDate; ACol, ARow: Integer;
  var AIndex, ADayNumber: Integer; var ATextRect: TRect);
var
  tmpRect: TRect;
  Y, M, D: Word;
  str: String;
  todayDate: TDate;
  fontStyle: TFontStyles;
  textAdjust: Integer;
  textHeight: Integer;
begin
  todayDate := Date();
  DecodeDate(ADate, Y, M, D);

  if (ACol = 6) then
    ATextRect.Right := ATextRect.Right + 8;

  tmpRect := ATextRect;
  if ARow = 0 then
    inc(tmpRect.Top);

  if FCurrHoliday <> '' then begin
    RenderCanvas.Brush.Color := FMonthView.HolidayAttributes.Color;
    TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect);
  end else if DisplayMonth <> M then begin
    RenderCanvas.Brush.Color := RealOffDayColor;
    TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect);
  end else if DayOfWeek(ADate) in [1, 7] then begin
    RenderCanvas.Brush.Color := FMonthView.WeekendAttributes.Color;
    TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect);
  end else
    RenderCanvas.Brush.Color := RealColor;

  if ACol = 6 then begin
    // Draw bottom line
    TPSMoveTo(RenderCanvas, Angle, RenderIn, ATextRect.Left, ATextRect.Bottom);
    TPSLineTo(RenderCanvas, Angle, RenderIn, RealRight, ATextRect.Bottom);
  end else begin
    // Draw right side and bottom lines
    TPSMoveTo(RenderCanvas, Angle, RenderIn, ATextRect.Right, ATextRect.top);
    if ATextRect.Bottom > RealBottom then begin
      TPSLineTo(RenderCanvas, Angle, RenderIn, ATextRect.Right, RealBottom);
      TPSLineTo(RenderCanvas, Angle, RenderIn, ATextRect.Left - 1, RealBottom);
    end else begin
      TPSLineTo(RenderCanvas, Angle, RenderIn, ATextRect.Right, ATextRect.Bottom);
      TPSLineTo(RenderCanvas, Angle, RenderIn, ATextRect.Left - 1, ATextRect.Bottom);
    end;
  end;

  // Prepare the day number as string
  str := FormatDateTime('d', ADate);

  // Set the proper font and style
  if ADate = todayDate then
    RenderCanvas.Font.Assign(FMonthView.TodayAttributes.Font)
  else
    RenderCanvas.Font.Assign(FMonthView.DayNumberFont);
  {$IF VP_LCL_SCALING = 0}
  RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
  {$ENDIF}
  fontstyle := RenderCanvas.Font.style;

  if (FDisplayDate = ADate) then begin
    if FMonthView.Focused then begin
      if ACol = 6 then begin
        tmpRect := ATextRect;
        dec(tmpRect.Right, 4);
        DrawFocusRect(tmpRect, true);
      end else
        DrawFocusRect(ATextRect);
    end;
    RenderCanvas.Font.Color := RealSelDayColor;
    RenderCanvas.Font.Style := FMonthView.DayNumberFont.Style + [fsBold];
    if (FMonthView.EventDayStyle <> []) and (FMonthView.Datastore <> nil) and
       (FMonthView.DataStore.Resource <> nil) and
       (FMonthView.DataStore.Resource.Schedule.EventCountByDay(ADate) > 0)
    then
      RenderCanvas.Font.Style := RenderCanvas.Font.Style + FMonthView.EventDayStyle;
  end else begin
    // Set the font style for days which have events.
    if (FMonthView.EventDayStyle <> []) and (FMonthview.Datastore <> nil) and
       (FMonthView.DataStore.Resource <> nil) and
       (FMonthView.DataStore.Resource.Schedule.EventCountByDay(ADate) > 0)
    then
      RenderCanvas.Font.Style := RenderCanvas.Font.Style + FMonthView.EventDayStyle
    else begin
      RenderCanvas.Font.Color := EventFontColor;
      RenderCanvas.Font.Style := FMonthView.DayNumberFont.Style;
    end;
  end;
  if DisplayMonth <> M then
    RenderCanvas.Font.Color := FMonthView.OffDayFontColor;
  if FCurrHoliday <> '' then
    RenderCanvas.Font.Assign(FMonthView.HolidayAttributes.Font);

  FontStyle := RenderCanvas.Font.Style;
  RenderCanvas.Font.Style := [fsBold, fsItalic];
  textAdjust := RenderCanvas.TextWidth(str);
  textHeight := RenderCanvas.TextHeight(str);
  RenderCanvas.Font.Style := FontStyle;

  // Calculate size of rect for the day number at the top of the TextRect.
  if ACol = 6 then
    tmpRect.Left := ATextRect.Left + mvColWidth - TextAdjust - FScaledDaysMargin
  else
    tmpRect.Left := ATextRect.Right - TextAdjust - FScaledDaysMargin;
  if fsItalic in RenderCanvas.Font.Style then
    dec(tmpRect.Left, 2);
  tmpRect.Top := ATextRect.Top + FScaledDaysMargin;
  tmpRect.Right := tmpRect.Left + textAdjust;
  tmpRect.Bottom := tmpRect.Top + textHeight;

  // Highlight today by a border
  if ADate = todayDate then begin
    FTodayRect := tmpRect;
    OffsetRect(FTodayRect, 2, 0);
    InflateRect(FTodayRect, 3, 3);
    FTodayStr := Str;
    // Will be painted after the events to avoid drawing events over the
    // "today" rectangle
  end else
    // Write the day number at the top of the TextRect
    TPSTextOut(RenderCanvas, Angle, RenderIn, tmpRect.Left, tmpRect.Top, Str);

  // Update MonthDayArray
  with TVpMonthViewOpener(FMonthView) do begin
    mvMonthDayArray[AIndex].Rec := ATextRect;
    mvMonthDayArray[AIndex].Date := ADate;
    mvMonthDayArray[AIndex].OffDay := DisplayMonth <> M;
  end;

  Inc(ADayNumber);
  Inc(AIndex);

  if ACol = 6 then begin
    // We just painted the last day in the row --> Drop rect down one row and
    // then all the way to the left
    ATextRect.TopLeft := Point(RealLeft + 1, ATextRect.Bottom + 1);
    ATextRect.BottomRight := Point(ATextRect.Left + mvColWidth, ATextRect.Top + mvRowHeight);
    if (ATextRect.Bottom > RealBottom - 1) then
      ATextRect.Bottom := RealBottom - 1;
  end else begin
    // Slide rect one column to the right
    ATextRect.Left := ATextRect.Right + 1;
    ATextRect.Right := ATextRect.Right + mvColWidth;
  end;
end;

procedure TVpMonthViewPainter.DrawDayHead;
var
  dhRect, R: TRect;
  P: TPoint;
  I: Integer;
  DayTAG: Integer;
  str: string;
  strLen: Integer;
  strHeight: Integer;
begin
  { clear day head area }
  RenderCanvas.Font.Assign(FMonthView.DayHeadAttributes.Font);
  {$IF VP_LCL_SCALING = 0}
  RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
  {$ENDIF}
  RenderCanvas.Brush.Color := DayHeadAttrColor;
  RenderCanvas.Pen.Color := RealLineColor;
  strHeight := RenderCanvas.TextHeight('00');

  { build rect }
  dhRect.Left := RealLeft;
  dhRect.Top := RealTop + FMonthHeadHeight;
  dhRect.Right := RealRight;
  dhRect.Bottom := dhRect.Top + FDayHeadHeight;
  if FMonthView.DrawingStyle = ds3d then begin
    inc(dhRect.Left, 2);
    inc(dhRect.Top, 2);
    dec(dhRect.Right, 2);
    dhRect.Bottom := dhRect.Top + FDayHeadHeight;

    TPSFillRect(RenderCanvas, Angle, RenderIn, dhRect);
    R := TPSRotateRectangle(Angle, RenderIn, dhRect);
    DrawBevelRect(RenderCanvas, R, BevelHighlight, BevelShadow);
  end else
  if FMonthView.DrawingStyle = dsFlat then begin
    TPSFillRect(RenderCanvas, Angle, RenderIn, dhRect);
    R := TPSRotateRectangle(Angle, RenderIn, dhRect);
    DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow);
  end else
  begin
    dhRect.Left := RealLeft;
    TPSFillRect(RenderCanvas, Angle, RenderIn, dhRect);
  end;

  DayTAG := Ord(FMonthView.WeekStartsOn);
  dhRect.Right := dhRect.Left + mvColWidth;

  for I := 0 to 6 do begin
    { draw the little vertical lines between each day }
    if I < 6 then begin
      if FMonthView.DrawingStyle = ds3d then
      begin
        R := Rect(dhRect.Right-1, dhRect.Top + 3, dhRect.Right, dhRect.Bottom - 3);
        R := TPSRotateRectangle(Angle, RenderIn, R);
        DrawBevelRect(RenderCanvas, TPSRotateRectangle(Angle, RenderIn, R), BevelShadow, BevelHighlight);
      end else
      begin
        TPSMoveTo(RenderCanvas, Angle, RenderIn, dhRect.Right + 1, dhRect.Top + 4);
        TPSLineTo(RenderCanvas, Angle, RenderIn, dhRect.Right + 1, dhRect.Bottom - 3);
      end;
    end;

   {$IFDEF LCL}
    case FMonthView.DayNameStyle of
      dsLong :  { Draw each day's full caption... }
        str := FormatSettings.LongDayNames[DayTAG+1];
      dsShort:  { Draw each day's abbreviated caption... }
        str := FormatSettings.ShortDayNames[DayTAG+1];
      dsLetter:  { Draw each day's first letter only }
        str := FormatSettings.ShortDayNames[DayTAG+1, 1];
    end;
   {$ELSE}
    case FMontheView.DayNameStyle of
      dsLong:   { Draw each day's full caption... }
        case DayTAG of
          0: str := RSSunday;
          1: str := RSMonday;
          2: str := RSTuesday;
          3: str := RSWednesday;
          4: str := RSThursday;
          5: str := RSFriday;
          6: str := RSSaturday;
        end
      dsShort:  { Draw each day's abbreviated caption... }
        case DayTAG of
          0: str := RSASunday;
          1: str := RSAMonday;
          2: str := RSATuesday;
          3: str := RSAWednesday;
          4: str := RSAThursday;
          5: str := RSAFriday;
          6: str := RSASaturday;
        end
      dsLetter: { Draw each day's first letter only }
        case DayTAG of
          0: str := RSLSunday;
          1: str := RSLMonday;
          2: str := RSLTuesday;
          3: str := RSLWednesday;
          4: str := RSLThursday;
          5: str := RSLFriday;
          6: str := RSLSaturday;
        end;
    end;
   {$ENDIF}

    { Fix header string }
    strLen := RenderCanvas.TextWidth(str);
    if (strLen > mvColWidth - FScaledDaysMargin * 2) then
      str := GetDisplayString(RenderCanvas, str, 0, mvColWidth - FScaledDaysMargin * 2);
    strLen := RenderCanvas.TextWidth(str);

    { Draw header text }
    P := Point(
      (dhRect.Left + dhRect.Right - strLen) div 2,
      (dhRect.Top + dhRect.Bottom - strHeight) div 2
    );
    TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);

    DayTAG := (DayTAG + 1) mod 7;

    dhRect.Left := dhRect.Right;
    dhRect.Right := dhRect.Left + mvColWidth;
  end;  // for I ...
end;

procedure TVpMonthViewPainter.DrawDays;
var
  TextRect: TRect;
  Col, Row: Integer;
  DayNumber: Integer;
  M, D, Y: Word;
  MonthStartsOn: Integer;
  DayTag: Integer;
  DayOffset: Integer;
  headHeight: Integer;
  StartingDate: TDateTime;
  ThisDate: TDateTime;
  I: Integer;
  Drawn: Boolean;
  OldBrush: TBrush;
  OldPen: TPen;
  OldFont: TFont;
begin
  // Initialize the MonthDayArray
  with TVpMonthViewOpener(FMonthView) do begin
    for I := 0 to Pred(Length(mvMonthDayArray)) do begin
      mvMonthDayArray[I].Rec := Rect(-1, -1, -1, -1);
      mvMonthDayArray[I].Date := 0.0;
    end;
  end;

  RenderCanvas.Pen.Color := RealLineColor;
  RenderCanvas.Brush.Color := RealColor;

  headHeight := FMonthHeadHeight + FDayHeadHeight;
  if FMonthView.DrawingStyle = ds3d then
  begin
    mvRowHeight := (RealHeight - headHeight - 2) div 6;
    TextRect.TopLeft := Point(RealLeft + 1, RealTop + headHeight + 2);
  end else
  begin
    mvRowHeight := (RealHeight - headHeight) div 6;
    TextRect.TopLeft := Point(RealLeft + 1, RealTop + headHeight);
  end;
  TextRect.BottomRight := Point(TextRect.Left +  mvColWidth, TextRect.Top + mvRowHeight);

  // Determine the starting date and offset
  DecodeDate(FDisplayDate, Y, DisplayMonth, D);
  StartingDate := EncodeDate(Y, DisplayMonth, 1);
  MonthStartsOn := DayOfWeek(StartingDate);
  DayTag := Ord(FMonthView.WeekStartsOn);
  DayOffset := DayTag - MonthStartsOn;
  if DayOffset = 0 then
    DayOffset := -7;

  I := 0;
  DayNumber := DayOffset + 1;

  // Iterate through each column row by row, drawing each day in numerical order.
  OldBrush := TBrush.Create;
  OldPen := TPen.Create;
  OldFont := TFont.Create;
  try
    for Row := 0 to 5 do begin
      for Col := 0 to 6 do begin
        ThisDate := Trunc(StartingDate + DayNumber);

        // Check and store if this date is a holiday
        FMonthView.IsHoliday(ThisDate, FCurrHoliday);

        OldBrush.Assign(RenderCanvas.Brush);
        OldPen.Assign(RenderCanvas.Pen);
        OldFont.Assign(RenderCanvas.Font);
        try
          // Allow the user to draw the day
          if Assigned(FMonthView.OwnerDrawCells) then begin
            Drawn := false;
            DecodeDate(ThisDate, Y,M,D);
            FMonthView.OwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn);
            if Drawn then
              Continue;
          end else
            DrawDayCell(ThisDate, Col, Row, I, DayNumber, TextRect);
        finally
          RenderCanvas.Brush.Assign(OldBrush);
          RenderCanvas.Pen.Assign(OldPen);
          RenderCanvas.Font.Assign(OldFont);
        end;
      end;
    end;

  finally
    OldFont.Free;
    OldPen.Free;
    OldBrush.Free;
  end;

  DrawEvents;
  DrawTodayRect;
end;

procedure TVpMonthViewPainter.DrawEvents;
var
  I, J: Integer;
  EventList: TList;
  event: TVpEvent;
  eventCat: TVpCategoryInfo;
  dayRect: TRect;
  TextRect: TRect;
  txtMargin: Integer;
  tmpRect: TRect;
  Str: String;
  StrLen: Integer;
  P: TPoint;
  visibleEvents: Integer;
  brushCol: TColor;
begin
  RenderCanvas.Pen.Color := RealLineColor;
  RenderCanvas.Pen.Style := psSolid;
  RenderCanvas.Brush.Color := RealColor;

  txtMargin := FScaledDaysMargin;

  { write the events }
  if (FMonthView.DataStore <> nil) and FMonthView.ShowEvents and
     (FMonthView.DataStore.Resource <> nil) and
     (FMonthView.DataStore.Resource.Schedule.EventCount <> 0)
  then begin
    visibleEvents := 0;
    EventList := TList.Create;
    try
      for I := 0 to 43 do begin
        EventList.Clear;
        FMonthView.DataStore.Resource.Schedule.EventsByDate(TVpMonthViewOpener(FMonthView).mvMonthDayArray[I].Date, EventList);
        if EventList.Count > 0 then begin
          { there are events scheduled for this day }
          dayRect := TVpMonthViewOpener(FMonthView).mvMonthDayArray[I].Rec;

          { initialize TextRect for this day }
          TextRect.TopLeft := Point(dayRect.Left+1, dayRect.Top+1);
          TextRect.BottomRight := Point(
            TextRect.Left + mvColWidth,
            TextRect.Top + mvEventTextHeight + txtMargin
          );

          { set canvas color }
          if TVpMonthViewOpener(FMonthView).mvMonthDayArray[I].OffDay then
            RenderCanvas.Brush.Color := RealOffDayColor
          else 
            RenderCanvas.Brush.Color := RealColor;            

          { spin through the events and paint them }
          for J := 0 to Pred(EventList.Count) do begin
            event := TVpEvent(EventList[j]);
            if (TextRect.Bottom > dayRect.Bottom) and (J <= Pred(EventList.Count)) then
            begin
              { draw a little red square with a (...) at the bottom right }
              { corner of the day to indicate that there are more events  }
              { than can be listed in the available space.                }
              DrawDotDotDot(dayRect, DotDotDotColor);
              Break;
            end;

            { shorten events that are next to the day number, in order }
            { to give the day number enough room }
            if (TextRect.Top < dayRect.Top + mvDayNumberHeight + txtMargin)
            then
              TextRect.Right := TextRect.Left + mvColWidth - mvDayNumberHeight - txtMargin * 2
            else
              TextRect.Right := TextRect.Left + mvColWidth - 3;

            if Assigned(FMonthView.Datastore) and FMonthView.ApplyCategoryInfos then
            begin
              brushCol := RenderCanvas.Brush.Color;
              eventCat := FMonthView.Datastore.CategoryColorMap.GetCategory(event.Category);
              if Assigned(eventCat) then
              begin
                tmpRect := TextRect;
                InflateRect(tmpRect, -1, -1);
                RenderCanvas.Brush.Color := eventCat.BackgroundColor;
                TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect);
              end;
              RenderCanvas.Brush.Color := brushCol;
            end;
            
            { Construct the display text }
            Str := FMonthView.BuildEventString(event, FMonthView.ShowEventTime, true);

            { set the event font }
            RenderCanvas.Font.Assign(FMonthView.EventFont);
            {$IF VP_LCL_SCALING = 0}
            RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
            {$ENDIF}
            if TVpMonthViewOpener(FMonthView).mvMonthDayArray[I].OffDay then
              RenderCanvas.Font.Color := FMonthView.OffDayFontColor;
            if Assigned(FMonthView.OnPrepareEventFont) then
              FMonthView.OnPrepareEventFont(FMonthView, event, RenderCanvas.Font);

            StrLen := RenderCanvas.TextWidth(Str);
            if StrLen > WidthOf(TextRect) - txtMargin * 2 then
              Str := GetDisplayString(RenderCanvas, Str, 0, WidthOf(TextRect) - txtMargin * 2);

            { write the event text }
            P := Point(TextRect.Left + txtMargin div 2, TextRect.Top + txtMargin div 2);
            TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, Str);

            { Store TextRect and Event in EventArray }
            with TVpMonthViewOpener(FMonthView) do begin
              mvEventArray[visibleEvents].Rec := TextRect;
              mvEventArray[visibleEvents].Event := TVpEvent(EventList.List^[j]);
              Inc(visibleEvents);
            end;

            { Move TextRect down one line for the next item... }
            TextRect.Top := TextRect.Bottom + 1;
            TextRect.Bottom := TextRect.Top + mvLineHeight;
          end;
        end;
      end;
    finally
      EventList.Free;
    end;
  end;
end;

procedure TVpMonthViewPainter.DrawFocusRect(ARect: TRect; FixRight: Boolean = false);
var
  tmpRect: TRect;
begin
  (*
  tmpRect := ARect;
  InflateRect(tmpRect, 2, 2);
  TPSDrawFocusRect(RenderCanvas, Angle, RenderIn, tmpRect);
    *)
  tmpRect := ARect;
//  InflateRect(tmpRect, -2, -2);
  InflateRect(tmpRect, -1, -1);
  if FixRight then
    inc(tmpRect.Right);
  TPSDrawFocusRect(RenderCanvas, Angle, RenderIn, tmpRect);
end;

procedure TVpMonthViewPainter.DrawHeader;
var
  headRect: TRect;
  HeadTextRect: TRect;
  HeadStr: string;
  HeadStrLen : Integer;
  R: TRect;
  txtstart: Integer;
begin
  RenderCanvas.Brush.Color := HeadAttrColor;
  headRect := Rect(RealLeft, RealTop, RealRight, RealTop + FMonthHeadHeight);

  // Draw the header cell and borders
  if FMonthView.DrawingStyle = dsFlat then begin
    // Draw a flat rectangular border
    TPSFillRect(RenderCanvas, Angle, RenderIn, headRect);
    R := TPSRotateRectangle(Angle, RenderIn, headRect);
    DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow);
  end else
  if FMonthView.DrawingStyle = ds3d then begin
    // Draw a 3d bevel
    InflateRect(headRect, -1, -1);
    dec(headRect.Right);
    headRect.Bottom := headRect.Top + FMonthHeadHeight;
    TPSFillRect(RenderCanvas, Angle, RenderIn, headRect);
    R := TPSRotateRectangle(Angle, RenderIn, headRect);
    DrawBevelRect(RenderCanvas, R, BevelHighlight, BevelShadow);
  end else
    TPSFillRect(RenderCanvas, Angle, RenderIn, headRect);

  // Position the spinner buttons
  with TVpMonthViewOpener(FMonthView) do begin
    FPrevYearBtn.Visible := not DisplayOnly;
    FPrevMonthBtn.Visible := not DisplayOnly;
    FNextMonthBtn.Visible := not DisplayOnly;
    FNextYearBtn.Visible := not DisplayOnly;

    if not DisplayOnly then
    begin
      FPrevYearBtn.Width := FPrevYearBtn.Height;
      FPrevYearBtn.Left := FScaledMonthMargin;
      FPrevYearBtn.Top := (HeadRect.Top + HeadRect.Bottom - FPrevYearBtn.Height) div 2 + 1;

      FPrevMonthBtn.Height := FPrevYearBtn.Height;
      FPrevMonthBtn.Width := FPrevYearBtn.Height;
      FPrevMonthBtn.Left := FPrevYearBtn.Left + FPrevYearBtn.Width;
      FPrevMonthBtn.Top := FPrevYearBtn.Top;

      FNextMonthBtn.Height := FPrevYearBtn.Height;
      FNextMonthBtn.Width := FPrevYearBtn.Height;
      FNextMonthBtn.Left := FPrevMonthBtn.Left + FPrevMonthBtn.Width;
      FNextMonthBtn.Top := FPrevYearBtn.Top;

      FNextYearBtn.Height := FPrevYearBtn.Height;
      FNextYearBtn.Width := FPrevYearBtn.Height;
      FNextYearBtn.Left := FNextMonthBtn.Left + FNextMonthBtn.Width;
      FNextYearBtn.Top := FPrevYearBtn.Top;

      txtStart := FNextYearBtn.Left + FNextYearBtn.Width + 2*FScaledMonthMargin;
    end else
      txtStart := RealLeft + FScaledMonthMargin;
  end;

  { Acquire startdate and end date }
  HeadStr := FormatDateTime(FMonthView.DateLabelFormat, FDisplayDate);
  {$IFDEF FPC}{$IF FPC_FULLVERSION < 30000}
  HeadStr := SysToUTF8(HeadStr);
  {$ENDIF}{$ENDIF}

  { Calculate the text rectangle }
  RenderCanvas.Font.Assign(FMonthView.HeadAttributes.Font);
  {$IF VP_LCL_SCALING = 0}
  RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
  {$ENDIF}
  if DisplayOnly and (RenderCanvas.TextWidth(HeadStr) >= RealWidth) then
    HeadTextRect.Left := RealLeft + FScaledMonthMargin * 2
  else
  if DisplayOnly then
    HeadTextRect.Left := RealLeft + (RealWidth - RenderCanvas.TextWidth(HeadStr)) div 2
  else
    HeadTextRect.Left := RealLeft + 30 + FScaledMonthMargin * 2;
  HeadTextRect.Top := (HeadRect.Top + HeadRect.Bottom - RenderCanvas.TextHeight('Tg')) div 2;
  HeadTextRect.BottomRight := HeadRect.BottomRight;

  { Fix Header String }
  HeadStrLen := RenderCanvas.TextWidth(HeadStr);

  if HeadStrLen > HeadTextRect.Right - HeadTextRect.Left then begin
    HeadStr := GetDisplayString(
      RenderCanvas,
      HeadStr,
      0,
      HeadTextRect.Right - HeadTextRect.Left - FScaledMonthMargin
    );
  end;

  // Draw the text
  RenderCanvas.Font.Assign(FMonthView.HeadAttributes.Font);
  {$IF VP_LCL_SCALING = 0}
  RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
  {$ENDIF}
  TPSTextOut(
    RenderCanvas,
    Angle,
    RenderIn,         // Viewport
    txtstart,         // Horizontal text position, after the spin buttons
    HeadTextRect.Top, // this vertical position is already centered
    HeadStr
  );
end;

procedure TVpMonthViewPainter.DrawTodayRect;
begin
  // Highlight toay by a border defined by FTodayRect (it was measured in
  // the DrawDayCell method).
  RenderCanvas.Pen.Assign(FMonthView.TodayAttributes.BorderPen);
  RenderCanvas.Brush.Color := FMonthView.TodayAttributes.Color;
  RenderCanvas.Brush.Style := bsSolid;
  RenderCanvas.Rectangle(FTodayRect);

  // Write the day number into the TodayRect.
  RenderCanvas.Font.Color := FMonthView.TodayAttributes.Font.Color;
  TPSTextOut(RenderCanvas, Angle, RenderIn, FTodayRect.Left+3, FTodayRect.Top+3, FTodayStr);
end;

procedure TVpMonthViewPainter.FixFontHeights;
begin
  with FMonthView do begin
   {$IF VP_LCL_SCALING = 0}
    HeadAttributes.Font.Height := GetRealFontHeight(HeadAttributes.Font);
    DayHeadAttributes.Font.Height := GetRealFontHeight(DayHeadAttributes.Font);
    DayNumberFont.Height := GetRealFontHeight(DayNumberFont);
    EventFont.Height := GetRealFontHeight(EventFont);
    Font.Height := GetRealFontHeight(Font);
   {$ELSE}
    HeadAttributes.Font.Height := FixFontHeight(HeadAttributes.Font);
    DayHeadAttributes.Font.Height := FixFontHeight(DayHeadAttributes.Font);
    DayNumberFont.Height := FixFontHeight(DayNumberFont);
    EventFont.Height := FixFontHeight(EventFont);
    Font.Height := FixFontHeight(Font);
   {$IFEND}
  end;
end;

procedure TVpMonthViewPainter.InitColors;
begin
  if DisplayOnly then begin
    BevelHighlight := clBlack;
    BevelShadow := clBlack;
    BevelDarkShadow := clBlack;
    BevelFace := clBlack;
    RealColor := clWhite;
    DayHeadAttrColor := clSilver;
    HeadAttrColor := clSilver;
    RealLineColor := clBlack;
    RealOffDayColor := clSilver;
    RealSelDayColor := clWhite;
    EventFontColor := clBlack;
    TodayFontColor := clBlack;
    TodayAttrColor := clWhite;
  end else begin
    BevelHighlight := clBtnHighlight;
    BevelShadow := clBtnShadow;
    BevelDarkShadow := cl3DDkShadow;
    BevelFace := clBtnFace;
    RealColor := FMonthView.Color;
    HeadAttrColor := FMonthView.HeadAttributes.Color;
    DayHeadAttrColor := FMonthView.DayHeadAttributes.Color;
    RealLineColor := FMonthView.LineColor;
    RealOffDayColor := FMonthView.OffDayColor;
    RealSelDayColor := FMonthView.SelectedDayColor;
    EventFontColor := FMonthView.DayNumberFont.Color;
    TodayFontColor := FMonthView.TodayAttributes.Font.Color;
    TodayAttrColor := FMonthView.TodayAttributes.Color;
  end;
  DotDotDotColor := clBlack;
end;

procedure TVpMonthViewPainter.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 and event array }
    Clear;

    { measure the row heights }
    SetMeasurements;

    { draw headers }
    DrawHeader;
    DrawDayHead;

    { draw days }
    DrawDays;

    { draw the borders }
    DrawBorders;

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

  { reinstate canvas settings}
  RestorePenBrush;
end;

procedure TVpMonthViewPainter.SetMeasurements;
var
  h: Integer;
  txt: String = VpProductName;
  // We use the VpProductName since it is a good representation of some generic text
begin
  inherited;

  FDisplayDate := RenderDate;

  with TVpMonthViewOpener(FMonthView) do
  begin
    FScaledMonthMargin := round(Scale * MonthMargin);
    FScaledDaysMargin := round(Scale * DaysMargin);

    h := GetCanvasTextHeight(RenderCanvas, HeadAttributes.Font, txt);
    mvMonthHeadHeight := Max(h, FPrevYearBtn.Height) + FScaledMonthMargin;

    h := GetCanvasTextHeight(RenderCanvas, DayHeadAttributes.Font, txt);
    mvDayHeadHeight := Max(h, FPrevYearBtn.Height) + FScaledDaysMargin;

    mvHeaderHeight := mvMonthHeadHeight + mvDayHeadHeight;

    mvDayNumberHeight := GetCanvasTextHeight(RenderCanvas, DayNumberFont, '00');
    mvEventTextHeight := GetCanvasTextHeight(RenderCanvas, EventFont, txt);
    mvLineHeight := GetCanvasTextHeight(RenderCanvas, Font, txt) + 2;
    mvColWidth := (RealWidth - 2) div 7;

    FMonthHeadHeight := mvMonthHeadHeight;
    FDayHeadHeight := mvDayHeadHeight;
  end;
end;

end.