tvplanit: Add new property TodayAttributes to MonthView (to highlight today). Refactoring of MonthView painting.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4982 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/examples/fulldemo/demomain.lfm

@@ -66,6 +66,10 @@ object MainForm: TMainForm
             HeadAttributes.Color = clBtnFace
             LineColor = clGray
             TimeFormat = tf12Hour
+            TodayAttributes.Color = clSkyBlue
+            TodayAttributes.Font.Color = clBlue
+            TodayAttributes.BorderPen.Color = clBlue
+            TodayAttributes.BorderPen.Width = 3
             OffDayColor = clSilver
             SelectedDayColor = clRed
             ShowEvents = True

components/tvplanit/source/vpmonthview.pas

@@ -59,7 +59,7 @@ type
   TVpOnEventClick =                                                      
     procedure(Sender: TObject; Event: TVpEvent) of object;               
 
-  TVpMvHeadAttributes = class(TPersistent)
+  TVpMvHeadAttr = class(TPersistent)
   protected{ private }
     FOwner: TVpMonthView;
     FColor: TColor;
@@ -91,6 +91,25 @@ type
     property Font: TVpFont read FFont write SetFont;
   end;
 
+  TVpMvTodayAttr = class(TPersistent)
+  protected
+    FMonthView: TVpMonthView;
+    FFont: TVpFont;
+    FColor: TColor;
+    FBorderPen: TPen;
+    procedure SetColor(Value: TColor);
+    procedure SetFont(Value: TVpFont);
+    procedure SetBorderPen(Value: TPen);
+  public
+    constructor Create(AOwner: TVpMonthView);
+    destructor Destroy; override;
+    property MonthView: TVpMonthView read FMonthView;
+  published
+    property Color: TColor read FColor write SetColor;
+    property Font: TVpFont read FFont write FFont;
+    property BorderPen: TPen read FBorderPen write SetBorderPen;
+  end;
+
   { TVpMonthView }
 
   TVpMonthView = class(TVpLinkableControl)
@@ -111,8 +130,9 @@ type
     FDateLabelFormat   : string;
     FShowEventTime     : Boolean;
     FTopLine           : Integer;
-    FDayHeadAttributes : TVpDayHeadAttr;
+    FDayHeadAttr       : TVpDayHeadAttr;
-    FHeadAttr          : TVpMvHeadAttributes;
+    FHeadAttr          : TVpMvHeadAttr;
+    FTodayAttr         : TVpMvTodayAttr;
     FDayNumberFont     : TVpFont;
     FEventFont         : TVpFont;
     FTimeFormat        : TVpTimeFormat;
@@ -165,6 +185,7 @@ type
     procedure SetWeekStartsOn(Value: TVpDayType);
     { internal methods }
     procedure mvHookUp;
+    procedure mvPenChanged(Sender: TObject);
 //    procedure mvFontChanged(Sender: TObject);
 
     procedure Paint; override;
@@ -245,7 +266,7 @@ type
     property DateLabelFormat:
       string read FDateLabelFormat write SetDateLabelFormat;
     property DayHeadAttributes: TVpDayHeadAttr
-      read FDayHeadAttributes write FDayHeadAttributes;
+      read FDayHeadAttr write FDayHeadAttr;
     property DayNameStyle: TVpMVDayNameStyle
       read FDayNameStyle write SetDayNameStyle;
     property DayNumberFont: TVpFont
@@ -256,12 +277,14 @@ type
       read FEventDayStyle write SetEventDayStyle;
     property EventFont: TVpFont
       read FEventFont write SetEventFont;
-    property HeadAttributes: TVpMvHeadAttributes
+    property HeadAttributes: TVpMvHeadAttr
       read FHeadAttr write FHeadAttr;
     property LineColor: TColor
       read FLineColor write SetLineColor;
     property TimeFormat: TVpTimeFormat
       read FTimeFormat write SetTimeFormat;
+    property TodayAttributes: TVpMvTodayAttr
+      read FTodayAttr write FTodayAttr;
     property OffDayColor: TColor
       read FOffDayColor write SetOffDayColor;
     property OffDayFontColor: TColor
@@ -293,9 +316,9 @@ uses
 
 
 (*****************************************************************************)
-{ TVpMvHeadAttributes }
+{ TVpMvHeadAttr }
 
-constructor TVpMvHeadAttributes.Create(AOwner: TVpMonthView);
+constructor TVpMvHeadAttr.Create(AOwner: TVpMonthView);
 begin
   inherited Create;
   FOwner := AOwner;
@@ -303,13 +326,13 @@ begin
   FFont := TVpFont.Create(AOwner);
 end;
 
-destructor TVpMvHeadAttributes.Destroy;
+destructor TVpMvHeadAttr.Destroy;
 begin
   FFont.Free;
   inherited;
 end;
 
-procedure TVpMvHeadAttributes.SetColor(const Value: TColor);
+procedure TVpMvHeadAttr.SetColor(const Value: TColor);
 begin
   if FColor <> Value then begin
     FColor := Value;
@@ -317,7 +340,7 @@ begin
   end;
 end;
 
-procedure TVpMvHeadAttributes.SetFont(Value: TVpFont);
+procedure TVpMvHeadAttr.SetFont(Value: TVpFont);
 begin
   FFont.Assign(Value);
 end;
@@ -358,7 +381,54 @@ begin
     MonthView.Invalidate;
   end;
 end;
-{=====}
+
+
+(*****************************************************************************)
+{ TVpMvTodayAttr }
+
+constructor TVpMvTodayAttr.Create(AOwner: TVpMonthView);
+begin
+  inherited Create;
+  FMonthView := AOwner;
+  FFont := TVpFont.Create(AOwner);
+  FFont.Assign(FMonthView.Font);
+  FColor := clSilver;
+  FBorderPen := TPen.Create;
+  FBorderPen.Color := clRed;
+  FBorderPen.Width := 3;
+  FBorderPen.OnChange := FMonthView.mvPenChanged;
+end;
+
+destructor TVpMvTodayAttr.Destroy;
+begin
+  FBorderPen.Free;
+  inherited;
+end;
+
+procedure TVpMvTodayAttr.SetColor(Value: TColor);
+begin
+  if Value <> FColor then begin
+    FColor := Value;
+    MonthView.Invalidate;
+  end;
+end;
+
+procedure TVpMvTodayAttr.SetFont(Value: TVpFont);
+begin
+  if Value <> FFont then begin
+    FFont.Assign(Value);
+    MonthView.Invalidate;
+  end;
+end;
+
+procedure TVpMvTodayAttr.SetBorderPen(Value: TPen);
+begin
+  if Value <> FBorderPen then begin
+    FBorderPen.Assign(Value);
+    MonthView.Invalidate;
+  end;
+end;
+
 
 (*****************************************************************************)
 { TVpMonthView }
@@ -369,8 +439,9 @@ begin
   ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
 
   { Create internal classes and stuff }
-  FHeadAttr := TVpMvHeadAttributes.Create(self);
+  FHeadAttr := TVpMvHeadAttr.Create(self);
-  FDayHeadAttributes := TVpDayHeadAttr.Create(self);
+  FDayHeadAttr := TVpDayHeadAttr.Create(self);
+  FTodayAttr := TVpMvTodayAttr.Create(self);
   mvEventList := TList.Create;
   mvSpinButtons := TUpDown.Create(self);
 
@@ -406,7 +477,7 @@ begin
 //  FDayHeadAttributes.Font.Name := 'Tahoma';   wp: better use defaults
 //  FDayHeadAttributes.Font.Size := 10;
 //  FDayHeadAttributes.Font.Style := [];
-  FDayHeadAttributes.Color := clBtnFace;
+  FDayHeadAttr.Color := clBtnFace;
 
   { Assign default font to DayNumberFont and EventFont }
   FDayNumberFont := TVpFont.Create(AOwner);
@@ -434,7 +505,8 @@ end;
 
 destructor TVpMonthView.Destroy;
 begin
-  FDayHeadAttributes.Free;
+  FTodayAttr.Free;
+  FDayHeadAttr.Free;
   FDayNumberFont.Free;
   FEventFont.Free;
   mvSpinButtons.Free;
@@ -487,13 +559,11 @@ begin
       end;
     end;
 end;
-{=====}
+
-                                 {
+procedure TVpMonthView.mvPenChanged(Sender: TObject);
-procedure TVpMonthView.mvFontChanged(Sender: TObject);
 begin
   Invalidate;
-end;                              }
+end;
-{=====}
 
 procedure TVpMonthView.Loaded;
 begin

components/tvplanit/source/vpmonthviewpainter.pas

@@ -26,6 +26,8 @@ type
     RealOffDayColor: TColor;
     RealSelDayColor: TColor;
     EventFontColor: TColor;
+    TodayFontColor: TColor;
+    TodayAttrColor: TColor;
     DotDotDotColor: TColor;
 
   protected
@@ -33,6 +35,7 @@ type
     procedure DrawBorders;
     procedure DrawDayHead;
     procedure DrawDays;
+    procedure DrawFocusRect(ARect: TRect; FixRight: Boolean = false);
     procedure DrawHeader;
     procedure FixFontHeights;
     procedure InitColors;
@@ -243,12 +246,16 @@ var
   EventList: TList;
   Drawn: Boolean;
   TextAdjust: Integer;
+  TextH: Integer;
   FontStyle: TFontStyles;
   OldBrush: TBrush;
   OldPen: TPen;
   OldFont: TFont;
-  dx: Integer;
+  todayDate: TDate;
+  tmpRect: TRect;
 begin
+  todayDate := Date();
+
   { initialize the MonthDayArray }
   with TVpMonthViewOpener(FMonthView) do
     for I := 0 to Pred(Length(mvMonthDayArray)) do begin
@@ -291,142 +298,6 @@ begin
       try
         for Row := 0 to 5 do begin
           for Col := 0 to 6 do begin
-            if (Col = 6) then begin
-              { draws the far right day for this week }
-              ThisDate := trunc(StartingDate + DayNumber);
-              DecodeDate(ThisDate, Y, Tmp, D);
-
-              { Allow the user to draw the day }
-              Drawn  := false;
-              if Assigned(FMonthView.OwnerDrawCells) then begin
-                {  wp: Using Canvas here does not seem correct ...
-                OldBrush.Assign(Canvas.Brush);
-                OldPen.Assign(Canvas.Pen);
-                OldFont.Assign(Canvas.Font); }
-                OldBrush.Assign(RenderCanvas.Brush);
-                OldPen.Assign(RenderCanvas.Pen);
-                OldFont.Assign(RenderCanvas.Font);
-                try
-                  FMonthView.OwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn);
-                  if Drawn then continue;
-                finally
-                  { wp: Again, using Canvas here does not seem correct ...
-                  Canvas.Brush.Assign (OldBrush);
-                  Canvas.Pen.Assign (OldPen);
-                  Canvas.Font.Assign (OldFont); }
-                  RenderCanvas.Brush.Assign(OldBrush);
-                  RenderCanvas.Pen.Assign(OldPen);
-                  RenderCanvas.Font.Assign(OldFont);
-                end;
-              end;
-
-              TextRect.Right := TextRect.Right + 8;
-              if Tmp <> M then begin
-                RenderCanvas.Brush.Color := RealOffDayColor;
-                if TextRect.Bottom > RealBottom then
-                  TPSFillRect(
-                    RenderCanvas,
-                    Angle,
-                    RenderIn,
-                    Rect(TextRect.Left, TextRect.Top, RealRight, RealBottom)
-                  )
-                else
-                  TPSFillRect(
-                    RenderCanvas,
-                    Angle,
-                    RenderIn,
-                    Rect(TextRect.Left, TextRect.Top, RealRight, TextRect.Bottom)
-                  );
-              end else
-                RenderCanvas.Brush.Color := RealColor;
-
-              { draw bottom line }
-              TPSMoveTo(RenderCanvas, Angle, RenderIn, TextRect.Left, TextRect.Bottom);
-              TPSLineTo(RenderCanvas, Angle, RenderIn, RealRight - 2, TextRect.Bottom);
-
-              { Paint the day number }
-              Str := FormatDateTime('d', ThisDate);
-
-              { set the proper font and style }
-              RenderCanvas.Font.Assign(FMonthView.DayNumberFont);
-              fontstyle := Rendercanvas.Font.style;
-
-
-              if (DisplayDate = ThisDate) then begin
-                if FMonthView.Focused then begin
-                  TPSDrawFocusRect(
-                    RenderCanvas,
-                    Angle,
-                    RenderIn,
-                    Rect(TextRect.Left - 2, TextRect.Top - 2, TextRect.Right + 2, TextRect.Bottom + 2)
-                  );
-                  TPSDrawFocusRect(
-                    RenderCanvas,
-                    Angle,
-                    RenderIn,
-                    Rect(TextRect.Left + 2, TextRect.Top + 2, TextRect.Right - 2, TextRect.Bottom - 2)
-                  );
-                end;
-                RenderCanvas.Font.Color := RealSelDayColor;
-                RenderCanvas.Font.Style := FMonthView.DayNumberFont.Style + [fsBold];
-                if (FMonthView.EventDayStyle <> []) and (FMonthView.DataStore.Resource <> nil) and
-                   (FMonthView.DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 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.Resource <> nil) and
-                   (FMonthView.DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0)
-                then
-                  RenderCanvas.Font.Style := RenderCanvas.Font.Style + FMonthView.EventDayStyle
-                else begin
-                  RenderCanvas.Font.Color := EventFontColor;
-                  RenderCanvas.Font.Style := FMonthView.DayNumberFont.Style;
-                end;
-              end;
-
-              FontStyle := RenderCanvas.Font.Style;
-              RenderCanvas.Font.Style := [fsBold, fsItalic];
-              TextAdjust := RenderCanvas.TextWidth(Str);
-              RenderCanvas.Font.Style := FontStyle;
-              if Tmp <> M then
-                RenderCanvas.Font.Color := FMonthView.OffDayFontColor;
-
-              { write the day number at the top of the square. }
-              if fsItalic in RenderCanvas.Font.Style then
-                dx := -2
-              else
-                dx := 0;
-              TPSTextOut(
-                RenderCanvas,
-                Angle,
-                RenderIn,
-                TextRect.Left + TVpMonthViewOpener(FMonthView).mvColWidth - TextAdjust - TextMargin + dx,
-                TextRect.Top + TextMargin div 2,
-                Str
-              );
-
-              { Update MonthDayArray }
-              with TVpMonthViewOpener(FMonthView) do begin
-                mvMonthDayArray[I].Rec := TextRect;
-                mvMonthDayArray[I].Date := ThisDate;
-                mvMonthDayArray[I].OffDay := Tmp <> M;
-              end;
-              Inc(DayNumber);
-              Inc(I);
-
-              { drop rect down one row and all the way to the left }
-              TextRect.TopLeft := Point(
-                RealLeft + 1,
-                TextRect.Bottom + 1
-              );
-              TextRect.BottomRight := Point(
-                TextRect.Left + TVpMonthViewOpener(FMonthView).mvColWidth,
-                TextRect.Top + TVpMonthViewOpener(FMonthView).mvRowHeight
-              );
-            end  // if Col = 6 ...
-            else begin
-              { draws all days for the week, except the far right one }
             ThisDate := Trunc(StartingDate + DayNumber);
             DecodeDate(ThisDate, Y, Tmp, D);
 
@@ -454,41 +325,41 @@ begin
               end;
             end;
 
+            { draws the far right day for this week }
+            if (Col = 6) then begin
+              TextRect.Right := TextRect.Right + 8;
+              tmpRect := TextRect;
+              if TextRect.Bottom > RealBottom then
+                tmpRect.Bottom := RealBottom;
               if Tmp <> M then begin
                 RenderCanvas.Brush.Color := RealOffDayColor;
-                TPSFillRect(RenderCanvas, Angle, RenderIn, TextRect);
+                TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect);
+              end else
+              if ThisDate = todayDate then begin
+                RenderCanvas.Brush.Color := TodayAttrColor;
+                TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect);
               end else
                 RenderCanvas.Brush.Color := RealColor;
 
-              { draw right side and bottom lines }
+              { draw bottom line }
-              TPSMoveTo(RenderCanvas, Angle, RenderIn, TextRect.Right, TextRect.top);
+              TPSMoveTo(RenderCanvas, Angle, RenderIn, TextRect.Left, TextRect.Bottom);
-              if TextRect.Bottom > RealBottom then begin
+              TPSLineTo(RenderCanvas, Angle, RenderIn, RealRight - 2, TextRect.Bottom);
-                TPSLineTo(RenderCanvas, Angle, RenderIn, TextRect.Right, RealBottom);
-                TPSLineTo(RenderCanvas, Angle, RenderIn, TextRect.Left - 1, RealBottom);
-              end else begin
-                TPSLineTo(RenderCanvas, Angle, RenderIn, TextRect.Right, TextRect.Bottom);
-                TPSLineTo(RenderCanvas, Angle, RenderIn, TextRect.Left - 1, TextRect.Bottom);
-              end;
 
-              { paint the day number }
+              { Paint the day number }
               Str := FormatDateTime('d', ThisDate);
 
               { set the proper font and style }
+              if ThisDate = todayDate then
+                RenderCanvas.Font.Assign(FMonthView.TodayAttributes.Font)
+              else
                 RenderCanvas.Font.Assign(FMonthView.DayNumberFont);
+              fontstyle := Rendercanvas.Font.style;
+
               if (DisplayDate = ThisDate) then begin
                 if FMonthView.Focused then begin
-                  TPSDrawFocusRect(
+                  tmpRect := TextRect;
-                    RenderCanvas,
+                  dec(tmpRect.Right, 4);
-                    Angle,
+                  DrawFocusRect(tmpRect, true);
-                    RenderIn,
-                    Rect(TextRect.Left - 2, TextRect.Top - 2, TextRect.Right + 2, TextRect.Bottom + 2)
-                  );
-                  TPSDrawFocusRect(
-                    RenderCanvas,
-                    Angle,
-                    RenderIn,
-                    Rect(TextRect.Left + 2, TextRect.Top + 2, TextRect.Right - 2, TextRect.Bottom - 2)
-                  );
                 end;
                 RenderCanvas.Font.Color := RealSelDayColor;
                 RenderCanvas.Font.Style := FMonthView.DayNumberFont.Style + [fsBold];
@@ -510,23 +381,130 @@ begin
 
               FontStyle := RenderCanvas.Font.Style;
               RenderCanvas.Font.Style := [fsBold, fsItalic];
-              TextAdjust := RenderCanvas.TextWidth (Str);
+              TextAdjust := RenderCanvas.TextWidth(Str);
+              TextH := RenderCanvas.TextHeight(Str);
+              RenderCanvas.Font.Style := FontStyle;
+              if Tmp <> M then
+                RenderCanvas.Font.Color := FMonthView.OffDayFontColor;
+
+              { Write the day number at the top of the TextRect. }
+              tmpRect.Left := TextRect.Left + TVpMonthViewOpener(FMonthView).mvColWidth - TextAdjust - TextMargin;
+              if fsItalic in RenderCanvas.Font.Style then
+                dec(tmpRect.Left, 2);
+              tmpRect.Top := TextRect.Top + TextMargin div 2;
+              tmpRect.Right := tmpRect.Left + TextAdjust;
+              tmpRect.Bottom := tmpRect.Top + RenderCanvas.TextHeight(Str);
+              TPSTextOut(RenderCanvas, Angle, RenderIn, tmpRect.Left, tmpRect.Top, Str);
+
+              { Highlight today by a border }
+              if ThisDate = todayDate then begin
+                InflateRect(tmpRect, 3, 3);
+                RenderCanvas.Pen.Assign(FMonthView.TodayAttributes.BorderPen);
+                RenderCanvas.Brush.Style := bsClear;
+                RenderCanvas.Rectangle(tmpRect);
+                RenderCanvas.Pen.Assign(OldPen);
+                RenderCanvas.Brush.Assign(OldBrush);
+              end;
+
+              { Update MonthDayArray }
+              with TVpMonthViewOpener(FMonthView) do begin
+                mvMonthDayArray[I].Rec := TextRect;
+                mvMonthDayArray[I].Date := ThisDate;
+                mvMonthDayArray[I].OffDay := Tmp <> M;
+              end;
+              Inc(DayNumber);
+              Inc(I);
+
+              { drop rect down one row and all the way to the left }
+              TextRect.TopLeft := Point(
+                RealLeft + 1,
+                TextRect.Bottom + 1
+              );
+              TextRect.BottomRight := Point(
+                TextRect.Left + TVpMonthViewOpener(FMonthView).mvColWidth,
+                TextRect.Top + TVpMonthViewOpener(FMonthView).mvRowHeight
+              );
+            end  // if Col = 6 ...
+            else
+            { draws all days for the week, except the far right one }
+            begin
+              if Tmp <> M then begin
+                RenderCanvas.Brush.Color := RealOffDayColor;
+                TPSFillRect(RenderCanvas, Angle, RenderIn, TextRect);
+              end else
+              if ThisDate = todayDate then begin
+                RenderCanvas.Brush.Color := TodayAttrColor;
+                TPSFillRect(RenderCanvas, Angle, RenderIn, TextRect);
+              end else
+                RenderCanvas.Brush.Color := RealColor;
+
+              { draw right side and bottom lines }
+              TPSMoveTo(RenderCanvas, Angle, RenderIn, TextRect.Right, TextRect.top);
+              if TextRect.Bottom > RealBottom then begin
+                TPSLineTo(RenderCanvas, Angle, RenderIn, TextRect.Right, RealBottom);
+                TPSLineTo(RenderCanvas, Angle, RenderIn, TextRect.Left - 1, RealBottom);
+              end else begin
+                TPSLineTo(RenderCanvas, Angle, RenderIn, TextRect.Right, TextRect.Bottom);
+                TPSLineTo(RenderCanvas, Angle, RenderIn, TextRect.Left - 1, TextRect.Bottom);
+              end;
+
+              { paint the day number }
+              Str := FormatDateTime('d', ThisDate);
+
+              { set the proper font and style }
+              if ThisDate = todayDate then
+                RenderCanvas.Font.Assign(FMonthView.TodayAttributes.Font)
+              else
+                RenderCanvas.Font.Assign(FMonthView.DayNumberFont);
+              fontstyle := Rendercanvas.Font.style;
+
+              if (DisplayDate = ThisDate) then begin
+                if FMonthView.Focused then
+                  DrawFocusRect(TextRect);
+                RenderCanvas.Font.Color := RealSelDayColor;
+                RenderCanvas.Font.Style := FMonthView.DayNumberFont.Style + [fsBold];
+                if (FMonthView.EventDayStyle <> []) and (FMonthView.DataStore.Resource <> nil) and
+                   (FMonthView.DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 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.Resource <> nil) and
+                   (FMonthView.DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0)
+                then
+                  RenderCanvas.Font.Style := RenderCanvas.Font.Style + FMonthView.EventDayStyle
+                else begin
+                  RenderCanvas.Font.Color := EventFontColor;
+                  RenderCanvas.Font.Style := FMonthView.DayNumberFont.Style;
+                end;
+              end;
+
+              FontStyle := RenderCanvas.Font.Style;
+              RenderCanvas.Font.Style := [fsBold, fsItalic];
+              TextAdjust := RenderCanvas.TextWidth(Str);
+              TextH := RenderCanvas.TextHeight(Str);
               RenderCanvas.Font.Style := FontStyle;
               if Tmp <> M then
                 RenderCanvas.Font.Color := FMonthView.OffdayFontColor;
 
+              { Write the day number at the top of the TextRect. }
+              tmpRect.Left := TextRect.Right - TextAdjust - TextMargin;
               if fsItalic in RenderCanvas.Font.Style then
-                dx := -2
+                dec(tmpRect.Left, 2);
-              else
+              tmpRect.Top := TextRect.Top + TextMargin div 2;
-                dx := 0;
+              tmpRect.Right := tmpRect.Left + TextAdjust;
-              TPSTextOut(
+              tmpRect.Bottom := tmpRect.Top + TextH;
-                RenderCanvas,
+              TPSTextOut(RenderCanvas, Angle, RenderIn, tmpRect.Left, tmpRect.Top, Str);
-                Angle,
+
-                RenderIn,
+              { Highlight today by a border }
-                TextRect.Right - TextAdjust - TextMargin + dx,
+              if ThisDate = todayDate then begin
-                TextRect.Top + TextMargin div 2,
+                InflateRect(tmpRect, 3, 3);
-                Str
+                RenderCanvas.Pen.Assign(FMonthView.TodayAttributes.BorderPen);
-              );
+                RenderCanvas.Brush.Style := bsClear;
+                RenderCanvas.Rectangle(tmpRect);
+                RenderCanvas.Pen.Assign(OldPen);
+                RenderCanvas.Brush.Assign(OldBrush);
+              end;
 
               { Update Array }
               with TVpMonthViewOpener(FMonthView) do begin
@@ -700,6 +678,21 @@ begin
   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);
+  if FixRight then
+    inc(tmpRect.Right);
+  TPSDrawFocusRect(RenderCanvas, Angle, RenderIn, tmpRect);
+end;
+
 procedure TVpMonthViewPainter.DrawHeader;
 var
   HeadRect: TRect;
@@ -807,6 +800,8 @@ begin
     RealOffDayColor := clSilver;
     RealSelDayColor := clWhite;
     EventFontColor := clBlack;
+    TodayFontColor := clBlack;
+    TodayAttrColor := clWhite;
   end else begin
     BevelHighlight := clBtnHighlight;
     BevelShadow := clBtnShadow;
@@ -819,6 +814,8 @@ begin
     RealOffDayColor := FMonthView.OffDayColor;
     RealSelDayColor := FMonthView.SelectedDayColor;
     EventFontColor := FMonthView.DayNumberFont.Color;
+    TodayFontColor := FMonthView.TodayAttributes.Font.Color;
+    TodayAttrColor := FMonthView.TodayAttributes.Color;
   end;
   DotDotDotColor := clBlack;
 end;