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

tvplanit: Add ISO week numbers to GanttView column headers

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8499 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-09-21 22:50:43 +00:00
parent e05d47afc0
commit b6753c216d
7 changed files with 349 additions and 67 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -37,6 +37,12 @@ type
Rect: TRect;
end;
TVpGanttWeekRec = record
WeekNo: Integer;
Date: TDateTime;
Rect: TRect;
end;
TVpGanttMonthRec = record
Date: TDateTime;
Rect: TRect;
@@ -67,18 +73,27 @@ type
property EventFont: TVpFont read FEventFont write SetEventFont;
end;
TVpGanttColHeaderKind = (gchMonth, gchWeek, gchDay);
TVpGanttColHeaderKinds = set of TVpGanttColHeaderKind;
TVpGanttColHeaderAttributes = class(TVpGanttHeaderAttributes)
private
FDayFont: TVpFont;
FMonthFont: TVpFont;
FWeekFont: TVpFont;
FVisible: TVpGanttColHeaderKinds;
procedure SetDayFont(AValue: TVpFont);
procedure SetMonthFont(AValue: TVpFont);
procedure SetVisible(AValue: TVpGanttColHeaderKinds);
procedure SetWeekFont(AValue: TVpFont);
public
constructor Create(AOwner: TVpGanttView); override;
destructor Destroy; override;
published
property DayFont: TVpFont read FDayFont write SetDayFont;
property MonthFont: TVpFont read FMonthFont write SetMonthFont;
property Visible: TVpGanttColHeaderKinds read FVisible write SetVisible default [gchMonth, gchDay];
property WeekFont: TVpFont read FWeekFont write SetWeekFont;
end;
TVpGanttView = class(TVpLinkableControl)
@@ -112,6 +127,7 @@ type
FFixedColWidth: Integer;
FRowHeight: Integer;
FMonthColHeaderHeight: Integer;
FWeekColHeaderHeight: Integer;
FDayColHeaderHeight: Integer;
FTotalColHeaderHeight: Integer;
FTextMargin: Integer;
@@ -149,6 +165,8 @@ type
function GetNumDays: Integer;
function GetNumEvents: Integer;
function GetNumMonths: Integer;
function GetNumWeeks: Integer;
function GetWeekRec(AIndex: Integer): TVpGanttWeekRec;
function IsStoredColWidth: Boolean;
function IsStoredDateFormat(AIndex: Integer): Boolean;
procedure SetActiveCol(AValue: Integer);
@@ -175,6 +193,7 @@ type
// Needed by the painter
FEventRecords: array of TVpGanttEventRec;
FDayRecords: array of TVpGanttDayRec;
FWeekRecords: array of TVpGanttWeekRec;
FMonthRecords: array of TVpGanttMonthRec;
{ internal methods }
@@ -195,6 +214,7 @@ type
procedure PopulateDayRecords;
procedure PopulateEventRecords;
procedure PopulateMonthRecords;
procedure PopulateWeekRecords;
procedure ScrollDateIntoView(ADate: TDateTime);
procedure ScrollHorizontal(ANumCols: Integer);
procedure ScrollRowIntoView(ARow: Integer);
@@ -296,10 +316,12 @@ type
property DayRecords[AIndex: Integer]: TVpGanttDayRec read GetDayRec;
property EventRecords[AIndex: Integer]: TVpGanttEventRec read GetEventRec;
property MonthRecords[AIndex: Integer]: TVpGanttMonthRec read GetMonthRec;
property WeekRecords[AIndex: Integer]: TVpGanttWeekRec read GetWeekRec;
property NumDays: Integer read GetNumDays;
property NumEvents: Integer read GetNumEvents;
property NumMonths: Integer read GetNumMonths;
property NumWeeks: Integer read GetNumWeeks;
published
// inherited properties
@@ -408,12 +430,15 @@ constructor TVpGanttColHeaderAttributes.Create(AOwner: TVpGanttView);
begin
inherited Create(AOwner);
FDayFont := TVpFont.Create(AOwner);
FWeekFont := TVpFont.Create(AOwner);
FMonthFont := TVpFont.Create(AOwner);
FVisible := [gchMonth, gchDay];
end;
destructor TVpGanttColHeaderAttributes.Destroy;
begin
FDayFont.Free;
FWeekFont.Free;
FMonthFont.Free;
inherited;
end;
@@ -438,6 +463,25 @@ begin
end;
end;
procedure TVpGanttColHeaderAttributes.SetVisible(AValue: TVpGanttColHeaderKinds);
begin
if FVisible <> AValue then
begin
FVisible := AValue;
UpdateGanttView;
end;
end;
procedure TVpGanttColHeaderAttributes.SetWeekFont(AValue: TVpFont);
begin
if FWeekFont <> AValue then
begin
FWeekFont := AValue;
FWeekFont.Owner := FGanttView;
UpdateGanttView;
end;
end;
{******************************************************************************}
{ TVpGanttView }
@@ -557,14 +601,25 @@ var
h: Integer;
begin
h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.MonthFont);
FMonthColHeaderHeight := h + 2 * FTextMargin;
FMonthColHeaderHeight := h; // + 2 * FTextMargin;
h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.WeekFont);
FWeekColHeaderHeight := h; // + 2 * FTextMargin;
// A typical date string to measure the text height (line breaks in DayFormat allowed)
s := FormatDateTime(DayFormat, EncodeDate(2000, 12, 28));
h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.DayFont, s);
FDayColHeaderHeight := h + FTextMargin;
FDayColHeaderHeight := h; // + FTextMargin;
FTotalColHeaderHeight := FMonthColHeaderHeight + FDayColHeaderHeight;
FTotalColHeaderHeight := 0;
if (gchMonth in FColHeaderAttributes.Visible) then
inc(FTotalColHeaderHeight, FMonthColHeaderHeight + FTextMargin);
if (gchWeek in FColHeaderAttributes.Visible) then
inc(FTotalColHeaderHeight, FWeekColHeaderHeight + FTextMargin);
if (gchDay in FColHeaderAttributes.Visible) then
inc(FTotalColHeaderHeight, FDayColHeaderHeight + FTextMargin);
if FTotalColHeaderHeight > 0 then
inc(FTotalColHeaderHeight, FTextMargin);
end;
procedure TVpGanttView.CalcRowHeight;
@@ -818,8 +873,8 @@ begin
end;
end;
{ Determines the date when the earliest event starts, and the date when the
latest event ends. }
{ Determines the dates when the earliest event in the entire Schedule starts,
and when the latest event ends. }
procedure TVpGanttView.GetEventDateRange(out AFirstDate, ALastDate: TDate);
var
i: Integer;
@@ -894,6 +949,56 @@ begin
Result := 0;
end;
{ Determines the number of weeks (complete or partial) between the first and
last Gantt events.
NOTE: Week calculations are based on ISO week numbers only! }
function TVpGanttView.GetNumWeeks: Integer;
var
d1, d2: TVpDayType;
dt1, dt2: TDate;
wn1, wn2: Integer;
begin
if (FRealStartDate <> NO_DATE) then
begin
d1 := GetVpDayType(FRealStartDate);
d2 := GetVpDayType(FRealEndDate);
if (FRealEndDate - FRealStartDate < 7) then
begin
wn1 := WeekOfTheYear(FRealStartDate);
wn2 := WeekOfTheYear(FRealEndDate);
if wn1 = wn2 then
Result := 1
else
Result := 2;
exit;
end;
if d1 = dtMonday then
begin
// No partial week at start
Result := 0;
dt1 := FRealStartDate;
end else
begin
// Partial week at start
Result := 1;
dt1 := StartOfTheWeek(FRealStartDate) + 7; // Start of next week
end;
if d2 = dtSunday then
// No partial week at end
dt2 := FRealEndDate
else begin
// Partial week at the end
Inc(Result);
dt2 := StartOfTheWeek(FRealEndDate) - 1;
end;
Result := Result + (trunc(dt2) - trunc(dt1) + 1) div 7;
end else
Result := 0;
end;
{ Calculates the first and last date to be displayed in the GanttView. This
is necessary because the properties StartDate and EndDate may be 0 which
means the very first/last event. }
@@ -921,6 +1026,11 @@ begin
Result := -1;
end;
function TVpGanttView.GetWeekRec(AIndex: Integer): TVpGanttWeekRec;
begin
Result := FWeekRecords[AIndex];
end;
{ If the component is being dropped on a form at designtime, then
automatically hook up to the first datastore component found. }
procedure TVpGanttView.HookUp;
@@ -947,6 +1057,7 @@ begin
FRowCount := GetNumEvents;
PopulateDayRecords;
PopulateWeekRecords;
PopulateMonthRecords;
PopulateEventRecords;
end;
@@ -1202,7 +1313,11 @@ var
begin
SetLength(FDayRecords, GetNumDays);
x1 := FixedColWidth;
y1 := FMonthColHeaderHeight;
y1 := 0;
if (gchMonth in FColHeaderAttributes.Visible) then
inc(y1, FMonthColHeaderHeight + FTextMargin);
if (gchWeek in FColHeaderAttributes.Visible) then
inc(y1, FWeekColHeaderHeight + FTextMargin);
y2 := FTotalColHeaderHeight;
for i := 0 to High(FDayRecords) do
begin
@@ -1333,6 +1448,49 @@ begin
end;
end;
procedure TVpGanttView.PopulateWeekRecords;
var
i: Integer;
x1, y1, x2, y2: Integer;
d: TVpDayType;
dt1, dt2: TDateTime;
begin
SetLength(FWeekRecords, GetNumWeeks);
x1 := FixedColWidth;
y1 := 0;
if (gchMonth in FColHeaderAttributes.Visible) then
inc(y1, FMonthColHeaderHeight + FTextMargin);
if (gchDay in FColHeaderAttributes.Visible) then
y2 := y1 + FWeekColHeaderHeight + FTextMargin
else
y2 := FTotalColHeaderHeight;
d := GetVpDayType(FRealStartDate);
dt1 := FRealStartDate;
if d = dtMonday then
dt2 := dt1 + 6
else
dt2 := StartOfTheWeek(FRealStartDate + 7) - 1;
if dt2 > FRealEndDate then
dt2 := FRealEndDate;
x2 := x1 + (trunc(dt2) - trunc(dt1) + 1) * FColWidth;
FWeekRecords[0].Rect := Rect(x1, y1, x2, y2);
FWeekRecords[0].Date := dt1;
FWeekRecords[0].WeekNo := WeekOfTheYear(dt1);
for i := 1 to High(FWeekRecords) do
begin
dt1 := dt2 + 1;
dt2 := Min(dt1 + 6, FRealEndDate);
x1 := x2;
x2 := x1 + (trunc(dt2) - trunc(dt1) + 1) * FColWidth;
FWeekRecords[i].Rect := Rect(x1, y1, x2, y2);
FWeekRecords[i].Date := dt1;
FWeekRecords[i].WeekNo := WeekOfTheYear(dt1);
end;
end;
procedure TVpGanttView.RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean);