TvPlanIt: Add event OnPrepareEventFont to TVpDayView, TVpWeekView and TVpMonthView. (https://forum.lazarus.freepascal.org/index.php/topic,61758.0.html).

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

components/tvplanit/source/vpbaseds.pas

@@ -83,6 +83,9 @@ type
   TVpDateChangedEvent = procedure (Sender: TObject;
     Date: TDateTime) of object;
 
+  TVpPrepareEventFontEvent = procedure (Sender: TObject;
+    AEvent: TVpEvent; AFont: TFont) of object;
+
   { contact events }
   TVpContactEvent = procedure(Sender: TObject; Contact: TVpContact) of object;
 

components/tvplanit/source/vpdayview.pas

@@ -284,6 +284,7 @@ type
     FOnDrawIcons: TVpOnDVDrawIcons;
     FOnHoliday: TVpHolidayEvent;
     FOnModifyEvent: TVpOnModifyEvent;
+    FOnPrepareEventFont: TVpPrepareEventFontEvent;
     FOwnerDrawCells: TVpOwnerDrawRowEvent;
     FOwnerDrawColHead: TVpOwnerDrawEvent;
     FOwnerDrawRowHead: TVpOwnerDrawRowEvent;
@@ -534,6 +535,7 @@ type
     property OnHoliday: TVpHolidayEvent read FOnHoliday write FOnHoliday; deprecated 'Use TControlLink.OnHoliday instead';
     property OnModifyEvent: TVpOnModifyEvent read FOnModifyEvent write FOnModifyEvent;
     property OnOwnerEditEvent: TVpEditEvent read FOwnerEditEvent write FOwnerEditEvent;
+    property OnPrepareEventFont: TVpPrepareEventFontEvent read FOnPrepareEventFont write FOnPrepareEventFont;
     property OnClick;
   end;
 

components/tvplanit/source/vpdayviewpainter.pas

@@ -883,6 +883,9 @@ begin
       RenderCanvas, GutterRect, tmpRect, IconRect);
   end;
 
+  if Assigned(FDayView.OnPrepareEventFont) then
+    FDayView.OnPrepareEventFont(FDayView, AEvent, RenderCanvas.Font);
+
   if FDayView.IconAttributes.ShowInPrint then
     DrawIcons(IconRect);
 

components/tvplanit/source/vpmonthview.pas

@@ -162,6 +162,7 @@ type
     FOnModifyEvent: TVpOnModifyEvent;
     FOwnerDrawCells: TVpOwnerDrawDayEvent;
     FOwnerEditEvent: TVpEditEvent;
+    FOnPrepareEventFont: TVpPrepareEventFontEvent;
 
     { property methods }
     function IsStoredDateLabelFormat: Boolean;
@@ -343,6 +344,7 @@ type
     property OnHoliday: TVpHolidayEvent read FOnHoliday write FOnHoliday; deprecated 'Use TControlLink.OnHoliday instead';
     property OnModifyEvent: TVpOnModifyEvent read FOnModifyEvent write FOnModifyEvent;
     property OnOwnerEditEvent: TVpEditEvent read FOwnerEditEvent write FOwnerEditEvent;
+    property OnPrepareEventFont: TVpPrepareEventFontEvent read FOnPrepareEventFont write FOnPrepareEventFont;
   end;
 
 

components/tvplanit/source/vpmonthviewpainter.pas

@@ -566,6 +566,8 @@ begin
             {$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

components/tvplanit/source/vpweekview.pas

@@ -186,6 +186,7 @@ type
     FOnHoliday: TVpHolidayEvent;
     FOnModifyEvent: TVpOnModifyEvent;
     FOwnerEditEvent: TVpEditEvent;
+    FOnPrepareEventFont: TVpPrepareEventFontEvent;
 
     // Property getter and setter methods
     function IsStoredDateLabelFormat: Boolean;
@@ -377,6 +378,7 @@ type
     property OnHoliday: TVpHolidayEvent read FOnHoliday write FOnHoliday; deprecated 'Use TControlLink.OnHoliday instead';
     property OnModifyEvent: TVpOnModifyEvent read FOnModifyEvent write FOnModifyEvent;
     property OnOwnerEditEvent: TVpEditEvent read FOwnerEditEvent write FOwnerEditEvent;
+    property OnPrepareEventFont: TVpPrepareEventFontEvent read FOnPrepareEventFont write FOnPrepareEventFont;
   end;
 
 

components/tvplanit/source/vpweekviewpainter.pas

@@ -32,6 +32,7 @@ type
     ADBackgroundColor: TColor;
     ADEventBackgroundColor: TColor;
     ADEventBorderColor: TColor;
+    FSavedFont: TFont;
 
   protected
     procedure Clear;
@@ -465,45 +466,50 @@ var
   I: 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;
+  FSavedFont := TFont.Create;
+  try
+    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;
 
-    // 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;
+    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);
+  finally
+    FSavedFont.Free;
   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;
@@ -514,11 +520,11 @@ var
   todayEndTime: TDateTime;
   txtMargin: Integer;
   strLen: Integer;
-  oldFontColor: TColor;
   eventCat: TVpCategoryInfo;
   R: TRect;
 begin
-  oldFontColor := RenderCanvas.Font.Color;
+  FSavedFont.Assign(RenderCanvas.Font);
+
   txtmargin := FWeekView.TextMargin;
 
   { format the display text }
@@ -540,6 +546,8 @@ begin
   {$ENDIF}
   if AEvent.IsOverlayed then
     RenderCanvas.Font.Color := clGray;
+  if Assigned(FWeekView.OnPrepareEventFont) then
+    FWeekView.OnPrepareEventFont(FWeekView, AEvent, RenderCanvas.Font);
 
   // Draw event background
   RenderCanvas.Brush.Color := RealColor;
@@ -574,7 +582,7 @@ begin
     dayStr
   );
 
-  RenderCanvas.Font.Color := oldFontColor;
+  RenderCanvas.Font.Assign(FSavedFont);
 end;
 
 procedure TVpWeekViewPainter.DrawHeader;