BillsEditor/MF/fraFileManagerFrame.pas

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.