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

{$I vp.inc}

unit VpWeekViewPainter;

interface

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

type
  TVpWeekViewPainter = class(TVpBasePainter)
  private
    FWeekView: TVpWeekView;
    FHeaderHeight: Integer;
    FDayHeadHeight: Integer;

    // local parameters of the old TVpWeekView method
    DayRectHeight: Integer;
    DayRectWidth: Integer;
    StartDate: TDateTime;
    ADEventsRect: TRect;
    DotDotDotColor: TColor;
    BevelHighlightColor: TColor;
    BevelShadowColor: TColor;
    BevelDarkShadow: TColor;
    BevelButtonFace: TColor;
    RealLineColor: TColor;
    RealDayHeadAttrColor: TColor;
    RealColor: TColor;
    RealHeadAttrColor: TColor;
    ADBackgroundColor: TColor;
    ADEventBackgroundColor: TColor;
    ADEventBorderColor: TColor;

  protected
    procedure Clear;
    function DrawAllDayEvents(ADate: TDateTime; DayRect: TRect; var EAIndex: Integer): Boolean;
    procedure DrawBorders;
    procedure DrawFocusRect(ADayIndex: Integer; DayRect: TRect);
    procedure DrawDay(ADayIndex: Integer; var DayRect: TRect; var EAIndex: Integer);
    procedure DrawDayHeader(ADayIndex: Integer; AHolidayName: String;
      var TextRect: TRect);
    procedure DrawDays;
    procedure DrawEvent(AEvent: TVpEvent; TextRect: TRect; ADayIndex: Integer);
    procedure DrawHeader;
    procedure FixFontHeights;
    procedure InitColors;
    procedure SetMeasurements; override;

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


implementation

uses
  StrUtils, Math,
 {$IFDEF LCL}
  LazUtf8, DateUtils,
 {$ENDIF}
  VpCanvasUtils, VpMisc, VpSR;

type
  TVpWeekViewOpener = class(TVpWeekView);

constructor TVpWeekViewPainter.Create(AWeekView: TVpWeekView;
  ARenderCanvas: TCanvas);
begin
  inherited Create(ARenderCanvas);
  FWeekView := AWeekView;
end;

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

function TVpWeekViewPainter.DrawAllDayEvents(ADate: TDateTime; DayRect: TRect;
  var EAIndex: Integer): Boolean;
var
  ADEventsList: TList;
  tempList: TList;
  I, J, K: Integer;
  ADEvRect: TRect;
  startsBeforeRange: Boolean;
  numADEvents: Integer;
  skip: Boolean;
  ADTextHeight: Integer;
  event: TVpEvent;
  eventStr: string;
  txtDist: Integer;
  txtMargin: Integer;
  txtHeight: Integer;
  totalHeight: Integer;
  cat: TVpCategoryInfo;
  savedBrushColor: TColor;
  savedPenColor: TColor;
begin
  Result := False;

  // Initialize the All Day Events area...
  ADEventsRect := DayRect;

  if (FWeekView.DataStore = nil) or (FWeekView.DataStore.Resource = nil) then
    Exit;

  { Collect all of the events for this range and determine the maximum     }
  { number of all day events for the range of days covered by the control. }
  numADEvents := 0;

  // txtMargin is the interal margin in the all-day box, distance of text from border
  txtMargin := FWeekView.TextMargin;
  // txtDist is the distance of the all-day box to the day rect
  txtDist := FWeekView.Textmargin * 2;

  savedPenColor := RenderCanvas.Pen.Color;
  savedBrushColor := RenderCanvas.Brush.Color;

  ADEventsList := TList.Create;
  try
    tempList := TList.Create;
    try
      // Get the all day events for the day specified by ADate + I
      FWeekView.DataStore.Resource.Schedule.AllDayEventsByDate(ADate, tempList);

      // Iterate through these events and place them in ADEventsList
      skip := false;
      for J := 0 to pred(tempList.Count) do begin
        if AdEventsList.Count > 0 then begin
          for K := 0 to pred(AdEventsList.Count) do begin
            if TVpEvent(AdEventsList[K]) = TVpEvent(tempList[J]) then begin
              skip := true;
              Break;
            end;
          end;
          if not skip then
            AdEventsList.Add(tempList[J]);
        end else
          AdEventsList.Add(tempList[J]);
      end;

      if tempList.Count > numADEvents then
        numADEvents := tempList.Count;
    finally
      tempList.Free;
    end;

    if numADEvents > 0 then begin
      // Measure the AllDayEvent TextHeight
      RenderCanvas.Font.Assign(FWeekView.AllDayEventAttributes.Font);
      {$IF VP_LCL_SCALING = 0}
      RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
      {$ENDIF}
      // Pure text height
      txtHeight := RenderCanvas.TextHeight(VpProductName);
      // All-day box height
      ADTextHeight := txtHeight + txtMargin * 2;

      // Build the AllDayEvent rect based on the value of NumADEvents
      totalHeight := numADEvents * ADTextHeight + txtDist * 2;
      ADEventsRect.Bottom := Min(ADEventsRect.Top + totalHeight, DayRect.Bottom);

      // Clear the AllDayEvents area using its background color
      RenderCanvas.Brush.Color := ADBackgroundColor;
      TpsFillRect(RenderCanvas, Angle, RenderIn, ADEventsRect);

      startsBeforeRange := false;

      // Cycle through the all-day events and draw them appropriately
      for I := 0 to pred(ADEventsList.Count) do begin
        event := ADEventsList[I];

        // Draw "..." if next event would not fit into ADEventsRect any more
        if ADEventsRect.Top + (I + 1) * ADTextHeight + txtDist > DayRect.Bottom then
        begin
          DrawDotDotDot(DayRect, DotDotDotColor);
          break;
        end;

        // Set the event's rect
        ADEvRect.Top := ADEventsRect.Top + txtDist + I * ADTextHeight;
        ADEvRect.Bottom := ADEvRect.Top + ADTextHeight + 1;
        ADEvRect.Left := AdEventsRect.Left + txtDist + 1;
        ADEvRect.Right := DayRect.Right - txtDist;

        // Paint the background of the event rect
        RenderCanvas.Brush.Color := ADEventBackgroundColor;
        RenderCanvas.Pen.Color := ADEventBorderColor;
        if FWeekView.ApplyCategoryInfos then
        begin
          cat := FWeekView.Datastore.CategoryColorMap.GetCategory(event.Category);
          if cat.UseForAllDayEvents then
          begin
            RenderCanvas.Brush.Color := cat.BackgroundColor;
            RenderCanvas.Pen.Color := cat.Color;
          end;
        end;
        TPSRectangle(RenderCanvas, Angle, RenderIn, ADEvRect);

        // See if the event began before the start of the range
        if event.StartTime < trunc(RenderDate) then   // wp: was DayOf(RenderDate) ???
          startsBeforeRange := true;

        // Paint the event string
        eventStr := IfThen(startsBeforeRange, '>> ', '') + event.Description;
        eventStr := GetDisplayString(RenderCanvas, eventStr, 0, WidthOf(ADEvRect) - 2 * txtMargin);

        TPSTextOut(RenderCanvas, Angle, RenderIn,
          ADEvRect.Left + txtMargin,
          (ADEvRect.Top + ADEvRect.Bottom - txtHeight) div 2,
          eventStr
        );

        TVpWeekViewOpener(FWeekView).wvEventArray[EAIndex].Rec := ADEvRect;
        TVpWeekViewOpener(FWeekView).wvEventArray[EAIndex].Event := event;

        Inc(EAIndex);
        Result := True;
      end; { for I := 0 to pred(ADEventsList.Count) do ... }
    end;   { if NumADEvents > 0 }

  finally
    RenderCanvas.Brush.Color := savedBrushColor;
    RenderCanvas.Pen.Color := savedPenColor;
    ADEventsList.Free;
  end;
end;

procedure TVpWeekViewPainter.DrawBorders;
var
  R: TRect;
begin
  R := Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1);
  R := TPSRotateRectangle(Angle, RenderIn, R);
  case FWeekView.DrawingStyle of
    dsNoBorder: ;
    dsFlat: DrawBevelRect(RenderCanvas, R, BevelShadowColor, BevelShadowColor);
    ds3D: DrawBevelRect(RenderCanvas, R, BevelShadowColor, BevelHighlightColor);
  end;
end;

procedure TVpWeekViewPainter.DrawFocusRect(ADayIndex: Integer; DayRect: TRect);
var
  tmpRect: TRect;
begin
  if (not DisplayOnly) and SameDate(StartDate + ADayIndex, FWeekView.Date) and FWeekView.Focused
  then begin
    tmpRect := DayRect;
    InflateRect(tmpRect, -2, -2);
    tmpRect.Top := tmpRect.Top + FDayHeadHeight;
    TPSDrawFocusRect(RenderCanvas, Angle, RenderIn, tmpRect);
  end;
end;

procedure TVpWeekViewPainter.DrawDay(ADayIndex: Integer; var DayRect: TRect;
  var EAIndex: Integer);
var
  TextRect: TRect;
  delta: Integer;
  J: Integer;
  EventList: TList;
  rowHeight: Integer;
  tmpRect: TRect;
  holiday: String;
begin
  // Abbreviations
  rowHeight := TVpWeekViewOpener(FWeekView).wvRowHeight;
  delta := IfThen(FWeekView.DrawingStyle = ds3D, 1, 0);

  // Check for holiday
  FWeekView.IsHoliday(StartDate + ADayIndex, holiday);

  // Get header rectangle
  TextRect := DayRect;
  TextRect.Bottom := DayRect.Top + FDayHeadHeight;

  // Draw day header
  RenderCanvas.Brush.Color := RealDayHeadAttrColor;
  TPSFillRect(RenderCanvas, Angle, RenderIn, TextRect);
  tmpRect := TPSRotateRectangle(Angle, RenderIn, TextRect);
  DrawBevelRect(RenderCanvas, tmpRect, BevelShadowColor, BevelShadowColor);

  // Fix header string and paint it
  RenderCanvas.Font.Assign(FWeekView.DayHeadAttributes.Font);
  {$IF VP_LCL_SCALING = 0}
  RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
  {$ENDIF}
  DrawDayHeader(ADayIndex, holiday, TextRect);

  if (FWeekView.DataStore <> nil) and (FWeekView.DataStore.Resource <> nil) and
     (FWeekView.DataStore.Resource.Schedule.EventCountByDay(StartDate + ADayIndex) > 0) and
     (HeightOf(DayRect) >= FWeekView.TextMargin * 2 + FDayHeadHeight)
  then begin
    // Events exist for this day
    EventList := TList.Create;
    try
      // Populate the event list with events for this day
      FWeekView.DataStore.Resource.Schedule.EventsByDate(StartDate + ADayIndex, EventList);

      { Now sort times in ascending order. This must be done because the event
        list can contain recurring events which have the wrong date part }
      EventList.Sort(CompareEventsByTimeOnly);

      // Initialize TextRect for this day
      TextRect := DayRect;
      TextRect.Top := DayRect.Top + FDayHeadHeight + 1;
      TextRect.Bottom := TextRect.Top + rowHeight;

      // Handle all-day events
      tmpRect := TextRect;
      tmpRect.Bottom := DayRect.Bottom;
      if DrawAllDayEvents(StartDate + ADayIndex, tmpRect, EAIndex) then
      begin
        TextRect.Bottom := TextRect.Bottom + ADEventsRect.Bottom - TextRect.Top;
        TextRect.Top := ADEventsRect.Bottom;
      end;

      // Discard AllDayEvents, because they are drawn above.
      for J := pred(EventList.Count) downto 0 do
        if TVpEvent(EventList[J]).AllDayEvent then
          EventList.Delete(J);

      // Iterate the events, painting them one by one
      for J := 0 to pred(EventList.Count) do begin
        { if the TextRect extends below the available space then draw a   }
        { dot dot dot to indicate there are more events than can be drawn }
        { in the available space }
        if TextRect.Bottom - FWeekView.TextMargin > DayRect.Bottom then begin
          { Draw ". . ." }
          DrawDotDotDot(DayRect, DotDotDotColor);
          break;
        end;

        // Write the event text
        DrawEvent(TVpEvent(EventList.List^[J]), TextRect, ADayIndex);

        // Update the EventArray
        with TVpWeekViewOpener(FWeekView).wvEventArray[EAIndex] do begin
          Rec := TextRect;
          Event := TVpEvent(EventList[J]);
        end;
        Inc(EAIndex);

        TextRect.Top := TextRect.Bottom;
        TextRect.Bottom := TextRect.Top + rowHeight;
      end; { for loop }

    finally
      EventList.Free;
    end;
  end;

  { Draw focus rect if this is the current day }
  DrawFocusRect(ADayIndex, DayRect);

  { update WeekdayArray }
  with TVpWeekViewOpener(FWeekView).wvWeekdayArray[ADayIndex] do begin
    Rec := DayRect;
    Day := StartDate + ADayIndex;
  end;

  // Adjust the DayRect for the next day
  case FWeekView.Layout of
    wvlVertical:                                              // DayIndex layout
      if (ADayIndex = 2) then begin                                //   0    3
        // Move the dayrect to the top of the next column          //
        DayRect := Rect(                                           //   1    4
          RealLeft + DayRectWidth,                                 //
          RealTop + FHeaderHeight,                                 //   2    5
          RealRight - 1 - delta,                                   //        6
          RealTop + FHeaderHeight + DayRectHeight
        )
      end else
      if (ADayIndex = 4) then
      begin
        // Friday: shrink DayRect for weekend days
        DayRect.Top := DayRect.Bottom;
        DayRect.Bottom := DayRect.Top + DayRectHeight div 2;
      end
      else if (ADayIndex = 5) then
      begin
        DayRect.Top := DayRect.Bottom;
        DayRect.Bottom := RealTop + FHeaderHeight + DayRectHeight;
      end else
      begin
        DayRect.Top := DayRect.Bottom;
        DayRect.Bottom := DayRect.Top + DayRectHeight;
      end;

    wvlHorizontal:
      begin                                                   // DayIndex layout
        if (ADayIndex in [0, 2, 4]) then                           //  0     1
        begin                                                      //
          DayRect.Left := RealLeft + DayRectWidth;                 //  2     3
          DayRect.Right := RealRight - 1 - delta;                  //
        end else if (ADayIndex <> 5) then                          //  4     5
        begin                                                      //        6
          DayRect.Right := RealLeft + DayRectWidth;
          DayRect.Left := RealLeft;
        end;
        if (ADayIndex in [1, 3]) then
        begin
          DayRect.Top := DayRect.Bottom;
          DayRect.Bottom := DayRect.Top + DayRectHeight;
        end else
        if ADayIndex = 4 then
          DayRect.Bottom := DayRect.Top + DayRectHeight div 2
        else if ADayIndex = 5 then
        begin
          DayRect.Top := DayRect.Bottom;
          DayRect.Bottom := DayRect.Top + DayRectHeight div 2;
        end;
      end;
  end;  // case
end;

procedure TVpWeekViewPainter.DrawDayHeader(ADayIndex: Integer; AHolidayName: String;
  var TextRect: TRect);
var
  dayStr: String;
  strWid: Integer;
  strH: Integer;
  savedFontstyle: TFontStyles;
begin
  savedFontstyle := RenderCanvas.Font.Style;
  if (not DisplayOnly) and SameDate(StartDate + ADayIndex, FWeekView.Date) then
    RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsBold];

  dayStr := GetDateDisplayString(RenderCanvas, StartDate + ADayIndex,
    FWeekView.DayHeadAttributes.DateFormat, AHolidayName, WidthOf(TextRect) - FWeekView.HeaderMargin*2);
  strWid := RenderCanvas.TextWidth(dayStr);
  strH := RenderCanvas.TextHeight(dayStr);

  case FWeekView.DayHeadAttributes.Alignment of
    taLeftJustify:
      TextRect.Left := TextRect.Left + FWeekView.HeaderMargin;
    taCenter:
      TextRect.Left := (TextRect.Left + TextRect.Right - strWid) div 2;
    taRightJustify:
      TextRect.Left := TextRect.Right - strWid - FWeekView.HeaderMargin;
  end;
  TPSTextOut(
    RenderCanvas,
    Angle,
    RenderIn,
    TextRect.Left,
    (TextRect.Top + TextRect.Bottom - strH) div 2,
    dayStr
  );

  RenderCanvas.Font.Style := savedFontstyle;
end;

procedure TVpWeekViewPainter.DrawDays;
var
  DayRect: TRect;
  EAIndex: Integer;   // Index of last-used item in wvEventArray
  I: Integer;
  realCenter: Integer;
  delta: Integer;
begin
  with TVpWeekViewOpener(FWeekView) do begin
    // Initialize weekday array
    for I := 0 to pred(Length(wvWeekdayArray)) do begin
      wvWeekdayArray[I].Rec.TopLeft := Point(-1, -1);
      wvWeekdayArray[I].Rec.BottomRight := Point(-1, -1);
      wvWeekdayArray[I].Day := 0;
    end;

    // Initialize event array
    EAIndex := 0;
    for I := 0 to pred(Length(wvEventArray)) do begin
      wvEventArray[I].Rec.TopLeft := Point(-1, -1);
      wvEventArray[I].Rec.BottomRight := Point(-1, -1);
      wvEventArray[I].Event := nil;
    end;

    if DrawingStyle = ds3D then delta := 1 else delta := 0;
  end;

  RenderCanvas.Pen.Color := RealLineColor;
  RenderCanvas.Pen.Style := psSolid;

  // Build the first day rect
  DayRectHeight := (RealBottom - RealTop - FHeaderHeight) div 3;
  DayRectWidth := (RealRight - RealLeft) div 2;
  DayRect := Rect(
    RealLeft,
    RealTop + FHeaderHeight,
    RealLeft + DayRectWidth,
    RealTop + FHeaderHeight + DayRectHeight
  );

  // Draw the day frames and texts
  for I := 0 to 6 do
    DrawDay(I, DayRect, EAIndex);

  // Draw the center vertical line
  RenderCanvas.Pen.Color := RealLineColor;
  realCenter := RealLeft + (RealRight - RealLeft) div 2;
  TPSMoveTo(RenderCanvas, Angle, RenderIn, realCenter, RealTop + FHeaderHeight + 1);
  TPSLineTo(RenderCanvas, Angle, RenderIn, realCenter, RealBottom - 1);
end;

procedure TVpWeekViewPainter.DrawEvent(AEvent: TVpEvent; TextRect: TRect;
  ADayIndex: Integer);
var
  dayStr: String;
  todayStartTime: TDateTime;
  todayEndTime: TDateTime;
  txtMargin: Integer;
  strLen: Integer;
  oldFontColor: TColor;
  eventCat: TVpCategoryInfo;
  R: TRect;
begin
  oldFontColor := RenderCanvas.Font.Color;
  txtmargin := FWeekView.TextMargin;

  { format the display text }
  todayStartTime := AEvent.StartTime;
  todayEndTime := AEvent.EndTime;

  // Event reaches into the next day(s)
  if trunc(todayEndTime) > trunc(todayStartTime) then begin
    if trunc(todayStartTime) < trunc(StartDate + ADayIndex) then  // first event
      todayStartTime := 0;
    if trunc(TodayEndTime) > trunc(StartDate + ADayIndex) then    // last event
      todayEndTime := 0.9999;
  end;

  // Set the event font
  RenderCanvas.Font.Assign(FWeekView.EventFont);
  {$IF VP_LCL_SCALING = 0}
  RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
  {$ENDIF}
  if AEvent.IsOverlayed then
    RenderCanvas.Font.Color := clGray;

  // Draw event background
  RenderCanvas.Brush.Color := RealColor;
  if Assigned(FWeekView.Datastore) and FWeekView.ApplyCategoryInfos then
  begin
    eventCat := FWeekView.Datastore.CategoryColorMap.GetCategory(AEvent.Category);  
    if Assigned(eventCat) then
    begin
      RenderCanvas.Brush.Color := eventCat.BackgroundColor;
      TPSFillRect(RenderCanvas, Angle, RenderIn, TextRect);
      R := TextRect;
      {$IF VP_LCL_SCALING > 0}
      R.Right := R.Left + FWeekView.Scale96ToFont(FWeekView.GutterWidth);
      {$ELSE}
      R.Right := R.Left + ScaleX(FWeekView.GutterWidth, DesignTimeDPI);
      {$IFEND}
      TextRect.Left := R.Right;
      RenderCanvas.Brush.Color := eventCat.Color;
      TPSFillRect(RenderCanvas, Angle, RenderIn, R);
    end;
  end;

  // Build the event text
  dayStr := FWeekView.BuildEventString(AEvent, todayStartTime, todayEndTime, false);
  strLen := RenderCanvas.TextWidth(dayStr);
  if (strLen > WidthOf(TextRect) - txtMargin * 2) then
    dayStr := GetDisplayString(RenderCanvas, dayStr, 0, WidthOf(TextRect) - txtMargin * 2);

  // Write out the event text
  TPSTextOut(RenderCanvas, Angle, RenderIn,
    TextRect.Left + txtMargin, TextRect.Top + txtMargin div 2,
    dayStr
  );

  RenderCanvas.Font.Color := oldFontColor;
end;

procedure TVpWeekViewPainter.DrawHeader;
var
  headRect, R: TRect;
//  headTextRect: TRect;
  headStr: string = '';
  headStrLen: Integer;
  maxStrLen: Integer;
  weekNo: Integer;
  startStr, endStr: String;
  txtStart: Integer;
  margin: Integer;
begin
  margin := FWeekView.HeaderMargin;

  RenderCanvas.Brush.Color := RealHeadAttrColor;
  RenderCanvas.Font.Assign(TFont(FWeekView.HeadAttributes.Font));
  {$IF VP_LCL_SCALING = 0}
  RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
  {$ENDIF}

  // Draw the header cell and borders
  headRect := Rect(RealLeft, RealTop, RealRight, RealTop + FHeaderHeight);
  case FWeekView.DrawingStyle of
    dsNoBorder:
      TPSFillRect(RenderCanvas, Angle, RenderIn, headRect);
    dsFlat:
      begin  // Draw simple border rectangle
        TPSFillRect(RenderCanvas, Angle, RenderIn, headRect);
        R := TPSRotateRectangle(Angle, RenderIn, headRect);
        DrawBevelRect(RenderCanvas, R, BevelShadowColor, BevelShadowColor);
      end;
    ds3D:
      begin  // Draw a 3D bevel (raised)
        R := Rect(headRect.Left+1, headRect.Top+1, headRect.Right-2, headRect.Bottom);
        TPSFillRect(RenderCanvas, Angle, RenderIn, headRect);
        R := TPSRotateRectangle(Angle, RenderIn, R);
        DrawBevelRect(RenderCanvas, R, BevelHighlightColor, BevelShadowColor);
      end;
  end;

  // Position the spinner buttons
  with FWeekView do begin
    PrevMonthBtn.Width := PrevMonthBtn.Height;
    PrevMonthBtn.Left := margin;
    PrevMonthBtn.Top :=  (headRect.Top + headRect.Bottom - PrevMonthBtn.Height) div 2;

    PrevWeekBtn.Height := PrevMonthBtn.Height;
    PrevWeekBtn.Width := PrevMonthBtn.Height;
    PrevWeekBtn.Left := PrevMonthBtn.Left + PrevMonthBtn.Width;
    PrevWeekBtn.Top := PrevMonthBtn.Top;

    NextWeekBtn.Height := PrevMonthBtn.Height;
    NextWeekBtn.Width := PrevMonthBtn.Height;
    NextWeekBtn.Left := PrevWeekBtn.Left + PrevWeekBtn.Width;
    NextWeekBtn.Top := PrevMonthBtn.Top;

    NextMonthBtn.Height := PrevMonthBtn.Height;
    NextMonthBtn.Width := PrevMonthBtn.Height;
    NextMonthBtn.Left := NextWeekBtn.Left + NextWeekBtn.Width;
    NextMonthBtn.Top := PrevMonthBtn.Top;

    txtStart := NextMonthBtn.Left + NextMonthBtn.Width + margin;
  end;

  // Build header caption
  weekNo := GetWeekOfYear(StartDate);
  startStr := FormatDateTime(FWeekView.DateLabelFormat, StartDate);
  endStr := FormatDateTime(FWeekView.DateLabelFormat, StartDate+6);
  headStr := Format('%s %d (%s - %s)', [RSCalendarWeek, weekNo, startStr, endStr]);

  // Draw the text
  {
  if DisplayOnly and (RenderCanvas.TextWidth(headStr) >= WidthOf(RenderIn)) then
    headTextRect.TopLeft := Point(RealLeft + margin, HeadRect.Top)
  else
  if DisplayOnly then
    headTextRect.TopLeft := Point(
      RealLeft + (RealRight - RealLeft - RenderCanvas.TextWidth(headStr)) div 2,
      headRect.Top
    )
  else
    headTextRect.TopLeft := Point(
      RealLeft + Trunc(TVpWeekViewOpener(FWeekView).wvHeaderHeight * 0.8) * 2 + margin,
      headRect.Top
    );
  headTextRect.BottomRight := headRect.BottomRight;
  dec(headTextRect.Right, margin);
  }

  // Fix length of header string
  headStrLen := RenderCanvas.TextWidth(headStr);
  maxStrLen := headRect.Right - margin - txtStart;
  if headStrLen > maxStrLen then
    headStr := GetDisplayString(RenderCanvas, headStr, 0, maxStrlen);

  TPSTextOut(RenderCanvas, Angle, RenderIn,
    txtStart, 
    (headRect.Top + headRect.Bottom - RenderCanvas.TextHeight('Tg')) div 2,
    headStr
  );
end;

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

procedure TVpWeekViewPainter.InitColors;
begin
  if DisplayOnly then begin
    BevelHighlightColor := clBlack;
    BevelShadowColor := clBlack;
    BevelDarkShadow := clBlack;
    BevelButtonFace := clBlack;
    RealLineColor := clBlack;
    RealColor := clWhite;
    RealDayHeadAttrColor := clSilver;
    RealHeadAttrColor := clSilver;
    ADBackgroundColor := clWhite;
    ADEventBackgroundColor := clWhite;
    ADEventBorderColor := clSilver;
  end else begin
    BevelHighlightColor := clBtnHighlight;
    BevelShadowColor := clBtnShadow;
    BevelDarkShadow := cl3DDkShadow;
    BevelButtonFace := clBtnFace;
    RealLineColor := FWeekView.LineColor;
    RealColor := FWeekView.Color;
    RealDayHeadAttrColor := FWeekView.DayHeadAttributes.Color;
    RealHeadAttrColor := FWeekView.HeadAttributes.Color;
    ADBackgroundColor := FWeekView.AllDayEventAttributes.BackgroundColor;
    ADEventBackgroundColor := FWeekView.AllDayEventAttributes.EventBackgroundColor;
    ADEventBorderColor := FWeekView.AllDayEventAttributes.EventBorderColor;
  end;
  DotDotDotColor := clBlack;
end;

procedure TVpWeekViewPainter.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 header }
    DrawHeader;

    { draw days }
    DrawDays;

    { draw the borders }
    DrawBorders;

  finally
    { reinstate canvas settings}
    SelectClipRgn(RenderCanvas.Handle, 0);
    DeleteObject(Rgn);
  end;

  RestorePenBrush;
end;

procedure TVpWeekViewPainter.SetMeasurements;
var
  h: Integer;
begin
  inherited;

  with TVpWeekViewOpener(FWeekView) do
  begin
    if RenderDate = 0 then
      StartDate := GetStartOfWeek(wvStartDate, WeekStartsOn)
    else
      StartDate := GetStartOfWeek(RenderDate, WeekStartsOn);

    wvRowHeight := GetCanvasTextHeight(RenderCanvas, EventFont, VpProductName) + TextMargin * 2;

    Self.FDayHeadHeight := GetCanvasTextHeight(RenderCanvas, DayHeadAttributes.Font) + TextMargin * 2;

    h := GetCanvasTextHeight(RenderCanvas, HeadAttributes.Font, VpProductName);
    Self.FHeaderHeight := Max(h, PrevMonthBtn.Height) + HeaderMargin * 2;
    wvHeaderHeight := FHeaderHeight;
  end;
end;

end.