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

tvplanit: Allow to draw all-day events in the category color (CategoryInfo.UseForAllDayEvents).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8394 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-08-16 19:58:12 +00:00
parent 6e9dd5576c
commit 0afcfc7a66
3 changed files with 29 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/tvplanit/source/vpbase.pas
View File

@ -243,6 +243,7 @@ type
FImageIndex: TImageIndex;
FIndex: Integer;
FBitmap: TBitmap;
FAllDayEvents: Boolean;
procedure SetBackgroundColor(const v: TColor);
procedure SetBitmap(v: TBitmap);
procedure SetColor(Value: TColor);
@ -260,6 +261,7 @@ type
property Description: string read FDescription write SetDescription;
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
property CategoryIndex: Integer read FCategoryIndex;
property UseForAllDayEvents: Boolean read FAllDayEvents write FAllDayEvents default false;
end;
TVpCategoryColorMap = class(TPersistent)

13
components/tvplanit/source/vpdayviewpainter.pas
View File

@ -308,6 +308,7 @@ var
AllDayWidth: Integer;
OldTop: LongInt;
txtDist: Integer;
cat: TVpCategoryInfo;
begin
// Initialize the rectangle to be used for all-day events
ADEventsRect := InitAllDayEventsRect;
@ -397,8 +398,16 @@ begin
AdEvRect.Left := AdEventsRect.Left + DayWidth * I + txtDist;
AdEvRect.Right := AdEventsRect.Left + DayWidth * (I + 1) - txtDist;
RenderCanvas.Brush.Color := ADEventAttrBkgColor;
RenderCanvas.Pen.Color := ADEventBorderColor;
cat := FDayView.Datastore.CategoryColorMap.GetCategory(Event.Category);
if cat.UseForAllDayEvents then
begin
RenderCanvas.Brush.Color := cat.BackgroundColor;
RenderCanvas.Pen.Color := cat.Color;
end else
begin
RenderCanvas.Brush.Color := ADEventAttrBkgColor;
RenderCanvas.Pen.Color := ADEventBorderColor;
end;
TPSRectangle(RenderCanvas, Angle, RenderIn,
ADEvRect.Left + txtDist,
ADEvRect.Top + txtDist,

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

@ -94,6 +94,9 @@ var
ADTextHeight: Integer;
EventStr: string;
txtDist: Integer;
cat: TVpCategoryInfo;
savedBrushColor: TColor;
savedPenColor: TColor;
begin
Result := False;
@ -107,6 +110,8 @@ begin
{ number of all day events for the range of days covered by the control. }
NumADEvents := 0;
savedPenColor := RenderCanvas.Pen.Color;
savedBrushColor := RenderCanvas.Brush.Color;
ADEventsList := TList.Create;
try
TempList := TList.Create;
@ -168,16 +173,6 @@ begin
if ADEventsRect.Top + ((I + 1) * ADTextHeight) > DayRect.Bottom then
begin
DrawDotDotDot(DayRect, DotDotDotColor);
{
RenderCanvas.Brush.Color := DotDotDotColor;
TPSFillRect(RenderCanvas, Angle, RenderIn,
Rect(DayRect.Right - 20, DayRect.Bottom - 7, DayRect.Right - 17, DayRect.Bottom - 4));
TPSFillRect(RenderCanvas, Angle, RenderIn,
Rect(DayRect.Right - 13, DayRect.Bottom - 7, DayRect.Right - 10, DayRect.Bottom - 4));
TPSFillRect(RenderCanvas, Angle, RenderIn,
Rect(DayRect.Right - 6, DayRect.Bottom - 7, DayRect.Right - 3, DayRect.Bottom - 4));
}
break;
end;
@ -194,6 +189,15 @@ begin
// Paint the background of the event rect
RenderCanvas.Brush.Color := ADEventBackgroundColor;
RenderCanvas.Pen.Color := ADEventBorderColor;
if FWeekView.ApplyCategoryInfos then
begin
cat := FWeekView.Datastore.CategoryColorMap.GetCategory(Event.Category);
if cat.UseForAllDayEvents then
begin
RenderCanvas.Brush.Color := cat.BackgroundColor;
RenderCanvas.Pen.Color := cat.Color;
end;
end;
TPSRectangle(RenderCanvas, Angle, RenderIn,
ADEvRect.Left + TextMargin,
ADEvRect.Top + txtDist,
@ -222,10 +226,11 @@ begin
TVpWeekViewOpener(FWeekView).wvEventArray[EAIndex].Event := Event;
Inc(EAIndex);
end; { for I := 0 to pred(ADEventsList.Count) do ... }
end; { if NumADEvents > 0 }
finally
RenderCanvas.Brush.Color := savedBrushColor;
RenderCanvas.Pen.Color := savedPenColor;
ADEventsList.Free;
end;
end;