gantttimeunit.pas

Gantt source file example to use in delphi 7

               paintArrowStyle(ShadowBitmapRect, ShadowBitmap.Canvas);

            if GanttItem.FitemType = dsFinish then
            begin
               ShadowBitmap.Canvas.Polygon([Point(ShadowBitmapRect.Left, ShadowBitmapRect.Bottom + 1),
                  Point(ShadowBitmapRect.Left, ShadowBitmapRect.Bottom - FProjectHeight),
                     Point(ShadowBitmapRect.Left + FDaysWidth, ShadowBitmapRect.Bottom - HalfHeight),
                     Point(ShadowBitmapRect.Left, ShadowBitmapRect.Bottom + 1)]);
            end;
            if GanttItem.FitemType = dsBenchMark then
            begin
               ShadowBitmap.Canvas.Polygon([Point(ShadowBitmapRect.Left, ShadowBitmapRect.Bottom - 1),
                  Point(ShadowBitmapRect.Left, ShadowBitmapRect.Bottom - HalfHeight),
                     Point(ShadowBitmapRect.Left + HalfDay, ShadowBitmapRect.Bottom - FProjectHeight),
                     Point(ShadowBitmapRect.Left + FDaysWidth, ShadowBitmapRect.Bottom - HalfHeight),
                     Point(ShadowBitmapRect.Left + FDaysWidth, ShadowBitmapRect.Bottom - 1),
                     Point(ShadowBitmapRect.Left, ShadowBitmapRect.Bottom - 1)]);
            end;

            if GanttItem.FitemType = dsDiaGroup then
               paintDiamondStyle(ShadowBitmapRect, ShadowBitmap.Canvas);

            if GanttItem.FitemType = dsPointGroup then
               PaintPointStyle(ShadowBitmapRect, ShadowBitmap.Canvas);

            if GanttItem.FitemType = dsShardGroup then
               PaintShardStyle(ShadowBitmapRect, ShadowBitmap.Canvas);


            GBlur(ShadowBitmap, 1.5);
            BitBlt(FOffScreenCanvas.Handle, ShadowRect.Left, ShadowRect.Top,
               ShadowRect.Right + 3, ShadowRect.Bottom + 3, ShadowBitmap.Canvas.Handle, 0, 0, SRCAND);
            ShadowBitmap.Free;
         end; // shadows


         if GanttItem.FitemType = dsBlock then
         begin
            FOffScreenCanvas.Rectangle(GanttItem.FItemDrawRect);
            Percent := Round(((GanttItem.FItemDrawRect.Right - GanttItem.FItemDrawRect.Left) / 100) * GanttItem.PercentCompleted);
            FOffScreenCanvas.Brush.Color := clNavy;
            FOffScreenCanvas.Rectangle(GanttItem.FItemDrawRect.Left, GanttItem.FItemDrawRect.Top + 4,
               GanttItem.FItemDrawRect.Left + Percent, GanttItem.FItemDrawRect.Bottom - 4);
            FOffScreenCanvas.Brush.Assign(GanttItem.ItemBrush);
         end;

         if GanttItem.FitemType = dsBall then
            FOffScreenCanvas.RoundRect(GanttItem.FItemDrawRect.Left, GanttItem.FItemDrawRect.Top, GanttItem.FItemDrawRect.Right, GanttItem.FItemDrawRect.Bottom, FProjectHeight, FProjectHeight);

         if GanttItem.FitemType = dsRing then
            FOffScreenCanvas.Ellipse(GanttItem.FItemDrawRect);

         if GanttItem.FitemType = dsArrow then
            paintArrowStyle(GanttItem.FItemDrawRect, FOffScreenCanvas);

         if GanttItem.FitemType = dsFinish then
         begin
            FOffScreenCanvas.Polygon([Point(ChartStart, Starty + 1),
               Point(ChartStart, Starty - FProjectHeight),
                  Point(ChartStart + FDaysWidth, Starty - HalfHeight),
                  Point(ChartStart, Starty + 1)]);
         end;

         if GanttItem.FitemType = dsBenchMark then
         begin
            FOffScreenCanvas.Polygon([Point(ChartStart, Starty - 1),
               Point(ChartStart, Starty - HalfHeight),
                  Point(ChartStart + HalfDay, Starty - FProjectHeight),
                  Point(ChartStart + FDaysWidth, Starty - HalfHeight),
                  Point(ChartStart + FDaysWidth, Starty - 1),
                  Point(ChartStart, Starty - 1)]);
            FOffScreenCanvas.MoveTo(GanttItem.FItemDrawRect.Left + HalfDay, GanttItem.FItemDrawRect.Bottom - FProjectHeight);
            FOffScreenCanvas.LineTo(GanttItem.FItemDrawRect.Left + HalfDay, 40);
            PrintText := False;
         end;

         if GanttItem.FitemType = dsEnd then
         begin
            FOffScreenCanvas.Rectangle(GanttItem.FItemDrawRect.Left, 40, GanttItem.FItemDrawRect.Left + FDaysWidth, GanttItem.FItemDrawRect.Bottom);
            PrintText := False;
         end;

         if GanttItem.FitemType = dsDiaGroup then
            paintDiamondStyle(GanttItem.FItemDrawRect, FOffScreenCanvas);

         if GanttItem.FitemType = dsPointGroup then
            PaintPointStyle(GanttItem.FItemDrawRect, FOffScreenCanvas);

         if GanttItem.FitemType = dsShardGroup then
            PaintShardStyle(GanttItem.FItemDrawRect, FOffScreenCanvas);

      end; // Paint Item

      FOffScreenCanvas.Brush.Style := bsClear;

      if (PrintText <> False) then
      begin
         if (FShowItemLength = True) then
            FOffScreenCanvas.TextOut(GanttItem.FItemDrawRect.Right + 8, (StartY - (HalfHeight + 5)), GanttItem.ItemName + ' : ' + inttostr(GanttItem.FNumberOfDays) + ' Days')
         else
            FOffScreenCanvas.TextOut(GanttItem.FItemDrawRect.Right + 8, (StartY - (HalfHeight + 5)), GanttItem.ItemName);
      end; // printtext
      FOffScreenCanvas.Font.Assign(TempFont);
   finally
      TempFont.free;
   end;
end;




procedure TGanttTimeChart.PaintProjectLength(StartY: Integer; GanttItem: TGanttProject);
var
   ChartStart, Index: Integer;
   TempFont: Tfont;
   GanttDaystoPaint, ProjectLength: Integer;
   ShadowRect, ShadowBitmapRect: TRect;
   ShadowBitmap: TBitmap;
   EarlyStartDate: TDateTime;
   TempItem: TGanttItem;

begin
   TempFont := Tfont.Create;
   try
   {Get the early project start date fix to stop the project resting on todays date}
      EarlyStartDate := EncodeDate(2200, 12, 1);
      for Index := 0 to GanttItem.Count - 1 do
      begin
         TempItem := GanttItem.GetGanttItem(Index);
         Inc(ProjectLength, TempItem.FNumberOfDays);
         if TempItem.FStartDate < EarlyStartDate then
            EarlyStartDate := TempItem.FStartDate
      end;
      GanttItem.FProjectStartDate := EarlyStartDate;
      GanttDaystoPaint := GanttItem.FProjectNumberOfDays;
      if (GanttItem.FProjectStartDate < FGridStartDate) then
      begin
         ChartStart := FBoxWidth;
         GanttDaystoPaint := GetDaysLeft(GanttItem.FProjectStartDate, FGridStartDate, GanttItem.FProjectNumberOfDays);
         if GanttDaystoPaint < 1 then exit;
      end
      else
         ChartStart := (GetDaysFromStart(GanttItem.FProjectStartDate, FGridStartDate, FStartMonth) * FDaysWidth) + FBoxWidth;

      GanttItem.FItemDrawRect.Left := ChartStart;
      GanttItem.FItemDrawRect.Top := StartY - FProjectHeight;
      GanttItem.FItemDrawRect.Right := (FDaysWidth * GanttDaystoPaint) + ChartStart;
      GanttItem.FItemDrawRect.Bottom := Starty;

      if FShadows = True then // create dynamic soft shadows
      begin
         ShadowRect := CalculateShadowoffsett(GanttItem.FItemDrawRect);
         ShadowBitmap := TBitmap.create;
         ShadowBitmap.PixelFormat := pf24Bit;
         ShadowBitmap.Width := (ShadowRect.Right - ShadowRect.Left) + 2;
         ShadowBitmap.Height := (ShadowRect.Bottom - ShadowRect.Top) + 2;
         ShadowBitmap.Canvas.Brush.Color := clWhite;
         ShadowBitmap.Canvas.Brush.Style := bsSolid;
         ShadowBitmap.Canvas.Pen.Color := clWhite;
         ShadowBitmapRect := Rect(0, 0, ShadowBitmap.Width - 2, ShadowBitmap.Height - 2);
         ShadowBitmap.Canvas.Rectangle(ShadowBitmapRect);

         ShadowBitmap.Canvas.Brush.Color := FShadowColor;
         ShadowBitmap.Canvas.Pen.Color := FShadowColor;

         PaintPointStyle(ShadowBitmapRect, ShadowBitmap.Canvas);


         GBlur(ShadowBitmap, 1.5);
         BitBlt(FOffScreenCanvas.Handle, ShadowRect.Left, ShadowRect.Top,
            ShadowRect.Right + 3, ShadowRect.Bottom + 3, ShadowBitmap.Canvas.Handle, 0, 0, SRCAND);
         ShadowBitmap.Free;
      end; // shadows

      PaintPointStyle(GanttItem.FItemDrawRect, FOffScreenCanvas);

      FOffScreenCanvas.Brush.Style := bsClear;
   finally
      TempFont.free;
   end;
end;




procedure TGanttTimeChart.PaintItemTitle(StartY: Integer; GanttItem: TGanttItem);
var
   TempColor: TColor;
   Title, DateTitle: string;
   TextWidth: Integer;
   ItemLength: TDateTime;
begin
   FOffScreenCanvas.Brush.Color := CLWhite;
   FOffScreenCanvas.Brush.Style := bsSolid;
   if FRoundTitles = True then
      FOffScreenCanvas.RoundRect(10, StartY - FProjectHeight, FBoxWidth, StartY, 10, 10)
   else
      FOffScreenCanvas.Rectangle(10, StartY - FProjectHeight, FBoxWidth, StartY);

   TempColor := FOffScreenCanvas.Pen.Color;
   if FShowGridLines = True then
   begin
      FOffScreenCanvas.Pen.Color := FProjectLinesColor;
      FOffScreenCanvas.MoveTo(0, StartY);
      FOffScreenCanvas.LineTo(width, StartY);
      FOffScreenCanvas.Pen.Color := TempColor;
   end;

   Title := GanttItem.FItemName;
   ItemLength := GanttItem.EndDate - GanttItem.StartDate;
   DateTimeToString(DateTitle, 'd Days, h Hours, n Minutes', ItemLength);

   TextWidth := Canvas.TextWidth(DateTitle);
   Title := MinimizeString(Title, FBoxWidth - TextWidth); // shrink title to fit

   FOffScreenCanvas.TextOut(14, StartY - 14, Title + ' ' + DateTitle);
end;




procedure TGanttTimeChart.PaintOneProject(StartY: Integer; Project: TGanttProject);
var
   TempColour: TColor;
   Title: string;
begin
   FOffScreenCanvas.Brush.Color := FProjectTitleColour;
   FOffScreenCanvas.Brush.Style := bsSolid;
   if FRoundTitles = True then
      FOffScreenCanvas.RoundRect(0, StartY - FProjectHeight, FBoxWidth, StartY, 10, 10)
   else
      FOffScreenCanvas.Rectangle(0, StartY - FProjectHeight, FBoxWidth, StartY);
   TempColour := FOffScreenCanvas.Pen.Color;
   if FShowGridLines = True then
   begin
      FOffScreenCanvas.Pen.Color := FProjectLinesColor;
      FOffScreenCanvas.MoveTo(0, StartY);
      FOffScreenCanvas.LineTo(width, StartY);
      FOffScreenCanvas.Pen.Color := TempColour;
   end;
   Project.FItemDrawRect.Left := 0;
   Project.FItemDrawRect.Top := StartY - FProjectHeight;
   Project.FItemDrawRect.Right := Width;
   Project.FItemDrawRect.Bottom := StartY;

   Title := Project.FProjectName;
   Title := MinimizeString(Title, FBoxWidth); // shrink title to fit
   FOffScreenCanvas.TextOut(4, StartY - 14, Title);
end;




function TGanttTimeChart.CheckAmountNeeded(StartY: Integer; Project: TGanttProject): Boolean;
var
   Count: Integer;
begin
   result := False;
   Count := (StartY + ((Project.Count + 1) * FProjectHeight));
   if (Height > Count) then Result := True;
end;



procedure TGanttTimeChart.PaintProjects;
var
   ProjectIndex, ItemIndex: Integer;
   StartY: Integer;
   Project: TGanttProject;
   GanttItem: TGanttItem;
   TempBrush: TBrush;
   EnoughLeftToDraw: Boolean;

begin
   FStartMonth := MonthOf(FGridStartDate);
   FDaysOnScreen := GetNumberOfDays(FStartMonth, FMonthCount);
   FProjectsLength := GetAllProjectsLength;
   if FShowHeaderWeeks = True then
      StartY := FBoxHeight + FProjectHeight + 10
   else
      StartY := FBoxHeight + FProjectHeight;

   FOffScreenCanvas.Pen.Color := clBlack;
   FOffScreenCanvas.Font.Name := 'Tahoma';
   FOffScreenCanvas.Font.Size := 7;
   TempBrush := TBrush.Create;
   TempBrush.assign(FOffScreenCanvas.Brush);
   Fnbpaintproject := 0;
   for ProjectIndex := 0 to FTopMostProject - 1 do // changed for scroll
   begin
      Project := GetProject(ProjectIndex);
      Project.FPainted := false;
   end;
   for ProjectIndex := FTopMostProject to FGanttProjectList.count - 1 do // changed for scroll
   begin
      Project := GetProject(ProjectIndex);
      EnoughLeftToDraw := CheckAmountNeeded(StartY, Project);
      if (StartY < Height) and (EnoughLeftToDraw = True) then
      begin
         PaintOneProject(StartY, Project); // Paint the project lines
         Project.FPainted := true;
         inc(Fnbpaintproject);
         FLastDrawnProject := ProjectIndex;
         if ProjectIndex = ProjectDragIndex then
         begin
            FOffScreenCanvas.Pen.Color := clNavy;
            FOffScreenCanvas.Pen.Width := 1;
            FOffScreenCanvas.Brush.Style := bsClear;
            FOffScreenCanvas.Rectangle(0, Project.FItemDrawRect.Top, width, Project.FItemDrawRect.Bottom);
            FOffScreenCanvas.Pen.Color := clBlack;
         end;
         FOffScreenCanvas.Pen.Width := 1;
         inc(StartY, FProjectHeight); // project lines
         for ItemIndex := 0 to Project.Count - 1 do
            begin
               GanttItem := Project.GetGanttItem(ItemIndex);
               PaintItemTitle(StartY, GanttItem);
               if (ItemIndex = ItemDragIndex) and (ProjectIndex = ProjectDragIndex) then
                  PaintOneMovingGanttItem(StartY, GanttItem) // paint the gantt items if moving or dragging
               else
                  PaintOneGanttItem(StartY, GanttItem); // paint the gantt items
               inc(StartY, FProjectHeight); // project lines
            end;
         FOffScreenCanvas.Brush.Assign(TempBrush);
     // inc(StartY, FProjectHeight); // project lines
      end // do not draw if past canvas
      else
         Project.FPainted := false;
   end;
   TempBrush.Free;
end;







procedure TGanttTimeChart.Paint;
begin
   FLanguage := setlanguage(FGanttLanguage);
   setFlinescount;
   ResetScrollBars(SB_VERT);
   ResetScrollBars(SB_HORZ);
   FMemBitmap.Width := ClientWidth;
   FMemBitmap.Height := ClientHeight;
  // PaintHeader;
   PaintTimeHeader;
   PaintProjects;