Subversion Repositories autosfx

Rev

Rev 4 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit ExtractorError;
  2.  
  3. interface
  4.  
  5. // TODO: Richtige Ordnerliste mit Icons anzeigen?
  6.  
  7. uses
  8.   Forms, StdCtrls, ExtCtrls, Controls, Graphics, Classes, Dialogs,
  9.   ZipMstr19, SysUtils;
  10.  
  11. type
  12.   TErrorForm = class(TForm)
  13.     ErrorList: TListBox;
  14.     ErrorImg: TImage;
  15.     ErrorLabel: TLabel;
  16.     OKBtn: TButton;
  17.     SaveBtn: TButton;
  18.     SaveDialog: TSaveDialog;
  19.     procedure FormResize(Sender: TObject);
  20.     procedure SaveBtnClick(Sender: TObject);
  21.   public
  22.     function ErrorsAvailable: boolean;
  23.     procedure NewError(Filename: string; SkipType: TZMSkipTypes);
  24.   end;
  25.  
  26. var
  27.   ErrorForm: TErrorForm;
  28.  
  29. implementation
  30.  
  31. {$R *.dfm}
  32.  
  33. function SkipTypeToStr(SkipType: TZMSkipTypes): string;
  34. begin
  35.   case SkipType of
  36.     stOnFreshen:           result := 'stOnFreshen';
  37.     stNoOverwrite:         result := 'stNoOverwrite';
  38.     stFileExists:          result := 'stFileExists';
  39.     stBadPassword:         result := 'stBadPassword';
  40.     stBadName:             result := 'stBadName';
  41.     stCompressionUnknown:  result := 'stCompressionUnknown';
  42.     stUnknownZipHost:      result := 'stUnknownZipHost';
  43.     stZipFileFormatWrong:  result := 'stZipFileFormatWrong';
  44.     stGeneralExtractError: result := 'stGeneralExtractError';
  45.     stUser:                result := 'stUser';
  46.     stCannotDo:            result := 'stCannotDo';
  47.     stNotFound:            result := 'stNotFound';
  48.     stNoShare:             result := 'stNoShare';
  49.     stNoAccess:            result := 'stNoAccess';
  50.     stNoOpen:              result := 'stNoOpen';
  51.     stDupName:             result := 'stDupName';
  52.     stReadError:           result := 'stReadError';
  53.     stSizeChange:          result := 'stSizeChange';
  54.   end;
  55. end;
  56.  
  57. function TErrorForm.ErrorsAvailable: boolean;
  58. begin
  59.   result := ErrorList.Items.Count > 0;
  60. end;
  61.  
  62. procedure TErrorForm.FormResize(Sender: TObject);
  63. begin
  64.   ErrorList.Width := ClientWidth - ErrorList.Left - ErrorImg.Left;
  65.   ErrorList.Height := ClientHeight - ErrorList.Top - (2 * ErrorImg.Left + OkBtn.Height);
  66.   OkBtn.Top := ErrorList.Top + ErrorList.Height + ErrorImg.Left;
  67.   OkBtn.Left := ErrorList.Left + ErrorList.Width - OkBtn.Width;
  68.   SaveBtn.Top := OkBtn.Top;
  69. end;
  70.  
  71. procedure TErrorForm.NewError(Filename: string; SkipType: TZMSkipTypes);
  72. resourcestring
  73.   Lng_Err_Entry = '%s (Grund: %s)';
  74. begin
  75.   // In future: Also add reason into list?
  76.   ErrorList.Items.Add(Format(Lng_Err_Entry, [Filename, SkipTypeToStr(SkipType)]));
  77. end;
  78.  
  79. procedure TErrorForm.SaveBtnClick(Sender: TObject);
  80. begin
  81.   if SaveDialog.Execute then
  82.   begin
  83.     ErrorList.Items.SaveToFile(SaveDialog.FileName);
  84.   end;
  85. end;
  86.  
  87. end.
  88.