home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ULDIAL.ZIP / ULSTATUS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-06-24  |  3.8 KB  |  130 lines
  1. (***********************************************************************
  2.   Status Handler Ojbects as Enhancements to Turbo Power OOP Professional
  3.                   New Communications Technology, Inc.
  4.                              Version 1.0
  5.                           by John Poindexter
  6.                              June 23, 1990
  7. ************************************************************************)
  8. {$I ULDEFINE.INC}
  9.  
  10. {$IFNDEF shDEBUG}
  11. {$A-,B-,E+,F+,I+,N-,O+,R-,S-,V-}
  12. {$ELSE}
  13. {$A-,B-,E+,F+,I+,N-,O+,R+,S+,V-}
  14. {$ENDIF}
  15.  
  16. Unit ULStatus;
  17.  
  18. Interface
  19.  
  20. Uses OpRoot, OpCrt, OpString, OpFrame, Filer, ULRoot, ULDial;
  21.  
  22. (************************************************************************
  23.   Global Routines
  24. ************************************************************************)
  25.  
  26. procedure StdStatus(UnitCode:byte; var Code: word; Msg:string);
  27.  
  28. (***********************************************************************)
  29. Implementation
  30. (***********************************************************************)
  31.  
  32. (* Standard Status and Error Handler *)
  33.  
  34. procedure StdStatus(UnitCode:byte; var Code: word; Msg:string);
  35. var
  36.   ErrorType : word;
  37.   ErrorCode : word;
  38.   ErrorClass : word;
  39.   Message : string;
  40.   StatusWin : DialogBox;
  41.   status : word;
  42.   Redraw : boolean;
  43.  
  44. begin
  45.   Message := '';
  46.   if Pos('ISAM', Msg) <> 0 then
  47.   begin
  48.     Message := IsamErrorMessage(Code);
  49.     case IsamErrorClass of
  50.       0 : ErrorType := etNoError;
  51.       1 : ErrorType := etMessage;
  52.       2 : ErrorType := etWarning;
  53.       3 : ErrorType := etWarning;
  54.       4 : ErrorType := etFatal;
  55.      99 : ErrorType := etFatal;
  56.      else ErrorType := etFatal;
  57.     end;
  58.   end
  59.   else
  60.   begin
  61.     ErrorType := Code div 10000;
  62.     ErrorCode := Code mod 10000;
  63.     ErrorClass := Code div 1000;
  64.   end;
  65.   if Msg = '' then Message := 'Error: '+Long2Str(ErrorCode)
  66.   else Message := Msg+' '+Message;
  67.   if ErrorType = etFatal then Message := 'Unit '+Long2Str(UnitCode)+': '+Message;
  68.   if ErrorClass = 8 then Message := 'Report to developer: '+Message;
  69.   if not StatusWin.Init(2,158,3,40) then
  70.   begin
  71.     WriteLn(emStatusHandlerFail);
  72.     Halt(1);
  73.   end;
  74.   with StatusWin do
  75.   begin
  76.     AddMessageString(Message);
  77.     case ErrorType of
  78.       etFatal    : begin
  79.                      AddChoiceString('Cancel');
  80.                      AddHeader(' Error ',heTC);
  81.                    end;
  82.       etNonFatal : begin
  83.                      AddChoiceString('Retry Cancel');
  84.                      AddMessageString(emPossibleRecovery);
  85.                      AddHeader(' Error ',heTC);
  86.                    end;
  87.       etWarning : begin
  88.                     AddChoiceString('Retry Ok Cancel');
  89.                     AddHeader(' Warning ',heTC);
  90.                   end;
  91.       etMessage : begin
  92.                     AddChoiceString('Ok Cancel');
  93.                     AddHeader(' Status ',heTC);
  94.                   end;
  95.       etNoError : begin
  96.                     AddChoiceString('  Ok  ');
  97.                     AddHeader(' Message ',heTC);
  98.                   end;
  99.     end;
  100.     if dlLastError <> 0 then
  101.     begin
  102.       WriteLn(emStatusHandlerFail);
  103.       Done;
  104.       Halt(1);
  105.     end;
  106.     Process;
  107.     Code := GetLastChoice;
  108.     Done;
  109.     case ErrorType of
  110.       etFatal    : Code := scCancel;
  111.       etNonFatal : case Code of
  112.                      1: Code := scRetry;
  113.                      2: Code := scCancel;
  114.                    end;
  115.       etWarning  : case Code of
  116.                      1: Code := scRetry;
  117.                      2: Code := scOk;
  118.                      3: Code := scCancel;
  119.                    end;
  120.       etMessage  : case Code of
  121.                      1: Code := scOk;
  122.                      2: Code := scCancel
  123.                    end;
  124.       etNoError  : Code := scOk;
  125.     end;
  126.   end;
  127. end;
  128.  
  129. end.
  130.