home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9302 / tvision / tvpas / xdrivers.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-11-10  |  3.0 KB  |  124 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      XDRIVERS.PAS                      *)
  3. (*                                                        *)
  4. (*        Systemfehler und erweiterte Statuszeilen        *)
  5. (*         (C) 1992 by Christian Ohr & DMV-Verlag         *)
  6. (* ------------------------------------------------------ *)
  7. {$R-,S-,I-,B-,D-,L-,V-,A+,F+,O+,X+}
  8.  
  9. UNIT XDrivers;
  10.  
  11.  
  12. INTERFACE
  13.  
  14.  
  15. USES Drivers, MsgBox, App;
  16.  
  17.  
  18. CONST
  19.   hcRShift = $FFFC;
  20.   hcLShift = $FFFD;
  21.   hcCtrl   = $FFFE;
  22.   hcAlt    = $FFFF;
  23.  
  24.  
  25. (* Systemfehler-Routine umschalten zwischen Typ 'MsgBox'  *)
  26. (* (Enable = TRUE) oder Typ 'StatusLine' (Enable = FALSE).*)
  27.  
  28. PROCEDURE SetSystemMsg (Enable: BOOLEAN);
  29.  
  30.  
  31. (* Setzt je nach gedrückter Sondertaste d. entsprechenden *)
  32. (* hc-Wert (s.o.). Dieser kann dann z.B. i.d. Statuszeile *)
  33. (* abgefragt werden.                                      *)
  34.  
  35. PROCEDURE SetStatusHelpCtx;
  36.  
  37.  
  38. IMPLEMENTATION
  39.  
  40. CONST
  41.   ErrCodeStr : ARRAY[0..15] OF STRING[40] =
  42.     (#3'Disk in Laufwerk %c: ist schreibgeschützt',
  43.      #3'Kritischer Disk-Fehler in %c:',
  44.      #3'Disk in %c: ist nicht bereit',
  45.      #3'Kritischer Disk-Fehler in %c:',
  46.      #3'Integritätsfehler in %c:',
  47.      #3'Kritischer Disk-Fehler in %c:',
  48.      #3'Posititionierungsfehler in %c:',
  49.      #3'Unbekannter Disktyp in %c:',
  50.      #3'Sektor nicht gefunden in %c:',
  51.      #3'Kein Papier im Drucker',
  52.      #3'Schreibfehler in %c:',
  53.      #3'Lesefehler in %c:',
  54.      #3'Hardware-Schaden an Laufwerk %c:',
  55.      #3'FAT ist fehlerhaft',
  56.      #3'Adressierungsfehler',
  57.      #3'Diskette in %c: einlegen');
  58.  
  59.   ToDoStr : STRING[40] =
  60.      #13#10#13#10#3'Ok TO retry, Cancel TO abort.';
  61.  
  62.  
  63.  
  64.  
  65. (* Ausgabe des Systemfehlers in einer normalen MessageBox *)
  66.  
  67. FUNCTION SystemErrorMsg (ErrorCode: INTEGER; Drive: BYTE)
  68.                          : INTEGER;
  69. VAR
  70.   Params: LONGINT;
  71. BEGIN
  72.   Params := Drive + 65;
  73.   Params := MessageBox(ErrCodeStr[ErrorCode] + ToDoStr,
  74.             @Params, mfError + mfOkButton + mfCancelButton);
  75.   SystemErrorMsg := Params - 10;
  76. END;
  77.  
  78.  
  79. PROCEDURE SetSystemMsg (Enable: BOOLEAN);
  80. BEGIN
  81.   IF Enable THEN
  82.     SysErrorFunc := SystemErrorMsg ELSE
  83.     SysErrorFunc := SystemError;
  84. END;
  85.  
  86.  
  87. PROCEDURE SetStatusHelpCtx;
  88. CONST
  89.   RShift = 1;
  90.   LShift = 2;
  91.   Ctrl   = 4;
  92.   Alt    = 8;
  93. VAR
  94.   ShiftState : BYTE ABSOLUTE $40:$17;
  95.   SaveCtx : WORD;
  96. BEGIN
  97.   IF Application^.GetHelpCtx < $FFFC THEN
  98.     SaveCtx := Application^.GetHelpCtx;
  99.  
  100.   IF ShiftState AND Alt <> 0 THEN BEGIN
  101.     Application^.HelpCtx := hcAlt;
  102.     Exit;
  103.   END;
  104.   IF ShiftState AND RShift = RShift THEN BEGIN
  105.     Application^.HelpCtx := hcRShift;
  106.     Exit;
  107.   END;
  108.   IF ShiftState AND LShift = LShift THEN BEGIN
  109.     Application^.HelpCtx := hcLShift;
  110.     Exit;
  111.   END;
  112.   IF ShiftState AND Ctrl = Ctrl THEN BEGIN
  113.     Application^.HelpCtx := hcCtrl;
  114.     Exit;
  115.   END;
  116.   Application^.HelpCtx := SaveCtx;
  117. END;
  118.  
  119. END.
  120.  
  121.  
  122. (* ------------------------------------------------------ *)
  123. (*                 Ende von XDRIVERS.PAS                  *)
  124.