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

📄 mainganttunit.pas

📁 Gantt source file example to use in delphi 7
💻 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 + -