📄 mainganttunit.pas
字号:
unit MainGanttUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, GanttUnit, DateUtils, StdCtrls, Spin, ComCtrls, ToolWin, ImgList,
ExtCtrls, ProjectDetailsUnit, ExtDlgs;
type
TGanttForm = class(TForm)
GanttChart1: TGanttChart;
StatusBar1: TStatusBar;
CoolBar1: TCoolBar;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ImageList1: TImageList;
SaveDialog: TSaveDialog;
OpenDialog: TOpenDialog;
ToolButton13: TToolButton;
ToolButton14: TToolButton;
ToolButton15: TToolButton;
ToolButton16: TToolButton;
ToolButton17: TToolButton;
ToolButton18: TToolButton;
ToolButton19: TToolButton;
ToolButton20: TToolButton;
ProjectColorBox: TColorBox;
ToolButton10: TToolButton;
ToolButton22: TToolButton;
ToolButton23: TToolButton;
ToolButton24: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
ToolButton11: TToolButton;
ToolButton12: TToolButton;
ToolButton21: TToolButton;
ToolButton25: TToolButton;
ToolButton26: TToolButton;
ToolButton27: TToolButton;
SavePictureDialog1: TSavePictureDialog;
ToolButton28: TToolButton;
ToolButton29: TToolButton;
ToolButton30: TToolButton;
ToolButton31: TToolButton;
ToolButton32: TToolButton;
ToolButton33: TToolButton;
ToolButton34: TToolButton;
ToolButton35: TToolButton;
ToolButton36: TToolButton;
ToolButton37: TToolButton;
ToolButton38: TToolButton;
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton17Click(Sender: TObject);
procedure ToolButton18Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure GanttChart1SelectItem(ProjectID, ItemID: Integer);
procedure GanttChart1SelectProject(ProjectID: Integer);
procedure ToolButton22Click(Sender: TObject);
procedure ToolButton24Click(Sender: TObject);
procedure ProjectColorBoxChange(Sender: TObject);
procedure ToolButton16Click(Sender: TObject);
procedure ToolButton9Click(Sender: TObject);
procedure ToolButton11Click(Sender: TObject);
procedure ToolButton21Click(Sender: TObject);
procedure ToolButton12Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton26Click(Sender: TObject);
procedure ToolButton27Click(Sender: TObject);
procedure ToolButton28Click(Sender: TObject);
procedure ToolButton30Click(Sender: TObject);
procedure ToolButton31Click(Sender: TObject);
procedure ToolButton33Click(Sender: TObject);
procedure ToolButton34Click(Sender: TObject);
procedure ToolButton35Click(Sender: TObject);
procedure GanttChart1DblClickItemEvent(ProjectID, ItemID: Integer);
procedure ToolButton36Click(Sender: TObject);
procedure ToolButton37Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
private
{ Private declarations }
Project: TGanttProject;
ProjectItem: TGanttItem;
SelectedProject, SelectedItem : Integer;
public
{ Public declarations }
CurrentStartMonth: Integer;
GridStart : TDateTime;
end;
var
GanttForm: TGanttForm;
implementation
uses ItemDetailsUnit, GanttDetailsUnit;
{$R *.dfm}
procedure TGanttForm.FormCreate(Sender: TObject);
begin
SelectedItem := -1;
CurrentStartMonth :=1;
GanttChart1.StartMonth := CurrentStartMonth;
GanttChart1.Repaint;
ProjectColorBox.Selected := GanttChart1.ProjectTitleColour;
GanttChart1.TitlesBoxWidth := 180;
end;
procedure TGanttForm.ToolButton1Click(Sender: TObject);
begin
if opendialog.Execute then
begin
GanttChart1.LoadFromXML(opendialog.FileName);
end;
SelectedItem := -1;
end;
procedure TGanttForm.ToolButton3Click(Sender: TObject);
begin
if savedialog.Execute then
GanttChart1.SavetoXML(savedialog.FileName);
end;
procedure TGanttForm.ToolButton17Click(Sender: TObject);
begin
GridStart := GanttChart1.GridStartDate;
//ttMonth, ttWeek, ttday, tthour
if GanttChart1.GanttTimeType = ttOpen then
GridStart := incMonth(GridStart);
if GanttChart1.GanttTimeType = ttMonth then
GridStart := incMonth(GridStart);
if GanttChart1.GanttTimeType = ttWeek then
GridStart := incWeek(GridStart);
if GanttChart1.GanttTimeType = ttday then
GridStart := incDay(GridStart);
if GanttChart1.GanttTimeType = tthour then
GridStart := incHour(GridStart);
GanttChart1.GridStartDate := GridStart;
GanttChart1.Repaint;
end;
procedure TGanttForm.ToolButton18Click(Sender: TObject);
begin
GridStart := GanttChart1.GridStartDate;
//ttMonth, ttWeek, ttday, tthour
if GanttChart1.GanttTimeType = ttOpen then
GridStart := incMonth(GridStart,-1);
if GanttChart1.GanttTimeType = ttMonth then
GridStart := incMonth(GridStart,-1);
if GanttChart1.GanttTimeType = ttWeek then
GridStart := incWeek(GridStart,-1);
if GanttChart1.GanttTimeType = ttday then
GridStart := incDay(GridStart,-1);
if GanttChart1.GanttTimeType = tthour then
GridStart := incHour(GridStart,-1);
GanttChart1.GridStartDate := GridStart;
GanttChart1.Repaint;
end;
procedure TGanttForm.ToolButton5Click(Sender: TObject);
begin
GanttChart1.PrintChart;
end;
procedure TGanttForm.ToolButton6Click(Sender: TObject);
begin
GanttChart1.StartLinking := Toolbutton6.down;
end;
procedure TGanttForm.GanttChart1SelectItem(ProjectID, ItemID: Integer);
begin
SelectedItem := -1;
SelectedProject := ProjectID;
SelectedItem := ItemID;
StatusBar1.SimpleText := 'Project : ' + inttostr(SelectedProject) + ' Item : ' + inttostr(ItemID);
end;
procedure TGanttForm.GanttChart1SelectProject(ProjectID: Integer);
begin
SelectedProject := ProjectID;
SelectedItem := -1;
StatusBar1.SimpleText := 'Project : ' + inttostr(SelectedProject);
end;
procedure TGanttForm.ToolButton22Click(Sender: TObject);
begin
Project := TGanttProject.Create(nil);
if EditProjectForm.EditDetails(Project) = True then
GanttChart1.AddNewProject(Project)
else
Project.Free;
end;
procedure TGanttForm.ToolButton24Click(Sender: TObject);
begin
if SelectedProject > -1 then
begin
Project := GanttChart1.GetProject(SelectedProject);
ProjectItem := TGanttItem.Create(nil);
ProjectItem.StartDate := now;
ProjectItem.Days := 5;
ProjectItem.ItemName := 'New Item';
ProjectItem.ItemBrush.Color := clSilver;
ProjectItem.ItemBrush.Style := bsSolid;
ProjectItem.ItemType := dsBlock;
if ItemDetailsForm.EditDetails(ProjectItem) = True then
Project.AddGanttItem(ProjectItem)
else
ProjectItem.Free;
end;
end;
procedure TGanttForm.ProjectColorBoxChange(Sender: TObject);
begin
GanttChart1.ProjectTitleColour := ProjectColorBox.Selected;
end;
procedure TGanttForm.ToolButton16Click(Sender: TObject);
begin
if SelectedItem > -1 then
begin
ProjectItem := GanttChart1.GetProjectItem(SelectedProject,SelectedItem);
ProjectItem.ClearItemLink;
GanttChart1.Repaint;
end;
end;
procedure TGanttForm.ToolButton9Click(Sender: TObject);
begin
if SelectedProject > -1 then
begin
if MessageDlg('Are you sure you want to delete this Project!', mtWarning, [mbYes,mbNo], 0) = mrYes then
begin
GanttChart1.DeleteProject(SelectedProject);
SelectedProject := -1;
end;
end;
end;
procedure TGanttForm.ToolButton11Click(Sender: TObject);
begin
if (SelectedItem > -1) and (SelectedProject > -1) then
begin
if MessageDlg('Are you sure you want to delete this Item!', mtWarning, [mbYes,mbNo], 0) = mrYes then
begin
GanttChart1.DeleteProjectItem(SelectedProject,SelectedItem);
SelectedItem := -1;
end;
end;
end;
procedure TGanttForm.ToolButton21Click(Sender: TObject);
begin
if SelectedProject > -1 then
begin
Project := GanttChart1.GetProject(SelectedProject);
if EditProjectForm.EditDetails(Project) = True then
GanttChart1.Repaint;
end;
end;
procedure TGanttForm.ToolButton12Click(Sender: TObject);
begin
if SelectedItem > -1 then
begin
ProjectItem := GanttChart1.GetProjectItem(SelectedProject,SelectedItem);
if ItemDetailsForm.EditDetails(ProjectItem) = True then
GanttChart1.Repaint;
end;
end;
procedure TGanttForm.ToolButton4Click(Sender: TObject);
begin
GanttChart1.ClearProjects
end;
procedure TGanttForm.ToolButton26Click(Sender: TObject);
begin
if GanttDetailsForm.EditDetails(GanttChart1) = True then
GanttChart1.Repaint;
end;
procedure TGanttForm.ToolButton27Click(Sender: TObject);
begin
if savepicturedialog1.Execute then
GanttChart1.SaveChartToBitmap(savepicturedialog1.FileName);
end;
procedure TGanttForm.ToolButton28Click(Sender: TObject);
begin
GanttChart1.ShowItemLength := Not GanttChart1.ShowItemLength;
GanttChart1.Repaint;
end;
procedure TGanttForm.ToolButton30Click(Sender: TObject);
var
Incr : Integer;
begin
Incr := GanttChart1.DayWidth;
Inc(Incr,4);
if Incr > 100 then Incr := 100;
GanttChart1.DayWidth := Incr;
GanttChart1.Repaint;
end;
procedure TGanttForm.ToolButton31Click(Sender: TObject);
var
Incr : Integer;
begin
Incr := GanttChart1.DayWidth;
Dec(Incr,4);
if Incr <10 then Incr := 10;
GanttChart1.DayWidth := Incr;
GanttChart1.Repaint;
end;
procedure TGanttForm.ToolButton33Click(Sender: TObject);
begin
GanttChart1.ShowGridLines := Not GanttChart1.ShowGridLines;
GanttChart1.Repaint;
end;
procedure TGanttForm.ToolButton34Click(Sender: TObject);
begin
GanttChart1.ShowHeaderWeeks := Not GanttChart1.ShowHeaderWeeks;
GanttChart1.Repaint;
end;
procedure TGanttForm.ToolButton35Click(Sender: TObject);
begin
GanttChart1.ShowHeaderDayNumbers := Not GanttChart1.ShowHeaderDayNumbers;
GanttChart1.Repaint;
end;
procedure TGanttForm.GanttChart1DblClickItemEvent(ProjectID,
ItemID: Integer);
begin
if (SelectedItem > -1) and (SelectedProject > -1) then
begin
ProjectItem := GanttChart1.GetProjectItem(ProjectID,ItemID);
if ItemDetailsForm.EditDetails(ProjectItem) = True then
GanttChart1.Repaint;
end;
end;
procedure TGanttForm.ToolButton36Click(Sender: TObject);
var
Incr : Integer;
begin
Incr := GanttChart1.TopMostProject;
inc(Incr);
GanttChart1.TopMostProject := Incr;
end;
procedure TGanttForm.ToolButton37Click(Sender: TObject);
var
Decr : Integer;
begin
Decr := GanttChart1.TopMostProject;
Dec(Decr);
GanttChart1.TopMostProject := Decr;
end;
procedure TGanttForm.ComboBox1Change(Sender: TObject);
begin
//(ttQtr,ttMonth, ttWeek, ttday, tthour);
case ComboBox1.ItemIndex of
0 : GanttChart1.GanttTimeType := ttOpen;
1 : GanttChart1.GanttTimeType := ttMonth;
2 : GanttChart1.GanttTimeType := ttWeek;
3 : GanttChart1.GanttTimeType := ttday;
4 : GanttChart1.GanttTimeType := tthour;
end;
GanttChart1.Refresh;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -