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; procedure TVpWeekViewPainter.DrawEvent(AEvent: TVpEvent; TextRect: TRect;
ADayIndex: Integer); ADayIndex: Integer);
const
GUTTER_WIDTH = 6;
var var
dayStr: String; dayStr: String;
todayStartTime: TDateTime; todayStartTime: TDateTime;
@ -532,6 +534,7 @@ var
strLen: Integer; strLen: Integer;
oldFontColor: TColor; oldFontColor: TColor;
eventCat: TVpCategoryInfo; eventCat: TVpCategoryInfo;
R: TRect;
begin begin
oldFontColor := RenderCanvas.Font.Color; oldFontColor := RenderCanvas.Font.Color;
@ -562,13 +565,22 @@ begin
begin begin
RenderCanvas.Brush.Color := eventCat.BackgroundColor; RenderCanvas.Brush.Color := eventCat.BackgroundColor;
TPSFillRect(RenderCanvas, Angle, RenderIn, TextRect); 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;
end; end;
{ Build the event text } { Build the event text }
dayStr := FWeekView.BuildEventString(AEvent, todayStartTime, todayEndTime, false); dayStr := FWeekView.BuildEventString(AEvent, todayStartTime, todayEndTime, false);
strLen := RenderCanvas.TextWidth(dayStr); 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); dayStr := GetDisplayString(RenderCanvas, dayStr, 0, WidthOf(TextRect) - TextMargin * 2);
{ Write the event text } { Write the event text }