unit fraFileManagerFrame; interface uses Classes, Graphics, Controls, Windows, Forms, ZjGridDBA, ActnList, ExtCtrls, ZJGrid, ImgList, ComCtrls, ToolWin, ConstTypeUnit, Dialogs, ProjectFileManager, Menus, StdCtrls, Types, JimLabels, ZJEdits, ZjCells, cxControls, cxContainer, cxEdit, cxTextEdit, cxMaskEdit, cxDropDownEdit, cxCalendar; type TFileManagerFrame = class(TFrame) ToolBar1: TToolBar; ToolButton1: TToolButton; ToolButton2: TToolButton; ToolButton3: TToolButton; ToolButton4: TToolButton; ToolButton5: TToolButton; ilstProject: TImageList; Actions: TActionList; actnNewProject: TAction; actnOpenProject: TAction; actnDeleteProject: TAction; actnImportProject: TAction; actnExportProject: TAction; ToolButton6: TToolButton; zaBidLot: TZjGridDBA; zaGatherBid: TZjGridDBA; ToolButton7: TToolButton; ToolButton8: TToolButton; actnRenameProject: TAction; zaGatherBidLot: TZjGridDBA; PopupMenu: TPopupMenu; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N4: TMenuItem; N5: TMenuItem; N8: TMenuItem; N9: TMenuItem; pnlBidLot: TPanel; Panel2: TPanel; zgProperties: TZJGrid; JimGradLabel4: TJimGradLabel; pnlBuildProject: TPanel; zgGatherBid: TZJGrid; JimGradLabel3: TJimGradLabel; Splitter1: TSplitter; Splitter3: TSplitter; Panel5: TPanel; zgBidLot: TZJGrid; JimGradLabel1: TJimGradLabel; zgGatherBidLot: TZJGrid; Splitter2: TSplitter; cxDateEdit: TcxDateEdit; cxComboBox: TcxComboBox; tlb1: TToolBar; tlb2: TToolBar; tbnNewProject: TToolButton; tbnOpenProject: TToolButton; tbnDeleteProject: TToolButton; tbnImportProject: TToolButton; tbnExportProject: TToolButton; tbnRenameProject: TToolButton; tbnNewSection: TToolButton; tbnOpenProject1: TToolButton; tbnDeleteProject1: TToolButton; tbnImportProject1: TToolButton; tbnExportProject1: TToolButton; tbnRenameProject1: TToolButton; JimGradLabel2: TJimGradLabel; tlb3: TToolBar; tbnOpenProject2: TToolButton; tbnDeleteProject2: TToolButton; tbnImportProject2: TToolButton; tbnExportProject2: TToolButton; tbnRenameProject2: TToolButton; pmBidLot: TPopupMenu; actNewSection: TAction; actDeleteSection: TAction; N6: TMenuItem; N7: TMenuItem; N10: TMenuItem; N11: TMenuItem; N12: TMenuItem; N13: TMenuItem; pmGather: TPopupMenu; actDeleteGatherBills: TAction; actRenameSection: TAction; Nopen: TMenuItem; N14: TMenuItem; N15: TMenuItem; N16: TMenuItem; N17: TMenuItem; actReNameGather: TAction; procedure actnNewProjectExecute(Sender: TObject); procedure actnOpenProjectExecute(Sender: TObject); procedure actnDeleteProjectExecute(Sender: TObject); procedure zgGatherBidMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure actnRenameProjectExecute(Sender: TObject); procedure actnImportProjectExecute(Sender: TObject); procedure actnExportProjectExecute(Sender: TObject); procedure zgPropertiesCellTextChanged(Sender: TObject; Col, Row: Integer); procedure zgPropertiesGetCellEditor(Sender: TObject; ACoord: TPoint; var AControl: TWinControl); procedure zgPropertiesEditorSaveCell(Sender: TObject; ACoord: TPoint; AControl: TWinControl); procedure zgPropertiesEditorLoadCell(Sender: TObject; ACoord: TPoint; AControl: TWinControl); procedure actNewSectionExecute(Sender: TObject); procedure actDeleteSectionExecute(Sender: TObject); procedure actDeleteGatherBillsExecute(Sender: TObject); procedure actRenameSectionExecute(Sender: TObject); procedure actReNameGatherExecute(Sender: TObject); private { Private declarations } FProjectFileMgr: TProjectFileMgr; FThreadList: TThreadList; function GetProjKind: Integer; procedure WaitThreadOver; function IsWaitOver: Boolean; procedure InitProperties; procedure RefreshProjectProperties(AProjKind: Integer); procedure SaveProjectProperties; procedure SetProjectFileMgr(const Value: TProjectFileMgr); public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure BeginUpdate; procedure EndUpdate; property ProjectFileMgr: TProjectFileMgr read FProjectFileMgr write SetProjectFileMgr; end; implementation {$R *.dfm} uses NewProjectFrm, ConstMethodUnit, SysUtils, ConstVarUnit, ProjectPropertyThread, MainForm, ProjectPropertyUnit; procedure TFileManagerFrame.actnNewProjectExecute(Sender: TObject); var strName: string; ProjList: TStrings; iProjectType, iProjKind, iGatherID: Integer; begin iProjectType := 5; iProjKind := 1 ; if ScInputQuery('新建建设项目', '请输入建设项目名称', strName, False) then begin FProjectFileMgr.CreateNewProjectOpen(strName, iProjectType, iProjKind); RefreshProjectProperties(iProjKind); end; if MainFrm.ProjectManager.ActiveProject = nil then begin if (iProjectType = 5) and (iProjKind = 1) then zgGatherBid.SetFocus; end else begin if (iProjectType = 5) and (iProjKind = 1) and (MainFrm.ProjectManager.ActiveProject.ProjectView = nil) then zgGatherBid.SetFocus; end; MainFrm.jpManager.ActivePageIndex := 1; // MainFrm.SetCaption(jtsBillsProjects.Tabs[0]); //MainFrm.jtsBillsProjects {$IFDEF _beOnLine} MainFrm.Caption := SoftWareName_OnLine + ' - [' + MainFrm.jtsBillsProjects.Tabs[0] + ']'; {$ELSE} {$IFDEF _beCommon} MainFrm.Caption := SoftWareName_ZY_Common + ' - [' + MainFrm.jtsBillsProjects.Tabs[0] + ']'; {$ELSE} {$IFDEF _beEncrypt} MainFrm.Caption := SoftWareName_ZY + ' - [' + MainFrm.jtsBillsProjects.Tabs[0] + ']'; {$ELSE} MainFrm.Caption := SoftWareName_XX + ' - [' + MainFrm.jtsBillsProjects.Tabs[0] + ']'; {$ENDIF} {$ENDIF} {$ENDIF} zgGatherBid.SetFocus; end; procedure TFileManagerFrame.SetProjectFileMgr( const Value: TProjectFileMgr); begin FProjectFileMgr := Value; if Assigned(FProjectFileMgr) then begin zaGatherBid.DataSet := FProjectFileMgr.GatherProjectDS; zaBidLot.DataSet := FProjectFileMgr.BidLotProjectDS; zaGatherBidLot.DataSet := FProjectFileMgr.GatherBidDS; end; end; procedure TFileManagerFrame.actnOpenProjectExecute(Sender: TObject); begin FProjectFileMgr.OpenProject(-1, GetProjKind); end; procedure TFileManagerFrame.actnDeleteProjectExecute(Sender: TObject); begin if MessageQuest('确定要删除该项目吗? ') then begin FProjectFileMgr.DeleteProject(GetProjKind); RefreshProjectProperties(GetProjKind); end; end; function TFileManagerFrame.GetProjKind: Integer; begin if zgGatherBid.Focused then Result := 1 else if zgBidLot.Focused then Result := 2 else if zgGatherBidLot.Focused then Result := 3 else Result := -1; end; procedure TFileManagerFrame.zgGatherBidMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) and (ssDouble in Shift) then begin WaitThreadOver; FProjectFileMgr.OpenProject(-1, GetProjKind); end else if Button = mbLeft then RefreshProjectProperties(GetProjKind); end; procedure TFileManagerFrame.actnRenameProjectExecute(Sender: TObject); var sOldProjName: string; sNewProjName: string; begin sOldProjName := FProjectFileMgr.GetProjectName(GetProjKind); sNewProjName := sOldProjName; while ScInputQuery('重命名', '新项目名称', sNewProjName) do begin if not CheckSpecialChar(sNewProjName) then begin FProjectFileMgr.RenameProject(GetProjKind, sNewProjName); Break; end else begin sNewProjName := sOldProjName; MessageWarning(Screen.ActiveForm.Handle, sSpecialChar); end; end; end; procedure TFileManagerFrame.actnImportProjectExecute(Sender: TObject); var iProjKind: Integer; strFileName: string; strShortName: string; begin if OpenFileDialog(sImportTip, '.smb', '', 'SmartCost造价 (*.smb)|*.smb|清单编制 (*.pcf)|*.pcf', strFileName) then begin BeginUpdate; try if ExtractFileExt(strFileName) = '.pcf' then begin FProjectFileMgr.ImportProjects(strFileName); end else begin strShortName := ExtractFileNameWithoutExt(strFileName); if InputStdLibName(strShortName, iProjKind, ftImportSmb) then FProjectFileMgr.ImportProject(strShortName, strFileName, iProjKind); end; finally EndUpdate; end; end; end; // pcf:(project compress file) procedure TFileManagerFrame.actnExportProjectExecute(Sender: TObject); var strFileName: string; begin if SaveFileDialog(sExportTip, '.smb', FProjectFileMgr.GetProjectName(GetProjKind), 'SmartCost造价 (*.smb)|*.smb|清单编制 (*.pcf)|*.pcf', strFileName) then begin if FileExists(strFileName) then begin if MessageQuest('已存在同名文件,是否替换?') then DeleteFile(strFileName) else Exit; end; Application.ProcessMessages; Screen.Cursor := crHourGlass; try if ExtractFileExt(strFileName) = '.pcf' then FProjectFileMgr.ExportProjects(strFileName, GetProjKind) else FProjectFileMgr.ExportProject(strFileName, GetProjKind, True); finally Screen.Cursor := crDefault; end; end; end; constructor TFileManagerFrame.Create(AOwner: TComponent); begin inherited; InitProperties; pnlBuildProject.Width := Round(0.3 * Screen.Width); pnlBidLot.Width := Round(0.3 * Screen.Width); FThreadList := TThreadList.Create; end; procedure TFileManagerFrame.InitProperties; var I: Integer; begin zgProperties.TextAligns.Cols[1] := gaCenterLeft; zgProperties.TextAligns.Cols[0] := gaCenterRight; zgProperties.Cells[0, 0].Text := '属性名称'; zgProperties.Cells[0, 0].TextAlign := gaCenterCenter; zgProperties.Cells[1, 0].Text := '属性内容'; zgProperties.Cells[1, 0].TextAlign := gaCenterCenter; zgProperties.CellClass.Item[1, 1] := TZjComboCell; zgProperties.CellClass.Item[1, 7] := TZjComboCell; zgProperties.CellClass.Item[1, 14] := TZjComboCell; for I := Low(ArrProjectProperties) to High(ArrProjectProperties) do begin zgProperties.Cells[0, I + 1].Text := ArrProjectProperties[I] + ':'; end; end; procedure TFileManagerFrame.RefreshProjectProperties(AProjKind: Integer); begin TProjPtyThread.Create(AProjKind, zgProperties, FProjectFileMgr, True, FThreadList); end; procedure TFileManagerFrame.SaveProjectProperties; begin TProjPtyThread.Create(GetProjKind, zgProperties, FProjectFileMgr, False, FThreadList); end; procedure TFileManagerFrame.zgPropertiesCellTextChanged(Sender: TObject; Col, Row: Integer); begin if (Col = 1) and (Row > 0) then SaveProjectProperties; end; procedure TFileManagerFrame.zgPropertiesGetCellEditor(Sender: TObject; ACoord: TPoint; var AControl: TWinControl); begin if ACoord.X = 1 then begin if ACoord.Y = 1 then begin cxComboBox.Properties.Items.Clear; cxComboBox.Properties.Items.Add('三级清单预算'); // cxComboBox.Properties.Items.Add('旧版本'); AControl := cxComboBox; end else if ACoord.Y = 14 then begin cxComboBox.Properties.Items.Clear; cxComboBox.Properties.Items.Add('高速公路'); cxComboBox.Properties.Items.Add('一级公路'); cxComboBox.Properties.Items.Add('二级公路'); cxComboBox.Properties.Items.Add('三级公路'); AControl := cxComboBox; end else if ACoord.Y = 7 then AControl := cxDateEdit; end; end; procedure TFileManagerFrame.zgPropertiesEditorSaveCell(Sender: TObject; ACoord: TPoint; AControl: TWinControl); begin if ACoord.X = 1 then begin if ACoord.Y in [1, 14] then zgProperties.Cells[ACoord.X, ACoord.Y].Text := cxComboBox.Text else if ACoord.Y = 7 then zgProperties.Cells[1, 7].Text := cxDateEdit.Text; end; end; procedure TFileManagerFrame.zgPropertiesEditorLoadCell(Sender: TObject; ACoord: TPoint; AControl: TWinControl); begin if ACoord.X = 1 then begin if ACoord.Y in [1, 14] then cxComboBox.Text := zgProperties.Cells[ACoord.X, ACoord.Y].Text else if ACoord.Y = 7 then cxDateEdit.Text := zgProperties.Cells[1, 7].Text; end; end; procedure TFileManagerFrame.WaitThreadOver; var iLoop: Integer; begin iLoop := 0; while True do begin Inc(iLoop); Sleep(100); // 因为线程中有界面同步: Synchronize(WriteToGrid); // 所以不能让等待一直占着主线程 Application.ProcessMessages; if IsWaitOver then Break; if iLoop >= 20 then Break; end; end; destructor TFileManagerFrame.Destroy; begin WaitThreadOver; FThreadList.Free; inherited; end; function TFileManagerFrame.IsWaitOver: Boolean; var thrList: TList; begin thrList := FThreadList.LockList; try Result := thrList.Count <= 0; finally FThreadList.UnlockList; end; end; procedure TFileManagerFrame.BeginUpdate; begin zgGatherBid.BeginUpdate; zgBidLot.BeginUpdate; zgGatherBidLot.BeginUpdate; end; procedure TFileManagerFrame.EndUpdate; begin zgGatherBid.EndUpdate; zgBidLot.EndUpdate; zgGatherBidLot.EndUpdate; end; procedure TFileManagerFrame.actNewSectionExecute(Sender: TObject); var strName: string; ProjList: TStrings; iProjectType, iProjKind, iGatherID: Integer; begin iProjectType := 5; ProjList := TStringList.Create; try FProjectFileMgr.GetBuildProjectList(ProjList); if not NewProjectInfo(ProjList, strName, iProjectType, iProjKind, iGatherID, FProjectFileMgr.GetBuildProjRecordNo) then Exit; finally ProjList.Free; end; if iProjKind = 2 then FProjectFileMgr.LocateBuildProject(iGatherID); FProjectFileMgr.CreateNewProjectOpen(strName, iProjectType, iProjKind); RefreshProjectProperties(iProjKind); end; procedure TFileManagerFrame.actDeleteSectionExecute(Sender: TObject); begin if MessageQuest('确定要删除该标段分项清单吗? ') then begin FProjectFileMgr.DeleteProject(GetProjKind); RefreshProjectProperties(GetProjKind); end; end; procedure TFileManagerFrame.actDeleteGatherBillsExecute(Sender: TObject); begin if MessageQuest('确定要删除该项目清单吗? ') then begin FProjectFileMgr.DeleteProject(GetProjKind); RefreshProjectProperties(GetProjKind); end; end; procedure TFileManagerFrame.actRenameSectionExecute(Sender: TObject); var sOldProjName: string; sNewProjName: string; begin sOldProjName := FProjectFileMgr.GetProjectName(GetProjKind); sNewProjName := sOldProjName; while ScInputQuery('重命名', '新标段分项清单名称', sNewProjName) do begin if not CheckSpecialChar(sNewProjName) then begin FProjectFileMgr.RenameProject(GetProjKind, sNewProjName); Break; end else begin sNewProjName := sOldProjName; MessageWarning(Screen.ActiveForm.Handle, sSpecialChar); end; end; end; procedure TFileManagerFrame.actReNameGatherExecute(Sender: TObject); var sOldProjName: string; sNewProjName: string; begin sOldProjName := FProjectFileMgr.GetProjectName(GetProjKind); sNewProjName := sOldProjName; while ScInputQuery('重命名', '新项目清单名称', sNewProjName) do begin if not CheckSpecialChar(sNewProjName) then begin FProjectFileMgr.RenameProject(GetProjKind, sNewProjName); Break; end else begin sNewProjName := sOldProjName; MessageWarning(Screen.ActiveForm.Handle, sSpecialChar); end; end; end; end.