Measure/Frames/ProjectManagerFme.pas

unit ProjectManagerFme;

interface

uses
  ProjectManagerDm, ZhAPI,
  NewProjectFrm,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ZjGridDBA, ZJGrid, ComCtrls, ToolWin, ActnList,
  dxBar, sdGridDBA, sdGridTreeDBA, sdIDTree, CslJson, ExtCtrls,
  StdCtrls, sdDB, CslButton, OrderCheckerFme, Contnrs;

type
  TStrArr = array of string;

  TProjectManagerFrame = class(TFrame)
    ToolBar: TToolBar;
    tobtnOpen: TToolButton;
    zgProjects: TZJGrid;
    tobtnDelete: TToolButton;
    ActionList1: TActionList;
    actnOpen: TAction;
    actnDelete: TAction;
    dxpmProjectManager: TdxBarPopupMenu;
    actnReceiveProject: TAction;
    stdProjects: TsdGridTreeDBA;
    actnNewProject: TAction;
    actnNewSubProject: TAction;
    actnNewTender: TAction;
    pnlTenderProperty: TPanel;
    sdTenderProperty: TsdGridDBA;
    sprProperty: TSplitter;
    tobtnRenane: TToolButton;
    actnRename: TAction;
    tobtnImport: TToolButton;
    tobtnExport: TToolButton;
    actnImport: TAction;
    actnExport: TAction;
    tobtn1: TToolButton;
    pnlWeb: TPanel;
    pnlProject: TPanel;
    shp2: TShape;
    shp1: TShape;
    shp3: TShape;
    shp4: TShape;
    pnlTenderTitle: TPanel;
    lblBidName: TLabel;
    pnlShadow: TPanel;
    pnlProgress: TPanel;
    lblPeriodTotal: TLabel;
    lblPeriodState: TLabel;
    lblProgress: TLabel;
    lblPeriod: TLabel;
    pnlBelongProject: TPanel;
    lblBelongProject: TLabel;
    lblProjName: TLabel;
    lblLeftHalfBracket: TLabel;
    lblOnwerCompany: TLabel;
    lblOnwerName: TLabel;
    pnlProjectType: TPanel;
    lblProjectType: TLabel;
    lblWebProjCtgyName: TLabel;
    zgTenderProperty: TZJGrid;
    actnOpenBackupFolder: TAction;
    sbChecker: TScrollBox;
    procedure actnOpenExecute(Sender: TObject);
    procedure actnDeleteExecute(Sender: TObject);
    procedure zgProjectsMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure actnReceiveProjectExecute(Sender: TObject);
    procedure actnNewProjectExecute(Sender: TObject);
    procedure actnNewSubProjectExecute(Sender: TObject);
    procedure actnNewTenderExecute(Sender: TObject);
    procedure zgProjectsDrawCellText(ACanvas: TCanvas; const ARect: TRect;
      const ACoord: TPoint; AGrid: TZJGrid; const Text: String;
      var ADefaultDraw: Boolean);
    procedure actnNewSubProjectUpdate(Sender: TObject);
    procedure actnNewTenderUpdate(Sender: TObject);
    procedure zgProjectsCurrentChanged(Sender: TObject; Col, Row: Integer);
    procedure actnSubmitProjectUpdate(Sender: TObject);
    procedure actnReplyProjectUpdate(Sender: TObject);
    procedure actnRenameExecute(Sender: TObject);
    procedure actnOpenUpdate(Sender: TObject);
    procedure actnImportExecute(Sender: TObject);
    procedure actnExportExecute(Sender: TObject);
    procedure actnDeleteUpdate(Sender: TObject);
    procedure actnOpenBackupFolderExecute(Sender: TObject);
    procedure actnRenameUpdate(Sender: TObject);
    procedure zgProjectsShowHint(var HintStr: String; var CanShow: Boolean;
      var HintInfo: THintInfo; const ACoord: TPoint);
    procedure actnExportUpdate(Sender: TObject);
    procedure actnOpenBackupFolderUpdate(Sender: TObject);
  private
    FProjectManagerData: TProjectManagerData;

                                             // Chenshilong,2016.03.24
                                             // 这部分线上和本地一致，无需区分
    FID: Integer;                            // 本地标段文件ID
    FWebID: Integer;                         // 关联服务器用的ID（服务器有自己的ID体系）
    FWebAuthorID: Integer;                   // 编制人
    FWebOwnerID: Integer;                    // 业主

                                             // 本地存储值、线上存储值。线上修改后，需要同步到本地
    FWebMD5_Local: string;                   // 本地存储的MD5
    FWebMD5_OnLine: string;                  // 线上存储的最新的MD5（下同）
    FWebBidName_Local: string;               // 标段名 （当无法同线上取得联系时，本地需要用到该名称来提示）
    FWebBidName_OnLine: string;

    FWebFolder_OnLine: string;               // 这个命名不妥，但很直观。线上的项目名称、项目类型概念跟本地颠倒，很混乱。
    FWebSubFolder_OnLine: string;

    FWebOwnerCompany: string;
    FWebOwnerRole: string;
    FWebOwnerName: string;

    FWebCheckStatusMy: TCheckStatus;          // 登陆用户在当前项目中的工作状态。
    FWebCheckStatusProject: TCheckStatus;     // 项目的审核状态。

    FOnLineCheckerBegin: Integer;               // 线上审批的起始人。 010110111 起7止9。 0101101110 起0止0。
    FOnLineCheckerEnd: Integer;                 // 线上审批的截止人。

    FPhaseTotal: Integer;
    FPhaseNo: Integer;

    FCurPos: Integer;                         // 用来控制审核人的添加位置
    FCheckerList: TObjectList;

    function ReceiveFile(const AFileName: string; AIsReback: Boolean = False): Boolean;
    function ImportFile(const AFileName: string; AFileMD5: string = ''): Boolean;
    procedure ConnectButtonWithAction;
    function GetImportProjectName(const AFileName: string; AParent: TsdIDTreeNode): string;
    function IsProject(ANode: TsdIDTreeNode): Boolean;
    function IsLeafProject(ANode: TsdIDTreeNode): Boolean;
    function IsUnEmptyLeafProject(ANode: TsdIDTreeNode): Boolean;
    function CheckOpened(ANode: TsdIDTreeNode): Boolean;
    procedure SetPropertyVisible(AVisible: Boolean);
    procedure ShowProjectInfoTopAndCheckers;
    // 网络上的目录结构，本地有则定位，没有则创建。
    procedure CheckWebFolders(AFolderID, ASubFolderID: Integer;
      AFolderName, ASubFolderName: string);
    // ANewBidName: 项目的最新标段名（取自服务器，有人改名了，本地的就变成旧的）
    procedure CheckBidName(AID: Integer; ANewBidName: string); overload;
    procedure CheckBidName(AUserID, AWebID: Integer; ANewBidName: string); overload;
    procedure ClearLocalValues;
    procedure GetLocalValues(ARec: TsdDataRecord); overload;
    // 用户ID、网络标段ID、Type=1可以定位一个标段。
    procedure GetLocalValues(AUserID, AWebID: Integer); overload;
    // 1 等待我审核的标段文件; 2 我参与的全部标段文件
    procedure DoBatchReceiveOnline(ARequestType: Integer);
    function LocalMD5(AUserID, AWebID: Integer): string;
    procedure BubbleSortProjects;
    // AReceiveKind: 1 接收； 2 导入
    function FileDownAndReceive(ADownURL: string; AReceiveKind: Integer): Boolean;
    // 线上审批的起止人
    procedure OnLineChecker(AAr: TOVArr; var ABegin, AEnd: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DoBatchReceiveAllOnline;
    // AType: -2 繁忙; -1 正常读取； 0 第0期； 1 第1期。
    procedure ShowProjectInfoTop(AType: Integer = -1);
    function Rec(AProjectID: Integer): TsdDataRecord;
    function CurRec: TsdDataRecord;
    function CurRecAttachmentPath: string;
    function AttachmentFileCountsWithoutManageFile(ANode: TsdIDTreeNode): Integer;
    property ProjectCheckStatus: TCheckStatus read FWebCheckStatusProject;
  end;

implementation

uses
  MainFrm, UtilMethods, ProjectCommands, Globals, ConfigDoc, ConstUnit,
<<<<<<< HEAD
  WebNewTenderFrm, PHPWebDm, Math, mProgressFrm, ProgressHintFrm,
  ShellAPI;
=======
  WebNewTenderFrm, PHPWebDm, Math, CslJson, mProgressFrm, ProgressHintFrm,
  ShellAPI, ProjectFme;
>>>>>>> 3.1.5

{$R *.dfm}

procedure TProjectManagerFrame.ConnectButtonWithAction;
begin
  SetDxBtnAction(actnNewProject, MainForm.dxbtnNewProject);
  SetDxBtnAction(actnNewSubProject, MainForm.dxbtnNewSubProject);
  SetDxBtnAction(actnNewTender, MainForm.dxbtnNewTender);
  SetDxBtnAction(actnOpen, MainForm.dxbtnOpenProject);
  SetDxBtnAction(actnDelete, MainForm.dxbtnDeleteProject);
  SetDxBtnAction(actnReceiveProject, MainForm.dxbtnReceiveProject);
  SetDxBtnAction(actnOpenBackupFolder, MainForm.dxbtnOpenBackupFolder);
  SetDxBtnAction(actnRename, MainForm.dxbtnRename);
end;

constructor TProjectManagerFrame.Create(AOwner: TComponent);
begin
  inherited;
  FCheckerList := TObjectList.Create;
  FProjectManagerData := ProjectManager;
  FProjectManagerData.Open;
  stdProjects.IDTree := FProjectManagerData.ProjectsTree;
  sdTenderProperty.DataView := FProjectManagerData.sdvTenderProperty;
  ConnectButtonWithAction;
  SetPropertyVisible(False);

  sbChecker.Height := 0;

  if G_IsCloud then
  begin
    Application.HintPause := 200;
    Application.HintHidePause := 60000;

    tobtnImport.Visible := False;
    stdProjects.TreeOptions := stdProjects.TreeOptions - [aoAllowUpLevel, aoAllowDownLevel];
    stdProjects.Options := stdProjects.Options - [aoAllowUpMove, aoAllowDownMove];

    CreateProgress('正在从云端下载新项目');
    try
      actnReceiveProject.Execute;
    finally
      CloseProgress;
    end;
  end;
end;

function SearchFileOnline(AURL: string; var ADownURL, AFolder, ASubFolder, ABidName, AMD5Web, AError: string;
  var AFolderID, ASubFolderID: Integer): Integer;
var vArr: TOVArr;
begin
  Result := PHPWeb.Search(AURL, [''], [''], vArr);
  AError := '';
  if Result = 1 then
  begin
    if High(vArr) >= 0 then
    begin
      ADownURL := vArr[0, 0];
      AFolder := vArr[0, 2];
      ASubFolder := vArr[0, 3];
      AMD5Web := vArr[0, 1];
      AFolderID := StrToInt(vArr[0, 4]);
      ASubFolderID := StrToInt(vArr[0, 5]);
      ABidName := vArr[0, 6];
    end
    else
      Result := 10;      // 返回10,表示无记录。用这个数字代表是否觉得怪异？没办法，0被占用了。
  end
  else if Result = 0 then
    AError := PHPWeb.PageError('标段更新数据失败')
  else if Result = -1 then
    AError := PHPWeb.NetError('标段更新数据失败');
end;

// 双击打开项目 TagB
procedure TProjectManagerFrame.actnOpenExecute(Sender: TObject);
var
  vSel: TsdIDTreeNode;
  vRec: TsdDataRecord;
  sHint: string;

  function CanOpen: Boolean;
  var
    sSearchURL, sDownURL,
    sMD5_UnLock, sError, sLocalFile: string;
    iSearch, iFolderID, iSubFolderID: Integer;

<<<<<<< HEAD
    function HasWebBidInfo(AWebID: Integer): Boolean;
    var vArr: array of string;
      iResult: Integer;
    begin
      sSearchURL := Format('%stender/get/%d/exist', [PHPWeb.MeasureURL, AWebID]);
      vArr := VarArrayOf(['id', 'name']);
      iResult := PHPWeb.Search(sSearchURL, [''], [''], vArr);

      if (iResult = 1) and (High(vArr) >= 0) then
        Result := True
      else
        Result := False;
    end;
=======
    bLock, bCanImp: Boolean;
    vFileCheck: TTenderFileChecker;

>>>>>>> 3.1.5
  begin
    Result := False;

    // 先按正常接口找到最新的MD5码看是否需要更新
    sSearchURL := Format('%stender/get/%d/update', [PHPWeb.MeasureURL, FWebID]);
    iSearch := SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, FWebMD5_OnLine, sError, iFolderID, iSubFolderID);

    if iSearch = 1 then
    begin
      try
        CheckWebFolders(iFolderID, iSubFolderID, FWebFolder_OnLine, FWebSubFolder_OnLine);
        CheckBidName(FID, FWebBidName_OnLine);
      finally
        if vSel <> nil then
          vSel.LocateInControl;
      end;

      // 打开前一定要先下载最新的标段文件（无论审核有没有通过）
      if FWebMD5_OnLine <> FWebMD5_Local then
        if not FileDownAndReceive(sDownURL, 1) then Exit;

      // 编制人且项目末通过
      if (FWebAuthorID = PHPWeb.UserID) and (FWebCheckStatusProject = csNotPass) then
      begin
        sHint := '本期计量审批不通过，你现在可以：' + #10#13 + '点击【是(Y)】重新开始本期计量，软件将打开本期上报时的数据，开始重新计量；' +
          #10#13 +'点击【否(N)】查看不通过计量，软件将打开本期最后审批的数据，重新打开标段' + '可再次打开本确认窗口。';
        if Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION) = ID_Yes then
        begin
          sSearchURL := Format('%suser/create/%d/%d/new/audit', [PHPWeb.MeasureURL, FWebID, FPhaseNo]);
          case SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, sMD5_UnLock, sError, iFolderID, iSubFolderID) of
            1:
            begin
<<<<<<< HEAD
              if not FileDownAndReceive(sDownURL, 2) then Exit;
=======
              // 下载
              sLocalFile := PHPWeb.UserPath + ExtractFileName(sDownURL);
              if not PHPWeb.DownFile(sDownURL, sLocalFile) then
              begin
                sHint := '云端已找到原报上传的无锁文件，但因网络出错无法下载，本次操作已取消。请重试！';
                Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
                Exit;
              end;


              // 导入更新-------------------------------------------------------

              // 导入前须检测无锁文件中仅含有原报数据
              vFileCheck := TTenderFileChecker.Create;
              try
                // 有一期以上数据，且最新期数据审核状态为原报
                bCanImp := vFileCheck.CheckFileValid(sLocalFile)
                    and (vFileCheck.PhaseCount > 0) and (vFileCheck.AuditStatus = 0);
                if not bCanImp then
                begin
                  Application.MessageBox(PChar('已从云端下载原报上传的无锁文件到本地，但文件有错误，禁止导入！请致电纵横服务人员以获取帮助。'), '警告', MB_OK + MB_ICONWARNING);
                  Exit;
                end;
              finally
                vFileCheck.Free;
              end;

              if not ImportFile(sLocalFile, sMD5) then
              begin
                Application.MessageBox(PChar('已从云端下载原报上传的无锁文件到本地，但导入失败！请重试。'), '警告', MB_OK + MB_ICONWARNING);
                Exit;
              end;
              sHint := '【重要提示】：本期计量已重新开始，在本次上报完成前，请勿删除该标段或更换电脑。';
              Application.MessageBox(PChar(sHint), '提示', MB_OK + MB_ICONINFORMATION);
              // 导入更新---------------------------------↑↑↑↑↑↑↑↑↑↑↑
>>>>>>> 3.1.5
            end;

            0, -1:
            begin
              sHint := sError + '（因网络出错，无法连接到云端以获取本期原报上传的无锁文件，无法重新开始本期，本次操作已取消。请重试。';
              Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
              Exit;
            end;
          end;
        end;
      end;
    end
    else if (iSearch = 10) then
    begin
      if not PHPWeb.ExistInServer(FWebID) then
      begin
        sHint :='该项目[' + FWebBidName_Local + ']在云端已被删除，点击"确定"后，可手动删除该项目。';
        Application.MessageBox(PChar(sHint), '提示', MB_OK + MB_ICONINFORMATION);
        Exit;
      end;
    end
    else if (iSearch = 0) or (iSearch = -1) then
    begin
      sHint := sError + '（因网络出错，无法检测[' + FWebBidName_Local + ']在云端是否有更新，本次操作已取消，请重试）。';
      Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
      Exit;
    end;

    Result := True;
  end;

var
  CurProjectFme: TProjectFrame;
begin
  // 打开前先下载更新
  Screen.Cursor := crHourGlass;
  try
    vSel := stdProjects.IDTree.Selected;
    vRec := vSel.Rec;

    if G_IsCloud then
    begin
      GetLocalValues(CurRec);
      // 以下这段已经包含在MainForm.OpenProject(vRec)中了，但在调用这句之前，网络版要提前用一下。
      if MainForm.HasOpened(FID) then
      begin
        MainForm.LocateProject(FID);
        Exit;
      end;

      if not CanOpen then
        Exit;
    end;

    CurProjectFme := MainForm.OpenProject(vRec);

    if G_IsCloud then
    begin
      // 云版，如果用户在打开项目的过程中，切换界面回项目管理，MainFrom.CurProjectFrame值为nil，后面的调用，包括MainForm.actnCloseProject.Execute都会出错
      // 其中由于前面调用的MainForm.LocateProject触发的一系列事件中，调用到了SetPropertyVisible，其中执行了Screen.Cursor := crDefault
      // 导致鼠标状态还原，用户可以点击，单机版下测试，属性状态为crHourGlass时，亦可以切换会项目管理
      // 按逻辑，CheckFileAndCloudCheckerList这种方法不应在界面，应在控制器，亦不可直接调用MainForm.actnCloseProject.Execute
      // 怕按逻辑改动引起更多Bug，故继续错下去，检查MainForm.CurProjectFrame是否正确，并再次禁用鼠标
      if CurProjectFme <> MainForm.CurProjectFrame then
      begin
        Screen.Cursor := crHourGlass;
        MainForm.LocateProject(CurProjectFme.ProjectData.ProjectID);
      end;

      if not MainForm.CurProjectFrame.CheckFileAndCloudChekerList then
      begin
        sHint := '项目校验：“' + FWebBidName_OnLine + '”文件中的审核人和云端的审核人不一致，' +
          '禁止继续操作，项目即将关闭！请删除本地项目重新从云端获取，' +
          '重新获取后如果仍然存在同样的问题，请联系纵横服务人员以寻求帮助。';
        Application.MessageBox(PChar(sHint), '文件错误', MB_OK +MB_ICONWARNING);
        MainForm.actnCloseProject.Execute;
        Exit;
      end;
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TProjectManagerFrame.actnDeleteExecute(Sender: TObject);
begin
  if stdProjects.IDTree.Count = 0 then Exit;
  with stdProjects.IDTree.Selected.Rec do
    if QuestMessage(Format('确定要删除[%s]吗？', [ValueByName('Name').AsString])) then
    begin
      Screen.Cursor := crHourGlass;
      try
        FProjectManagerData.Delete;
      finally
        Screen.Cursor := crDefault;
      end;
    end;
end;

procedure TProjectManagerFrame.zgProjectsMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbRight then
    dxpmProjectManager.PopupFromCursorPos
  else if (zgProjects.CurCol = 1) and (Button = mbLeft) and (ssDouble in Shift)
    and Assigned(stdProjects.IDTree.Selected) then
  begin
    if IsProject(stdProjects.IDTree.Selected) then
      stdProjects.IDTree.Selected.Expand
    else
      actnOpen.Execute;
  end;
end;

function TProjectManagerFrame.ReceiveFile(const AFileName: string; AIsReback: Boolean): Boolean;
var
  vRP: TReceiveProject;
  vNode: TsdIDTreeNode;
  bLock, bIsOwner: Boolean;
begin
  Result := False;
  vRP := TReceiveProject.Create(stdProjects.IDTree.Selected);
  try
    ProjectManager.RefreshSeedID;

    if G_IsCloud then
    begin
      vRP.IsReback := AIsReback;
      bLock := (FWebAuthorID = PHPWeb.UserID) or
           ((FWebAuthorID <> PHPWeb.UserID) and (FWebCheckStatusMy <> csChecking));
      vRP.Lock := bLock;
      bIsOwner := FWebOwnerID = PHPWeb.UserID;
      vNode := vRP.ReceiveForLost(AFileName, FOnLineCheckerBegin, FOnLineCheckerEnd, bIsOwner);

      if vNode <> nil then
      begin
        vNode.Rec.BeginUpdate;
        vNode.Rec.ValueByName('WebMD5').AsString := FWebMD5_OnLine;
        vNode.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID;
        vNode.Rec.EndUpdate;
      end;
    end
    else
      vNode := vRP.Receive(AFileName);
  finally
    case vRP.MessageID of
      0: begin
           Result := True;
           vNode.LocateInControl;
         end;
      1: ErrorMessage('当前标段处于打开状态，未能成功接收，请先关闭标段再次接收。');
      2: ErrorMessage('下载数据与审核状态不一致，未能成功接收，请再次接收。');
      3: ErrorMessage('升级数据失败，未能成功接收，请再次接收。');
    end;
    vRP.Free;
    FProjectManagerData.Save;
  end;
end;

// 登录后自动扫描等待我审核的项目 TagC
procedure TProjectManagerFrame.actnReceiveProjectExecute(Sender: TObject);

  procedure DoReceiveLocal;
  var
    sFileName: string;
  begin
    if SelectFile(sFileName, '.rmf;*.arf') then
    begin
      ShowProgressHint('正在接收项目并升级数据');
      try
        ReceiveFile(sFileName);
      finally
        CloseProgressHint;
      end;
    end;
  end;


var OnCC: TZjCellNotifyEvent;
begin
  Screen.Cursor := crHourGlass;
  try
    if G_IsCloud then
    begin
      OnCC := zgProjects.OnCurrentChanged;
      try
        zgProjects.OnCurrentChanged := nil;
        DoBatchReceiveOnline(1);
        if stdProjects.IDTree.FirstNode <> nil then
          stdProjects.IDTree.FirstNode.LocateInControl;
      finally
        zgProjects.OnCurrentChanged := OnCC;
      end;
    end
    else
      DoReceiveLocal;
  finally
    Screen.Cursor := crDefault;
  end;
end;

function TProjectManagerFrame.GetImportProjectName(
  const AFileName: string; AParent: TsdIDTreeNode): string;
begin
  Result := ExtractSimpleFileName(AFileName);
  while FProjectManagerData.ExistProject(Result, AParent) do
    if not InputNewProjectName(Result, '导入', AParent) then Abort;
end;

procedure TProjectManagerFrame.actnNewProjectExecute(Sender: TObject);
var
  sName: string;
begin
  if G_IsCloud then Exit;    // 云版线上与本地要保持同步，不允许本地新建
  if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then
    FProjectManagerData.InsertProject(sName, stdProjects.IDTree.Selected);
end;

procedure TProjectManagerFrame.actnNewSubProjectExecute(Sender: TObject);
var
  sName: string;
begin
  if G_IsCloud then Exit;
  if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then
    FProjectManagerData.InsertSubProject(sName, stdProjects.IDTree.Selected);
end;

procedure TProjectManagerFrame.actnNewTenderExecute(Sender: TObject);

  function AddAndOpenTender(const ATenderName: string): TsdIDTreeNode;
  begin
    Result := FProjectManagerData.InsertTender(ATenderName, stdProjects.IDTree.Selected);
    MainForm.OpenProject(Result.Rec);
  end;

  // 网络版新建标段 TagD
  procedure NewProjectWithOnline;
  var
    WebNewTenderForm: TWebNewTenderForm;
    sName, sKey, sURL: string;
    stnNew: TsdIDTreeNode;
    iID, iFolderID, iSubFolderID: Integer;
    vRec: TsdDataRecord;
    vArr: array of string;
  begin
    WebNewTenderForm := TWebNewTenderForm.Create(nil);
    try
      WebNewTenderForm.ShowModal;
      if WebNewTenderForm.ModalResult = mrOK then
      begin
        sKey := WebNewTenderForm.edtKey.Text;
        sName := WebNewTenderForm.edtTenderName.Text;

        // 同服务器取得联系
        iID := -1;
        vArr := VarArrayOf(['catid', 'name', 'company', 'phone', 'mobile', 'qq',
         'pname', 'ptype', 'jobs', 'avatar', 'ownuid', 'pnameid', 'ptypeid']);

        sURL := Format('%s%d/%s/%s/creatmeasure', [PHPWeb.MeasureURL, PHPWeb.UserID, sName, sKey]);     // AnsiToUtf8(sName)
        case PHPWeb.Search(sURL, [], [], vArr) of
          1:
          begin
            iID := StrToInt(vArr[0]);
            iFolderID := StrToInt(vArr[11]);
            iSubFolderID := StrToInt(vArr[12]);
            CheckWebFolders(iFolderID, iSubFolderID, vArr[6], vArr[7]);
          end;

          0:
          begin
            Application.MessageBox(PChar(PHPWeb.PageError('创建标段失败' + '[' + vArr[0] + ']')),
              '警告', MB_OK + MB_ICONWARNING);
            Exit;
          end;
          -1:
          begin
            Application.MessageBox(PChar(PHPWeb.NetError('创建标段失败')),
              '警告', MB_OK + MB_ICONWARNING);
            Exit;
          end;
        end;

        // 本地创建
        stnNew := FProjectManagerData.InsertTender(sName, stdProjects.IDTree.Selected);

        // 这里把Web获取的信息存储到项目管理里面。
        vRec := stnNew.Rec;
        vRec.BeginUpdate;
        vRec.ValueByName('WebID').AsInteger := iID;
        vRec.ValueByName('WebOwnerID').AsInteger := StrToInt(vArr[10]);       // 业主
        vRec.ValueByName('WebAuthorID').AsInteger := PHPWeb.UserID;   // 编制人
        vRec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID;  // 当前用户，用于只显示自己的项目
        vRec.ValueByName('WebKey').AsString := sKey;
        vRec.EndUpdate;

        GetLocalValues(vRec);

        FWebOwnerName := vArr[1];
        FWebOwnerCompany := vArr[2];
        FWebOwnerRole := vArr[8];
        FWebFolder_OnLine := vArr[6];
        FWebSubFolder_OnLine := vArr[7];
//          WebOwnerImage := vArr[9];
//          WebOwnerPhone := vArr[3];
//          WebOwnerMobile := vArr[4];
//          WebOwnerQQ := vArr[5];
        ShowProjectInfoTop(0);
        FProjectManagerData.Save;
        MainForm.OpenProject(vRec);
      end;
    finally
      WebNewTenderForm.Free;
    end;
  end;

  procedure NewProject;
  var
    sName: string;
  begin
    if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then
      AddAndOpenTender(sName);
  end;

begin
  if G_IsCloud then
    NewProjectWithOnline
  else
    NewProject;
end;

procedure TProjectManagerFrame.zgProjectsDrawCellText(ACanvas: TCanvas;
  const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid;
  const Text: String; var ADefaultDraw: Boolean);

  procedure GetBitmap(AImage: TBitmap; ANode: TsdIDTreeNode);
  begin
    if Assigned(ANode) and Assigned(ANode.Rec) then
    begin
      if ANode.Rec.ValueByName('Type').AsInteger = 0 then
        if ANode.Expanded and ANode.HasChildren then
          MainForm.Images.GetBitmap(34, AImage)
        else
          MainForm.Images.GetBitmap(34, AImage)
      else
        MainForm.Images.GetBitmap(11, AImage);
    end
    else
      AImage := nil;
  end;

const
  rIconWidth = 16;
  rIconHeight = 16;
var
  Img: TBitmap;
  Cell: TZjCell;
  rImg: TRect;
  vNode: TsdIDTreeNode;
begin
  if (ACoord.X = 1) and (ACoord.Y > zgProjects.FixedRowCount - 1) then
  begin
    Cell := zgProjects.Cells[ACoord.X, ACoord.Y];
    Img := TBitmap.Create;
    try
      vNode := stdProjects.IDTree.Items[ACoord.Y-zgProjects.FixedRowCount];
      GetBitmap(Img, vNode);
      case Cell.Align of
        gaTopLeft, gaTopCenter, gaTopRight:
          rImg := Rect(ARect.Left + 2, ARect.Top, ARect.Left + rIconWidth, ARect.Top + rIconHeight);
        gaCenterLeft, gaCenterCenter, gaCenterRight:
          rImg := Rect(ARect.Left + 2, ARect.Top + (ARect.Bottom - ARect.Top - rIconHeight) div 2, ARect.Left + rIconWidth, ARect.Bottom - (ARect.Bottom - ARect.Top - rIconHeight) div 2);
        gaBottomLeft, gaBottomCenter, gaBottomRight:
          rImg := Rect(ARect.Left + 2, ARect.Bottom - rIconHeight, ARect.Left + rIconWidth, ARect.Bottom);
      end;
      ACanvas.StretchDraw(rImg, Img);
      WriteText(ACanvas, Rect(ARect.Left + rIconWidth, ARect.Top, ARect.Right, ARect.Bottom)
        , 2, 2, Text, Cell.Align, False);
      ADefaultDraw := False;
    finally
      Img.Free;
    end;
  end;
end;

procedure TProjectManagerFrame.actnNewSubProjectUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
    and IsProject(stdProjects.IDTree.Selected)
    and (not IsUnEmptyLeafProject(stdProjects.IDTree.Selected));
end;

procedure TProjectManagerFrame.actnNewTenderUpdate(Sender: TObject);
var bCloud: Boolean;
  vNode: TsdIDTreeNode;
begin
  bCloud := G_IsCloud;
  // 只有编制人才能创建新标段？逻辑先后有问题：编制人是在创建标段之后产生的。
  // 创建前，当前用户只是一个帐户，它是不是编制人末知，因为它还可以是其它角色。
  // 同一帐户在不同的标段可以作为不同的角色。
  if bCloud then
  begin
    TAction(Sender).Enabled := True;
  end
  else
  begin
    vNode := stdProjects.IDTree.Selected;
    TAction(Sender).Enabled := Assigned(vNode) and IsProject(vNode) and IsLeafProject(vNode);
  end;
end;

function TProjectManagerFrame.IsLeafProject(ANode: TsdIDTreeNode): Boolean;
begin
  if ANode.HasChildren then
    Result := ANode.FirstChild.Rec.ValueByName('Type').AsInteger = 1
  else
    Result := ANode.Rec.ValueByName('Type').AsInteger = 0;
end;

function TProjectManagerFrame.IsProject(ANode: TsdIDTreeNode): Boolean;
begin
  Result := ANode.Rec.ValueByName('Type').AsInteger = 0;
end;

function TProjectManagerFrame.IsUnEmptyLeafProject(
  ANode: TsdIDTreeNode): Boolean;
begin
  Result := ANode.HasChildren and (ANode.Rec.ValueByName('Type').AsInteger = 1);
end;

procedure TProjectManagerFrame.SetPropertyVisible(AVisible: Boolean);
begin
  // 单击刷新项目信息 TagA
  if G_IsCloud then
  begin
    if CurRec = nil then Exit;
    pnlTenderProperty.Visible := False;
    pnlWeb.Visible := AVisible;
    if AVisible then
    begin
      CreateProgress('云端读取项目信息');
      try
        ShowProjectInfoTopAndCheckers;
      finally
        CloseProgress;
      end;
    end;
  end
  else
  begin
    pnlWeb.Visible := False;
    pnlTenderProperty.Visible := AVisible;
    sprProperty.Visible := AVisible;
  end;
end;

procedure TProjectManagerFrame.zgProjectsCurrentChanged(Sender: TObject;
  Col, Row: Integer);
begin
  if G_IsCloud then
  begin
    if CurRec <> nil then
    begin
      // 加这句后产生Bug：上报项目后，记录不曾移动，FID不变，不会刷新
//      if FID <> CurRec.ValueByName('ID').AsInteger then
        SetPropertyVisible(CurRec.ValueByName('Type').AsInteger = 1);

      // OnCurrentChanged取得的 CurRec.ValueByName() 值并不总是可靠，这里加保险。
      // 如调用locateInControl后，执行到这里取得的CurRec.ValueByName('ID')值还是上一条的。
      if (CurRec.ValueByName('Type').AsInteger = 1) and (not pnlWeb.Visible) then
        pnlWeb.Visible := True;
    end;
  end;
end;

procedure TProjectManagerFrame.actnSubmitProjectUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
    and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1)
    and (stdProjects.IDTree.Selected.Rec.ValueByName('AuditStatus').AsInteger < iMaxStageCount-1);
end;

procedure TProjectManagerFrame.actnReplyProjectUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
    and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);
end;

procedure TProjectManagerFrame.actnRenameExecute(Sender: TObject);

  function CanRename(ARec: TsdDataRecord; const ANewName: string): Boolean;
  var
    sURL: string;
    iRename: Integer;
    vArr: array [0..0] of string;
  begin
    Result := True;
    if not G_IsCloud then Exit;
    // 云版 重命名须确保同步服务器
    sURL := Format('%stender/%d/%s/update', [PHPWeb.MeasureURL, ARec.ValueByName('WebID').AsInteger, ANewName]);
    iRename := PHPWeb.Search(sURL, [], [], vArr);
    Result := iRename = 1;
    case iRename of
      1: ShowMessage('新的标段名称已同步到服务器！');
      0: Application.MessageBox(PChar(PHPWeb.PageError('重命名同步到云端失败' + '[' + vArr[0] + ']')),
          '警告', MB_OK + MB_ICONWARNING);
     -1: Application.MessageBox(PChar(PHPWeb.NetError('重命名同步到云端失败')),
          '警告', MB_OK + MB_ICONWARNING);
    end;
  end;

var
  stnNode: TsdIDTreeNode;
  sName: string;
begin
  stnNode := stdProjects.IDTree.Selected;
  sName := stnNode.Rec.ValueByName('Name').AsString;
  if not Assigned(OpenProjectManager.FindProjectData(stnNode.ID)) then
  begin
    if InputNewProjectName(sName, '重命名', stnNode.Parent, stnNode.ID) then
    begin
      if (sName <> stnNode.Rec.ValueByName('Name').AsString) and CanRename(stnNode.Rec, sName) then
      begin
        stnNode.Rec.ValueByName('Name').AsString := sName;
        ProjectManager.Save;
      end;
    end;
  end
  else
    ErrorMessage(Format('项目[%s]已经打开，无法重命名！', [sName]));
end;

procedure TProjectManagerFrame.actnOpenUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
      and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);
end;

procedure TProjectManagerFrame.actnImportExecute(Sender: TObject);

  procedure ImportTender(const AFileName, AProjectName: string);
  var
    Importor: TTenderImport;
  begin
    Importor := TTenderImport.Create(stdProjects.IDTree.Selected,
      AProjectName, AFileName);
    try
      Importor.Execute;
    finally
      Importor.Free;
    end;
  end;

  procedure ImportProject(const AFileName, AProjectName: string);
  var
    Importor: TProjectImport;
  begin
    Importor := TProjectImport.Create(stdProjects.IDTree.Selected,
      AProjectName, AFileName);
    try
      Importor.Execute;
    finally
      Importor.Free;
    end;
  end;

var
  sFileName, sProjectName: string;
  vCur: TsdIDTreeNode;
begin
  if SelectFile(sFileName, '.mtf;*.mpf') then
  begin
    vCur := stdProjects.IDTree.Selected;
    if Assigned(vCur) then
    begin
      if SameText(ExtractFileExt(sFileName), '.mtf')
        and (vCur.Rec.ValueByName('Type').AsInteger = 0) then
        sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected)
      else
        sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected.Parent);
    end
    else
      sProjectName := GetImportProjectName(sFileName, vCur);

    Screen.Cursor := crHourGlass;
    try
      if SameText(ExtractFileExt(sFileName), '.mtf') then
        ImportTender(sFileName, sProjectName)
      else
        ImportProject(sFileName, sProjectName);
    finally
      Screen.Cursor := crDefault;
    end;
  end;
  FProjectManagerData.Save;
end;

procedure TProjectManagerFrame.actnExportExecute(Sender: TObject);

  procedure ExportTender(ANode: TsdIDTreeNode);
  var
    Exportor: TTenderExport;
    sFileName, sHint: string;
    bExpAtch: Boolean;
    iCount: Integer;
  begin
    bExpAtch := False;
    sFileName := SupportManager.ConfigInfo.OutputPath + ANode.Rec.ValueByName('Name').AsString + '.mtf';
    if SaveFile(sFileName, '.mtf') then
    begin
      if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”，是否替换？', [ExtractFileName(sFileName)])) then
        Exit;

      Screen.Cursor := crHourGlass;
      try
        Exportor := TTenderExport.Create(ANode.Rec, sFileName);
        try
         { if not G_IsCloud then
          begin
            iCount := FileCount(CurRecAttachmentPath);
            if iCount > 1 then        // 排除管理文件库
            begin
              sHint := Format('本标段包含 %d 个附件，是否将附件一起导出？', [iCount - 1]);
              bExpAtch := Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = ID_Yes;
            end;
          end;   }   // FFFFF
          Exportor.Execute(bExpAtch);
        finally
          Exportor.Free;
        end;
      finally
        Screen.Cursor := crDefault;
      end;
    end;
  end;

  procedure ExportProject(ANode: TsdIDTreeNode);
  var
    Exportor: TProjectExport;
    sFileName, sHint: string;
    bExpAtch: Boolean;
    iCount: Integer;
  begin
    sFileName := SupportManager.ConfigInfo.OutputPath + ANode.Rec.ValueByName('Name').AsString + '.mpf';
    if SaveFile(sFileName, '.mpf') then
    begin
      if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”，是否替换？', [ExtractFileName(sFileName)])) then
        Exit;

      Screen.Cursor := crHourGlass;
      try
        bExpAtch := False;
       { if not G_IsCloud then
        begin
          iCount := AttachmentFileCountsWithoutManageFile(ANode);
          if iCount > 0 then
          begin
            sHint := Format('本建设项目共包含 %d 个附件，是否将附件一起导出？', [iCount]);
            bExpAtch := Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = ID_Yes;
          end;
        end;  }    // FFFFF

        Exportor := TProjectExport.Create(ANode, sFileName, bExpAtch);
        try
          Exportor.Execute;
        finally
          Exportor.Free;
        end;
      finally
        Screen.Cursor := crDefault;
      end;
    end;
  end;

var
  stnNode: TsdIDTreeNode;
begin
  stnNode := stdProjects.IDTree.Selected;
  if stnNode.Rec.ValueByName('Type').AsInteger = 1 then
  begin
    ExportTender(stnNode);
  end
  else
    ExportProject(stnNode);
end;

procedure TProjectManagerFrame.actnDeleteUpdate(Sender: TObject);
begin
  if Assigned(stdProjects.IDTree.Selected) then
    TAction(Sender).Enabled := not CheckOpened(stdProjects.IDTree.Selected)
  else
    TAction(Sender).Enabled := False;
end;

function TProjectManagerFrame.CheckOpened(ANode: TsdIDTreeNode): Boolean;
var
  iChild: Integer;
begin
  Result := False;
  if ANode.Rec.ValueByName('Type').AsInteger = 1 then
    Result := OpenProjectManager.ProjectIndex(ANode.ID) > -1
  else
  begin
    if not ANode.HasChildren then
      Result := False
    else
    begin
      for iChild := 0 to ANode.ChildCount - 1 do
        Result := Result or CheckOpened(ANode.ChildNodes[iChild]);
    end
  end;
end;

procedure TProjectManagerFrame.ShowProjectInfoTopAndCheckers;
var
  vPSArr: TStrArr;
  vCArr: TOVArr;    // Checkers
  vChecker: TOrderCheckerFrame;
  sPicPath, sURL: string;

  procedure AddChecker(AType: TCheckerFrameType; AArr: array of string);
  begin
    vChecker := TOrderCheckerFrame.Create(self);
    FCheckerList.Add(vChecker);
    vChecker.Owner := Self;
    sbChecker.VertScrollBar.Range := sbChecker.VertScrollBar.Range + vChecker.Height;
    sbChecker.Height := Min(sbChecker.Height + vChecker.Height, pnlWeb.Height - pnlProject.Height);
    vChecker.Parent := sbChecker;
    vChecker.Top := FCurPos;
    FCurPos := FCurPos + vChecker.Height;
    vChecker.Align := alTop;

    sPicPath := PHPWeb.UserPath + '1_' + AArr[0] + '.jpg';
    PHPWeb.DownFile(AArr[4], sPicPath);
    vChecker.Init(AType, StrToInt(AArr[0]), AArr[1], AArr[3],
      AArr[2], sPicPath, AArr[6], TCheckStatus(StrToInt(AArr[5])-1));
    vChecker.Name := 'ProjectOrderFrame' + AArr[0];
  end;

  procedure RepairOrder;
  var k: Integer;
  begin
    for k := 0 to sbChecker.ControlCount - 1 do
      TOrderCheckerFrame(sbChecker.Controls[k]).Order := k + 1;
  end;

<<<<<<< HEAD
  procedure ShowProjectCheckers;
  var i, j, n: Integer;
    vOwner: array of string;  // 业主信息
=======
  procedure RefreshProjectCheckers;
  var i, j: Integer;
    vOwner: array[0..6] of string;    // 业主信息
>>>>>>> 3.1.5
  begin
    FCheckerList.Clear;
    sbChecker.Height := 0;
    FCurPos := 0;

    sbChecker.VertScrollBar.Range := 0;
    for i := Low(vCArr) to High(vCArr) do
    begin
      if StrToInt(vCArr[i, 0]) = PHPWeb.UserID then
        FWebCheckStatusMy := TCheckStatus(StrToInt(vCArr[i, 5])-1);

      if StrToInt(vCArr[i, 0]) = FWebOwnerID then
      begin
        for j := 0 to 6 do
          vOwner[j] := vCArr[i, j];

        Continue;
      end;

      AddChecker(cftChecker, vCArr[i]);
    end;
    if vOwner[0] <> '' then
      AddChecker(cftOwner, vOwner);
    RepairOrder;

    OnLineChecker(vCArr, FOnLineCheckerBegin, FOnLineCheckerEnd);
  end;

begin
  GetLocalValues(CurRec);
  if FWebID = 0 then Exit;
  SetLength(vPSArr, 8);
  sURL := Format('%smeasure/status/%d/get', [PHPWeb.MeasureURL, FWebID]);
  if PHPWeb.Search(sURL, [''], [''], 3, vPSArr, vCArr) = 1 then
  begin
    LockWindowUpdate(pnlWeb.Handle);
    try
      FPhaseNo := StrToInt(vPSArr[0]);
      FWebCheckStatusProject := TCheckStatus(StrToInt(vPSArr[1])-1);
      FPhaseTotal := StrToInt(vPSArr[2]);
      FWebFolder_OnLine := vPSArr[3];
      FWebSubFolder_OnLine := vPSArr[4];
      FWebOwnerName := vPSArr[5];
      FWebOwnerCompany := vPSArr[6];
      FWebOwnerRole := vPSArr[7];

      ShowProjectInfoTop;
      ShowProjectCheckers;
    finally
      LockWindowUpdate(0);
    end;
  end
  else
  begin
    FPhaseNo := 0;
    FWebCheckStatusProject := csNotBegin;
    FPhaseTotal := 0;
    FWebFolder_OnLine := '';
    FWebSubFolder_OnLine := '';
    FWebOwnerName := '';
    FWebOwnerCompany := '';
    FWebOwnerRole := '';

    ShowProjectInfoTop;

    sbChecker.Height := 0;
  end;
end;

procedure TProjectManagerFrame.ShowProjectInfoTop(AType: Integer);

  procedure ShowOwner;
  begin
    lblBidName.Caption := FWebBidName_Local;
    lblBidName.Update;
    lblProjName.Caption := FWebFolder_OnLine;
    lblProjName.Update;
    lblWebProjCtgyName.Caption := FWebSubFolder_OnLine;
    lblWebProjCtgyName.Update;
    lblOnwerName.Caption := FWebOwnerName;
    lblOnwerName.Update;
    lblOnwerCompany.Caption := Format('－%s）', [FWebOwnerCompany]);
    lblOnwerCompany.Update;
    lblOnwerCompany.Left := lblOnwerName.Left + lblOnwerName.Width;
  end;

  procedure ShowStatus(ANo: Integer; AState: TCheckStatus);
  begin
    lblPeriod.Caption := Format('第%d期', [ANo]);
    lblPeriod.Update;
    lblPeriodState.Caption := CheckStatusNames[AState];
    lblPeriodState.Font.Color := CheckStatusColors[AState];
    lblPeriodState.Update;
    lblPeriodState.Left := lblPeriod.Left + lblPeriod.Width + 5;
    lblPeriodTotal.Caption := Format('（共%d期）', [ANo]);
    lblPeriodTotal.Update;
    lblPeriodTotal.Left := lblPeriodState.Left + lblPeriodState.Width + 3;
  end;
begin
  GetLocalValues(CurRec);
  case AType of
    -2:
    begin
      lblPeriod.Caption := '正在从云端读取状态信息...';
      lblPeriod.Update;
    end;
    -1:
    begin
      ShowOwner;
      ShowStatus(FPhaseNo, FWebCheckStatusProject);
    end;
    0:
    begin
      ShowOwner;
      ShowStatus(0, csNotBegin);
    end;
  end;
end;


// 检查后，应该定位到最后一层目录，不应该回到原先的选择节点。否则从网络拉下来的项目无法组织正确的树结构。
procedure TProjectManagerFrame.CheckWebFolders(AFolderID, ASubFolderID: Integer;
  AFolderName, ASubFolderName: string);
var
  vTree: TsdIDTree;
  vNode, vSubNode: TsdIDTreeNode;
  i: Integer;
  sName: string;
  iUserID, iWebID, iWebFolderLevel: Integer;
  bExist, bSubExist, bModified: Boolean;
begin
  bExist := False;
  bSubExist := False;
  bModified := False;

  vTree := stdProjects.IDTree;

  for i := 0 to vTree.Count - 1 do
  begin
    vNode := vTree.Items[i];
    sName := vNode.Rec.ValueByName('Name').AsString;
    iUserID := vNode.Rec.ValueByName('WebUserID').AsInteger;
    iWebID := vNode.Rec.ValueByName('WebID').AsInteger;
    iWebFolderLevel := vNode.Rec.ValueByName('WebFolderLevel').AsInteger;

    if (iWebID = AFolderID) and (iWebFolderLevel = G_WFL_ProjName) and (iUserID = PHPWeb.UserID) then
    begin
      bExist := True;
      vNode.LocateInControl;
      if not SameText(sName, AFolderName) then
      begin
        vNode.Rec.ValueByName('Name').AsString := AFolderName;
        bModified := True;
      end;

      Break;
    end;
  end;

  if not bExist then
  begin
    vNode := vTree.Items[0];
    if Assigned(vNode) then
      vNode.LocateInControl;
    vNode := FProjectManagerData.InsertProject(AFolderName, stdProjects.IDTree.Selected, AFolderID, G_WFL_ProjName);
    vNode.LocateInControl;
  end;

  for i := 0 to vNode.ChildCount - 1 do
  begin
    vSubNode := vNode.ChildNodes[i];
    sName := vSubNode.Rec.ValueByName('Name').AsString;
    iUserID := vSubNode.Rec.ValueByName('WebUserID').AsInteger;
    iWebID := vSubNode.Rec.ValueByName('WebID').AsInteger;
    iWebFolderLevel := vSubNode.Rec.ValueByName('WebFolderLevel').AsInteger;

    if (iWebID = ASubFolderID) and (iWebFolderLevel = G_WFL_BidType) and (iUserID = PHPWeb.UserID) then
    begin
      bSubExist := True;
      vSubNode.LocateInControl;
      if not SameText(sName, ASubFolderName) then
      begin
        vSubNode.Rec.ValueByName('Name').AsString := ASubFolderName;
        bModified := True;
      end;

      Break;
    end;
  end;

  if not bSubExist then
  begin
    vNode.LocateInControl;
    vNode := FProjectManagerData.InsertSubProject(ASubFolderName, stdProjects.IDTree.Selected, ASubFolderID, G_WFL_BidType);
    vNode.LocateInControl;
  end;

  if bModified then
    ProjectManager.Save;

end;

function TProjectManagerFrame.Rec(AProjectID: Integer): TsdDataRecord;
var i: Integer;
  vTree: TsdIDTree;
begin
  vTree := stdProjects.IDTree;
  if vTree.Selected.Rec.ValueByName('ID').AsInteger = AProjectID then
  begin
    Result := stdProjects.IDTree.Selected.Rec;
    Exit;
  end;

  for i := 0 to vTree.Count - 1 do
  begin
    if vTree.Items[i].Rec.ValueByName('ID').AsInteger = AProjectID then
    begin
      Result := vTree.Items[i].Rec;
      vTree.Items[i].LocateInControl;
      Break;
    end;
  end;
end;

destructor TProjectManagerFrame.Destroy;
begin
  FCheckerList.Free;
  inherited;
end;

procedure TProjectManagerFrame.DoBatchReceiveOnline(ARequestType: Integer);
var
  sURL, sCheckersURL, sHint: string;
  vArr: TOVArr;
  i, iFolderID, iSubFolderID: Integer;
  vPSArr: TStrArr;
  vCArr: TOVArr;    // Checkers
begin
  // 查询等待我审核的标段文件,杰哥说分三种：①业主未审核 ②业主审核中 ③审核人审核中 （为什么加①？问杰哥）
  case PHPWeb.Search(PHPWeb.MeasureURL + 'user/get/audit/project', ['audituid', 'RequestType'],
    [IntToStr(PHPWeb.UserID), IntToStr(ARequestType)], vArr) of
    1:
    begin
      CreateProgress('正在从云端下载新项目');
      try
        for i := Low(vArr) to High(vArr) do
        begin
          sURL := vArr[i, 0];
          FWebFolder_OnLine := vArr[i, 1];
          FWebSubFolder_OnLine := vArr[i, 2];
          FWebMD5_OnLine := vArr[i, 3];
          FWebID := StrToInt(vArr[i, 5]);
          iFolderID := StrToInt(vArr[i, 6]);
          iSubFolderID := StrToInt(vArr[i, 7]);
          FWebCheckStatusMy := TCheckStatus(StrToInt(vArr[i, 8])-1);      // vArr[i, 4]项目审核状态；vArr[i, 8]当前登陆用户的审核状态
          FWebAuthorID := StrToInt(vArr[i, 9]);
          FWebBidName_OnLine := vArr[i, 10];
          FWebMD5_Local := LocalMD5(PHPWeb.UserID, FWebID);

          CheckWebFolders(iFolderID, iSubFolderID, FWebFolder_OnLine, FWebSubFolder_OnLine);
          CheckBidName(PHPWeb.UserID, FWebID, FWebBidName_OnLine);

          if FWebMD5_OnLine <> FWebMD5_Local then
          begin
            sCheckersURL := Format('%smeasure/status/%d/get', [PHPWeb.MeasureURL, FWebID]);
            if PHPWeb.Search(sCheckersURL, [''], [''], 3, vPSArr, vCArr) = 1 then
              OnLineChecker(vCArr, FOnLineCheckerBegin, FOnLineCheckerEnd)
            else
            begin
              FOnLineCheckerBegin := 0;
              FOnLineCheckerEnd := 0;
            end;

            if not FileDownAndReceive(sURL, 1) then Exit;
          end;
        end;

        BubbleSortProjects;
      finally
        CloseProgress;
      end;
    end;

    0, -1:
    begin
      sHint := '网络出错，无法查询云端项目的更新情况，请重试！';
      Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
      Exit;
    end;
  end;
end;

function TProjectManagerFrame.ImportFile(const AFileName: string; AFileMD5: string): Boolean;
var
  vImport: TTenderImport;
  vNode: TsdIDTreeNode;
begin
  Result := False;

  vNode := stdProjects.IDTree.Selected;
  vImport := TTenderImport.Create(vNode, '', AFileName);
  try
    try
      vImport.ImportToSelect;

      vNode.LocateInControl;
      Result := True;
    except
      Result := False;
    end;
  finally
    vImport.Free;

    vNode.Rec.BeginUpdate;
    vNode.Rec.ValueByName('WebMD5').AsString := AFileMD5;
    vNode.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID;
    vNode.Rec.EndUpdate;

    FProjectManagerData.Save;
  end;
end;

procedure TProjectManagerFrame.actnOpenBackupFolderExecute(
  Sender: TObject);
var
  stnNode: TsdIDTreeNode;
begin
  stnNode := stdProjects.IDTree.Selected;
  if stnNode.Rec.ValueByName('BackupFolder').AsString = '' then
    TipMessage('该项目暂无备份数据！')
  else
    ShellExecute(Handle, 'open', 'Explorer.exe',
      PChar(FProjectManagerData.BackupPath(stnNode.ID)), nil, 1);
end;

procedure TProjectManagerFrame.actnRenameUpdate(Sender: TObject);
var
  Rec: TsdDataRecord;
  bNet, bEnabled: Boolean;
begin
  if Assigned(stdProjects.IDTree.Selected) and Assigned(stdProjects.IDTree.Selected.Rec) then
  begin
    bEnabled := True;
    Rec := stdProjects.IDTree.Selected.Rec;
    bNet := G_IsCloud;
    if bNet then
    begin
      bEnabled := (Rec.ValueByName('Type').AsInteger = 1) and
        (Rec.ValueByName('WebAuthorID').AsInteger = PHPWeb.UserID);
    end;
  end
  else
    bEnabled := False;
  if bEnabled <> TAction(Sender).Enabled then
    TAction(Sender).Enabled := bEnabled;
end;

procedure TProjectManagerFrame.CheckBidName(AID: Integer; ANewBidName: string);
var vNode: TsdIDTreeNode;
begin
  vNode := stdProjects.IDTree.FindNode(AID);

  if vNode = nil then Exit;
  
  if vNode.Rec.ValueByName('Name').AsString <> ANewBidName then
  begin
    vNode.Rec.ValueByName('Name').AsString := ANewBidName;
    ProjectManager.Save;
  end;
end;

procedure TProjectManagerFrame.DoBatchReceiveAllOnline;
var
  OnCC: TZjCellNotifyEvent;
begin
  OnCC := zgProjects.OnCurrentChanged;
  try
    zgProjects.OnCurrentChanged := nil;
    DoBatchReceiveOnline(2);
    if stdProjects.IDTree.FirstNode <> nil then
      stdProjects.IDTree.FirstNode.LocateInControl;
  finally
    zgProjects.OnCurrentChanged := OnCC;
  end;
end;


procedure TProjectManagerFrame.GetLocalValues(ARec: TsdDataRecord);
begin
  if not Assigned(ARec) then
  begin
    ClearLocalValues;
    Exit;
  end;

  // 加这句后产生Bug：上报项目后，记录不曾移动，FID不变，不会刷新
//  if ARec.ValueByName('ID').AsInteger <> FID then
  begin
    FID := ARec.ValueByName('ID').AsInteger;
    FWebID := ARec.ValueByName('WebID').AsInteger;
    FWebAuthorID := ARec.ValueByName('WebAuthorID').AsInteger;
    FWebOwnerID := ARec.ValueByName('WebOwnerID').AsInteger;
    FWebMD5_Local := ARec.ValueByName('WebMD5').AsString;
    FWebBidName_Local := ARec.ValueByName('Name').AsString;
  end;
end;

procedure TProjectManagerFrame.GetLocalValues(AUserID, AWebID: Integer);
var i: Integer;
  vTree: TsdIDTree;
  vRec: TsdDataRecord;
begin
  ClearLocalValues;      // 先清空，以防没找到。

  if (CurRec <> nil) and
    (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and
    (CurRec.ValueByName('WebID').AsInteger = AWebID) and
    (CurRec.ValueByName('Type').AsInteger = 1) then
  begin
    GetLocalValues(vRec);
    Exit;
  end;

  vTree := stdProjects.IDTree;
  for i := 0 to vTree.Count - 1 do
  begin
    vRec := vTree.Items[i].Rec;
    if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and
      (vRec.ValueByName('WebID').AsInteger = AWebID) and
      (vRec.ValueByName('Type').AsInteger = 1) then
    begin
      GetLocalValues(vRec);
      Break;
    end;
  end;
end;

procedure TProjectManagerFrame.ClearLocalValues;
begin
  FID := -1;
  FWebID := -1;
  FWebAuthorID := -1;
  FWebOwnerID := -1;
  FWebMD5_Local := '';
  FWebBidName_Local := '';
end;


function TProjectManagerFrame.LocalMD5(AUserID, AWebID: Integer): string;
var i: Integer;
  vTree: TsdIDTree;
  vRec: TsdDataRecord;
begin
  Result := '本地无MD5码';

  if (CurRec <> nil) and
    (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and
    (CurRec.ValueByName('WebID').AsInteger = AWebID) and
    (CurRec.ValueByName('Type').AsInteger = 1) then
  begin
    Result := vRec.ValueByName('WebMD5').AsString;
    Exit;
  end;

  vTree := stdProjects.IDTree;
  for i := 0 to vTree.Count - 1 do
  begin
    vRec := vTree.Items[i].Rec;
    if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and
      (vRec.ValueByName('WebID').AsInteger = AWebID) and
      (vRec.ValueByName('Type').AsInteger = 1) then
    begin
      Result := vRec.ValueByName('WebMD5').AsString;
      Break;
    end;
  end;
end;

function TProjectManagerFrame.CurRec: TsdDataRecord;
begin
  if stdProjects.IDTree.Selected = nil then
    Result := nil
  else
    Result := stdProjects.IDTree.Selected.Rec;
end;


procedure TProjectManagerFrame.CheckBidName(AUserID, AWebID: Integer;
  ANewBidName: string);
var i: Integer;
  vTree: TsdIDTree;
  vRec: TsdDataRecord;
begin
  if (CurRec <> nil) and
    (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and
    (CurRec.ValueByName('WebID').AsInteger = AWebID) and
    (CurRec.ValueByName('Type').AsInteger = 1) then
  begin
    if (CurRec.ValueByName('Name').AsString <> ANewBidName) then
    begin
      CurRec.ValueByName('Name').AsString := ANewBidName;
      ProjectManager.Save;
    end;

    Exit;
  end;

  vTree := stdProjects.IDTree;
  for i := 0 to vTree.Count - 1 do
  begin
    vRec := vTree.Items[i].Rec;
    if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and
      (vRec.ValueByName('WebID').AsInteger = AWebID) and
      (vRec.ValueByName('Type').AsInteger = 1) then
    begin
      if vRec.ValueByName('Name').AsString <> ANewBidName then
      begin
        vRec.ValueByName('Name').AsString := ANewBidName;
        ProjectManager.Save;
      end;
      Break;
    end;
  end;
end;

function TProjectManagerFrame.CurRecAttachmentPath: string;
begin
  if G_IsCloud then
    Result := PHPWeb.WebPath + 'Projects\' + CurRec.ValueByName('WebID').AsString + '\Attachment\'
  else
    Result := GetMyProjectsFilePath + 'Attachment\' + CurRec.ValueByName('FileName').AsString + '\';
end;


function TProjectManagerFrame.AttachmentFileCountsWithoutManageFile(ANode: TsdIDTreeNode): Integer;
  function GetCount(ANode: TsdIDTreeNode): Integer;
  var sPath: string;
  begin
    if not Assigned(ANode) then Exit;

    Result := 0;
    if ANode.Rec.ValueByName('Type').AsInteger = 0 then
      Result := Result + 0
    else
    begin
      sPath := GetMyProjectsFilePath + 'Attachment\' + ANode.Rec.ValueByName('FileName').AsString + '\';
      Result := Result + FileCount(sPath) - 1;
    end;

    if Assigned(ANode.FirstChild) then
      Result := Result + GetCount(ANode.FirstChild);

    if Assigned(ANode.NextSibling) then
      Result := Result + GetCount(ANode.NextSibling);
  end;
begin
  if not Assigned(ANode) then Exit;
  if Assigned(ANode.FirstChild) then
    Result := GetCount(ANode.FirstChild)
  else
    Result := 0;
end;


procedure TProjectManagerFrame.BubbleSortProjects;

  // 不能排最顶层
  procedure BubbleSort(ANode: TsdIDTreeNode);
    var n, t, c, temp: Integer;
      bSwap: Boolean;
      vNode1, vNode2, vTempNode: TsdIDTreeNode;
  begin
    if ANode = nil then Exit;
//    if ANode.Rec.ValueByName('WebFolderLevel').AsInteger = G_WFL_ProjName then Exit;

    n := ANode.ChildCount;

    for t := 1 to n - 1 do
    begin
      bSwap := False;

      for c := 1 to (n - t) do
      begin
        vNode1 := ANode.ChildNodes[c - 1];
        vNode2 := ANode.ChildNodes[c];

        if AnsiCompareStr(vNode1.Rec.ValueByName('Name').AsString,
          vNode2.Rec.ValueByName('Name').AsString) = 1 then
        begin
          vNode1.DownMove;
          bSwap := True;
        end;
      end;

      if bSwap = False then Break;
    end;

    if Assigned(ANode.FirstChild) then
      BubbleSort(ANode.FirstChild);

    if Assigned(ANode.NextSibling) then
      BubbleSort(ANode.NextSibling);
  end;
begin
  BubbleSort(stdProjects.IDTree.FirstNode);
end;

procedure TProjectManagerFrame.zgProjectsShowHint(var HintStr: String;
  var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint);
var
  vCell: TZjCell;
  vNode: TsdIDTreeNode;
  iLevelWidth: Integer;
  rText: TRect;

  procedure CalcTextRect(var R: TRect);
  var
    DC: HDC;
    iTextHeight: Integer;
  begin
    DC := CreateCompatibleDC(0);
    try
      SelectObject(DC, vCell.Font.Handle);
      iTextHeight := DrawText(DC, PChar(vCell.Text), Length(vCell.Text), R, DT_SINGLELINE or DT_VCenter
        or DT_NOCLIP or DT_CALCRECT);
    finally
      DeleteDC(DC);
    end;
  end;

begin
  if (ACoord.Y < 1) and (ACoord.X <> 1) then Exit;
  
  vCell := zgProjects.Cells[ACoord.X, ACoord.Y];
  with HintInfo do
  begin
    vNode := stdProjects.IDTree.Items[ACoord.Y - 1];
    if not Assigned(vNode) then Exit;
    iLevelWidth := (vNode.Level + 1) * 20 + 16;

    rText := CursorRect;
    CalcTextRect(rText);
    if (rText.Right - rText.Left + iLevelWidth > CursorRect.Right - CursorRect.Left) or
      (rText.Right > ClientWidth) then
    begin
      CanShow := True;
      HintStr := vCell.Text;
      GetCursorPos(HintPos);
    end;
  end;
end;

<<<<<<< HEAD
function TProjectManagerFrame.FileDownAndReceive(ADownURL: string; AReceiveKind: Integer): Boolean;
var sLocalFile, sHint: string;
  bCanImp: Boolean;
  vFileCheck: TTenderFileChecker;
begin
  Result := False;

  // 下载
  sLocalFile := PHPWeb.UserPath + ExtractFileName(ADownURL);
  if not PHPWeb.DownFile(ADownURL, sLocalFile) then
  begin
    sHint := Format('云端已找到[%s]的新文件，但由于网络原因下载失败！请重试！', [FWebBidName_Local]);
    Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING);
    Exit;
  end;

  // 接收前先检验原报文件是否正确（审核不通过打回）
  if AReceiveKind = 2 then
  begin
    // 有时原报文件出错：包含了1审2审的数据。
    vFileCheck := TTenderFileChecker.Create;
    try
      // 有一期以上数据，且最新期数据审核状态为原报
      bCanImp := vFileCheck.CheckFileValid(sLocalFile) and (vFileCheck.PhaseCount > 0) and (vFileCheck.AuditStatus = 0);
      if not bCanImp then
      begin
        Application.MessageBox(PChar('已从云端下载原报文件到本地，但文件有错误(包含1审数据)禁止接收！请致电纵横服务人员以获取帮助。'),
          '警告', MB_OK + MB_ICONWARNING);
        Exit;
      end;
    finally
      vFileCheck.Free;
    end;

    {注意: 审核末通过的导入更新，这里的MD5码应取最终审核不通过项目的，否则会带来下载循环问题。
    问题描述：
    ①编制人运行软件，双击项目，发现审核不通过，自动下载无锁文件，开始新一期，保存关闭。
    ②编制人再次运行软件，双击项目，MD5码不同，自动下载旧的审核不通过文件，覆盖本地。
    ③编制人再次运行软件，双击项目，发现审核不通过，重复①，循环....
    问：①那里下载无锁文件后不能改成新的MD5码吗？
    答：不能，因为审核人的项目会变成无锁文件，看不到不通过项目。MD5码只能在上传后更新。
    且编制人有个交互界面2种选择：a.下载更新不通过项目查看；b.下载更新无锁文件开始新一期。}
  end;

  // 接收更新
  if not ReceiveFile(sLocalFile, (AReceiveKind = 2)) then
  begin
    sHint := Format('已从云端下载新的[%s]到本地[%s]，但接收失败，请删除该项目然后重新从云端获取！', [FWebBidName_Local, sLocalFile]);
    Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING);
    Exit;
  end;

  if FileExists(sLocalFile) then
    DeleteFile(sLocalFile);

  Result := True;
end;

// 为了跟PHP的数组兼容，这里限制数组的第一个元素是A[0]（不能是A[1]）
procedure TProjectManagerFrame.OnLineChecker(AAr: TOVArr; var ABegin,
  AEnd: Integer);
var i, j, n: Integer;
  vCS: TCheckStatus;
begin
  ABegin := 0;
  AEnd := 0;
  n := -1;

  for i := 0 to High(AAr) do
  begin
    vCS := TCheckStatus(StrToInt(AAr[i, 5])-1);
    if vCS = csChecking then
    begin
      n := i - 1;  // 非常重要：传入的数组必须从第一个审核人到轮到工作中的那个人的前一个人
      Break;
    end;
  end;

  for i := n downto 0 do
  begin
    if AAr[i, 7] = '1' then             // 接口返回的第7列是线上审批标记
    begin
      AEnd := i + 1;
      Break;
    end
    else
      Break;
  end;

  if AEnd = 0 then Exit;

  i := i - 1;
  if i < 0 then
  begin
    ABegin := 1;
    Exit;
  end;


  for j := i downto 0 do
  begin
    if AAr[j, 7] = '0' then
    begin
      ABegin := j + 2;
      Break;
    end
    else
    begin
      if j = 0 then
        ABegin := 1;
    end;
  end;
=======
procedure TProjectManagerFrame.actnExportUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected);
end;

procedure TProjectManagerFrame.actnOpenBackupFolderUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected) and
    (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);
>>>>>>> 3.1.5
end;

end.