Ups ... ja, da ist ein kleiner Fehler drinnen.
TStrings.LoadFromStream muß natürlich TProgressStrings.LoadFromStream heißen und im OnProgress ist auch ein Copy&Paste-Fehler
Zitat:
TProgressStrings = Class(TStringList)
für das TStringList kann man auch einen anderen Nachfolger von TStrings einsetzen ... jenachdem, was man benötigt.
Das hier dürfte jetzt wohl mindestens ab Delphi 7 laufen (hoff ich mal)
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: TProgressyEvent;
Protected
Procedure SetTextStr(Const Value: String); Override;
Property OnProgress: TProgressEvent Read FProgress Write FProgress;
Public
{$IF Declared(TEncoding)}
Procedure LoadFromStream(Stream: TStream; Encoding: TEncoding); Override;
{$ELSE}
Procedure LoadFromStream(Stream: TStream); Override;
{$IFEND}
End;
Procedure TProgressStringList.SetTextStr(Const Value: String);
{$IF Declared(TEncoding)}
Var P, Start, LB: PChar;
S: String;
LineBreakLen: Integer;
Begin
BeginUpdate;
Try
If Assigned(FProgress) Then FProgress(Self, -1);
Clear;
If Assigned(FProgress) Then FProgress(Self, 0);
P := Pointer(Value);
If P <> nil Then
If CompareStr(LineBreak, sLineBreak) = 0 Then Begin
// 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) Then FProgress(Self, Int64(Length(Value))
* 9999 div ((Integer(P) - Integer(Value)) div SizeOf(Char)));
End;
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) Then FProgress(Self, Int64(Length(Value))
* 9999 div ((Integer(P) - Integer(Value)) div SizeOf(Char)));
End;
End;
If Assigned(FProgress) Then FProgress(Self, 10000);
Finally
EndUpdate;
End;
End;
{$ELSE}
Var P, Start: PChar;
S: String;
Begin
BeginUpdate;
Try
If Assigned(FProgress) Then FProgress(Self, -1);
Clear;
If Assigned(FProgress) Then FProgress(Self, 0);
P := Pointer(Value);
If P <> nil Then
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) Then FProgress(Self, Int64(Length(Value))
* 9999 div ((Integer(P) - Integer(Value)) div SizeOf(Char)));
End;
If Assigned(FProgress) Then FProgress(Self, 10000);
Finally
EndUpdate;
End;
End;
{$IFEND}
{$IF Declared(TEncoding)}
Procedure TProgressStringList.LoadFromStream(Stream: TStream; Encoding: TEncoding);
Var Size: Integer;
Buffer: TBytes;
S: String;
Begin
BeginUpdate;
Try
Size := Stream.Size - Stream.Position;
If Assigned(FProgress) Then FProgress(Self, -3);
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);
SetTextStr(S);
Finally
EndUpdate;
End;
End;
{$ELSE}
Procedure TProgressStringList.LoadFromStream(Stream: TStream);
Var Size: Integer;
S: String;
Begin
BeginUpdate;
Try
Size := Stream.Size - Stream.Position;
If Assigned(FProgress) Then FProgress(Self, -3;
SetString(S, nil, Size);
Stream.Read(Pointer(S)^, Size);
SetTextStr(S);
Finally
EndUpdate;
End;
End;
{$IFEND}
Du mußt jetzt im Prinzip nur noch statt TStringList die TProgressStringList zum Einlesen verwenden,
dem OnProgress eine Ereignisprozedur verpassen und darin dann deine Progressbar anzeigen.
'nen einfaches Beispiel wäre z.B.:
Delphi-Quellcode:
Procedure TForm1.MyProgressEvent(Sender: TObject; Progress: Integer);
Begin
Case Progress of
-3: Label1.Caption := 'lese Datei...';
-2: Label1.Caption := 'dekodiere...';
-1: Label1.Caption := 'leere alte Liste';
10000: Label1.Caption := 'fertig';
Else Begin
Label1.Caption := 'Add';
ProgressBar1.Position := Progress;
End;
End;
End;
Bei dem dekodieren kann man nicht viel machen, da man dort nicht reinkommt,
aber wenn das "lese Datei..." noch zu lange dauert, dann könnte man da eben noch den Stream mit in den Fortschritt aufnehmen.
[add]
also in etwa so
Delphi-Quellcode:
procedure TForm2.ProgressEvent(Sender: TObject; Progress: Integer);
begin
case Progress of
-3: Panel1.Caption := 'lese Datei ein ...';
-2: Panel1.Caption := 'dekodiere den Text ...';
-1: Panel1.Caption := 'leere alte Liste ...';
10000: Panel1.Caption := 'fertig';
else begin
Panel1.Caption := 'befülle die Liste';
ProgressBar1.Position := Progress div 100; // .Min=0 und .Max=100
end;
end;
Application.ProcessMessages;
end;
procedure TForm2.Button1Click(Sender: TObject);
var laden: TOpenDialog;
start, dauer: Cardinal;
sl: TStringList; // kann auch TProgressStringList sein
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;
Panel1.Caption := 'Laden hat ' + (floattostr(dauer/1000)) + ' Sekunden gedauert';
//...
finally
sl.Free;
end;
end;
finally
laden.Free;
end;
end;