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

tvplanit: Display gutter in TVpWeekView if ApplyCategoryInfos is true.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8371 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-08-06 09:51:54 +00:00
parent 080f303cd1
commit db859044f4
1 changed files with 13 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -525,6 +525,8 @@ end;
procedure TVpWeekViewPainter.DrawEvent(AEvent: TVpEvent; TextRect: TRect;
ADayIndex: Integer);
const
GUTTER_WIDTH = 6;
var
dayStr: String;
todayStartTime: TDateTime;
@ -532,6 +534,7 @@ var
strLen: Integer;
oldFontColor: TColor;
eventCat: TVpCategoryInfo;
R: TRect;
begin
oldFontColor := RenderCanvas.Font.Color;
@ -562,13 +565,22 @@ begin
begin
RenderCanvas.Brush.Color := eventCat.BackgroundColor;
TPSFillRect(RenderCanvas, Angle, RenderIn, TextRect);
R := TextRect;
{$IF VP_LCL_SCALING > 0}
R.Right := R.Left + FWeekView.Scale96ToFont(GUTTER_WIDTH);
{$ELSE}
R.Right := R.Left + ScaleX(GUTTER_WIDTH, DesignTimeDPI);
{$IFEND}
TextRect.Left := R.Right;
RenderCanvas.Brush.Color := eventCat.Color;
TPSFillRect(RenderCanvas, Angle, RenderIn, R);
end;
end;
{ Build the event text }
dayStr := FWeekView.BuildEventString(AEvent, todayStartTime, todayEndTime, false);
strLen := RenderCanvas.TextWidth(dayStr);
if (strLen > WidthOf(TextRect) - TextMargin) then // wp: shouldn't this be 2*TextMargin ?
if (strLen > WidthOf(TextRect) - 2*TextMargin) then
dayStr := GetDisplayString(RenderCanvas, dayStr, 0, WidthOf(TextRect) - TextMargin * 2);
{ Write the event text }