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

TvPlanIt: Extend GanttView by hour resolution

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8937 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-10-08 22:41:21 +00:00
parent d826f29a29
commit a41f9dbdcb
5 changed files with 561 additions and 152 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -13,6 +13,7 @@ type
private
FGanttView: TVpGanttView;
FHourFont: TFont;
FDayFont: TFont;
FMonthFont: TFont;
FWeekFont: TFont;
@ -43,6 +44,7 @@ type
procedure DrawDayColHeaders;
procedure DrawEvents;
procedure DrawGrid;
procedure DrawHourColHeaders;
procedure DrawMonthColHeaders;
procedure DrawRowHeader;
procedure DrawSpecialDays;
@ -87,6 +89,7 @@ var
dx, dy: Integer;
bs: TBrushStyle;
pw: Integer;
c: Integer;
begin
with FGanttView do
begin
@ -95,7 +98,10 @@ begin
if (ActiveCol < 0) or (ActiveCol >= ColCount) then
exit;
dayRec := DayRecords[ActiveCol];
c := ActiveCol;
if HourMode then
c := c div HoursPerDay;
dayRec := DayRecords[c];
eventRec := EventRecords[ActiveRow];
dx := LeftCol * FScaledColWidth;
@ -184,6 +190,9 @@ begin
// Draw the day column headers
DrawDayColHeaders;
// Draw the hour column headers
DrawHourColHeaders;
end;
procedure TVpGanttViewPainter.DrawDayColHeaders;
@ -191,8 +200,9 @@ var
dayRec: TVpGanttDayRec;
dx: Integer;
strH, strLen: Integer;
str: String;
fmt, str: String;
i, n: Integer;
yLineBottom: Integer;
R, R1: TRect;
P: TPoint;
begin
@ -239,6 +249,10 @@ begin
// No dividing line at last day of month because it already has been
// drawn as the month divider.
if FGanttView.HourMode then
yLineBottom := FScaledTotalColHeaderHeight
else
yLineBottom := R.Bottom;
if (DayOf(dayRec.Date) <> DaysInMonth(dayRec.Date)) or
([gchWeek, gchDay] * FGanttView.ColHeaderAttributes.Visible = [gchWeek, gchDay]) then
begin
@ -246,19 +260,23 @@ begin
DrawBevelLine(
RenderCanvas,
TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Top)),
TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Bottom)),
TPSRotatePoint(Angle, RenderIn, Point(R.Right, yLineBottom)),
BevelShadow,
BevelHighlight
)
else
begin
TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top);
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom);
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, yLineBottom);
end;
end;
// Paint day name
str := FormatDateTime(FGanttView.DayFormat, dayRec.Date);
if FGanttView.HourMode then
fmt := FGanttView.Dayformat_HourMode
else
fmt := FGanttView.DayFormat;
str := FormatDateTime(fmt, dayRec.Date);
strLen := RenderCanvas.TextWidth(str);
P := Point((R.Left + R.Right - strLen) div 2, (R.Top + R.Bottom - strH) div 2);
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
@ -321,6 +339,7 @@ begin
RenderCanvas.Pen.Color := cat.Color;
RenderCanvas.Pen.Width := round(Scale);
RenderCanvas.Brush.Color := cat.BackgroundColor;
//RenderCanvas.Brush.Style := bsSolid;
TPSRectangle(RenderCanvas, Angle, RenderIn, R);
end;
end;
@ -399,6 +418,84 @@ begin
end;
end;
procedure TVpGanttViewPainter.DrawHourColHeaders;
var
hourRec: TVpGanttHourRec;
dx: Integer;
strH, strLen: Integer;
str: String;
i, n: Integer;
R, R1: TRect;
P: TPoint;
begin
if not (gchHour in FGanttView.ColHeaderAttributes.Visible) then
exit;
// Offset due to scrolling
dx := FGanttView.LeftCol * FScaledColWidth;
// Draw hour captions (always centered) and dividing lines (always at right side).
RenderCanvas.Font.Assign(FHourFont);
strH := RenderCanvas.TextHeight('Tg');
n := FGanttView.NumHours;
for i := 0 to n - 1 do
begin
hourRec := FGanttView.HourRecords[i];
R := ScaleRect(hourRec.Rect);
OffsetRect(R, -dx, 0);
if R.Left < RealLeft + FScaledFixedColWidth 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(hourRec.Date) then
begin;
RenderCanvas.Brush.Color := FGanttView.Weekendcolor;
TPSFillRect(RenderCanvas, Angle, RenderIn, R1);
end else
if (gvoHolidays in FGanttView.Options) and FGanttView.IsHoliday(hourRec.Date, str) then
begin
RenderCanvas.Brush.Color := FGanttView.HolidayColor;
TPSFillRect(RenderCanvas, Angle, RenderIn, R1);
end;
end;
// No dividing line at last hour of day because it already has been
// drawn as the day divider.
if hourRec.Hour <> 23 then
begin
if FGanttView.DrawingStyle = ds3D then
DrawBevelLine(
RenderCanvas,
TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Top)),
TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Bottom)),
BevelShadow,
BevelHighlight
)
else
begin
TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top);
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom);
end;
end;
// Paint hour value
str := IntToStr(hourRec.Hour);
strLen := RenderCanvas.TextWidth(str);
P := Point((R.Left + R.Right - strLen) div 2, (R.Top + R.Bottom - strH) div 2);
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
end;
end;
procedure TVpGanttViewPainter.DrawMonthColHeaders;
var
dx: Integer;
@ -710,6 +807,7 @@ begin
RealLineColor := ColorToRGB(FGanttView.LineColor);
end;
FHourFont := FGanttView.ColHeaderAttributes.HourFont;
FDayFont := FGanttView.ColHeaderAttributes.DayFont;
FMonthFont := FGanttView.ColHeaderAttributes.MonthFont;
FWeekFont := FGanttView.ColHeaderAttributes.WeekFont;