From 77c9810c0a7caeb2a5962620ec416d3893b80214 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 31 Dec 2022 12:55:15 +0000 Subject: [PATCH] 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 | 3 + components/tvplanit/source/vpdayview.pas | 2 + .../tvplanit/source/vpdayviewpainter.pas | 3 + components/tvplanit/source/vpmonthview.pas | 2 + .../tvplanit/source/vpmonthviewpainter.pas | 2 + components/tvplanit/source/vpweekview.pas | 2 + .../tvplanit/source/vpweekviewpainter.pas | 86 ++++++++++--------- 7 files changed, 61 insertions(+), 39 deletions(-) diff --git a/components/tvplanit/source/vpbaseds.pas b/components/tvplanit/source/vpbaseds.pas index 7b6762c79..d774c2933 100644 --- a/components/tvplanit/source/vpbaseds.pas +++ b/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; diff --git a/components/tvplanit/source/vpdayview.pas b/components/tvplanit/source/vpdayview.pas index a64cceb42..cea9e3b3b 100644 --- a/components/tvplanit/source/vpdayview.pas +++ b/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; diff --git a/components/tvplanit/source/vpdayviewpainter.pas b/components/tvplanit/source/vpdayviewpainter.pas index 84a01d1ef..ca71f371f 100644 --- a/components/tvplanit/source/vpdayviewpainter.pas +++ b/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); diff --git a/components/tvplanit/source/vpmonthview.pas b/components/tvplanit/source/vpmonthview.pas index fa8d8ac42..c5dde7571 100644 --- a/components/tvplanit/source/vpmonthview.pas +++ b/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; diff --git a/components/tvplanit/source/vpmonthviewpainter.pas b/components/tvplanit/source/vpmonthviewpainter.pas index 103c62d4f..3cb0bd1ae 100644 --- a/components/tvplanit/source/vpmonthviewpainter.pas +++ b/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 diff --git a/components/tvplanit/source/vpweekview.pas b/components/tvplanit/source/vpweekview.pas index f392d6d56..dc303d29c 100644 --- a/components/tvplanit/source/vpweekview.pas +++ b/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; diff --git a/components/tvplanit/source/vpweekviewpainter.pas b/components/tvplanit/source/vpweekviewpainter.pas index 5801e1409..80fa1bae7 100644 --- a/components/tvplanit/source/vpweekviewpainter.pas +++ b/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;