⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 gantttimeunit.pas

📁 Gantt source file example to use in delphi 7
💻 PAS
📖 第 1 页 / 共 5 页
字号:
   PaintItemLinks;
   Canvas.Draw(Canvas.ClipRect.Left, Canvas.ClipRect.Top, FMemBitmap);
end;


procedure TGanttTimeChart.setFlinescount;
var
   ProjectIndex: Integer;
   Project: TGanttProject;
begin
   Flinescount := 0;
   for ProjectIndex := 0 to FGanttProjectList.count - 1 do
   begin
      Project := GetProject(ProjectIndex);
      if Project <> nil then
      begin
         Project.Fscrollpos := Flinescount;
         inc(Flinescount);
         if project.FTreeClosed = false then
            Flinescount := Flinescount + Project.Count;
      end;
   end;
end;





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



procedure TGanttProjectTimeChart.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 TGanttProjectTimeChart.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 TGanttProjectTimeChart.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 TGanttProjectTimeChart.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;
      showRect.Left := DragGanttItemRect.Left;
      showRect.Right := DragGanttItemRect.Right + DeltaX;
      invalidate;
   end;

end;



procedure TGanttProjectTimeChart.WMRButtonDown(var Message: TWMRButtonDown);
begin
   inherited;
  { If a selection has been made, and a right click procedure has been set,
    execute it }
end;



{ Method to set variable and property values and create objects }



procedure TGanttProjectTimeChart.AutoInitialize;
begin
   FGanttTimeType := ttMonth;
end; { of AutoInitialize }

{ Method to free any objects created by AutoInitialize }

procedure TGanttProjectTimeChart.AutoDestroy;
begin
   ClearProjects;
     { No objects from AutoInitialize to free }
end; { of AutoDestroy }





{ Override OnClick handler from TCustomControl }

procedure TGanttProjectTimeChart.Click;
begin
     { Code to execute before activating click
       behavior of component's parent class }

     { Activate click behavior of parent }
   inherited Click;

     { Code to execute after click behavior
       of parent }

end;



{ Override OnKeyPress handler from TCustomControl }

procedure TGanttProjectTimeChart.KeyPress(var Key: Char);
const
   TabKey = Char(VK_TAB);
   EnterKey = Char(VK_RETURN);
begin
     { Key contains the character produced by the keypress.
       It can be tested or assigned a new value before the
       call to the inherited KeyPress method.  Setting Key
       to #0 before call to the inherited KeyPress method
       terminates any further processing of the character. }

     { Activate KeyPress behavior of parent }
   inherited KeyPress(Key);

     { Code to execute after KeyPress behavior of parent }

end;


constructor TGanttProjectTimeChart.Create(AOwner: TComponent);
begin
     { Call the Create method of the parent class }
   inherited Create(AOwner);
   ControlStyle := ControlStyle + [csOpaque];
     { AutoInitialize sets the initial values of variables and      }
     { properties; also, it creates objects for properties of       }
     { standard Delphi object types (e.g., TFont, TTimer,           }
     { TPicture) and for any variables marked as objects.           }
     { AutoInitialize method is generated by Component Create.      }
   AutoInitialize;

     { Code to perform other tasks when the component is created }

end;

destructor TGanttProjectTimeChart.Destroy;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -