gantttimeunit.pas

Gantt source file example to use in delphi 7

unit GanttTimeUnit;

interface

uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls, GanttUnit,
   Forms, Graphics, DateUtils, Printers, Dialogs, ExtCtrls, Contnrs, GanttDataBinder4, StdCtrls, GanttLang;


Const
   DaysPerWeek = 7;
   HoursPerDay = 24;
   MinutesPerHour = 60;
   PixelsPerHour = 30;





type
   TGanttTimeChart = class(TGanttChart)
   private
      {Paint Consts}
      FMinuteDivisor: Integer;
      procedure WMLButtonDown(var Message: TWMLButtonDown); message wm_LButtonDown;
      procedure WMLButtonUp(var Message: TWMLButtonUp); message wm_LButtonUp;
      procedure WMRButtonDown(var Message: TWMRButtonDown); message wm_RButtonDown;
      procedure WMMouseMove(var Message: TWMMouseMove); message wm_MouseMove;
      { Private methods of TGanttTimeChart }
        { Method to set variable and property values and create objects }
      procedure AutoInitialize;
        { Method to free any objects created by AutoInitialize }
      procedure AutoDestroy;
   protected
      { Protected fields of TGanttTimeChart }
      { Protected methods of TGanttTimeChart }
      procedure Click; override;
      procedure KeyPress(var Key: Char); override;
      procedure Loaded; override;
      function CheckAmountNeeded(StartY: Integer; Project: TGanttProject): Boolean;
      procedure PaintProjects;
      procedure PaintOneProject(StartY: Integer; Project: TGanttProject);
      procedure PaintItemTitle(StartY: Integer; GanttItem: TGanttItem);
      procedure PaintProjectLength(StartY: Integer; GanttItem: TGanttProject);
      procedure PaintOneGanttItem(StartY: Integer; GanttItem: TGanttItem);
      procedure PaintOneMovingGanttItem(StartY: Integer; GanttItem: TGanttItem);
      procedure Paint; override;
      procedure setFlinescount;
      Function AjustDateTime(CurrentDate : TDateTime; Amount : Integer): TDateTime;
   public
      { Public fields and properties of TGanttTimeChart }
      { Public methods of TGanttTimeChart }
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
   published
      { Published properties of TGanttTimeChart }
   end;




type
   TGanttProjectTimeChart = class(TGanttChart)
   private
      {Paint Consts}
      FMinuteDivisor: Integer;
      procedure WMLButtonDown(var Message: TWMLButtonDown); message wm_LButtonDown;
      procedure WMLButtonUp(var Message: TWMLButtonUp); message wm_LButtonUp;
      procedure WMRButtonDown(var Message: TWMRButtonDown); message wm_RButtonDown;
      procedure WMMouseMove(var Message: TWMMouseMove); message wm_MouseMove;
      { Private methods of TGanttProjectTimeChart }
        { Method to set variable and property values and create objects }
      procedure AutoInitialize;
        { Method to free any objects created by AutoInitialize }
      procedure AutoDestroy;
   protected
      { Protected fields of TGanttProjectTimeChart }
      { Protected methods of TGanttProjectTimeChart }
      procedure Click; override;
      procedure KeyPress(var Key: Char); override;
      procedure Loaded; override;
      function CheckAmountNeeded(StartY: Integer; Project: TGanttProject): Boolean;
      procedure PaintProjects;
      procedure PaintOneProject(StartY: Integer; Project: TGanttProject);
      procedure PaintItemTitle(StartY: Integer; GanttItem: TGanttItem);
      procedure PaintProjectLength(StartY: Integer; GanttItem: TGanttProject);
      procedure PaintOneGanttItem(StartY: Integer; GanttItem: TGanttItem);
      procedure PaintOneMovingGanttItem(StartY: Integer; GanttItem: TGanttItem);
      procedure Paint; override;
      procedure setFlinescount;
      Function AjustDateTime(CurrentDate : TDateTime; Amount : Integer): TDateTime;
   public
      { Public fields and properties of TGanttProjectTimeChart }
      { Public methods of TGanttProjectTimeChart }
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
   published
      { Published properties of TGanttProjectTimeChart }
   end;


procedure Register;


implementation


uses GBlur2, MiscHelpFunctions, Jpeg, OutLookDataLink, Variants, GanttImport;




procedure Register;
begin
     { Register TGanttChart with Samples as its
       default page on the Delphi component palette }
   RegisterComponents('Samples', [TGanttTimeChart]);
   RegisterComponents('Samples', [TGanttProjectTimeChart]);
end;




{++++++++++++++++++++++++++ Gantt TimeChart +++++++++++++++++++++++++++++}



procedure TGanttTimeChart.WMLButtonDown(var Message: TWMLButtonDown);
var
   Temp: TPoint;
begin
   inherited;
  // Check to see if the mouse is over a cell
   Temp := ClientToScreen(Point(Message.XPos, Message.YPos));
   if not (FindDragTarget(Temp, True) = Self) then Exit;
   if XYtoGanttItem(Message.XPos, Message.YPos, ProjectDragIndex, ItemDragIndex) = True then
   begin
      if ((Message.XPos > DragGanttItemRect.Right - 3) and (Message.XPos < DragGanttItemRect.Right + 3)) then
         FResizing := True
      else
         if FLinking = False then FDragging := True;
      OldX := Message.XPos;
      OldY := Message.YPos;
   end;
end;





Function TGanttTimeChart.AjustDateTime(CurrentDate : TDateTime; Amount : Integer): TDateTime;
begin
  //TGanttTimeType = (ttMonth, ttWeek, ttday, tthour);

  if (GanttTimeType = ttMonth) or (GanttTimeType = ttWeek) then
                 Result := incday(CurrentDate, Amount)
     else
  if (GanttTimeType = ttday) then
                 Result := incHour(CurrentDate, Amount)
     else
  if (GanttTimeType = tthour) then
                 Result := incMinute(CurrentDate, Amount);
end;




procedure TGanttTimeChart.WMLButtonUp(var Message: TWMLButtonUp);
var
   Temp: TPoint;
   ProjectDragToIndex, ItemDragToIndex: Integer;
   Project1, Project2: TGanttProject;
   GanttItem: TGanttItem;
   BlocksMoved: Integer;

begin
   if FDragging then
   begin
      Temp := Point(Message.XPos, Message.YPos);
         // work out if we have moved along the chart
      if Temp.X < OldX then
      begin
         BlocksMoved := Round((OldX - Temp.X) / FDaysWidth);
         BlocksMoved := -BlocksMoved;
      end
      else
      begin
         BlocksMoved := Round((Temp.X - OldX) / FDaysWidth);
      end;
      if XYtoGanttProject(Message.XPos, Message.YPos, ProjectDragToIndex) = True then
      begin
         if FItemCanMoveProject then
         begin
            Project1 := GetProject(ProjectDragIndex);
            Project2 := GetProject(ProjectDragToIndex);
            GanttItem := Project1.GetGanttItem(ItemDragIndex);
            GanttItem.FStartDate := AjustDateTime(GanttItem.FStartDate, BlocksMoved);
            GanttItem.FEndDate := AjustDateTime(GanttItem.FEndDate, BlocksMoved);
            ItemDragToIndex := Project2.Add(Project1.Extract(GanttItem));
            Project1.Pack;
            if (GanttItem.ItemHardLink = true) then
               ResetHardLink(GanttItem.FItemLink.ProjectID, GanttItem.FItemLink.ItemID, BlocksMoved);

            ResetDraggedLinks(ProjectDragToIndex, ItemDragToIndex, BlocksMoved); {do links}
            if Assigned(FOnMoveItemEvent) then
               FOnMoveItemEvent(ProjectDragIndex, ItemDragIndex, ProjectDragToIndex, ItemDragToIndex);
            Project1.Loaded;
            Cursor := crArrow;
            FDragging := False;
         end
      end
      else
         FDragging := False;
      begin // just moving
      //
         Project1 := GetProject(ProjectDragIndex);
         GanttItem := Project1.GetGanttItem(ItemDragIndex);
         GanttItem.FStartDate := AjustDateTime(GanttItem.FStartDate, BlocksMoved);
         GanttItem.FEndDate := AjustDateTime(GanttItem.FEndDate, BlocksMoved);

         if (GanttItem.ItemHardLink = true) then
            ResetHardLink(GanttItem.FItemLink.ProjectID, GanttItem.FItemLink.ItemID, BlocksMoved);
         if Assigned(FOnMoveItemEvent) then
            FOnMoveItemEvent(ProjectDragIndex, ItemDragIndex, -1, -1);
//         ResetDraggedLinks(ProjectDragToIndex, ItemDragToIndex, DaysMoved); {do links}
         Project1.Loaded;
         Cursor := crArrow;
         FDragging := False;
      end
   end;


   if FLinking then // create a link to another Item
   begin
      if XYtoGanttItem(Message.XPos, Message.YPos, ProjectDragToIndex, ItemDragToIndex) = True then
      begin
         Project1 := GetProject(ProjectDragIndex);
         GanttItem := Project1.GetGanttItem(ItemDragIndex);
         GanttItem.FItemLink.ProjectID := ProjectDragToIndex;
         GanttItem.FItemLink.ItemID := ItemDragToIndex;
         GanttItem.FItemLink.LinkType := lsFinishStart;
         GanttItem.FItemLink.HardLink := False;
         Project1.Loaded;
         Cursor := crArrow;
         FLinking := False;
      end;
   end;

   if FResizing then
   begin
      Temp := Point(Message.XPos, Message.YPos);
         // work out if we have moved along the chart
      if Temp.X < OldX then
      begin
         BlocksMoved := Round((OldX - Temp.X) / FDaysWidth);
         BlocksMoved := -BlocksMoved;
      end
      else
      begin
         BlocksMoved := Round((Temp.X - OldX) / FDaysWidth);
      end;
      Project1 := GetProject(ProjectDragIndex);
      GanttItem := Project1.GetGanttItem(ItemDragIndex);
      // New Conditions thanks to Jacek
      //if (Ganttitem.FNumberOfDays + BlocksMoved = 0) then BlocksMoved := (1 - Ganttitem.FNumberOfDays);
      //if (Ganttitem.FNumberOfDays + BlocksMoved < 0) then BlocksMoved := 0;

    //  GanttItem.FNumberOfDays := GanttItem.FNumberOfDays + BlocksMoved;
      GanttItem.FEndDate := AjustDateTime(GanttItem.FEndDate, BlocksMoved);
      Project1.Loaded;
      Cursor := crArrow;
      FResizing := False;
   end;

   if FItemCanMoveProject then
      if XYtoGanttItem(Message.XPos, Message.YPos, ProjectDragToIndex, ItemDragToIndex) = True then
         if Assigned(FOnSelectItemEvent) then
            FOnSelectItemEvent(ProjectDragToIndex, ItemDragToIndex);

   if XYtoGanttProjectTitle(Message.XPos, Message.YPos, ProjectDragToIndex) = True then
   begin
      ProjectDragIndex := ProjectDragToIndex;
      Project1 := GetProject(ProjectDragIndex);
      Project1.FTreeClosed := not Project1.FTreeClosed;
      if Assigned(FOnSelectItemEvent) then
         FOnSelectProjectEvent(ProjectDragIndex);
   end;
   DeltaX := 0;
   DeltaY := 0;
   Invalidate;
   inherited;
end;




procedure TGanttTimeChart.WMMouseMove(var Message: TWMMouseMove);
var
   Temp: TPoint;
   ShowRect: TRect;
   TempProj, TempItem: Integer;
   CursorType: Integer;
begin
   inherited;
   if FInHint = True then Invalidate;
   FInHint := False;
   FHintTimer.Enabled := False;
   Temp := Point(Message.XPos, Message.YPos);
   CurrentX := Message.XPos;
   CurrentY := Message.YPos;
   CursorType := 1; //arrow

   if XYtoGanttItem(Message.XPos, Message.YPos, TempProj, TempItem) = True then
   begin
      FHintTimer.Enabled := True;
      if ((Message.XPos > DragGanttItemRect.Right - 3) and (Message.XPos < DragGanttItemRect.Right + 3)) then
         CursorType := 2 // streching
      else
         if FLinking = False then CursorType := 3 // dragging
         else
            if FLinking = True then CursorType := 4; // linking
   end;

   case CursorType of
      1: Cursor := crArrow;
      2: Cursor := crSizeWE;
      3: Cursor := crDrag;
      4: Cursor := crHandPoint;
   end;

   if FDragging then
   begin
      DeltaX := Temp.X - Oldx;
      DeltaY := Temp.Y - Oldy;
      ShowRect.Top := DragGanttItemRect.Top + DeltaY;
      ShowRect.Bottom := DragGanttItemRect.Bottom + DeltaY;
      showRect.Left := DragGanttItemRect.Left + DeltaX;
      showRect.Right := DragGanttItemRect.Right + DeltaX;
      invalidate;
   end;
   if FResizing then
   begin
      DeltaX := Temp.X - Oldx;

      // Code update thanks to Jacek
     // if (Temp.X <= DragGanttItemRect.Left + FDaysWidth) then DeltaX := FDaysWidth;
      if (Temp.X <= DragGanttItemRect.Left) then DeltaX := 0;

      ShowRect.Top := DragGanttItemRect.Top;
      ShowRect.Bottom := DragGanttItemRect.Bottom;