上报文件提示信息锁定

Forms/mProgressProFrm.pas

@@ -38,6 +38,7 @@ procedure ProgressProFree;
 procedure ProgressProRun(AMemoValue: string; APosValue: Integer = 10;
                          AMemoType: TProgressMemoType = pmtAdd; APosType: TProgressPosType = pptAdd);
 procedure ProgressProTitle(ATitle: string);
+function ProgressProHandle: THandle;
 
 var
   ProgressProForm: TProgressProForm = nil;
@@ -119,6 +120,13 @@ begin
   end;
 end;
 
+function ProgressProHandle: THandle;
+begin
+  Result := 0;
+  if ProgressProForm <> nil then
+    Result := ProgressProForm.Handle;
+end;
+
 procedure TProgressProForm.Shape1MouseDown(Sender: TObject;
   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 begin

Frames/ProjectFme.pas

@@ -875,7 +875,7 @@ begin
         if not ProjectData.SubmitProject(sAppFile) then
         begin
           bNeedFreeEarlier := True;
-          Application.MessageBox('Sorry！待审核文件连续2次生成失败！如果重试后仍不能解决该问题，请联系纵横客服。', '提示', MB_OK + MB_ICONWARNING);
+          WarningMessage('Sorry！待审核文件连续2次生成失败！如果重试后仍不能解决该问题，请联系纵横客服。', ProgressProHandle);
           Exit;
         end;
       ProgressProRun('生成检验文件。OK', 10, pmtEdit);
@@ -910,7 +910,7 @@ begin
         if not ProjectData.SubmitProject(sAppFile) then
         begin
           bNeedFreeEarlier := True;
-          Application.MessageBox('Sorry！待审核文件连续2次生成失败！如果重试后仍不能解决该问题，请联系纵横客服。', '提示', MB_OK + MB_ICONWARNING);
+          WarningMessage('Sorry！待审核文件连续2次生成失败！如果重试后仍不能解决该问题，请联系纵横客服。', ProgressProHandle);
           Exit;
         end;
       ProgressProRun('生成检验文件。OK', 10, pmtEdit);
@@ -933,7 +933,7 @@ begin
         else
           sCheckerMemo := vCF.Memo;
 
-        if Application.MessageBox(PChar(sNoPassedHint2), '询问', MB_OKCANCEL + MB_ICONQUESTION) = ID_CANCEL then
+        if not QuestMessage(sNoPassedHint2) then
           Exit;
       end;
 
@@ -947,7 +947,7 @@ begin
         if not ProjectData.ReplyProject(sAppFile) then
         begin
           bNeedFreeEarlier := True;
-          Application.MessageBox('Sorry！批复文件连续2次生成失败！如果重试后仍不能解决该问题，请联系纵横客服。', '提示', MB_OK + MB_ICONWARNING);
+          WarningMessage('Sorry！批复文件连续2次生成失败！如果重试后仍不能解决该问题，请联系纵横客服。', ProgressProHandle);
           Exit;
         end;
       ProgressProRun('生成检验文件。OK', 10, pmtEdit);
@@ -979,7 +979,7 @@ begin
 
     if not PHPWeb.CheckZip(sZipFile, iFile) then
     begin
-      Application.MessageBox('up数据包文件无法通过检验请重试！如果重试后仍不能解决该问题，请联系纵横客服。', '提示', MB_OK + MB_ICONWARNING);
+      WarningMessage('up数据包文件无法通过检验请重试！如果重试后仍不能解决该问题，请联系纵横客服。', ProgressProHandle);
       Exit;
     end;
     ProgressProRun('校验数据包。OK', 10, pmtEdit);
@@ -1038,13 +1038,12 @@ begin
         btnNotPass.Enabled := btnPass.Enabled;
         pnlProjectCheckStatus.Visible := CheckerFrame.OwnerFrame.CheckStatus = csFinished;
 
-        Application.MessageBox('^_^ 恭喜！数据已成功上传到云端服务器。', '提示', MB_OK + MB_ICONINFORMATION);
+        TipMessage('^_^ 恭喜！数据已成功上传到云端服务器。', ProgressProHandle);
       end
       else
-        Application.MessageBox(PChar('数据上传失败请重试！服务器故障：' + sResult), '警告', MB_OK + MB_ICONWARNING);
+        WarningMessage(PChar('数据上传失败请重试！服务器故障：' + sResult), ProgressProHandle);
     except
-      Application.MessageBox(PChar('数据上传失败请重试！网络较差，数据文件无法送达云端：' +
-        sResult), '警告', MB_OK + MB_ICONWARNING);
+      WarningMessage(PChar('数据上传失败请重试！网络较差，数据文件无法送达云端：' + sResult), ProgressProHandle);
     end;
   finally
     ProgressProFree;

Units/UtilMethods.pas

@@ -24,10 +24,10 @@ type
 
   {Message}
   procedure WarningMessage(const AMsg: string; AHandle: THandle = 0);
-  procedure ErrorMessage(const AMsg: string);
+  procedure ErrorMessage(const AMsg: string; AHandle: THandle = 0);
   function QuestMessage(const AMsg: string; AHandle: THandle = 0): Boolean;
   function QuestMessageYesNo(const AMsg: string; AHandle: THandle = 0): Boolean;
-  procedure TipMessage(const AMsg: string);
+  procedure TipMessage(const AMsg: string; AHandle: THandle = 0);
   procedure DataSetErrorMessage(var Allow: Boolean; const AMsg: string);
 
   {Get Common Path}
@@ -181,38 +181,43 @@ begin
 end;
 
 {Message}
-procedure WarningMessage(const AMsg: string; AHandle: THandle = 0);
+
+function GetValidHandle(AHandle: THandle = 0): THandle;
 begin
   if AHandle = 0 then
-    MessageBox(Application.Handle, PChar(AMsg), PChar('¾¯¸æ'), MB_OK or MB_ICONWARNING)
+  begin
+    if (Screen.ActiveForm <> nil) and (Screen.ActiveForm.HandleAllocated) then
+      Result := Screen.ActiveForm.Handle
+    else
+      Result := Application.Handle;
+  end
   else
-    MessageBox(AHandle, PChar(AMsg), PChar('¾¯¸æ'), MB_OK or MB_ICONWARNING);
+    Result := AHandle;
 end;
 
-procedure ErrorMessage(const AMsg: string);
+procedure WarningMessage(const AMsg: string; AHandle: THandle = 0);
 begin
-  MessageBox(Application.Handle, PChar(AMsg), PChar('´íÎó'), MB_OK or MB_ICONERROR);
+  MessageBox(GetValidHandle(AHandle), PChar(AMsg), PChar('¾¯¸æ'), MB_OK or MB_ICONWARNING);
+end;
+
+procedure ErrorMessage(const AMsg: string; AHandle: THandle = 0);
+begin
+  MessageBox(GetValidHandle(AHandle), PChar(AMsg), PChar('´íÎó'), MB_OK or MB_ICONERROR);
 end;
 
 function QuestMessage(const AMsg: string; AHandle: THandle = 0): Boolean;
 begin
-  if AHandle = 0 then
-    Result := MessageBox(Application.Handle, PChar(AMsg), PChar('ѯÎÊ'), MB_OKCANCEL or MB_ICONQUESTION) = IDOK
-  else
-    Result := MessageBox(AHandle, PChar(AMsg), PChar('ѯÎÊ'), MB_OKCANCEL or MB_ICONQUESTION) = IDOK;
+  Result := MessageBox(GetValidHandle(AHandle), PChar(AMsg), PChar('ѯÎÊ'), MB_OKCANCEL or MB_ICONQUESTION) = IDOK;
 end;
 
 function QuestMessageYesNo(const AMsg: string; AHandle: THandle = 0): Boolean;
-begin 
-  if AHandle = 0 then
-    Result := MessageBox(Application.Handle, PChar(AMsg), PChar('ѯÎÊ'), MB_YESNO or MB_ICONQUESTION) = IDYes
-  else
-    Result := MessageBox(AHandle, PChar(AMsg), PChar('ѯÎÊ'), MB_YESNO or MB_ICONQUESTION) = IDYes;
+begin
+  Result := MessageBox(GetValidHandle(AHandle), PChar(AMsg), PChar('ѯÎÊ'), MB_YESNO or MB_ICONQUESTION) = IDYes;
 end;
 
-procedure TipMessage(const AMsg: string);
+procedure TipMessage(const AMsg: string; AHandle: THandle = 0);
 begin
-  MessageBox(Application.Handle, PChar(AMsg), PChar('Ìáʾ'), MB_OK or MB_ICONINFORMATION);
+  MessageBox(GetValidHandle(AHandle), PChar(AMsg), PChar('Ìáʾ'), MB_OK or MB_ICONINFORMATION);
 end;
 
 procedure DataSetErrorMessage(var Allow: Boolean; const AMsg: string);