pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8667 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-12-31 12:55:15 +00:00
parent fcdd876a2b
commit 77c9810c0a
7 changed files with 61 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

86
components/tvplanit/source/vpweekviewpainter.pas
View File

@ -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;