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

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8421 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/source/vpganttview.pas

@@ -5,8 +5,9 @@ unit VpGanttView;
 interface
 
 uses
-  LCLType, LCLIntf, LMessages, Classes, SysUtils, Graphics, Types, StdCtrls,
+  LCLType, LCLIntf, LMessages,
-  VpConst, VpBase, VpBaseDS, VpData;
+  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);

components/tvplanit/source/vpganttviewpainter.pas

@@ -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.
+  // Draw day captions (always centered) and dividing lines (always at right side).
-  RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.DayFont);
+  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;
+  dx := FGanttView.LeftCol * FGanttView.ColWidth;
-  dy := FColHeadHeightTotal - FGanttView.TopRow * FRowHeight;
+  dy := FGanttView.TopRow * FGanttView.RowHeight;
-  for i := 0 to High(TVpGanttViewOpener(FGanttView).FEventRecords) do
+
+  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,52 +275,53 @@ 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];
+    monthRec := FGanttView.MonthRecords[n-1];
-    x2 := monthRec.Rect.Right + FGanttView.FixedColWidth;
+    x2 := monthRec.Rect.Right - dx;
   end else
     x2 := RealRight;
-
+  y0 := FGanttView.TotalColHeaderHeight;
-  y0 := FColHeadHeightTotal;
   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];
+    eventRec := FGanttView.EventRecords[numEvents-1];
-    y2 := eventRec.EventRect.Bottom + FColHeadHeightTotal;
+    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];
+    dayRec := FGanttView.DayRecords[i];
-    x1 := dayRec.Rect.Right + FGanttView.FixedColWidth;
+    x1 := dayRec.Rect.Right - dx;
     x2 := x1;
+    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.Top := RealTop;
-    R.Right := RealLeft + FGanttView.FixedColWidth-1;
+    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;
+    eventRec := FGanttView.EventRecords[i];
-    R := TVpGanttViewOpener(FGanttView).FEventRecords[i].HeadRect;
+    str := eventRec.Caption;
-    OffsetRect(R, 0, dy);
+    R := eventRec.HeadRect;
-    if R.Top < FColHeadHeightTotal then
+    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
+  FGanttView.Init;
-  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;
-
   // 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;
+    y1 := RealTop + FGanttView.MonthColHeaderHeight;
-    y2 := RealTop + FColHeadHeightTotal;
+    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.VisibleCols := (RealRight - RealLeft - FGanttView.FixedColWidth) div FGanttView.ColWidth;
-    FGanttView.VisibleRows := (RealBottom - RealTop + FColHeadHeightTotal) div FRowHeight;
+  FGanttView.VisibleRows := (RealBottom - RealTop - FGanttView.TotalColHeaderHeight) div FGanttView.RowHeight;
-    FGanttView.RowCount := eventCount;
-    FGanttView.ColCount := numdays;
-  end;
 end;
 
 end.

components/tvplanit/source/vpmisc.pas

@@ -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;