Progressbar um Loadfromfile fortschritt anzuzeigen.

[himitsu]

Mathe 5, würd ich mal sagen

nja, immerhin ist der Code jetzt kürzer

Delphi-Quellcode:

// If Progress is -3, then starting to read the file or stream.
// If Progress is -2, then starting to decode. (only in Delphi 2009 and successors)
// If Progress is -1, then started to empty the old list.
// If Progress is 0, then starting the Add.
// If Progress is between 0 and 10000, then the text will be added to the list
//   and "Progress" is the progress in hundredths of a percent.
// If Progress is 10000, then the read is completed.

Type TProgressEvent = Procedure(Sender: TObject; Progress: Integer) of Object;
  TProgressStringList = Class(TStringList)
  Private
    FProgress: TProgressEvent;
  Protected
    Procedure SetTextStr(Const Value: String); Override;
    Property OnProgress: TProgressEvent Read FProgress Write FProgress;
  Public
    {$IFDEF UNICODE}
      Procedure LoadFromStream(Stream: TStream; Encoding: TEncoding); Override;
    {$ELSE}
      Procedure LoadFromStream(Stream: TStream); Override;
    {$ENDIF}
  End;

Procedure TProgressStringList.SetTextStr(Const Value: String);
  Var P, Start: PChar;
    S: String;
    {$IFDEF UNICODE}
      LB: PChar;
      LineBreakLen: Integer;
    {$ENDIF}
    C: LongWord;

  Begin
    BeginUpdate;
    Try
      If Assigned(FProgress) Then FProgress(Self, -1);
      Clear;
      If Assigned(FProgress) Then FProgress(Self, 0);
      C := GetTickCount;
      P := Pointer(Value);
      If P <> nil Then
        {$IFDEF UNICODE}
        If CompareStr(LineBreak, sLineBreak) = 0 Then Begin
        {$ENDIF}
          // This is a lot faster than using StrPos/AnsiStrPos when
          // LineBreak is the default (#13#10)
          While P^ <> #0 do Begin
            Start := P;
            While not (P^ in [#0, #10, #13]) do Inc(P);
            SetString(S, Start, P - Start);
            Add(S);
            If P^ = #13 Then Inc(P);
            If P^ = #10 Then Inc(P);
            If Assigned(FProgress) and (GetTickCount - C > 50) Then Begin
              FProgress(Self, Int64((Integer(P) - Integer(Value))
                div SizeOf(Char)) * 9999 div Length(Value));
              C := GetTickCount;
            End;
          End;
        {$IFDEF UNICODE}
        End Else Begin
          LineBreakLen := Length(LineBreak);
          While P^ <> #0 do Begin
            Start := P;
            LB := AnsiStrPos(P, PChar(LineBreak));
            While (P^ <> #0) and (P <> LB) do Inc(P);
            SetString(S, Start, P - Start);
            Add(S);
            If P = LB Then Inc(P, LineBreakLen);
            If Assigned(FProgress) and (GetTickCount - C > 50) Then Begin
              FProgress(Self, Int64((Integer(P) - Integer(Value))
                div SizeOf(Char)) * 9999 div Length(Value));
              C := GetTickCount;
            End;
          End;
        End;
        {$ENDIF}
      If Assigned(FProgress) Then FProgress(Self, 10000);
    Finally
      EndUpdate;
    End;
  End;

Procedure TProgressStringList.LoadFromStream(Stream: TStream
    {$IFDEF UNICODE}; Encoding: TEncoding{$ENDIF} );

  Var Size: Integer;
    S: String;
    {$IFDEF UNICODE} Buffer: TBytes; {$ENDIF}

  Begin
    BeginUpdate;
    Try
      Size := Stream.Size - Stream.Position;
      If Assigned(FProgress) Then FProgress(Self, -3);
      {$IFDEF UNICODE}
        SetLength(Buffer, Size);
        Stream.Read(Buffer[0], Size);
        If Assigned(FProgress) Then FProgress(Self, -2);
        Size := TEncoding.GetBufferEncoding(Buffer, Encoding);
        S := Encoding.GetString(Buffer, Size, Length(Buffer) - Size);
      {$ELSE}
        SetString(S, nil, Size);
        Stream.Read(Pointer(S)^, Size);
      {$ENDIF}
      SetTextStr(S);
    Finally
      EndUpdate;
    End;
  End;

Delphi-Quellcode:

procedure TForm1.ProgressEvent(Sender: TObject; Progress: Integer);
begin
  case Progress of
    -3:    Label1.Caption := 'lese Datei ein ...';
    -2:    Label1.Caption := 'dekodiere den Text ...';
    -1:    Label1.Caption := 'leere alte Liste ...';
    10000: Label1.Caption := 'fertig';
    else begin
      Label1.Caption := 'befülle die Liste';
      ProgressBar1.Position := Progress div 100;  // .Min=0 und .Max=100
    end;
  end;
  //Application.ProcessMessages;
  Label1.Refresh;
  ProgressBar1.Refresh;
end;

procedure TForm1.Button1Click(Sender: TObject);
var laden: TOpenDialog;
  start, dauer: Cardinal;
  sl: TProgressStringList;
begin
  laden := TOpenDialog.Create(self);
  try
    if laden.Execute then begin
      sl := TProgressStringList.Create;
      try
        start := GetTickCount();
        sl.OnProgress := ProgressEvent;
        sl.LoadFromFile(laden.FileName);
        dauer := GetTickCount() - start;
        Label1.Caption := 'Laden hat ' + (floattostr(dauer/1000)) + ' Sekunden gedauert';
        //...
      finally
        sl.Free;
      end;
    end;
  finally
    laden.Free;
  end;
end;