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

unit VpCalendarPainter;

{$I vp.inc}

interface

uses
  SysUtils, Classes, Graphics,
  VpBase, VpMisc, VpBasePainter, VpCalendar;

type
  TVpCalendarPainter = class(TVpBasePainter)
  private
    FCalendar: TVpCustomCalendar;
    // local variables of the old RenderToCanvas method of TVpCalendar
//    R, C: Integer;
//    I: Integer;
    SatCol: Integer;
    SunCol: Integer;
    DOW: TVpDayType;
    Y, M, D: Word;
    lBadDate: Boolean;
    lDate: TDateTime;
    BevelHighlight: TColor;
    BevelShadow: TColor;
    InactiveDayColor: TColor;
    MonthYearColor: TColor;
    DayNameColor: TColor;
    LineColor: TColor;
    EventDayColor: TColor;
    DayColor: TColor;
    RealColor: TColor;
    WeekendColor: TColor;

  protected
    procedure DrawAllDays;
    procedure DrawDate;
    procedure DrawDay(R, C, I: Integer; Grayed: Boolean);
    procedure DrawDayNames;
    procedure DrawFocusBox;
    procedure DrawLine;
    procedure FixFontHeights;
    procedure InitColors;
    procedure SetMeasurements; override;

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

implementation

uses
  LCLProc, LazUtf8,
  VpConst, VpCanvasUtils;

type
  TVpCalendarOpener = class(TVpCustomCalendar);

constructor TVpCalendarPainter.Create(ACalendar: TVpCustomCalendar;
  ARenderCanvas: TCanvas);
begin
  inherited Create(ARenderCanvas);
  FCalendar := ACalendar;
end;

procedure TVpCalendarPainter.DrawAllDays;
var
  I, R, C: Integer;
begin
  I := 1;
  for R := 2 to 8 do
    for C := 0 to 6 do begin
      if ((C = SatCol) and (cdoHighlightSat in FCalendar.Options)) or
         ((C = SunCol) and (cdoHighlightSun in Fcalendar.Options))
      then
        RenderCanvas.Font.Color := WeekendColor
      else
        RenderCanvas.Font.Color := DayColor;

      { set highlight color and font style for days with events }
      RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold];
      lBadDate := false;
      if (FCalendar.DataStore <> nil) and (FCalendar.DataStore.Resource <> nil) then
      begin
        DecodeDate(RenderDate, Y, M, D);
        try begin
          {$IFDEF VERSION6}
          if not TryEncodeDate(Y, M, TVpCalendarOpener(FCalendar).clCalendar[I], lDate) then
            lBadDate := True;
          {$ELSE}
          if TVpCalendarOpener(FCalendar).clCalendar[I] > DaysInMonth(Y, M) then
            lDate := EncodeDate(Y, M, DaysInMonth(Y, M))
          else
            lDate := EncodeDate(Y, M, TVpCalendarOpener(FCalendar).clCalendar[I]);
          {$ENDIF}
        end;
        except
          lBadDate := true;
        end;

        if (not lBadDate) and (FCalendar.DataStore.Resource.Schedule.EventCountByDay(lDate) > 0)
        then begin
          RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsBold, fsUnderline];
          RenderCanvas.Font.Color := EventDayColor;
        end else
          RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold, fsUnderline];
      end;
      with TVpCalendarOpener(FCalendar) do
        DrawDay(R, C, I, (I < clFirst) or (I > clLast));
      Inc(I);
    end;
end;

procedure TVpCalendarPainter.DrawDate;
var
  R: TRect;
  S: string;
begin
  // Calculate size of available rectangle
  with TVpCalendarOpener(FCalendar) do begin
    R := Rect(clRowCol[0, 1].Left + RealLeft,
              clRowCol[0, 1].Top + RealTop,
              clRowCol[0, 1].Right + RealLeft,
              clRowCol[0, 1].Bottom + RealTop
    );
    R.Right := clRowCol[0, 6].Left + RealLeft;
  end;

  // Calculate string to be displayed
  if FCalendar.DateFormat = dfLong then
    if cdoShowYear in FCalendar.Options then
      S := FormatDateTime('mmmm yyyy', RenderDate)
    else
      S := FormatDateTime('mmmm', RenderDate)
  else
    if cdoShowYear in FCalendar.Options then
      S := FormatDateTime('mmm yyyy', RenderDate)
    else
      S := FormatDateTime('mmm', RenderDate);

  // switch to short date format if string won't fit
  if FCalendar.DateFormat = dfLong then
    if RenderCanvas.TextWidth(S) > R.Right - R.Left then
      S := FormatDateTime('mmm yyyy', RenderDate);

  {$IF FPC_FULLVERSION < 30000}
  S := SysToUTF8(S);
  {$ENDIF}

  RenderCanvas.Font.Color := MonthYearColor;
  if Assigned(FCalendar.OnDrawDate) then
    FCalendar.OnDrawDate(Self, RenderDate, R)
  else
    TPSCenteredTextOut(RenderCanvas, Angle, RenderIn, R, S);
end;

procedure TVpCalendarPainter.DrawDay(R, C, I: Integer; Grayed: Boolean);
var
  Cl: TColor;
  OldIdx: Integer;
  NewIdx: Integer;
  S: string[10];
  DrawRect: TRect;
  TH: Integer;
begin
  {avoid painting day number under buttons}
  if cdoShowRevert in FCalendar.Options then
    if (R = 8) and (C >= 3) then
      Exit;
  if cdoShowToday in FCalendar.Options then
    if (R = 8) and (C >= 5) then
      Exit;

  {convert to a string and draw it centered in its rectangle}
  S := IntToStr(TVpCalendarOpener(FCalendar).clCalendar[I]);

  if Grayed then
    RenderCanvas.Font.Color := InactiveDayColor;

  if not Grayed or (cdoShowInactive in FCalendar.Options) then begin
    NewIdx := ((R-2) * 7) + Succ(C);
    with TVpCalendarOpener(FCalendar) do
      OldIdx := clFirst + Pred(clDay);
    if Assigned(FCalendar.OnGetHighlight) then begin
      Cl := RenderCanvas.Font.Color;
      FCalendar.OnGetHighlight(Self, RenderDate + NewIdx - OldIdx , Cl);
      RenderCanvas.Font.Color := Cl;
    end;
    with TVpCalendarOpener(FCalendar) do
      if Assigned(OnDrawItem) then
        OnDrawItem(Self, RenderDate + NewIdx - OldIdx, clRowCol[R,C])
      else
      if clRowCol[R, C].Top <> 0 then begin
        DrawRect := clRowCol[R, C];
        OffsetRect(DrawRect, RealLeft, RealTop);
        TH := RenderCanvas.TextHeight(S);
        if TH < DrawRect.Bottom - DrawRect.Top then
          DrawRect.Top := DrawRect.Top + ((DrawRect.Bottom - DrawRect.Top) - TH) div 2;
        TPSCenteredTextOut(RenderCanvas, Angle, RenderIn, DrawRect, S);
      end;
  end;
end;

procedure TVpCalendarPainter.DrawDayNames;
var
  I: Integer;
  S: string;
  DrawRect: TRect;
begin
  {draw the day name column labels}
  RenderCanvas.Font.Color := DayNameColor;
  I := 0;
  DOW := FCalendar.WeekStarts;
  repeat
    {record columns for weekends}
    if DOW = dtSaturday then
      SatCol := I;
    if DOW = dtSunday then
      SunCol := I;

    {get the day name}
    if cdoShortNames in FCalendar.Options then begin
      if FCalendar.DayNameWidth < 1 then
        S := DefaultFormatSettings.ShortDayNames[Ord(DOW)+1]
      else
        S := Copy(DefaultFormatSettings.ShortDayNames[Ord(DOW)+1], 1, FCalendar.DayNameWidth)
    end else begin
      if FCalendar.DayNameWidth < 1 then
        S := DefaultFormatSettings.LongDayNames[Ord(DOW)+1]
      else
        S := Copy(DefaultFormatSettings.LongDayNames[Ord(DOW)+1], 1, FCalendar.DayNameWidth)
    end;
   {$IF FPC_FULLVERSION < 30000}
    S := SysToUTF8(S);
   {$ENDIF}

    {draw the day name above each column}
    DrawRect := TVpCalendarOpener(FCalendar).clRowCol[1, I];
    OffsetRect(DrawRect, RealLeft, Realtop);
    TPSCenteredTextOut(RenderCanvas, Angle, RenderIn, DrawRect, S);
    Inc(I);
    if DOW < High(DOW) then
      Inc(DOW)
    else
      DOW := Low(DOW);
  until DOW = FCalendar.WeekStarts;
end;

procedure TVpCalendarPainter.FixFontHeights;
begin
  with TVpCalendarOpener(FCalendar) do begin
    Font.Height := GetRealFontHeight(Font);
    calRebuildCalArray(RenderDate);
  end;
end;

procedure TVpCalendarPainter.InitColors;
begin
  if DisplayOnly then begin
    BevelHighlight := clBlack;
    BevelShadow := clBlack;
    InactiveDayColor := clSilver;
    MonthYearColor := clBlack;
    DayNameColor := clBlack;
    LineColor := clBlack;
    EventDayColor := clBlack;
    DayColor := clBlack;
    RealColor := clWhite;
    WeekendColor := $5f5f5f;
  end else begin
    BevelHighlight := clBtnHighlight;
    BevelShadow := clBtnShadow;
    InactiveDayColor := FCalendar.Colors.InactiveDays;
    MonthYearColor := FCalendar.Colors.MonthAndYear;
    DayNameColor := FCalendar.Colors.DayNames;
    LineColor := FCalendar.Font.Color;
    EventDayColor := FCalendar.Colors.EventDays;
    DayColor := FCalendar.Colors.Days;
    RealColor := FCalendar.Color;
    WeekendColor := FCalendar.Colors.WeekEnd;
  end;
end;

procedure TVpCalendarPainter.DrawFocusBox;
var
  R: TRect;
  S: string[10];
begin
  S := IntToStr(TVpCalendarOpener(FCalendar).clDay);

  { set highlight color and font style for days with events }
  RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold];
  lBadDate := false;

  if (FCalendar.DataStore <> nil) and (FCalendar.DataStore.Resource <> nil) then begin
    DecodeDate(RenderDate, Y, M, D);
    try
      {$IFDEF VERSION6}
      if not TryEncodeDate (Y, M, TVpCalendarOpener(FCalendar).clDay, lDate) then
        lBadDate := true;
      {$ELSE}
      lDate := EncodeDate(Y, M, TVpCalendarOpener(FCalendar).clDay);
      {$ENDIF}
    except
      lBadDate := true;
    end;

    if (not lBadDate) and (FCalendar.DataStore.Resource.Schedule.EventCountByDay(lDate) > 0)
    then begin
      RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsBold, fsUnderline];
      RenderCanvas.Font.Color := EventDayColor;
    end else
      RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold, fsUnderline];
  end;

  R := TVpCalendarOpener(FCalendar).calGetCurrentRectangle;
  R.Left := R.Left + RealLeft;
  R.Top := R.Top + RealTop;
  R.Right := R.Right + RealLeft;
  R.Bottom := R.Bottom + RealTop;

  R := TPSRotateRectangle (Angle, RenderIn, R);
  if not DisplayOnly then begin
  {$IFNDEF LCL}
    if Focused then
      DrawButtonFace (RenderCanvas, R, 1, bsNew, True, True, False)
    else
      DrawButtonFace (RenderCanvas, R, 1, bsNew, True, False, False);
  {$ENDIF}
    R := TVpCalendarOpener(FCalendar).calGetCurrentRectangle;
    R.Left := R.Left + RealLeft;
    R.Top := R.Top + RealTop;
    R.Right := R.Right + RealLeft;
    R.Bottom := R.Bottom + RealTop;
    TPSCenteredTextOut (RenderCanvas, Angle, RenderIn, R, S);
  end;
end;

procedure TVpCalendarPainter.DrawLine;
begin
//    if (not Ctl3D) then begin
    with TVpCalendarOpener(FCalendar) do begin
      RenderCanvas.Pen.Color := LineColor;
      TPSMoveTo(RenderCanvas, Angle, RenderIn, RealLeft, clRowCol[1,0].Bottom-3 + RealTop);
      TPSLineTo(RenderCanvas, Angle, RenderIn, RealRight, clRowCol[1,0].Bottom-3 + RealTop);
    end;
{    end else if Ctl3D then begin
    RenderCanvas.Pen.Color := BevelHighlight;
    TPSMoveTo (RenderCanvas, Angle, RenderIn,
               RealLeft, clRowCol[1,0].Bottom-3 + RealTop);
    TPSLineTo (RenderCanvas, Angle, RenderIn,
               RealRight, clRowCol[1,0].Bottom-3 + RealTop);
    RenderCanvas.Pen.Color := BevelShadow;
    TPSMoveTo (RenderCanvas, Angle, RenderIn,
               RealLeft,  clRowCol[1,0].Bottom-2 + RealTop);
    TPSLineTo (RenderCanvas, Angle, RenderIn,
               RealRight, clRowCol[1,0].Bottom-2 + RealTop);
  end;  }
end;

procedure TVpCalendarPainter.RenderToCanvas(ARenderIn: TRect;
  AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime;
  AStartLine, AStopLine: Integer; AUseGran: TVpGranularity; ADisplayOnly: Boolean);
var
  Row: TRowArray;
  Col: TColArray;
begin
  inherited;

  InitColors;
  SavePenBrush;
  InitPenBrush;
  if ADisplayOnly then FixFontHeights;

  RenderCanvas.Lock;
  try
    SetMeasurements;

    RenderCanvas.Font.Assign(FCalendar.Font);
    {$IF VP_LCL_SCALING = 0}
    RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
    {$ENDIF}

    with TVpCalendarOpener(FCalendar) do
      if (RealRight - RealLeft <> FLastRenderX) or
         (RealBottom - RealTop <> FLastRenderY)
      then begin
        FLastRenderX := RealRight - RealLeft;
        FLastRenderY := RealBottom - RealTop;
        CalculateSizes(RenderCanvas, Angle, RenderIn, Row, Col, DisplayOnly);
      end;
    RenderCanvas.Brush.Color := RealColor;
    RenderCanvas.FillRect(RenderIn);

    {draw the month and year at the top of the calendar}
    DrawDate;

    {draw the days of the week}
    DrawDayNames;

    {draw line under day names}
    DrawLine;

    {draw each day}
    DrawAllDays;

    RenderCanvas.Font.Color := DayColor;
    if not Assigned(FCalendar.OnDrawItem) then
      if not (cdoHideActive in FCalendar.Options) then
        DrawFocusBox;

  finally
    RenderCanvas.Unlock;
  end;
end;

procedure TVpCalendarPainter.SetMeasurements;
begin
  inherited;
  if RenderDate = 0 then
    RenderDate := FCalendar.Date;
end;

end.