diff --git a/components/tvplanit/languages/demo.de.po b/components/tvplanit/languages/demo.de.po index 635b78ff2..77ffde3e4 100644 --- a/components/tvplanit/languages/demo.de.po +++ b/components/tvplanit/languages/demo.de.po @@ -306,3 +306,4 @@ msgstr "Erledigte Aufgaben verbergen" #: tmainform.titlelbl.caption msgid "TitleLbl" msgstr "" + diff --git a/components/tvplanit/languages/demo.en.po b/components/tvplanit/languages/demo.en.po index b0520979c..f3375bf4e 100644 --- a/components/tvplanit/languages/demo.en.po +++ b/components/tvplanit/languages/demo.en.po @@ -303,3 +303,4 @@ msgstr "Hide completed tasks" #: tmainform.titlelbl.caption msgid "TitleLbl" msgstr "TitleLbl" + diff --git a/components/tvplanit/languages/vpsr.de.po b/components/tvplanit/languages/vpsr.de.po index 6cb51f653..d3bea7f6e 100644 --- a/components/tvplanit/languages/vpsr.de.po +++ b/components/tvplanit/languages/vpsr.de.po @@ -1095,7 +1095,7 @@ msgstr "Druckformat-Designer" msgid "Print order" msgstr "" "Druck-\n" -"Reihenfolge" +"Reihenfolge\n" #: vpsr.rsprintprvcancel msgctxt "vpsr.rsprintprvcancel" @@ -1813,3 +1813,4 @@ msgstr "Unbekannte Achsen-Spezifikation: %s" #: vpsr.sxmldecnotatbeg msgid "The XML declaration must appear before the first element" msgstr "Die XML-Deklaration muss vor dem ersten Element erscheinen" + diff --git a/components/tvplanit/languages/vpsr.en.po b/components/tvplanit/languages/vpsr.en.po index 603bb3668..d52fb0a37 100644 --- a/components/tvplanit/languages/vpsr.en.po +++ b/components/tvplanit/languages/vpsr.en.po @@ -1792,3 +1792,4 @@ msgstr "Unknown axis specifier: %s" #: vpsr.sxmldecnotatbeg msgid "The XML declaration must appear before the first element" msgstr "The XML declaration must appear before the first element" + diff --git a/components/tvplanit/source/vpganttview.pas b/components/tvplanit/source/vpganttview.pas index 608f96b0d..71170aa53 100644 --- a/components/tvplanit/source/vpganttview.pas +++ b/components/tvplanit/source/vpganttview.pas @@ -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); diff --git a/components/tvplanit/source/vpganttviewpainter.pas b/components/tvplanit/source/vpganttviewpainter.pas index 507bccbd0..653d76866 100644 --- a/components/tvplanit/source/vpganttviewpainter.pas +++ b/components/tvplanit/source/vpganttviewpainter.pas @@ -15,6 +15,7 @@ type FDayFont: TFont; FMonthFont: TFont; + FWeekFont: TFont; FEventFont: TFont; FScaledColWidth: Integer; @@ -39,11 +40,14 @@ type procedure DrawActiveDate; procedure DrawBorders; procedure DrawColHeader; + procedure DrawDayColHeaders; procedure DrawEvents; procedure DrawGrid; + procedure DrawMonthColHeaders; procedure DrawRowHeader; - procedure FixFontHeights; procedure DrawSpecialDays; + procedure DrawWeekColHeaders; + procedure FixFontHeights; procedure InitColors; procedure SetMeasurements; override; @@ -60,7 +64,7 @@ implementation uses DateUtils, - VpConst, VpMisc, VpCanvasUtils, VpData; + VpSR, VpConst, VpMisc, VpCanvasUtils, VpData; constructor TVpGanttViewPainter.Create(AGanttView: TVpGanttView; ARenderCanvas: TCanvas); @@ -137,14 +141,7 @@ end; procedure TVpGanttViewPainter.DrawColHeader; var - i, n: Integer; R, R1: TRect; - P: TPoint; - monthRec: TVpGanttMonthRec; - dayRec: TVpGanttDayRec; - str: String; - strLen, strH: Integer; - dx: Integer; begin RenderCanvas.Brush.Color := RealColHeadAttrColor; RenderCanvas.Pen.Color := RealLineColor; @@ -179,59 +176,29 @@ begin TPSLineTo(RenderCanvas, Angle, RenderIn, RealRight, R.Bottom); end; + // Draw the month column headers + DrawMonthColHeaders; + + // Draw the week column headers + DrawWeekColHeaders; + + // Draw the day column headers + DrawDayColHeaders; +end; + +procedure TVpGanttViewPainter.DrawDayColHeaders; +var + dayRec: TVpGanttDayRec; + dx: Integer; + strH, strLen: Integer; + str: String; + i, n: Integer; + R, R1: TRect; + P: TPoint; +begin // Offset due to scrolling dx := FGanttView.LeftCol * FScaledColWidth; - // Draw month rectangles and month captions - RenderCanvas.Font.Assign(FMonthFont); - n := FGanttView.NumMonths; - for i := 0 to n-1 do - begin - monthRec := FGanttView.MonthRecords[i]; - R := monthRec.Rect; - R := ScaleRect(R); - OffsetRect(R, -dx , 0); - - // Clip at fixed col edge - if R.Left < RealLeft + FScaledFixedColWidth then - R.Left := RealLeft + FScaledFixedColWidth; - - // Draw month box - if FGanttView.DrawingStyle = ds3D then - begin - R1 := R; - if i > 0 then - inc(R1.Left); - dec(R1.Bottom); - DrawBevelRect( - RenderCanvas, - TPSRotateRectangle(Angle, RenderIn, R1), - BevelHighlight, - BevelShadow - ) - end else - begin - TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top); - TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom); - end; - - // Paint month name. Use short format if space is too small for long format. - str := FormatDateTime(FGanttView.MonthFormat, monthRec.Date); - strLen := RenderCanvas.TextWidth(str); - if strLen > R.Width - 2 * FScaledTextMargin then - begin - str := FormatDateTime(FGanttView.MonthFormat_short, monthRec.Date); - strLen := RenderCanvas.TextWidth(str); - end; - if strLen > R.Width - 2 * FScaledTextMargin then - str := ''; - if str <> '' then - begin - P := Point((R.Left + R.Right - strLen) div 2, R.Top + FScaledTextMargin); - TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str); - end; - end; - // Draw day captions (always centered) and dividing lines (always at right side). RenderCanvas.Font.Assign(FDayFont); strH := RenderCanvas.TextHeight('Tg'); @@ -296,7 +263,6 @@ begin // strLen := GetCanvasTextWidth(RenderCanvas, FDayFont, str); // TPSTextRect(RencerCanvas, Angle, RenderIn, R, P.X, P.Y, str); // BUT: TPSTextRect does not yet exist... - end; end; @@ -429,6 +395,70 @@ begin end; end; +procedure TVpGanttViewPainter.DrawMonthColHeaders; +var + dx: Integer; + i, n: Integer; + monthRec: TVpGanttMonthRec; + R, R1: TRect; + P: TPoint; + str: String; + strLen: Integer; +begin + // Offset due to scrolling + dx := FGanttView.LeftCol * FScaledColWidth; + + // Draw month rectangles and month captions + RenderCanvas.Font.Assign(FMonthFont); + n := FGanttView.NumMonths; + for i := 0 to n-1 do + begin + monthRec := FGanttView.MonthRecords[i]; + R := monthRec.Rect; + R := ScaleRect(R); + OffsetRect(R, -dx , 0); + + // Clip at fixed col edge + if R.Left < RealLeft + FScaledFixedColWidth then + R.Left := RealLeft + FScaledFixedColWidth; + + // Draw month box + if FGanttView.DrawingStyle = ds3D then + begin + R1 := R; + if i > 0 then + inc(R1.Left); + dec(R1.Bottom); + DrawBevelRect( + RenderCanvas, + TPSRotateRectangle(Angle, RenderIn, R1), + BevelHighlight, + BevelShadow + ) + end else + begin + TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top); + TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom); + end; + + // Paint month name. Use short format if space is too small for long format. + str := FormatDateTime(FGanttView.MonthFormat, monthRec.Date); + strLen := RenderCanvas.TextWidth(str); + if strLen > R.Width - 2 * FScaledTextMargin then + begin + str := FormatDateTime(FGanttView.MonthFormat_short, monthRec.Date); + strLen := RenderCanvas.TextWidth(str); + end; + if strLen > R.Width - 2 * FScaledTextMargin then + str := ''; + if str <> '' then + begin + P := Point((R.Left + R.Right - strLen) div 2, R.Top + FScaledTextMargin); + TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str); + end; + end; +end; + procedure TVpGanttViewPainter.DrawRowHeader; var R: TRect; @@ -552,10 +582,92 @@ begin end; end; +procedure TVpGanttViewPainter.DrawWeekColHeaders; +var + dx: Integer; + i, n: Integer; + weekRec: TVpGanttWeekRec; + weekNo, yearNo: Integer; + R, R1: TRect; + P: TPoint; + str: String; + strLen: Integer; +begin + // Offset due to scrolling + dx := FGanttView.LeftCol * FScaledColWidth; + + // Draw week rectangles and week numbers as captions + RenderCanvas.Font.Assign(FWeekFont); + n := FGanttView.NumWeeks; + for i := 0 to n-1 do + begin + weekRec := FGanttView.WeekRecords[i]; + R := weekRec.Rect; + R := ScaleRect(R); + OffsetRect(R, -dx , 0); + + // Clip at fixed col edge + if R.Left < RealLeft + FScaledFixedColWidth then + R.Left := RealLeft + FScaledFixedColWidth; + + // Draw week box + if FGanttView.DrawingStyle = ds3D then + begin + R1 := R; + if i > 0 then + inc(R1.Left); + dec(R1.Bottom); + DrawBevelLine( + RenderCanvas, + TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Top)), + TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Bottom)), + BevelShadow, + BevelHighlight + ) +(* + DrawBevelRect( + RenderCanvas, + TPSRotateRectangle(Angle, RenderIn, R1), + BevelHighlight, + BevelShadow + ) + *) + end else + begin + TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top); + TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom); + end; + + // Paint ISO week number. + weekNo := WeekOfTheYear(weekRec.Date); + yearNo := YearOf(weekRec.Date); + str := Format('%s %d (%d)', [RSCalendarWeekAbbr, weekNo, yearNo]); + strLen := RenderCanvas.TextWidth(str); + if strLen > R.Width - 2 * FScaledTextMargin then + begin + str := Format('%s %d', [RSCalendarWeekAbbr, weekNo]); + strLen := RenderCanvas.TextWidth(str); + end; + if strLen > R.Width - 2 * FScaledTextMargin then + begin + str := IntToStr(weekNo); + strLen := RenderCanvas.TextWidth(str); + end; + if strLen > R.Width - 2 * FScaledTextMargin then + str := ''; + if str <> '' then + begin + P := Point((R.Left + R.Right - strLen) div 2, R.Top + FScaledTextMargin); + TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str); + end; + end; +end; + procedure TVpGanttViewPainter.FixFontHeights; begin with FGanttView do begin ColHeaderAttributes.DayFont.Height := GetRealFontHeight(ColHeaderAttributes.DayFont); + ColHeaderAttributes.WeekFont.Height := GetRealFontHeight(ColHeaderAttributes.WeekFont); ColHeaderAttributes.MonthFont.Height := GetRealFontHeight(ColHeaderAttributes.MonthFont); RowHeaderAttributes.EventFont.Height := GetRealFontHeight(RowHeaderAttributes.EventFont); end; @@ -585,6 +697,7 @@ begin FDayFont := FGanttView.ColHeaderAttributes.DayFont; FMonthFont := FGanttView.ColHeaderAttributes.MonthFont; + FWeekFont := FGanttView.ColHeaderAttributes.WeekFont; FEventFont := FGanttView.RowHeaderAttributes.EventFont; end; diff --git a/components/tvplanit/source/vpmisc.pas b/components/tvplanit/source/vpmisc.pas index d16a5e525..fcb1adcd3 100644 --- a/components/tvplanit/source/vpmisc.pas +++ b/components/tvplanit/source/vpmisc.pas @@ -150,6 +150,7 @@ function DatePart(ADateTime: TDateTime): TDateTime; inline; function TimePart(ADateTime: TDateTime): TDateTime; inline; function GetJulianDate(Date: TDateTime): Word; +function GetVpDayType(ADate: TDateTime): TVpDayType; function GetWeekOfYear(ADate: TDateTime): byte; function IsWeekend(ADate: TDateTime): Boolean; function SameDate(dt1, dt2: TDateTime): Boolean; @@ -893,6 +894,12 @@ begin Result := SameTime(t1, t2) or (t1 > t2); end; +// Determines the TVpDayType for the given date, i.e. dtSunday, dtMonday, etc. +function GetVpDayType(ADate: TDateTime): TVpDayType; +begin + Result := TVpDayType(DayOfWeek(ADate) - 1); +end; + // Calculates ISO week number (checked with Jan 1, 2016, which is in week 53). function GetWeekOfYear(ADate: TDateTime): byte; // wp: was in TvWeekView.