📄 gantttimeunit.pas
字号:
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 + -