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

tvplanit/TVpGanttView: Highlight weekends.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8427 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-08-29 22:00:20 +00:00
parent 3de78ed971
commit 9af978b9fb
3 changed files with 71 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -102,7 +102,7 @@ const
strFALSE = 'false';
WEEKDAY_COLOR = $FFFFFF;
WEEKEND_COLOR = $C0C0C0;
WEEKEND_COLOR = $D0D0D0;
HOLIDAY_COLOR = $8080FF;
TODAY_COLOR = $FFC0C0;
OFF_COLOR = $E0E0E0;

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

@ -102,6 +102,7 @@ type
FColor: TColor;
FLineColor: TColor;
FWeekendColor: TColor;
FColHeaderAttributes: TVpGanttColHeaderAttributes;
FRowHeaderAttributes: TVpGanttRowHeaderAttributes;
@ -141,6 +142,7 @@ type
procedure SetShowActiveDate(AValue: Boolean);
procedure SetTextMargin(AValue: Integer);
procedure SetTopRow(AValue: Integer);
procedure SetWeekendColor(AValue: TColor);
protected
// Needed by the painter
@ -258,6 +260,7 @@ type
property RowHeaderAttributes: TVpGanttRowHeaderAttributes read FRowHeaderAttributes write FRowHeaderAttributes;
property ShowActiveDate: Boolean read FShowActiveDate write SetShowActiveDate default true;
property TextMargin: Integer read FTextMargin write SetTextMargin default 2;
property WeekendColor: TColor read FWeekendColor write SetWeekendColor default WEEKEND_COLOR;
// inherited events
property OnClick;
// new events
@ -397,6 +400,7 @@ begin
FColor := DEFAULT_COLOR;
FLineColor := DEFAULT_LINECOLOR;
FWeekendColor := WEEKEND_COLOR;
FRowHeaderAttributes := TVpGanttRowHeaderAttributes.Create(self);
FColHeaderAttributes := TVpGanttColHeaderAttributes.Create(self);
@ -1423,6 +1427,15 @@ begin
SetScrollInfo(Handle, SB_VERT, scrollInfo, True);
end;
procedure TVpGanttView.SetWeekendColor(AValue: TColor);
begin
if FWeekendColor <> AValue then
begin
FWeekendColor := AValue;
Invalidate;
end;
end;
procedure TVpGanttView.SpawnEventEditDialog(IsNewEvent: Boolean);
var
AllowIt: Boolean;

58
components/tvplanit/source/vpganttviewpainter.pas
View File

@ -31,6 +31,7 @@ type
procedure DrawActiveDate;
procedure DrawBorders;
procedure DrawColHeader;
procedure DrawDays;
procedure DrawEvents;
procedure DrawGrid;
procedure DrawRowHeader;
@ -282,6 +283,56 @@ begin
end;
end;
procedure TVpGanttViewPainter.DrawDays;
var
i, j1, j2, nDays, nEvents: Integer;
x1, y1, x2, y2: Integer;
dx, dy: Integer;
begin
with FGanttView do
begin
if StartDate = NO_DATE then
exit;
nEvents := NumEvents;
nDays := NumDays;
dx := LeftCol * ColWidth;
dy := TopRow * RowHeight;
y1 := TotalColHeaderHeight;
y2 := EventRecords[nEvents-1].HeadRect.Bottom - dy;
for i := 0 to nDays-1 do
if IsWeekend(DayRecords[i].Date) then
begin
j1 := i;
break;
end;
end;
if y2 > RealBottom then
y2 := RealBottom;
RenderCanvas.Brush.Color := FGanttView.WeekendColor;
RenderCanvas.Brush.Style := bsSolid;
while j1 < nDays do
begin
if j1 < nDays-1 then
j2 := j1 + 1
else
j2 := j1;
x2 := FGanttView.DayRecords[j2].Rect.Right - dx;
if x2 >= FGanttView.FixedColWidth then
begin
x1 := FGanttView.DayRecords[j1].Rect.Left - dx;
if x1 < FGanttView.FixedColWidth then
x1 := FGanttView.FixedColWidth;
RenderCanvas.FillRect(x1, y1, x2, y2);
end;
inc(j1, 7);
end;
end;
procedure TVpGanttViewPainter.DrawEvents;
var
i: Integer;
@ -315,8 +366,10 @@ begin
dec(R.Bottom, bottom_margin);
if R.Top < FGanttView.TotalColHeaderHeight then
Continue;
if R.Left < FGanttView.FixedColWidth then
if R.Right < FGanttView.FixedColWidth then
Continue;
if R.Left < FGanttView.FixedColWidth then
R.Left := FGanttView.FixedColWidth;
cat := FGanttView.DataStore.CategoryColorMap.GetCategory(event.Category);
RenderCanvas.Pen.Color := cat.Color;
RenderCanvas.Brush.Color := cat.BackgroundColor;
@ -508,6 +561,9 @@ begin
DrawRowHeader;
DrawColHeader;
{ Draw weekends }
DrawDays;
{ Draw grid }
DrawGrid;