Delphi-PRAXiS - Delphi Progressbar um Loadfromfile fortschritt anzuzeigen.

Mathe 5, würd ich mal sagen :roll:

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;