unit NewProjectFrm; interface uses UtilMethods, ZhAPI, sdIDTree, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TNewProjectForm = class(TForm) ldeValue: TLabeledEdit; labTip: TLabel; btnOK: TButton; btnCancel: TButton; procedure btnCancelClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); private FParent: TsdIDTreeNode; FCurID: Integer; function CheckLegalChar: Boolean; function CheckSameFileName: Boolean; public function GetValue: string; procedure SetValue(const AValue: string; ACurID: Integer); property Parent: TsdIDTreeNode read FParent write FParent; end; function InputNewProjectName(var FileName: string; const Caption: string; AParent: TsdIDTreeNode; ACurID: Integer = -1): Boolean; implementation uses Globals, ConstUnit, ProjectManagerDm; {$R *.dfm} function InputNewProjectName(var FileName: string; const Caption: string; AParent: TsdIDTreeNode; ACurID: Integer = -1): Boolean; var NewProjectForm: TNewProjectForm; begin NewProjectForm := TNewProjectForm.Create(nil); try NewProjectForm.Caption := Caption; NewProjectForm.SetValue(FileName, ACurID); NewProjectForm.Parent := AParent; NewProjectForm.CheckSameFileName; Result := NewProjectForm.ShowModal = mrOk; FileName := NewProjectForm.GetValue; finally NewProjectForm.Free; end; end; procedure TNewProjectForm.btnCancelClick(Sender: TObject); begin Close; end; function TNewProjectForm.GetValue: string; begin Result := ldeValue.Text; end; procedure TNewProjectForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin CanClose := (CheckLegalChar and not CheckSameFileName) or (ModalResult = mrCancel); end; function TNewProjectForm.CheckLegalChar: Boolean; begin Result := CheckFileNameLegal(GetValue); if not Result then labTip.Caption := '不能包含特殊字符[/ \ : * ? " < > |],请重新输入!'; end; procedure TNewProjectForm.SetValue(const AValue: string; ACurID: Integer); begin ldeValue.Text := AValue; FCurID := ACurID; end; function TNewProjectForm.CheckSameFileName: Boolean; var iSameNameID: Integer; begin Result := False; // 云版只认ID,随便重名不会怀孕 if G_IsCloud then Exit; if ldeValue.Text <> '' then begin iSameNameID := ProjectManager.ProjectID(ldeValue.Text, Parent); Result := (iSameNameID <> FCurID) and (iSameNameID <> -1); if Result then labTip.Caption := '存在同名文件,请修改标段名称!'; end; end; end.