tvplanit: Progress in painting of TVpGanttView.

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

components/tvplanit/source/vpganttview.pas

@@ -11,6 +11,23 @@ uses
 type
   TVpGanttView = class;
 
+  TVpGanttEventRec = record
+    Event: TVpEvent;
+    Caption: String;
+    HeadRect: TRect;
+    EventRect: TRect;
+  end;
+
+  TVpGanttDayRec = record
+    Date: TDateTime;
+    Rect: TRect;
+  end;
+
+  TVpGanttMonthRec = record
+    Date: TDateTime;
+    Rect: TRect;
+  end;
+
   TVpGanttHeaderAttributes = class(TPersistent)
   private
     FGanttView: TVpGanttView;
@@ -72,15 +89,25 @@ type
     FRowHeaderAttributes: TVpGanttRowHeaderAttributes;
 
     FDrawingStyle: TVpDrawingStyle;
+    FDateFormat: array[0..2] of String;
 
+    function GetDateFormat(AIndex: Integer): String;
+    function IsStoredColWidth: Boolean;
+    function IsStoredDateFormat(AIndex: Integer): Boolean;
     procedure SetColor(Value: TColor); reintroduce;
     procedure SetColWidth(AValue: Integer);
     procedure SetDate(AValue: TDateTime);
+    procedure SetDateFormat(AIndex: Integer; AValue: String);
     procedure SetDrawingStyle(AValue: TVpDrawingStyle);
     procedure SetFixedColWidth(AValue: Integer);
     procedure SetLineColor(Value: TColor);
 
   protected
+    // Needed by the painter
+    FEventRecords: array of TVpGanttEventRec;
+    FDayRecords: array of TVpGanttDayRec;
+    FMonthRecords: array of TVpGanttMonthRec;
+
     { internal methods }
     procedure Hookup;
     procedure Populate;
@@ -89,6 +116,7 @@ type
     class function GetControlClassDefaultSize: TSize; override;
     procedure Loaded; override;
     procedure Paint; override;
+    procedure Resize; override;
 
   public
     constructor Create(AOwner: TComponent); override;
@@ -101,14 +129,23 @@ type
       DisplayOnly: Boolean); override;
 
     property Date: TDateTime read FDate write SetDate;
+    property StartDate: TDateTime read FStartDate write FStartDate;
+    property EndDate: TDateTime read FEndDate write FEndDate;
 
   published
+    property Align;
+    property Anchors;
+    property BorderSpacing;
+
     property ColHeaderAttributes: TVpGanttColHeaderAttributes read FColHeaderAttributes write FColHeaderAttributes;
     property Color: TColor read FColor write SetColor default DEFAULT_COLOR;
-    property ColWidth: Integer read FColWidth write SetColWidth default 32;
+    property ColWidth: Integer read FColWidth write SetColWidth stored IsStoredColWidth;
+    property DayFormat: String index 0 read GetDateFormat write SetDateFormat stored IsStoredDateFormat;
     property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle default ds3d;
     property FixedColWidth: Integer read FFixedColWidth write SetFixedColWidth default 120;
     property LineColor: TColor read FLineColor write SetLineColor default DEFAULT_LINECOLOR;
+    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;
 
   end;
@@ -118,6 +155,12 @@ implementation
 uses
   VpGanttViewPainter;
 
+const
+  DEFAULT_DAYFORMAT = 'd';
+  DEFAULT_MONTHFORMAT = 'mmmm yyyy';
+  DEFAULT_MONTHFORMAT_SHORT = 'mmm yyyy';
+  DEFAULT_COLWIDTH = 20;
+
 {******************************************************************************}
 {   TVpGanttHeaderAttributes                                                   }
 {******************************************************************************}
@@ -227,7 +270,7 @@ begin
   SetDate(Now);
   FStartDate := FDate;
 
-  FColWidth := 32;
+  FColWidth := DEFAULT_COLWIDTH;
   FFixedColWidth := 120;
 
   FColor := DEFAULT_COLOR;
@@ -237,6 +280,9 @@ begin
   FColHeaderAttributes := TVpGanttColHeaderAttributes.Create(self);
 
   FDrawingStyle := ds3d;
+  FDateFormat[0] := DEFAULT_DAYFORMAT;
+  FDateFormat[1] := DEFAULT_MONTHFORMAT;
+  FDateFormat[2] := DEFAULT_MONTHFORMAT_SHORT;
 
   with GetControlClassDefaultSize do
     SetInitialBounds(0, 0, CX, CY);
@@ -255,6 +301,11 @@ begin
   Result.CY := 200;
 end;
 
+function TVpGanttView.GetDateFormat(AIndex: Integer): String;
+begin
+  Result := FDateFormat[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;
@@ -270,6 +321,20 @@ begin
     end;
 end;
 
+function TVpGanttView.IsStoredColWidth: Boolean;
+begin
+  Result := FColWidth <> DEFAULT_COLWIDTH;
+end;
+
+function TVpGanttView.IsStoredDateFormat(AIndex: Integer): Boolean;
+begin
+  case AIndex of
+    0: Result := FDateFormat[0] <> DEFAULT_DAYFORMAT;
+    1: Result := FDateFormat[1] <> DEFAULT_MONTHFORMAT;
+    2: Result := FDateFormat[2] <> DEFAULT_MONTHFORMAT_SHORT;
+  end;
+end;
+
 procedure TVpGanttView.LinkHandler(Sender: TComponent;
   NotificationType: TVpNotificationType; const Value: Variant);
 begin
@@ -330,6 +395,12 @@ begin
   end;
 end;
 
+procedure TVpGanttView.Resize;
+begin
+  inherited;
+  Invalidate;
+end;
+
 procedure TVpGanttView.SetColor(Value: TColor);
 begin
   if FColor <> Value then begin
@@ -369,9 +440,19 @@ begin
   end;
 end;
 
+procedure TVpGanttView.SetDateFormat(AIndex: Integer; AValue: String);
+begin
+  if FDateFormat[AIndex] <> AValue then
+  begin
+    FDateFormat[AIndex] := AValue;
+    Invalidate;
+  end;
+end;
+
 procedure TVpGanttView.SetDrawingStyle(AValue: TVpDrawingStyle);
 begin
-  if FDrawingStyle <> AValue then begin
+  if FDrawingStyle <> AValue then
+  begin
     FDrawingStyle := AValue;
     Invalidate;
   end;

components/tvplanit/source/vpganttviewpainter.pas

@@ -22,13 +22,19 @@ type
     RealLineColor: TColor;
     RealRowHeadAttrColor: TColor;
 
-    FColHeadRowHeight: Integer;
+    FColHeadHeightTotal: Integer;
+    FColHeadRowHeightMonth: Integer;
+    FColHeadRowHeightDay: Integer;
     FRowHeight: Integer;
+    FTextMargin: Integer;
+
+    function CountMonths(ADate1, ADate2: TDateTime): Integer;
 
   protected
     procedure Clear;
     procedure DrawBorders;
     procedure DrawColHeader;
+    procedure DrawEvents;
     procedure DrawGrid;
     procedure DrawRowHeader;
     procedure FixFontHeights;
@@ -47,14 +53,18 @@ type
 implementation
 
 uses
-  Grids,
+  DateUtils,
-  VpMisc, VpCanvasUtils;
+  VpConst, VpMisc, VpCanvasUtils, VpData;
+
+type
+  TVpGanttViewOpener = class(TVpGanttView);
 
 constructor TVpGanttViewPainter.Create(AGanttView: TVpGanttView;
   ARenderCanvas: TCanvas);
 begin
   inherited Create(ARenderCanvas);
   FGanttView := AGanttView;
+  FTextMargin := 2;
 end;
 
 procedure TVpGanttViewPainter.Clear;
@@ -63,6 +73,22 @@ begin
   RenderCanvas.FillRect(RenderIn);
 end;
 
+function TVpGanttViewPainter.CountMonths(ADate1, ADate2: TDateTime): Integer;
+var
+  dt: TDateTime;
+begin
+  if ADate1 > ADate2 then
+    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;
@@ -70,6 +96,8 @@ begin
   R := Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1);
 
   case FGanttView.DrawingStyle of
+    dsNoBorder:
+      ;  // no border
     dsFlat: // Draw a simple rectangular border
       DrawBevelRect(
         RenderCanvas,
@@ -85,101 +113,260 @@ begin
           BevelShadow,
           BevelHighlight
         );
+        (*
         InflateRect(R, -1, -1);
         DrawBevelRect(
           RenderCanvas,
           TPSRotateRectangle(Angle, RenderIn, R),
           BevelDarkShadow,
-          BevelFace
+          clRed //BevelFace
         );
+        *)
       end;
   end;
 end;
 
 procedure TVpGanttViewPainter.DrawColHeader;
 var
-  headRect: TRect;
+  i: Integer;
+  R, R1: TRect;
+  P: TPoint;
+  monthRec: TVpGanttMonthRec;
+  dayRec: TVpGanttDayRec;
+  str: String;
+  strLen, strH: Integer;
 begin
   RenderCanvas.Brush.Color := RealColHeadAttrColor;
+  RenderCanvas.Pen.Color := RealLineColor;
 
-  if FGanttView.DrawingStyle = ds3d then begin
+  R := Rect(RealLeft, RealTop, RealRight, FColHeadHeightTotal);
-    // Draw a 3d bevel
+  TPSFillRect(RenderCanvas, Angle, RenderIn, R);
-    headRect.Left := RealLeft + 2;
+
-    headRect.Top := RealTop + 2;
+  if FGanttView.DrawingStyle = ds3D then
-    headRect.Right := RealLeft + FGanttView.FixedColWidth; // RealRight - 3;
+  begin
-    headRect.Bottom := RealTop + FColHeadRowHeight;
+    R1 := R;
-    TPSFillRect(RenderCanvas, Angle, RenderIn, headRect);
+    InflateRect(R1, -1, -1);
+    R1.Right := FGanttView.FixedColWidth-1;
     DrawBevelRect(
       RenderCanvas,
-      TPSRotateRectangle(Angle, RenderIn, headRect),
+      TPSRotateRectangle(Angle, RenderIn, R1),
       BevelHighlight,
-      BevelDarkShadow
+      BevelShadow
     );
-    headRect.Left := headRect.Right + 1;
+    R1.Left := FGanttView.FixedColWidth;
-    headRect.Right := RealRight - 3;
+    R1.Right := RealRight-2;
-    TPSFillRect(RenderCanvas, Angle, RenderIn, headRect);
     DrawBevelRect(
       RenderCanvas,
-      TPSRotateRectangle(Angle, RenderIn, headRect),
+      TPSRotateRectangle(Angle, RenderIn, R1),
       BevelHighlight,
-      BevelDarkShadow
+      BevelShadow
     );
-  end else begin
+  end else
-    // Draw simple border rectangle
+  begin
-    headRect := Rect(RealLeft, RealTop, RealRight, RealTop + FColHeadRowHeight-1);
+    TPSMoveTo(RenderCanvas, Angle, RenderIn, FGanttView.FixedColWidth, R.Top);
-    TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect);
+    TPSLineTo(RenderCanvas, Angle, RenderIn, FGanttView.FixedColWidth, R.Bottom);
-    RenderCanvas.Pen.Color := RealLineColor;
+    TPSMoveTo(RenderCanvas, Angle, RenderIn, RealLeft, R.Bottom);
-    RenderCanvas.Line(headRect.Left, headRect.Bottom, headRect.Right, headRect.Bottom);
+    TPSLineTo(RenderCanvas, Angle, RenderIn, RealRight, R.Bottom);
-    headRect.Left := headRect.Left + FGanttView.FixedColWidth;
+  end;
-    RenderCanvas.Line(headRect.Left, headRect.Top, headRect.Left, headRect.Bottom);
+
+  // Draw month rectangles and month captions
+  for i := 0 to High(TVpGanttViewOpener(FGanttView).FMonthRecords) do
+  begin
+    monthRec := TVpGanttViewOpener(FGanttView).FMonthRecords[i];
+    R := monthRec.Rect;
+    OffsetRect(R, FGanttView.FixedColWidth, 0);
+    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;
+
+    str := FormatDateTime(FGanttView.MonthFormat, monthRec.Date);
+    strLen := RenderCanvas.TextWidth(str);
+    if strLen > R.Width - 2 * FTextMargin then
+    begin
+      str := FormatDateTime(FGanttView.MonthFormat_short, monthRec.Date);
+      strLen := RenderCanvas.TextWidth(str);
+    end;
+    if strLen > R.Width - 2 * FTextMargin then
+      str := '';
+    if str <> '' then
+    begin
+      P := Point((R.Left + R.Right - strLen) div 2, R.Top + FTextMargin);
+      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);
+  strH := RenderCanvas.TextHeight('Tg');
+  for dayRec in TVpGanttViewOpener(FGanttView).FDayRecords do
+  begin
+    R := dayRec.Rect;
+    OffsetRect(R, FGanttView.FixedColWidth, 0);
+    if (DayOf(dayRec.Date) <> DaysInMonth(dayRec.Date)) then
+    begin
+      if FGanttView.DrawingStyle = ds3D then
+        DrawBevelLine(
+          RenderCanvas,
+          TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Top)),
+          TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Bottom)),
+          BevelShadow,
+          BevelHighlight
+        )
+      else
+      begin
+        TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top);
+        TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom);
+      end;
+    end;
+    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);
+    TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
+  end;
+end;
+
+procedure TVpGanttViewPainter.DrawEvents;
+var
+  i: Integer;
+  eventRec: TVpGanttEventRec;
+  event: TVpEvent;
+  cat: TVpCategoryInfo;
+  R: TRect;
+begin
+  for i := 0 to High(TVpGanttViewOpener(FGanttView).FEventRecords) do
+  begin
+    eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[i];
+    event := eventRec.Event;
+    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, FGanttView.FixedColWidth, FColHeadHeightTotal);
+    InflateRect(R, 0, -2);
+    TPSRectangle(RenderCanvas, Angle, RenderIn, R);
   end;
 end;
 
 procedure TVpGanttViewPainter.DrawGrid;
 var
-  x1, x2, y1, y2: Integer;
+  x1, x2, y0, y1, y2: Integer;
+  i: Integer;
+  eventRec: TVpGanttEventRec;
+  dayRec: TVpGanttDayRec;
+  monthRec: TVpGanttMonthRec;
+  numDays, numMonths, numEvents: Integer;
 begin
-  exit;
   RenderCanvas.Pen.Color := RealLineColor;
 
-  x1 := RenderIn.Left;
+  numDays := Length(TVpGanttViewOpener(FGanttView).FDayRecords);
-  x2 := RenderIn.Right;
+  numMonths := Length(TVpGanttViewOpener(FGanttView).FMonthRecords);
-  y1 := RenderIn.Top + FColHeadRowHeight;
+  numEvents := Length(TVpGanttViewOpener(FGanttView).FEventRecords);
-  y2 := y1;
-  RenderCanvas.Line(x1, y1, x2, y2);
 
-  x1 := RenderIn.Left + FGanttView.FixedColWidth;
+  // Horizontal lines
-  x2 := x1;
+  x1 := RealLeft + FGanttView.FixedColWidth;
-  y1 := RenderIn.Top;
+  if numMonths > 0 then
-  y2 := RenderIn.Bottom;
+  begin
-  RenderCanvas.Line(x1, y1, x2, y2);
+    monthRec := TVpGanttViewOpener(FGanttView).FMonthRecords[numMonths-1];
+    x2 := monthRec.Rect.Right + FGanttView.FixedColWidth;
+  end else
+    x2 := RealRight;
+
+  y0 := FColHeadHeightTotal;
+  if FGanttView.DrawingStyle = ds3D then dec(y0);
+
+  RenderCanvas.Line(x1, y0, x2, y0);
+
+  for i := 0 to numEvents-1 do
+  begin
+    eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[i];
+    y1 := y0 + eventRec.EventRect.Bottom;
+    RenderCanvas.Line(x1, y1, x2, y1);
+  end;
+
+  // Vertical lines
+  y1 := RealTop + FColHeadHeightTotal;
+  if numEvents > 0 then
+  begin
+    eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[numEvents-1];
+    y2 := eventRec.EventRect.Bottom + FColHeadHeightTotal;
+  end else
+    y2 := RealBottom;
+  for i := 0 to numDays-1 do
+  begin
+    dayRec := TVpGanttViewOpener(FGanttView).FDayRecords[i];
+    x1 := dayRec.Rect.Right + FGanttView.FixedColWidth;
+    x2 := x1;
+    RenderCanvas.Line(x1, y1, x2, y2);
+  end;
 end;
 
 procedure TVpGanttViewPainter.DrawRowHeader;
 var
-  headRect: TRect;
+  R: TRect;
+  P: TPoint;
+  strH: Integer;
+  str: String;
+  i: Integer;
 begin
   RenderCanvas.Brush.Color := RealRowHeadAttrColor;
 
   if FGanttView.DrawingStyle = ds3d then begin
-    // Draw a 3d bevel
+    R.Left := RealLeft + 1;
-    headRect.Left := RealLeft + 2;
+    R.Top := RealTop + FColHeadHeightTotal;
-    headRect.Top := RealTop + FColHeadRowHeight + 1;
+    R.Right := RealLeft + FGanttView.FixedColWidth-1;
-    headRect.Right := RealLeft + FGanttView.FixedColWidth;
+    R.Bottom := RealBottom - 1;
-    headRect.Bottom := RealBottom - 3;
+    TPSFillRect(RenderCanvas, Angle, RenderIn, R);
-    TPSFillRect(RenderCanvas, Angle, RenderIn, headRect);
     DrawBevelRect(
       RenderCanvas,
-      TPSRotateRectangle(Angle, RenderIn, headRect),
+      TPSRotateRectangle(Angle, RenderIn, R),
       BevelHighlight,
-      BevelDarkShadow
+      BevelShadow
     );
   end else begin
-    // Draw simple border rectangle
+    R := Rect(RealLeft, RealTop + FColHeadHeightTotal + 1, RealLeft + FGanttView.FixedColWidth, RealBottom);
-    headRect := Rect(RealLeft, RealTop + FColHeadRowHeight, RealLeft + FGanttView.FixedColWidth, RealBottom);
+    TPSFillRect(RenderCanvas, Angle, RenderIn, R);
-    TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect);
     RenderCanvas.Pen.Color := RealLineColor;
-    RenderCanvas.Line(headRect.Right, headRect.Top, headrect.Right, headRect.Bottom);
+    RenderCanvas.Line(R.Right, R.Top, R.Right, R.Bottom);
+  end;
+
+  RenderCanvas.Font.Assign(FGanttView.RowHeaderAttributes.EventFont);
+  strH := RenderCanvas.TextHeight('Tg');
+  RenderCanvas.Pen.Color := RealLineColor;
+  for i := 0 to High(TVpGanttViewOpener(FGanttView).FEventRecords) do
+  begin
+    str := TVpGanttViewOpener(FGanttView).FEventRecords[i].Caption;
+    R := TVpGanttViewOpener(FGanttView).FEventRecords[i].HeadRect;
+    OffsetRect(R, 0, FColHeadHeightTotal);
+    if FGanttView.DrawingStyle = ds3D then
+    begin
+      R.BottomRight := R.BottomRight - Point(1, 1);
+      DrawBevelRect(
+        RenderCanvas,
+        TPSRotateRectangle(Angle, RenderIn, R),
+        BevelHighlight,
+        BevelShadow
+      );
+    end else
+      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);
+    TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, Str);
   end;
 end;
 
@@ -245,8 +432,8 @@ begin
     { Draw grid }
     DrawGrid;
 
-    { draw days }
+    { draw events }
-    //DrawDays;
+    DrawEvents;
 
     { Draw the borders }
     DrawBorders;
@@ -264,17 +451,153 @@ begin
 end;
 
 procedure TVpGanttViewPainter.SetMeasurements;
+var
+  firstEvent: TVpEvent;
+  firstDay, lastDay: TDateTime;
+  firstMonth, lastMonth: TDateTime;
+  eventCount, numDays, numMonths: Integer;
+  x1, x2, y1, y2: Integer;
+  i: Integer;
+  dt, t1, t2: TDateTime;
+  totalWidth: double;
+  event: TVpEvent;
 begin
   inherited;
 
+  // Height of the event rows
   RenderCanvas.Font.Assign(FGanttView.RowHeaderAttributes.EventFont);
-  FRowHeight := RenderCanvas.TextHeight('Tg') + 2 * varCellPadding;
+  FRowHeight := RenderCanvas.TextHeight('Tg') + 2 * FTextMargin;
 
+  // Height of the month part in the column header
   RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.MonthFont);
-  FColHeadRowHeight := RenderCanvas.TextHeight('Tg') + 2 * varCellPadding;
+  FColHeadRowHeightMonth := RenderCanvas.TextHeight('Tg') + FTextMargin;
 
+  // Height of the day part in the column header
   RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.DayFont);
-  FColHeadRowHeight := FColHeadRowHeight + RenderCanvas.TextHeight('Tg') + varCellPadding;
+  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
+     (FGanttView.Datastore.Resource.Schedule.EventCount = 0) then
+  begin
+    eventCount := 0;
+    FGanttView.StartDate := NO_DATE;
+    FGanttView.EndDate := NO_DATE;
+    SetLength(TVpGanttViewOpener(FGanttView).FEventRecords, 0);
+    SetLength(TVpGanttViewOpener(FGanttView).FDayRecords, 0);
+    SetLength(TVpGanttViewOpener(FGanttView).FMonthRecords, 0);
+  end else
+  begin
+    eventCount := FGanttView.Datastore.Resource.Schedule.EventCount;
+    firstEvent := FGanttView.DataStore.Resource.Schedule.GetEvent(0);
+
+    // Find date range needed for the GanttView
+    firstDay := trunc(firstEvent.StartTime);
+    lastDay := trunc(firstEvent.EndTime);
+    if frac(lastDay) = 0.0 then lastDay := lastDay + 1;
+    for i := 1 to FGanttView.Datastore.Resource.Schedule.EventCount-1 do
+    begin
+      event := FGanttView.Datastore.Resource.Schedule.GetEvent(i);
+      if event.AllDayEvent then begin
+        t1 := trunc(event.StartTime);
+        t2 := trunc(event.EndTime);
+      end else
+      begin
+        t1 := event.StartTime;
+        t2 := event.EndTime;
+      end;
+      if t1 < firstDay then
+        firstDay := trunc(t1);
+      if t2 > lastDay then
+        lastDay := trunc(t2);
+    end;
+    lastDay := lastDay + 1;
+    FGanttView.StartDate := firstDay;
+    FGanttView.EndDate := lastDay;
+
+    // Prepare the event, day and month records for painting the cells
+    numdays := DaysBetween(FGanttView.StartDate, FGanttView.EndDate);
+    totalWidth := numdays * FGanttView.ColWidth;
+
+    // Populate event records
+    SetLength(TVpGanttViewOpener(FGanttView).FEventRecords, eventCount);
+    y1 := 0;   // this dimension is scrollable
+    for i := 0 to eventCount-1 do
+    begin
+      event := FGanttView.DataStore.Resource.Schedule.GetEvent(i);
+      if event.AllDayEvent then
+      begin
+        t1 := trunc(event.StartTime);
+        t2 := trunc(event.EndTime);
+        if frac(t2) = 0 then t2 := t2 + 1;
+      end else
+      begin
+        t1 := event.StartTime;
+        t2 := event.EndTime;
+      end;
+      x1 := round((t1 - FGanttView.StartDate) / numDays * totalWidth);
+      x2 := round((t2 - FGanttView.StartDate) / numDays * totalWidth);
+      y2 := y1 + FRowHeight;
+      with TVpGanttViewOpener(FGanttView) do
+      begin
+        FEventRecords[i].Event := event;
+        FEventRecords[i].Caption := event.Description;
+        FEventRecords[i].HeadRect := Rect(RealLeft, y1, RealLeft + FixedColWidth, y2);
+        FEventRecords[i].EventRect := Rect(x1, y1, x2, y2);
+      end;
+      y1 := y2;
+    end;
+
+    // Populate day records
+    SetLength(TVpGanttViewOpener(FGanttView).FDayRecords, numDays);
+    x1 := 0;  // Scrollable dimension
+    y1 := RealTop + FColHeadRowHeightMonth;
+    y2 := RealTop + FColHeadHeightTotal;
+    dt := trunc(FGanttView.StartDate);
+    for i := 0 to numDays-1 do
+    begin
+      x2 := x1 + FGanttView.ColWidth;
+      with TVpGanttViewOpener(FGanttView) do
+      begin
+        FDayRecords[i].Date := dt;
+        FDayRecords[i].Rect := Rect(x1, y1, x2, y2);
+      end;
+      dt := IncDay(dt, 1);
+      x1 := x2;
+    end;
+
+    // Populate month records
+    firstMonth := FGanttView.StartDate;
+    lastMonth := FGanttView.EndDate;
+    numMonths := CountMonths(firstMonth, lastMonth);
+    SetLength(TVpGanttViewOpener(FGanttView).FMonthRecords, numMonths);
+    dt := firstMonth;
+    x1 := 0;    // Scrollable dimension;
+    y1 := RealTop;
+    y2 := RealTop + FColHeadHeightTotal;
+    for i := 0 to numMonths - 1do
+    begin
+      numDays := DaysInMonth(dt);
+      if i = 0 then
+        // partial first month
+        numDays := numDays - DayOf(dt) + 1
+      else
+      if i = numMonths-1 then
+        numDays := DayOf(lastMonth) - 1;
+      x2 := x1 + numDays * FGanttView.ColWidth;
+      with TVpGanttViewOpener(FGanttView) do
+      begin
+        FMonthRecords[i].Date := dt;
+        FMonthRecords[i].Rect := Rect(x1, y1, x2, y2);
+      end;
+      dt := IncMonth(dt, 1);
+      x1 := x2;
+    end;
+  end;
 end;
 
 end.

components/tvplanit/source/vpmisc.pas

@@ -40,7 +40,7 @@ uses
   Windows, Consts, Messages,
   {$ENDIF}
   SysUtils, Buttons, Classes, Controls, StdCtrls, ExtCtrls, Forms, Graphics, Menus,
-  VpBase, VpData, VpConst;
+  VpBase, VpData, VpConst, VpCanvasUtils;
 
 type
   TDayList = array[1..12] of Word;
@@ -115,9 +115,13 @@ function GetDisplayString(Canvas : TCanvas; const S : string;
 function GetDateDisplayString(ACanvas: TCanvas; ADate: TDateTime;
   AFormat, AHoliday: String; AWidth: Integer): String;
 
+{ Draws a bevel in the specified TRect, using the specified colors }
 procedure DrawBevelRect(const Canvas: TCanvas; R: TRect;
   Shadow, Highlight: TColor);
-  { Draws a bevel in the specified TRect, using the specified colors }
+
+{ Draws a bevelled vertical line using the specified colors }
+procedure DrawBevelLine(const Canvas: TCanvas; P1, P2: TPoint;
+  Shadow, Highlight: TColor);
 
 procedure AlignOKCancel(OKButton, CancelButton: TButton; APanel: TPanel);
   { Aligns the OK and Cancel buttons to the right of the panel. In Windows the
@@ -471,7 +475,27 @@ begin
       Point(R.Left, R.Bottom)]);
   end;
 end;
-{=====}
+
+
+procedure DrawBevelLine(const Canvas: TCanvas; P1, P2: TPoint;
+  Shadow, Highlight: TColor);
+begin
+  with Canvas do
+  begin
+    Pen.Color := Shadow;
+    Line(P1.X, P1.Y, P2.X, P2.Y);
+    Pen.Color := Highlight;
+    if P1.X = P2.X then
+      // vertical line
+      Line(P1.X+1, P1.Y, P2.X+1, P2.Y)
+    else if (P1.Y = P2.Y) then
+      // horizontal line
+      Line(P1.X, P1.Y+1, P2.X, P2.Y+1)
+    else
+      Line(P1.X+1, P1.Y+1, P2.X+1, P2.Y+1)
+  end;
+end;
+
 
 procedure AlignOKCancel(OKButton, CancelButton: TButton; APanel: TPanel);
 var