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

tvplanit: Add SpecialDayMode for TVpGanttView.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8435 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-09-01 09:42:04 +00:00
parent 1c707883ce
commit 2c6c88fa8b
4 changed files with 137 additions and 124 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -31,11 +31,11 @@ type
procedure DrawActiveDate;
procedure DrawBorders;
procedure DrawColHeader;
procedure DrawDays;
procedure DrawEvents;
procedure DrawGrid;
procedure DrawRowHeader;
procedure FixFontHeights;
procedure DrawSpecialDays;
procedure InitColors;
procedure SetMeasurements; override;
@ -256,6 +256,29 @@ begin
if R.Left < FGanttView.FixedColWidth then
Continue;
// In sdmHeader SpecialDayMode we must repaint the background of the
// day cells in the color of the special day (weekend/holiday)
if (FGanttView.SpecialDayMode = sdmHeader) then
begin
R1 := R;
if FGanttView.DrawingStyle = ds3D then
begin
inc(R1.Left, 2);
dec(R1.Bottom);
end else
inc(R1.Left);
if (gvoWeekends in FGanttView.Options) and IsWeekend(dayRec.Date) then
begin;
RenderCanvas.Brush.Color := FGanttView.Weekendcolor;
TPSFillRect(RenderCanvas, Angle, RenderIn, R1);
end else
if (gvoHolidays in FGanttView.Options) and FGanttView.IsHoliday(dayRec.Date, str) then
begin
RenderCanvas.Brush.Color := FGanttView.HolidayColor;
TPSFillRect(RenderCanvas, Angle, RenderIn, R1);
end;
end;
// No dividing line at last day of month because it already has been
// drawn as the month divider.
if (DayOf(dayRec.Date) <> DaysInMonth(dayRec.Date)) then
@ -289,85 +312,6 @@ begin
end;
end;
procedure TVpGanttViewPainter.DrawDays;
var
i, j1, j2, nDays, nEvents: Integer;
x1, y1, x2, y2: Integer;
dx, dy: Integer;
clr: TColor;
dayRec: TVpGanttDayRec;
holiday: String;
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;
RenderCanvas.Brush.style := bsSolid;
for i := 0 to nDays-1 do
begin
dayRec := DayRecords[i];
clr := clNone;
if (gvoWeekends in Options) and IsWeekend(dayRec.Date) then
clr := WeekendColor
else
if (gvoHolidays in Options) and IsHoliday(dayRec.Date, holiday) then
clr := HolidayColor;
if clr <> clNone then
begin
RenderCanvas.Brush.Color := clr;
x1 := dayRec.Rect.Left - dx;
x2 := dayRec.Rect.Right - dx;
RenderCanvas.FillRect(x1, y1, x2, y2);
end;
end;
end;
(*
begin
j1 := i;
break;
end;
end;
if y2 > RealBottom then
y2 := RealBottom;
if (gvoWeekends in FGanttView.Options) then
begin
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;
*)
end;
procedure TVpGanttViewPainter.DrawEvents;
var
i: Integer;
@ -540,6 +484,49 @@ begin
end;
end;
procedure TVpGanttViewPainter.DrawSpecialDays;
var
i, nDays, nEvents: Integer;
x1, y1, x2, y2: Integer;
dx, dy: Integer;
clr: TColor;
dayRec: TVpGanttDayRec;
holiday: String;
begin
with FGanttView do
begin
if (StartDate = NO_DATE) or (SpecialDayMode <> sdmColumn) then
exit;
nEvents := NumEvents;
nDays := NumDays;
dx := LeftCol * ColWidth;
dy := TopRow * RowHeight;
y1 := TotalColHeaderHeight;
y2 := EventRecords[nEvents-1].HeadRect.Bottom - dy;
RenderCanvas.Brush.style := bsSolid;
for i := 0 to nDays-1 do
begin
dayRec := DayRecords[i];
clr := clNone;
if (gvoWeekends in Options) and IsWeekend(dayRec.Date) then
clr := WeekendColor
else
if (gvoHolidays in Options) and IsHoliday(dayRec.Date, holiday) then
clr := HolidayColor;
if clr <> clNone then
begin
RenderCanvas.Brush.Color := clr;
x1 := dayRec.Rect.Left - dx;
x2 := dayRec.Rect.Right - dx;
RenderCanvas.FillRect(x1, y1, x2, y2);
end;
end;
end;
end;
procedure TVpGanttViewPainter.FixFontHeights;
begin
with FGanttView do begin
@ -603,8 +590,8 @@ begin
DrawRowHeader;
DrawColHeader;
{ Draw weekends }
DrawDays;
{ Draw weekends and holidays }
DrawSpecialDays;
{ Draw grid }
DrawGrid;