新进度条。

Forms/mProgressProFrm.pas

@@ -33,10 +33,11 @@ type
   TProgressPosType = (pptNo, pptAdd, pptSet);    // 进度不变；增加进度；指定进度；
   TProgressMemoType = (pmtNo, pmtAdd, pmtEdit);  // 备注信息不变；增加一条备注；修改当前这条备注。
 
-procedure ProgressProCreate(AMaxValue: Integer; ATitle: string = '正在处理请稍候>>>');
+procedure ProgressProCreate(AMaxValue: Integer = 100; ATitle: string = '正在处理请稍候>>>');
 procedure ProgressProFree;
-procedure ProgressProRun(APosType: TProgressPosType; APosValue: Integer;
-                         AMemoType: TProgressMemoType; AMemoValue: string);
+procedure ProgressProRun(AMemoValue: string; APosValue: Integer = 10;
+                         AMemoType: TProgressMemoType = pmtAdd; APosType: TProgressPosType = pptAdd);
+procedure ProgressProTitle(ATitle: string);
 
 var
   ProgressProForm: TProgressProForm = nil;
@@ -68,7 +69,7 @@ begin
     with ProgressProForm.Gauge1 do
     begin
       if (Progress <> MaxValue) then
-      ProgressProRun(pptSet, MaxValue, pmtAdd, '已完成。');
+      ProgressProRun('已完成。', MaxValue, pmtAdd, pptSet);
     end;
 
     // 关闭前要延迟500ms，有些地方如果不延迟，关得太快，感觉进度条没走完就关了，体验很不好。
@@ -78,8 +79,8 @@ begin
   end;
 end;
 
-procedure ProgressProRun(APosType: TProgressPosType; APosValue: Integer;
-                         AMemoType: TProgressMemoType; AMemoValue: string);
+procedure ProgressProRun(AMemoValue: string; APosValue: Integer;
+                         AMemoType: TProgressMemoType; APosType: TProgressPosType);
 begin
   if ProgressProForm = nil then Exit;
   with ProgressProForm do
@@ -108,6 +109,16 @@ begin
   end;
 end;
 
+procedure ProgressProTitle(ATitle: string);
+begin
+  if ProgressProForm = nil then Exit;
+  with ProgressProForm do
+  begin
+    lblTitle.Caption := ATitle;
+    Update;
+  end;
+end;
+
 procedure TProgressProForm.Shape1MouseDown(Sender: TObject;
   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 begin

Frames/ProjectFme.dfm

@@ -877,7 +877,7 @@ object ProjectFrame: TProjectFrame
           OnChanged = jcbPhaseChanged
         end
         object btnPass: TCslButton
-          Left = 221
+          Left = 226
           Top = 1
           Width = 77
           Height = 19

Frames/ProjectFme.pas

@@ -189,7 +189,7 @@ uses
   PhaseData, BGLDm, MainFrm, ZhAPI, SearchDm, PHPWebDm, ActiveX,
   ConstUnit, MD5Unit, sdIDTree, sdDB, mProgressFrm, ConditionalDefines,
   ProjectCommands, ProjectProperty, CheckerMemoFrm, BillsMeasureDm,
-  ProgressHintFrm;
+  ProgressHintFrm, mProgressProFrm;
 
 {$R *.dfm}
 
@@ -812,8 +812,9 @@ begin
       if Application.MessageBox(PChar(CheckersHint), '询问', MB_YESNO + MB_ICONQUESTION) = ID_No then
         Exit;
 
-      CreateProgress('正在保存项目');
+      ProgressProCreate(100, '本地数据文件上传到云端');
       ProjectData.Save;
+      ProgressProRun('保存本地数据。OK');
 
       // 生成无锁文件
       vRec := MainForm.ProjectManagerFrame.Rec(ProjectData.ProjectID);
@@ -823,8 +824,9 @@ begin
       finally
         vExportor.Free;
       end;
-
+      ProgressProRun('生成无锁文件。OK');
       ProjectData.SubmitProject(sAppFile);
+      ProgressProRun('生成待审核文件。OK');
     end
     else if ProjectData.CurUserIsChecker then
     begin
@@ -848,9 +850,11 @@ begin
           Exit;
       end;
 
-      CreateProgress('正在保存项目');
+      ProgressProCreate(100, '本地数据文件上传到云端');
       ProjectData.Save;
+      ProgressProRun('保存本地数据。OK');
       ProjectData.SubmitProject(sAppFile);
+      ProgressProRun('生成待审核文件。OK');
     end
     else if ProjectData.CurUserIsOwner then
     begin
@@ -874,16 +878,17 @@ begin
           Exit;
       end;
 
-      CreateProgress('正在保存项目');
+      ProgressProCreate(100, '本地数据文件上传到云端');
       ProjectData.Save;
+      ProgressProRun('保存本地数据。OK');
       ProjectData.ReplyProject(sAppFile);
+      ProgressProRun('生成批复文件。OK');
     end;
   finally
     vCF.Free;
   end;
 
   try
-    RefreshProgress('创建文件包');
     sJsonFile_Bills := ExtractFilePath(sAppFile) + 'JsonFile_Bills.json';
     sJsonFile_Common := ExtractFilePath(sAppFile) + 'JsonFile_Common.json';
     sMD5_JL := MD5_File(sAppFile);
@@ -891,16 +896,18 @@ begin
     // 上传清单，每期都传，可覆盖旧的。
     ProjectData.ExportJson_Bills(sJsonFile_Bills);
     ProjectData.ExportJson_Common(sJsonFile_Common);
+    ProgressProRun('生成Web汇总数据文件。OK', 5);
     sZipFile := PHPWeb.zip([sAppFile, sJsonFile_Bills, sJsonFile_Common, sAppFile_UnLock]);
+    ProgressProRun('数据文件打包。OK', 5);
     try
-      // 上传标段文件
-      RefreshProgress('上传到云端');
+      ProgressProRun('上传数据包到云端...', 0);
       if PHPWeb.UpDataFile(PHPWeb.UserID, ProjectData.WebID, ProjectData.PhaseIndex,
         sZipFile, sMD5_JL, bSubmit, sResult, ACheckPassed, sCheckerMemo) then
       begin
+        ProgressProRun('上传数据包到云端。OK', 90, pmtEdit, pptSet);
         if ProjectData.CurUserIsChecker then
           ProjectData.Checkers.FindByID(PHPWeb.UserID).Memo := sCheckerMemo;
-        RefreshProgress('本地刷新显示');
+
         if ProjectData.PhaseIndex = 0 then   // 0号台账，现已废弃
         begin
           MainForm.ProjectManagerFrame.ShowProjWebInfoTop(0);
@@ -944,6 +951,7 @@ begin
         btnPass.Enabled := False;
         btnNotPass.Enabled := btnPass.Enabled;
         pnlProjectCheckStatus.Visible := CheckerFrame.OwnerFrame.CheckStatus = csFinished;
+        ProgressProRun('本地刷新显示。OK', 5);
 
         Application.MessageBox('^_^ 恭喜！数据已成功上传到云端服务器。', '提示', MB_OK + MB_ICONINFORMATION);
       end
@@ -954,7 +962,7 @@ begin
         sResult), '警告', MB_OK + MB_ICONWARNING);
     end;
   finally
-    CloseProgress;
+    ProgressProFree;
   end;
 end;