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

tvplanit: refactor handling of day/month/event rectangles in TVpGanttView.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8421 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-08-28 18:17:04 +00:00
parent 9d0e64788e
commit 31a3ed6a14
3 changed files with 386 additions and 126 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,8 +5,9 @@ unit VpGanttView;
interface
uses
LCLType, LCLIntf, LMessages, Classes, SysUtils, Graphics, Types, StdCtrls,
VpConst, VpBase, VpBaseDS, VpData;
LCLType, LCLIntf, LMessages,
Classes, SysUtils, Graphics, Types, Controls, StdCtrls,
VpConst, VpMisc, VpBase, VpBaseDS, VpData;
type
TVpGanttView = class;
@ -73,7 +74,6 @@ type
FDate: TDateTime; // Selected date
FStartDate: TDateTime; // Date of the first event
FEndDate: TDateTime; // Date of the last event
FLeftDate: TDateTime; // Date of the left-most event (after scrolling > FStartDate)
FLeftCol: Integer; // Index of the left-most day column
FTopRow: Integer; // Index of the top-most event row
@ -89,6 +89,11 @@ type
FColWidth: Integer;
FFixedColWidth: Integer;
FRowHeight: Integer;
FMonthColHeaderHeight: Integer;
FDayColHeaderHeight: Integer;
FTotalColHeaderHeight: Integer;
FTextMargin: Integer;
FColor: TColor;
FLineColor: TColor;
@ -100,6 +105,12 @@ type
FDateFormat: array[0..2] of String;
function GetDateFormat(AIndex: Integer): String;
function GetDayRec(AIndex: Integer): TVpGanttDayRec;
function GetEventRec(AIndex: Integer): TVpGanttEventRec;
function GetMonthRec(AIndex: Integer): TVpGanttMonthRec;
function GetNumDays: Integer;
function GetNumEvents: Integer;
function GetNumMonths: Integer;
function IsStoredColWidth: Boolean;
function IsStoredDateFormat(AIndex: Integer): Boolean;
procedure SetColor(Value: TColor); reintroduce;
@ -110,6 +121,7 @@ type
procedure SetFixedColWidth(AValue: Integer);
procedure SetLeftCol(AValue: Integer);
procedure SetLineColor(AValue: TColor);
procedure SetTextMargin(AValue: Integer);
procedure SetTopRow(AValue: Integer);
protected
@ -119,8 +131,14 @@ type
FMonthRecords: array of TVpGanttMonthRec;
{ internal methods }
procedure CalcColHeaderHeight;
procedure CalcRowHeight;
procedure GetEventDateRange;
procedure Hookup;
procedure Populate;
procedure PopulateDayRecords;
procedure PopulateEventRecords;
procedure PopulateMonthRecords;
procedure ScrollHorizontal(ANumCols: Integer);
procedure ScrollVertical(ANumRows: Integer);
procedure SetHScrollPos;
@ -141,6 +159,7 @@ type
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Init;
procedure LinkHandler(Sender: TComponent;
NotificationType: TVpNotificationType; const Value: Variant); override;
procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
@ -158,6 +177,18 @@ type
property LeftCol: Integer read FLeftCol write SetLeftCol;
property TopRow: Integer read FTopRow write SetTopRow;
property RowHeight: Integer read FRowHeight;
property DayColHeaderHeight: Integer read FDayColHeaderHeight;
property MonthColHeaderHeight: Integer read FMonthColHeaderHeight;
property TotalColHeaderHeight: Integer read FTotalColHeaderHeight;
property DayRecords[AIndex: Integer]: TVpGanttDayRec read GetDayRec;
property EventRecords[AIndex: Integer]: TVpGanttEventRec read GetEventRec;
property MonthRecords[AIndex: Integer]: TVpGanttMonthRec read GetMonthRec;
property NumDays: Integer read GetNumDays;
property NumEvents: Integer read GetNumEvents;
property NumMonths: Integer read GetNumMonths;
published
property Align;
property Anchors;
@ -173,12 +204,14 @@ type
property MonthFormat: String index 1 read GetDateFormat write SetDateFormat stored IsStoredDateFormat;
property MonthFormat_short: String index 2 read GetDateFormat write SetDateFormat stored IsStoredDateFormat;
property RowHeaderAttributes: TVpGanttRowHeaderAttributes read FRowHeaderAttributes write FRowHeaderAttributes;
property TextMargin: Integer read FTextMargin write SetTextMargin default 2;
end;
implementation
uses
DateUtils,
VpGanttViewPainter;
const
@ -288,6 +321,7 @@ end;
constructor TVpGanttView.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
FInLinkHandler := false;
FLoaded := false;
@ -298,6 +332,7 @@ begin
FColWidth := DEFAULT_COLWIDTH;
FFixedColWidth := 120;
FTextMargin := 2;
FColor := DEFAULT_COLOR;
FLineColor := DEFAULT_LINECOLOR;
@ -323,6 +358,18 @@ begin
inherited;
end;
procedure TVpGanttView.CalcColHeaderHeight;
begin
FMonthColHeaderHeight := GetCanvasTextHeight(Canvas, FColHeaderAttributes.MonthFont) + 2 * FTextMargin;
FDayColHeaderHeight := GetCanvasTextHeight(Canvas, FColHeaderAttributes.DayFont) + FTextMargin;
FTotalColHeaderHeight := FMonthColHeaderHeight + FDayColHeaderHeight;
end;
procedure TVpGanttView.CalcRowHeight;
begin
FRowHeight := GetCanvasTextHeight(Canvas, FRowHeaderAttributes.EventFont) + 2 * FTextMargin;
end;
procedure TVpGanttView.CreateParams(var AParams: TCreateParams);
begin
inherited CreateParams(AParams);
@ -364,6 +411,7 @@ begin
end;
end;
{ Defines the initial size of the control. }
class function TVpGanttView.GetControlClassDefaultSize: TSize;
begin
Result.CX := 300;
@ -375,6 +423,82 @@ begin
Result := FDateFormat[AIndex];
end;
function TVpGanttView.GetDayRec(AIndex: Integer): TVpGanttDayRec;
begin
Result := FDayRecords[AIndex];
end;
{ Determines the date when the earliest event starts, and the date when the
latest event ends.
Stores them in the internal variables FStartdate and FEndDate. }
procedure TVpGanttView.GetEventDateRange;
var
i: Integer;
event: TVpEvent;
d: TDateTime;
begin
if (Datastore = nil) or (Datastore.Resource = nil) or (Datastore.Resource.Schedule.EventCount = 0) then
begin
FStartDate := NO_DATE;
FEndDate := NO_DATE;
end else
begin
event := Datastore.Resource.Schedule.GetEvent(0);
FStartDate := trunc(event.StartTime);
FEndDate := -99999;
for i := 0 to Datastore.Resource.Schedule.EventCount-1 do
begin
event := Datastore.Resource.Schedule.GetEvent(i);
d := trunc(event.EndTime);
if d > FEndDate then FEndDate := d;
end;
end;
end;
function TVpGanttView.GetEventRec(AIndex: Integer): TVpGanttEventRec;
begin
Result := FEventRecords[AIndex];
end;
function TVpGanttView.GetMonthRec(AIndex: Integer): TVpGanttMonthRec;
begin
Result := FMonthRecords[AIndex];
end;
{ Determines the number days between the first and last Gantt event. This is
the number of day columns in the view. }
function TVpGanttView.GetNumDays: Integer;
begin
if (FStartDate <> NO_DATE) then
Result := trunc(FEndDate) - trunc(FStartDate) + 1
else
Result := 0;
end;
{ Determines the number of events (= rows) to be displayed in the GanttView. }
function TVpGanttView.GetNumEvents: Integer;
begin
if (Datastore <> nil) and (Datastore.Resource <> nil) then
Result := Datastore.Resource.Schedule.EventCount
else
Result := 0;
end;
{ Determines the number of months (complete or partial) between the first and
last Gantt event. }
function TVpGanttView.GetNumMonths: Integer;
var
dm1, dm2: Integer;
begin
if (FStartDate <> NO_DATE) then
begin
dm1 := trunc(StartOfTheMonth(FStartDate));
dm2 := trunc(StartOfTheMonth(FEndDate));
Result := MonthsBetween(dm1, dm2) + 1;
end else
Result := 0;
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;
@ -390,6 +514,20 @@ begin
end;
end;
procedure TVpGanttView.Init;
begin
CalcRowHeight;
CalcColHeaderHeight;
GetEventDateRange;
FColCount := GetNumDays;
FRowCount := GetNumEvents;
PopulateDayRecords;
PopulateMonthRecords;
PopulateEventRecords;
end;
procedure TVpGanttView.KeyDown(var Key: Word; Shift: TShiftState);
var
PopupPoint : TPoint;
@ -471,12 +609,6 @@ begin
Populate;
end;
procedure TVpGanttView.Populate;
begin
if DataStore <> nil then
DataStore.Date := FDate;
end;
procedure TVpGanttView.Paint;
begin
RenderToCanvas(
@ -494,6 +626,109 @@ begin
SetHScrollPos;
end;
procedure TVpGanttView.Populate;
begin
if DataStore <> nil then
DataStore.Date := FDate;
end;
// Populates the array of TVpGanttRec records containing the date of each day
// cell and the *unscrolled* cell rectangle coordinates.
procedure TVpGanttView.PopulateDayRecords;
var
i: Integer;
x1, y1, x2, y2: Integer;
begin
SetLength(FDayRecords, GetNumDays);
x1 := FixedColWidth;
y1 := FMonthColHeaderHeight;
y2 := FTotalColHeaderHeight;
for i := 0 to High(FDayRecords) do
begin
x2 := x1 + ColWidth;
FDayRecords[i].Rect := Rect(x1, y1, x2, y2);
FDayRecords[i].Date := FStartDate + i;
x1 := x2;
end;
end;
procedure TVpGanttView.PopulateEventRecords;
var
eventRec: TVpGanttEventRec;
event: TVpEvent;
i: Integer;
xh1, xh2, y1, xe1, xe2, y2: Integer;
t1, t2: TDateTime;
totalWidth: Integer;
begin
SetLength(FEventRecords, GetNumEvents);
if (Datastore = nil) or (DataStore.Resource = nil) then
exit;
xh1 := 0;
xh2 := FixedColWidth;
y1 := FTotalColHeaderHeight;
totalWidth := GetNumDays * ColWidth;
eventRec := Default(TVpGanttEventRec);
for i := 0 to High(FEventRecords) do
begin
event := Datastore.Resource.Schedule.GetEvent(i);
if event.AllDayEvent then
begin
t1 := trunc(event.StartTime);
t2 := trunc(event.EndTime) + 1;
if frac(event.EndTime) = 0 then t2 := t2 + 1;
end else
begin
t1 := event.StartTime;
t2 := event.EndTime;
end;
y2 := y1 + FRowHeight;
xe1 := round((t1 - FStartDate) / numDays * totalWidth) + FixedColWidth;
xe2 := round((t2 - FStartDate) / numDays * totalWidth) + FixedColWidth;
if xe1 = xe2 then xe2 := xe1 + 1;
FEventRecords[i].Event := event;
FEventRecords[i].Caption := event.Description;
FEventRecords[i].HeadRect := Rect(xh1, y1, xh2, y2);
FEventRecords[i].EventRect := Rect(xe1, y1, xe2, y2);
y1 := y2;
end;
end;
procedure TVpGanttView.PopulateMonthRecords;
var
i, n: Integer;
x1, y1, x2, y2: Integer;
dm: TDateTime;
ndays: Integer;
begin
n := GetNumMonths;
SetLength(FMonthRecords, n);
if (Datastore = nil) or (Datastore.Resource = nil) then
exit;
x1 := FixedColWidth;
y1 := 0;
y2 := FTotalColHeaderHeight;
dm := FStartDate;
for i := 0 to n - 1 do
begin
if i = 0 then begin
nDays := DaysInMonth(dm) - DayOf(dm) + 1;
dm := StartOfTheMonth(dm);
end else
if i = n-1 then
nDays := DayOf(FEndDate)
else
nDays := DaysInMonth(dm);
x2 := x1 + nDays * ColWidth;
FMonthRecords[i].Rect := Rect(x1, y1, x2, y2);
FMonthRecords[i].Date := dm;
dm := IncMonth(dm, 1);
x1 := x2;
end;
end;
procedure TVpGanttView.RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean);
@ -519,13 +754,13 @@ end;
procedure TVpGanttView.ScrollHorizontal(ANumCols: Integer);
begin
FLeftCol := FLeftCol + ANumCols;
SetLeftCol(FLeftCol + ANumCols);
Invalidate;
end;
procedure TVpGanttView.ScrollVertical(ANumRows: Integer);
begin
TopRow := FTopRow + ANumRows;
SetTopRow(FTopRow + ANumRows);
Invalidate;
end;
@ -625,13 +860,13 @@ end;
procedure TVpGanttView.SetHScrollPos;
var
SI: TScrollInfo;
scrollInfo: TScrollInfo;
begin
if not HandleAllocated then
Exit;
with SI do
with scrollInfo do
begin
cbSize := SizeOf(SI);
cbSize := SizeOf(scrollInfo);
fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
nMin := 0;
nMax := FColCount;
@ -645,7 +880,16 @@ begin
nPos := FLeftCol;
nTrackPos := nPos;
end;
SetScrollInfo(Handle, SB_HORZ, SI, True);
SetScrollInfo(Handle, SB_HORZ, scrollInfo, True);
end;
procedure TVpGanttView.SetTextMargin(AValue: Integer);
begin
if FTextMargin <> AValue then
begin
FTextMargin := AValue;
Invalidate;
end;
end;
procedure TVpGanttView.SetTopRow(AValue: Integer);
@ -663,6 +907,8 @@ begin
FTopRow := 0
else
FTopRow:= AValue;
WriteLn('TopRow = ', TopRow);
Invalidate;
SetVScrollPos;
end;
@ -670,13 +916,13 @@ end;
procedure TVpGanttView.SetVScrollPos;
var
SI: TScrollInfo;
scrollInfo: TScrollInfo;
begin
if not HandleAllocated then
Exit;
with SI do
with scrollInfo do
begin
cbSize := SizeOf(SI);
cbSize := SizeOf(scrollInfo);
fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
nMin := 0;
nMax := FRowCount;
@ -685,12 +931,12 @@ begin
else
nPage := FVisibleRows;
if FTopRow = pred(RowCount) - VisibleRows then
nPos := RowCount
nPos := FRowCount
else
nPos := FTopRow;
nTrackPos := nPos;
end;
SetScrollInfo(Handle, SB_VERT, SI, True);
SetScrollInfo(Handle, SB_VERT, scrollInfo, True);
end;
procedure TVpGanttView.WMHScroll(var Msg: TLMHScroll);

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

@ -13,6 +13,10 @@ type
private
FGanttView: TVpGanttView;
FDayFont: TFont;
FMonthFont: TFont;
FEventFont: TFont;
BevelHighlight: TColor;
BevelShadow: TColor;
BevelDarkShadow: TColor;
@ -22,14 +26,6 @@ type
RealLineColor: TColor;
RealRowHeadAttrColor: TColor;
FColHeadHeightTotal: Integer;
FColHeadRowHeightMonth: Integer;
FColHeadRowHeightDay: Integer;
FRowHeight: Integer;
FTextMargin: Integer;
function CountMonths(ADate1, ADate2: TDateTime): Integer;
protected
procedure Clear;
procedure DrawBorders;
@ -64,7 +60,6 @@ constructor TVpGanttViewPainter.Create(AGanttView: TVpGanttView;
begin
inherited Create(ARenderCanvas);
FGanttView := AGanttView;
FTextMargin := 2;
end;
procedure TVpGanttViewPainter.Clear;
@ -73,23 +68,6 @@ begin
RenderCanvas.FillRect(RenderIn);
end;
function TVpGanttViewPainter.CountMonths(ADate1, ADate2: TDateTime): Integer;
var
dt: TDateTime;
begin
if ADate1 > ADate2 then
exit;
// raise Exception.Create('[TVpGanttViewPainter.CountMonts] Dates not in order.');
Result := 0;
dt := ADate1;
while dt <= ADate2 do
begin
inc(Result);
dt := StartOfTheMonth(IncMonth(dt));
end;
end;
procedure TVpGanttViewPainter.DrawBorders;
var
R: TRect;
@ -129,7 +107,7 @@ end;
procedure TVpGanttViewPainter.DrawColHeader;
var
i: Integer;
i, n: Integer;
R, R1: TRect;
P: TPoint;
monthRec: TVpGanttMonthRec;
@ -141,7 +119,7 @@ begin
RenderCanvas.Brush.Color := RealColHeadAttrColor;
RenderCanvas.Pen.Color := RealLineColor;
R := Rect(RealLeft, RealTop, RealRight, FColHeadHeightTotal);
R := Rect(RealLeft, RealTop, RealRight, FGanttView.TotalColHeaderHeight);
TPSFillRect(RenderCanvas, Angle, RenderIn, R);
if FGanttView.DrawingStyle = ds3D then
@ -171,16 +149,23 @@ begin
TPSLineTo(RenderCanvas, Angle, RenderIn, RealRight, R.Bottom);
end;
dx := FGanttView.FixedColWidth - FGanttView.LeftCol * FGanttView.ColWidth;
// Offset due to scrolling
dx := FGanttView.LeftCol * FGanttView.ColWidth;
// Draw month rectangles and month captions
for i := 0 to High(TVpGanttViewOpener(FGanttView).FMonthRecords) do
RenderCanvas.Font.Assign(FMonthFont);
n := FGanttView.NumMonths;
for i := 0 to n-1 do
begin
monthRec := TVpGanttViewOpener(FGanttView).FMonthRecords[i];
monthRec := FGanttView.MonthRecords[i];
R := monthRec.Rect;
OffsetRect(R, dx , 0);
OffsetRect(R, -dx , 0);
// Clip at fixed col edge
if R.Left < FGanttView.FixedColWidth then
R.Left := FGanttView.FixedColWidth;
// Draw month box
if FGanttView.DrawingStyle = ds3D then
begin
R1 := R;
@ -199,31 +184,37 @@ begin
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 * FTextMargin then
if strLen > R.Width - 2 * FGanttView.TextMargin then
begin
str := FormatDateTime(FGanttView.MonthFormat_short, monthRec.Date);
strLen := RenderCanvas.TextWidth(str);
end;
if strLen > R.Width - 2 * FTextMargin then
if strLen > R.Width - 2 * FGanttView.TextMargin then
str := '';
if str <> '' then
begin
P := Point((R.Left + R.Right - strLen) div 2, R.Top + FTextMargin);
P := Point((R.Left + R.Right - strLen) div 2, R.Top + FGanttView.TextMargin);
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
end;
end;
// Draw day dividing lines and day captions. Always at right side.
RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.DayFont);
// Draw day captions (always centered) and dividing lines (always at right side).
RenderCanvas.Font.Assign(FDayFont);
strH := RenderCanvas.TextHeight('Tg');
for dayRec in TVpGanttViewOpener(FGanttView).FDayRecords do
n := FGanttView.NumDays;
for i := 0 to n - 1 do
begin
dayRec := FGanttView.DayRecords[i];
R := dayRec.Rect;
OffsetRect(R, dx, 0);
OffsetRect(R, -dx, 0);
if R.Left < FGanttView.FixedColWidth then
Continue;
// 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
begin
if FGanttView.DrawingStyle = ds3D then
@ -240,6 +231,8 @@ begin
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom);
end;
end;
// Paint day name
str := FormatDateTime(FGanttView.DayFormat, dayRec.Date);
strLen := RenderCanvas.TextWidth(str);
P := Point((R.Left + R.Right - strLen) div 2, (R.Top + R.Bottom - strH) div 2);
@ -256,21 +249,25 @@ var
R: TRect;
dx, dy: Integer;
begin
dx := FGanttView.FixedColWidth - FGanttView.LeftCol * FGanttView.ColWidth;
dy := FColHeadHeightTotal - FGanttView.TopRow * FRowHeight;
for i := 0 to High(TVpGanttViewOpener(FGanttView).FEventRecords) do
dx := FGanttView.LeftCol * FGanttView.ColWidth;
dy := FGanttView.TopRow * FGanttView.RowHeight;
RenderCanvas.Font.Assign(FEventFont);
for i := 0 to FGanttView.NumEvents-1 do
begin
eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[i];
eventRec := FGanttView.EventRecords[i];
event := eventRec.Event;
R := eventRec.EventRect;
OffsetRect(R, -dx, -dy);
inc(R.Top, 2);
dec(R.Bottom, 1); // 1 less than top due to grid linewidth.
if R.Top < FGanttView.TotalColHeaderHeight then
Continue;
if R.Left < FGanttView.FixedColWidth then
Continue;
cat := FGanttView.DataStore.CategoryColorMap.GetCategory(event.Category);
RenderCanvas.Pen.Color := cat.Color;
RenderCanvas.Brush.Color := cat.BackgroundColor;
R := eventRec.EventRect;
if R.Left = R.Right then R.Right := R.Left + 1;
OffsetRect(R, dx, dy);
InflateRect(R, 0, -2);
if (R.Top < FColHeadHeightTotal) or (R.Left < FGanttView.FixedColWidth) then
Continue;
TPSRectangle(RenderCanvas, Angle, RenderIn, R);
end;
end;
@ -278,53 +275,54 @@ end;
procedure TVpGanttViewPainter.DrawGrid;
var
x1, x2, y0, y1, y2: Integer;
i: Integer;
dx, dy: Integer;
i, n, numEvents: Integer;
eventRec: TVpGanttEventRec;
dayRec: TVpGanttDayRec;
monthRec: TVpGanttMonthRec;
numDays, numMonths, numEvents: Integer;
begin
RenderCanvas.Pen.Color := RealLineColor;
numDays := Length(TVpGanttViewOpener(FGanttView).FDayRecords);
numMonths := Length(TVpGanttViewOpener(FGanttView).FMonthRecords);
numEvents := Length(TVpGanttViewOpener(FGanttView).FEventRecords);
// Horizontal lines
x1 := RealLeft + FGanttView.FixedColWidth;
if numMonths > 0 then
dx := FGanttView.LeftCol * FGanttView.ColWidth;
n := FGanttView.NumMonths;
if n > 0 then
begin
monthRec := TVpGanttViewOpener(FGanttView).FMonthRecords[numMonths-1];
x2 := monthRec.Rect.Right + FGanttView.FixedColWidth;
monthRec := FGanttView.MonthRecords[n-1];
x2 := monthRec.Rect.Right - dx;
end else
x2 := RealRight;
y0 := FColHeadHeightTotal;
y0 := FGanttView.TotalColHeaderHeight;
if FGanttView.DrawingStyle = ds3D then dec(y0);
RenderCanvas.Line(x1, y0, x2, y0);
for i := 0 to numEvents-1 do
numEvents := FGanttView.NumEvents;
y0 := 0;
for i := 0 to numEvents - 1 do
begin
eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[i];
eventRec := FGanttView.EventRecords[i];
y1 := y0 + eventRec.EventRect.Bottom;
RenderCanvas.Line(x1, y1, x2, y1);
end;
// Vertical lines
y1 := RealTop + FColHeadHeightTotal;
y1 := RealTop + FGanttView.TotalColHeaderHeight;
dy := FGanttView.TopRow * FGanttView.RowHeight;
if numEvents > 0 then
begin
eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[numEvents-1];
y2 := eventRec.EventRect.Bottom + FColHeadHeightTotal;
eventRec := FGanttView.EventRecords[numEvents-1];
y2 := eventRec.EventRect.Bottom - dy;
end else
y2 := RealBottom;
for i := 0 to numDays-1 do
n := FGanttView.NumDays;
for i := 0 to n-1 do
begin
dayRec := TVpGanttViewOpener(FGanttView).FDayRecords[i];
x1 := dayRec.Rect.Right + FGanttView.FixedColWidth;
dayRec := FGanttView.DayRecords[i];
x1 := dayRec.Rect.Right - dx;
x2 := x1;
RenderCanvas.Line(x1, y1, x2, y2);
if x1 >= FGanttView.FixedColWidth then
RenderCanvas.Line(x1, y1, x2, y2);
end;
end;
@ -336,13 +334,14 @@ var
str: String;
i: Integer;
dy: Integer;
eventRec: TVpGanttEventRec;
begin
RenderCanvas.Brush.Color := RealRowHeadAttrColor;
if FGanttView.DrawingStyle = ds3d then begin
R.Left := RealLeft + 1;
R.Top := RealTop + FColHeadHeightTotal;
R.Right := RealLeft + FGanttView.FixedColWidth-1;
R.Top := RealTop;
R.Right := RealLeft + FGanttView.FixedColWidth - 1;
R.Bottom := RealBottom - 1;
TPSFillRect(RenderCanvas, Angle, RenderIn, R);
DrawBevelRect(
@ -352,22 +351,26 @@ begin
BevelShadow
);
end else begin
R := Rect(RealLeft, RealTop + FColHeadHeightTotal + 1, RealLeft + FGanttView.FixedColWidth, RealBottom);
R := Rect(RealLeft, RealTop + 1, RealLeft + FGanttView.FixedColWidth, RealBottom);
TPSFillRect(RenderCanvas, Angle, RenderIn, R);
RenderCanvas.Pen.Color := RealLineColor;
RenderCanvas.Line(R.Right, R.Top, R.Right, R.Bottom);
end;
RenderCanvas.Font.Assign(FGanttView.RowHeaderAttributes.EventFont);
RenderCanvas.Font.Assign(FEventFont);
strH := RenderCanvas.TextHeight('Tg');
RenderCanvas.Pen.Color := RealLineColor;
dy := FColHeadHeightTotal - FGanttView.TopRow * FRowHeight;
for i := 0 to High(TVpGanttViewOpener(FGanttView).FEventRecords) do
// Offset due to scrolling
dy := FGanttView.TopRow * FGanttView.RowHeight;
for i := 0 to FGanttView.NumEvents-1 do
begin
str := TVpGanttViewOpener(FGanttView).FEventRecords[i].Caption;
R := TVpGanttViewOpener(FGanttView).FEventRecords[i].HeadRect;
OffsetRect(R, 0, dy);
if R.Top < FColHeadHeightTotal then
eventRec := FGanttView.EventRecords[i];
str := eventRec.Caption;
R := eventRec.HeadRect;
OffsetRect(R, 0, -dy);
if R.Top < FGanttView.TotalColHeaderHeight then
Continue;
if FGanttView.DrawingStyle = ds3D then
begin
@ -382,7 +385,7 @@ begin
RenderCanvas.Line(R.Left, R.Bottom, R.Right, R.Bottom);
// Paint event description as header
P := Point(R.Left + FTextMargin, (R.Top + R.Bottom - strH) div 2);
P := Point(R.Left + FGanttView.TextMargin, (R.Top + R.Bottom - strH) div 2);
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, Str);
end;
end;
@ -417,6 +420,10 @@ begin
RealColor := ColorToRGB(FGanttView.Color);
RealLineColor := ColorToRGB(FGanttView.LineColor);
end;
FDayFont := FGanttView.ColHeaderAttributes.DayFont;
FMonthFont := FGanttView.ColHeaderAttributes.MonthFont;
FEventFont := FGanttView.RowHeaderAttributes.EventFont;
end;
procedure TVpGanttViewPainter.RenderToCanvas(ARenderIn: TRect;
@ -443,8 +450,8 @@ begin
SetMeasurements;
{ Draw headers }
DrawColHeader;
DrawRowHeader;
DrawColHeader;
{ Draw grid }
DrawGrid;
@ -481,21 +488,8 @@ var
begin
inherited;
// Height of the event rows
RenderCanvas.Font.Assign(FGanttView.RowHeaderAttributes.EventFont);
FRowHeight := RenderCanvas.TextHeight('Tg') + 2 * FTextMargin;
// Height of the month part in the column header
RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.MonthFont);
FColHeadRowHeightMonth := RenderCanvas.TextHeight('Tg') + FTextMargin;
// Height of the day part in the column header
RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.DayFont);
FColHeadRowHeightDay := RenderCanvas.TextHeight('Tg') + 2 * FTextMargin;
// total height of header: month row + day row
FColHeadHeightTotal := FColHeadRowHeightMonth + FColHeadRowHeightDay;
FGanttView.Init;
(*
// Determine range of dates as well as the rectangles containing the day,
// column and event headers and the event data.
if (FGanttView.Datastore = nil) or (FGanttView.Datastore.Resource = nil) or
@ -561,7 +555,7 @@ begin
end;
x1 := round((t1 - FGanttView.StartDate) / numDays * totalWidth);
x2 := round((t2 - FGanttView.StartDate) / numDays * totalWidth);
y2 := y1 + FRowHeight;
y2 := y1 + FGanttView.RowHeight;
with TVpGanttViewOpener(FGanttView) do
begin
FEventRecords[i].Event := event;
@ -575,8 +569,8 @@ begin
// Populate day records
SetLength(TVpGanttViewOpener(FGanttView).FDayRecords, numDays);
x1 := 0; // Scrollable dimension
y1 := RealTop + FColHeadRowHeightMonth;
y2 := RealTop + FColHeadHeightTotal;
y1 := RealTop + FGanttView.MonthColHeaderHeight;
y2 := RealTop + FGanttView.TotalColHeaderHeight;
dt := trunc(FGanttView.StartDate);
for i := 0 to numDays-1 do
begin
@ -598,7 +592,7 @@ begin
dt := firstMonth;
x1 := 0; // Scrollable dimension;
y1 := RealTop;
y2 := RealTop + FColHeadHeightTotal;
y2 := RealTop + FGanttView.TotalColHeaderHeight;
for i := 0 to numMonths - 1do
begin
numDays := DaysInMonth(dt);
@ -617,12 +611,10 @@ begin
dt := IncMonth(dt, 1);
x1 := x2;
end;
*)
FGanttView.VisibleCols := (RealRight - RealLeft + FGanttView.FixedColWidth) div FGanttView.ColWidth;
FGanttView.VisibleRows := (RealBottom - RealTop + FColHeadHeightTotal) div FRowHeight;
FGanttView.RowCount := eventCount;
FGanttView.ColCount := numdays;
end;
FGanttView.VisibleCols := (RealRight - RealLeft - FGanttView.FixedColWidth) div FGanttView.ColWidth;
FGanttView.VisibleRows := (RealBottom - RealTop - FGanttView.TotalColHeaderHeight) div FGanttView.RowHeight;
end;
end.

22
components/tvplanit/source/vpmisc.pas
View File

@ -175,6 +175,7 @@ function GranularityToStr(Gran: TVpGranularity): string;
function TaskPriorityToStr(APriority: TVpTaskPriority): String;
function GetCanvasTextHeight(ACanvas: TCanvas; AFont: TFont): Integer;
function GetLabelWidth(ALabel: TLabel): Integer;
function GetRealFontHeight(AFont: TFont): Integer;
@ -911,6 +912,27 @@ begin
end;
end;
function GetCanvasTextHeight(ACanvas: TCanvas; AFont: TFont): Integer;
var
lCanvas: TCanvas;
bmp: TBitmap = nil;
begin
if not ACanvas.HandleAllocated then
begin
bmp := TBitmap.Create;
bmp.SetSize(1, 1);
lCanvas := bmp.Canvas;
end else
lCanvas := ACanvas;
lCanvas.Font.Assign(AFont);
lCanvas.Font.Height := GetRealFontHeight(lCanvas.Font);
{$IF VP_LCL_SCALING = 0}
lCanvas.Font.Size := ScaleY(lCanvas.Font.Size, DesignTimeDPI);
{$ENDIF}
Result := lCanvas.TextHeight('Tg');
bmp.Free;
end;
function GetLabelWidth(ALabel: TLabel): Integer;
var
canvas: TControlCanvas;