unit NewProjectFrm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ConstMethodUnit, ConstVarUnit, ConstTypeUnit; type TNewProjectForm = class(TForm) ldeProjectName: TLabeledEdit; GroupBox1: TGroupBox; btnCreate: TButton; btnClose: TButton; cbGatherProject: TCheckBox; cbBidLotProject: TCheckBox; GroupBox2: TGroupBox; cbEstimate: TCheckBox; cbBillsBudget: TCheckBox; Label1: TLabel; cbbProjList: TComboBox; procedure btnCloseClick(Sender: TObject); procedure cbBillsBudgetClick(Sender: TObject); procedure cbEstimateClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure cbGatherProjectClick(Sender: TObject); procedure cbBidLotProjectClick(Sender: TObject); procedure ldeProjectNameChange(Sender: TObject); private FProjectName: string; function GetProjectName: string; function GetProjectType: Integer; function GetProjectKind: Integer; function GetProjectGatherID: Integer; procedure SetProjectType(const Value: Integer); procedure SetProjectName(const Value: string); {} procedure InitProjList(aProjList: TStrings; aCurIdx: Integer); procedure DisabledBuildProject; { FX lib } procedure InputLibView(aFormType: TFormType); function GetFileFlag: Integer; property FileFlag: Integer read GetFileFlag; property ProjectName: string read GetProjectName write SetProjectName; property ProjectType: Integer read GetProjectType write SetProjectType; property ProjectKind: Integer read GetProjectKind; property ProjectGatherID: Integer read GetProjectGatherID; public end; function NewProjectInfo(aProjList: TStrings; var aProjName: string; var aProjType, aProjKind, aGatherID: Integer; aCurIdx: Integer = -1): Boolean; { TODO : Import FXQD } function InputStdLibName(var aLibName: string; var aFileFlag: Integer; aFormType: TFormType = ftImportStdLib): Boolean; implementation {$R *.dfm} function NewProjectInfo(aProjList: TStrings; var aProjName: string; var aProjType, aProjKind, aGatherID: Integer; aCurIdx: Integer): Boolean; var NewProjectForm: TNewProjectForm; begin NewProjectForm := TNewProjectForm.Create(nil); try if Assigned(aProjList) then if aProjList.Count = 0 then begin Result := False; ShowMessage('项目文件不存在, 请先创建项目文件!'); Exit; end else NewProjectForm.InitProjList(aProjList, aCurIdx) else begin // 以前处理方法,如不存在项目文件,则创建 NewProjectForm.DisabledBuildProject; end; NewProjectForm.ProjectName := aProjName; NewProjectForm.ProjectType := aProjType; Result := NewProjectForm.ShowModal = mrYes; if Result then begin aProjName := NewProjectForm.ProjectName; aProjType := NewProjectForm.ProjectType; aProjKind := NewProjectForm.ProjectKind; if Assigned(aProjList) then aGatherID := NewProjectForm.ProjectGatherID; end; finally NewProjectForm.Free; end; end; function InputStdLibName(var aLibName: string; var aFileFlag: Integer; aFormType: TFormType): Boolean; var NewProjectForm: TNewProjectForm; begin NewProjectForm := TNewProjectForm.Create(nil); try NewProjectForm.ldeProjectName.Text := aLibName; NewProjectForm.InputLibView(aFormType); Result := NewProjectForm.ShowModal = mrYes; if Result then begin aLibName := NewProjectForm.ldeProjectName.Text; aFileFlag := NewProjectForm.FileFlag; end; finally NewProjectForm.Free; end; end; procedure TNewProjectForm.btnCloseClick(Sender: TObject); begin Close; end; procedure TNewProjectForm.cbBillsBudgetClick(Sender: TObject); begin cbEstimate.Checked := not cbBillsBudget.Checked; end; procedure TNewProjectForm.cbEstimateClick(Sender: TObject); begin cbBillsBudget.Checked := not cbEstimate.Checked; end; function TNewProjectForm.GetProjectName: string; begin Result := ldeProjectName.Text; end; function TNewProjectForm.GetProjectType: Integer; begin if cbBillsBudget.Checked then Result := 5 else Result := 6; end; procedure TNewProjectForm.SetProjectType(const Value: Integer); begin cbBillsBudget.Checked := Value = 5; end; procedure TNewProjectForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if ModalResult <> mrYes then Exit; if ProjectName = '' then begin MessageWarning(0, sNameNotNull); CanClose := False; Exit; end; if CheckFileExists(ProjectName) then begin MessageWarning(0, sSameFileName); CanClose := False; Exit; end; end; procedure TNewProjectForm.SetProjectName(const Value: string); begin ldeProjectName.Text := Value; end; procedure TNewProjectForm.cbGatherProjectClick(Sender: TObject); begin cbBidLotProject.Checked := not cbGatherProject.Checked; Label1.Enabled := False; cbbProjList.Enabled := False; end; procedure TNewProjectForm.cbBidLotProjectClick(Sender: TObject); begin cbGatherProject.Checked := not cbBidLotProject.Checked; Label1.Enabled := True; cbbProjList.Enabled := True; end; function TNewProjectForm.GetProjectKind: Integer; begin if cbGatherProject.Checked then Result := 1 else Result := 2; end; procedure TNewProjectForm.InitProjList(aProjList: TStrings; aCurIdx: Integer); var I: Integer; begin if aProjList.Count = 0 then begin { TODO : 如果建设项目没有,则只能创建新建设项目,不可以创建标段 [litao 2011.7.4] } cbGatherProject.Checked := True; DisabledBuildProject; Exit; end; for I := 0 to aProjList.Count - 1 do begin cbbProjList.Items.AddObject(aProjList[I], aProjList.Objects[I]); end; cbbProjList.ItemIndex := aCurIdx; end; function TNewProjectForm.GetProjectGatherID: Integer; begin Result := 0; if cbbProjList.ItemIndex = -1 then Exit; Result := Integer(cbbProjList.Items.Objects[cbbProjList.ItemIndex]); end; procedure TNewProjectForm.DisabledBuildProject; begin Label1.Enabled := False; cbbProjList.Enabled := False; cbGatherProject.Enabled := False; cbBidLotProject.Enabled := False; end; procedure TNewProjectForm.ldeProjectNameChange(Sender: TObject); begin if CheckSpecialChar(TLabeledEdit(Sender).Text) then begin MessageWarning(0, sSpecialChar); TLabeledEdit(Sender).Text := FProjectName; TLabeledEdit(Sender).SelStart := Length(FProjectName); end else FProjectName := TLabeledEdit(Sender).Text; end; procedure TNewProjectForm.InputLibView(aFormType: TFormType); begin Caption := '导入'; Label1.Visible := False; cbbProjList.Visible := False; GroupBox2.Visible := False; GroupBox1.Width := ldeProjectName.Width; GroupBox1.Top := 60; // Maixinrong 2012-03-26 类型框错位了 GroupBox1.Left := ldeProjectName.Left; if aFormType = ftImportStdLib then begin cbGatherProject.Checked := True; ldeProjectName.EditLabel.Caption := '名称:'; cbBidLotProject.Visible := False; cbGatherProject.Caption := '分项清单'; cbBidLotProject.Caption := '工程量清单'; end; btnCreate.Caption := '确定'; Height := 210; OnCloseQuery := nil; end; function TNewProjectForm.GetFileFlag: Integer; begin if cbGatherProject.Checked then Result := 1 else Result := 2; end; end.