You've already forked lazarus-ccr
tvplanit: Add ISO week numbers to GanttView column headers
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
@ -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;
|
||||
|
||||
|
||||
Reference in New Issue
Block a user