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;
    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;
  Event: TVpEvent;
  ADEvRect: TRect;
  StartsBeforeRange: Boolean;
  NumADEvents: Integer;
  Skip: Boolean;
  ADTextHeight: Integer;
  EventStr: string;
  txtDist: Integer;
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;

  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
      { Set attributes }
      RenderCanvas.Brush.Color := ADBackgroundColor;

      { Measure the AllDayEvent TextHeight }
      txtDist := TextMargin div 2;
      RenderCanvas.Font.Assign(FWeekView.AllDayEventAttributes.Font);
      {$IF VP_LCL_SCALING = 0}
      RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
      {$ENDIF}
      ADTextHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin + txtDist;

      { Build the AllDayEvent rect based on the value of NumADEvents }
      if AdEventsRect.Top + (NumADEvents * ADTextHeight) + TextMargin * 2 > DayRect.Bottom
      then
        ADEventsRect.Bottom := DayRect.Bottom
      else
        ADEventsRect.Bottom := AdEventsRect.Top + NumADEvents * ADTextHeight + TextMargin * 2;

      // Clear the AllDayEvents area
      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 ADEventsRect.Top + ((I + 1) * ADTextHeight) > DayRect.Bottom then
        begin
          DrawDotDotDot(DayRect, DotDotDotColor);

        {
          RenderCanvas.Brush.Color := DotDotDotColor;
          TPSFillRect(RenderCanvas, Angle, RenderIn,
            Rect(DayRect.Right - 20,  DayRect.Bottom - 7, DayRect.Right - 17,  DayRect.Bottom - 4));
          TPSFillRect(RenderCanvas, Angle, RenderIn,
            Rect(DayRect.Right - 13,  DayRect.Bottom - 7, DayRect.Right - 10,  DayRect.Bottom - 4));
          TPSFillRect(RenderCanvas, Angle, RenderIn,
            Rect(DayRect.Right - 6,  DayRect.Bottom - 7, DayRect.Right -  3,  DayRect.Bottom - 4));
            }
          break;
        end;

        // See if the event began before the start of the range
        if (Event.StartTime < DayOf(RenderDate)) then
          StartsBeforeRange := true;

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

        // Paint the background of the event rect
        RenderCanvas.Brush.Color := ADEventBackgroundColor;
        RenderCanvas.Pen.Color := ADEventBorderColor;
        TPSRectangle(RenderCanvas, Angle, RenderIn,
          ADEvRect.Left + TextMargin,
          ADEvRect.Top + txtDist,
          ADEvRect.Right - TextMargin,
          ADEvRect.Top + ADTextHeight + txtDist
        );

        // Paint the event string
        EventStr := IfThen(StartsBeforeRange, '>> ', '') + Event.Description;
        EventStr := GetDisplayString(RenderCanvas, EventStr, 0, WidthOf(ADEvRect) - 3*TextMargin);

        TPSTextOut(RenderCanvas,Angle, RenderIn,
          ADEvRect.Left + TextMargin * 2 + txtDist,
          ADEvRect.Top + TextMargin,
          EventStr
        );

        Result := True;

        TVpWeekViewOpener(FWeekView).wvEventArray[EAIndex].Rec := Rect(
          ADEvRect.Left + TextMargin,
          ADEvRect.Top + TextMargin,
          ADEvRect.Right - TextMargin,
          ADEvRect.Bottom
        );
        TVpWeekViewOpener(FWeekView).wvEventArray[EAIndex].Event := Event;
        Inc(EAIndex);
      end; { for I := 0 to pred(ADEventsList.Count) do ... }

    end;   { if NumADEvents > 0 }

  finally
    ADEventsList.Free;
  end;
end;

procedure TVpWeekViewPainter.DrawBorders;
begin
  if FWeekView.DrawingStyle = dsFlat then begin
    {
    DrawBevelRect(RenderCanvas,
      TPSRotateRectangle(Angle, RenderIn, Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1)),
      BevelShadowColor,
      BevelShadowColor
    );
    }
    DrawBevelRect(RenderCanvas,
      TPSRotateRectangle(Angle, RenderIn, Rect(RealLeft + 1, RealTop + 1, RealRight - 2, RealBottom - 2)),
      BevelShadowColor,
      BevelShadowColor    // use the same color --> no bevel in flat mode!
    );
  end else
  if FWeekView.DrawingStyle = ds3d then begin
    { draw a 3d bevel }
    DrawBevelRect(RenderCanvas,
      TPSRotateRectangle(Angle, RenderIn, Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1)),
      BevelShadowColor,
      BevelShadowColor
    );
    DrawBevelRect(RenderCanvas,
      TPSRotateRectangle(Angle, RenderIn, Rect(RealLeft + 1, RealTop + 1, RealRight - 2, RealBottom - 2)),
      BevelDarkShadow,
      BevelButtonFace
    );
  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;
  J: Integer;
  EventList: TList;
  rowHeight: Integer;
  headerHeight: Integer;
  tmpRect: TRect;
  holiday: String;
begin
  // Abbreviations
  rowHeight := TVpWeekViewOpener(FWeekView).wvRowHeight;
  headerHeight := TVpWeekViewOpener(FWeekView).wvHeaderHeight;

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

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

  // Draw day header
  tmpRect := TextRect;
  inc(tmpRect.Right);
  RenderCanvas.Font.Assign(FWeekView.DayHeadAttributes.Font);
  {$IF VP_LCL_SCALING = 0}
  RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
  {$ENDIF}
  RenderCanvas.Brush.Color := RealDayHeadAttrColor;
  TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect);
  if FWeekView.DayHeadAttributes.Bordered and (FWeekView.DrawingStyle <> dsNoBorder) then
    TPSRectangle(RenderCanvas, Angle, RenderIn, tmpRect);

  // Fix header string and paint it
  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) >= 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;
      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 - 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:
      if (ADayIndex = 2) then begin
        { move the dayrect to the top of the next column }
        DayRect := Rect(
          RealLeft + DayRectWidth, //(RealRight - RealLeft) div 2,
          RealTop + headerHeight + 2,
          RealRight - 2,
          RealTop + headerHeight + DayRectHeight
        );
        if FWeekView.DrawingStyle = ds3D then begin
          inc(DayRect.Top);
          dec(DayRect.Right);
        end;
      end
      else
      if (ADayIndex = 4 {Friday}) then begin
        { shrink DayRect for weekend days }
        DayRectHeight := DayRectHeight div 2;
        DayRect.Top := DayRect.Bottom;
        DayRect.Bottom := DayRect.Top + DayRectHeight;
      end
      else begin
        DayRect.Top := DayRect.Bottom;
        DayRect.Bottom := DayRect.Top + DayRectHeight;
      end;

    wvlHorizontal:
      if (ADayIndex = 1) or (ADayIndex = 3) then begin
        { move the day rect to the left of the next row }
        DayRect := Rect(
          RealLeft + 1,
          DayRect.Bottom,
          RealLeft + DayRectWidth + 1,
          DayRect.Bottom + DayRectHeight);
        if FWeekView.DrawingStyle = ds3D then begin
          inc(DayRect.Top);
          dec(DayRect.Right);
        end;
      end else
      if (ADayIndex in [4, 5]) {Friday or Saturday} then begin
        if ADayIndex = 4 then begin
          DayRectHeight := DayRectHeight div 2;
          DayRect.Left := DayRect.Right - 1;
          DayRect.Right := RealRight - 2;
        end else
          DayRect.Top := DayRect.Bottom;
        DayRect.Bottom := DayRect.Top + DayRectHeight;
      end else
      begin
        DayRect.Left := DayRect.Right - 1;
        DayRect.Right := RealRight - 2;
      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) - TextMargin);
  strWid := RenderCanvas.TextWidth(dayStr);
  strH := RenderCanvas.TextHeight(dayStr);

  TextRect.Left := TextRect.Right - strWid - TextMargin;
  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;
  headerHeight: Integer;
  realCenter: 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;
  end;

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

  { build the first day rect }
  headerHeight := TVpWeekViewOpener(FWeekView).wvHeaderHeight;
  DayRectHeight := (RealBottom - RealTop - headerHeight) div 3;
  DayRectWidth := (RealRight - RealLeft) div 2;
  DayRect := Rect(
    RealLeft + 1,
    RealTop + headerHeight + 2,
    RealLeft + DayRectWidth + 1,
    RealTop + headerHeight + DayRectHeight
  );
  if FWeekView.DrawingStyle = ds3D then
    inc(DayRect.Top, 1);

  { 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 + headerHeight + 2);
  TPSLineTo(RenderCanvas, Angle, RenderIn, realCenter, RealBottom - 1);
end;

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

  { 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;
  RenderCanvas.Brush.Color := RealColor;

  { Build the event text }
  dayStr := FWeekView.BuildEventString(AEvent, todayStartTime, todayEndTime, false);
  strLen := RenderCanvas.TextWidth(dayStr);
  if (strLen > WidthOf(TextRect) - TextMargin) then      // wp: shouldn't this be 2*TextMargin ?
    dayStr := GetDisplayString(RenderCanvas, dayStr, 0, WidthOf(TextRect) - TextMargin * 2);

  { Write the event text }
  TPSTextOut(RenderCanvas, Angle, RenderIn,
    TextRect.Left + TextMargin, TextRect.Top + TextMargin div 2,
    dayStr
  );

  RenderCanvas.Font.Color := oldFontColor;
end;

procedure TVpWeekViewPainter.DrawHeader;
var
  HeadRect: TRect;
  HeadTextRect: TRect;
  HeadStr: string;
  HeadStrLen: Integer;
  weekNo: Integer;
begin
  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 }
  if FWeekView.DrawingStyle = ds3d then begin
    { draw a 3d bevel }
    HeadRect.Left := RealLeft + 2;
    HeadRect.Top := RealTop + 2;
    HeadRect.Right := RealRight - 3;
    HeadRect.Bottom := RealTop + TVpWeekViewOpener(FWeekView).wvHeaderHeight + 2;
    TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect);
    DrawBevelRect(
      RenderCanvas,
      TPSRotateRectangle(Angle, RenderIn, HeadRect),
      BevelHighlightColor,
      BevelDarkShadow
    );
  end else begin
//  if FWeekView.DrawingStyle = dsFlat then begin
//    { draw simple border rectangle }
    HeadRect := Rect(RealLeft, RealTop, RealRight, RealTop + TVpWeekViewOpener(FWeekView).wvHeaderHeight + 2);
    TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect);
  end;

  { build header caption }
  weekNo := GetWeekOfYear(StartDate);
  HeadStr := HeadStr + Format('%s %s (%s %d)', [
    RSWeekOf, FormatDateTime(FWeekView.DateLabelFormat, StartDate), RSCalendarWeekAbbr, weekNo
  ]);

  { draw the text }
  if DisplayOnly and (RenderCanvas.TextWidth(HeadStr) >= WidthOf(RenderIn)) then
    HeadTextRect.TopLeft:= Point(RealLeft + TextMargin * 2, 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 + TextMargin * 2,
      HeadRect.Top
    );
  HeadTextRect.BottomRight := HeadRect.BottomRight;

  { Fix Header String }
  HeadStrLen := RenderCanvas.TextWidth(HeadStr);
  if HeadStrLen > HeadTextRect.Right - HeadTextRect.Left - TextMargin then
  begin
    HeadStr := GetDisplayString(RenderCanvas, HeadStr, 0,
      HeadTextRect.Right - HeadTextRect.Left - TextMargin );
  end;

  { position the spinner }
  with TVpWeekViewOpener(FWeekView) do begin
    wvSpinButtons.Height := Trunc(wvHeaderHeight * 0.8);
    wvSpinButtons.Width := wvSpinButtons.Height * 2;
    wvSpinButtons.Left := TextMargin;
    wvSpinButtons.Top := (wvHeaderHeight - wvSpinButtons.Height) div 2 + 2;
  end;
  TPSTextOut(RenderCanvas, Angle, RenderIn,
    HeadTextRect.Left + TextMargin,
    (HeadTextRect.Top + HeadTextRect.Bottom - RenderCanvas.TextHeight('Tg')) div 2, //HeadTextRect.Top + TextMargin,
    HeadStr
  );
end;

procedure TVpWeekViewPainter.FixFontHeights;
begin
  with FWeekView do begin
    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);
  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;
begin
  inherited;

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

  RenderCanvas.Font.Assign(FWeekView.DayHeadAttributes.Font);
  {$IF VP_LCL_SCALING = 0}
  RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
  {$ENDIF}
  FDayHeadHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin + 2 ;

  RenderCanvas.Font.Assign(FWeekView.EventFont);
  {$IF VP_LCL_SCALING = 0}
  RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
  {$ENDIF}
  with TVpWeekViewOpener(FWeekView) do
    wvRowHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin div 2;

  RenderCanvas.Font.Assign(TFont(FWeekView.HeadAttributes.Font));
  {$IF VP_LCL_SCALING = 0}
  RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
  {$ENDIF}
  with TVpWeekViewOpener(FWeekView) do
    wvHeaderHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin * 2;
end;

end.