Thread opdatering af label

Prøv at erstatte variablen TimeLeft med fx. 'Her står resttiden' og se om programmet stadig fejler.
Gør det ikke det, skal I koncentrere jer om udregningen af resttiden.

I ændrer properties inde i execute-metoden. Det har jeg flyttet ud i "synchronized" metoder. Har prøvet at optimere på beregningerne, men det er ikke lykkes ret godt. Endelig bruger jeg TProgressBar da det var den jeg kunne finde i min pallette.

uses
  Windows, SysUtils, Classes, StdCtrls, ExtCtrls, ComCtrls;

type
  TThreadCopy = class(TThread)
  private
    fSource: string;
    fDestination: string;
    fProgressBar: TProgressBar;
    fLabel: TLabel;
    fPosition: integer;
    fTimeLeftText: string;
    fFileLength: longint;
    procedure UpdateProgress;
    procedure InitializeProgress;
    procedure FinalizeProgress;
  public
    constructor Create(aProgressBar: TProgressBar; aLabel: TLabel); reintroduce;
    property Source: string read fSource write fSource;
    property Destination: string read fDestination write fDestination;
    procedure Execute; override;
  end;

implementation

{ TThreadCopy }

type
  TBuffer = array[0..4096] of char;

constructor TThreadCopy.Create(aProgressBar: TProgressBar; aLabel: TLabel);
begin
  inherited Create(true);
  fProgressBar := aProgressBar;
  fLabel := aLabel;
  FreeOnTerminate := true;
end;

procedure TThreadCopy.Execute;
var
  FromF, ToF: file of byte;
  Buffer: TBuffer;
  NumRead: integer;
  t1, t2, t3: cardinal;
  PctDone: double;
  ETA: double;
begin
  AssignFile(FromF, fSource);
  reset(FromF);
  AssignFile(ToF, fDestination);
  rewrite(ToF);
  try
    fFileLength := FileSize(FromF);
    Synchronize(InitializeProgress);
    t1 := GetTickCount; t3 := t1;
    while fPosition < fFileLength do
    begin
      BlockRead(FromF, Buffer[0], SizeOf(TBuffer), NumRead);
      BlockWrite(ToF, Buffer[0], NumRead);
      inc(fPosition,NumRead);
      t2  := GetTickCount;
      if t3 - t2 > 500 then // Opdatér hvert halve sekund
      begin
        PctDone := fPosition / fFileLength;
        ETA := (t2 - t1) * (1 - PctDone);
        fTimeLeftText := FormatFloat('00ms', ETA);
        t3 := t2;
        Synchronize(UpdateProgress);
      end;
    end;
  finally
    CloseFile(FromF);
    CloseFile(ToF);
    Synchronize(FinalizeProgress);
  end;
end;

procedure TThreadCopy.FinalizeProgress;
begin
  fPosition := 0;
  fTimeLeftText := FormatFloat('00ms', 0.0);
  Synchronize(UpdateProgress);
end;

procedure TThreadCopy.InitializeProgress;
begin
  fProgressBar.Min := 0;
  fProgressBar.Max := fFileLength;
  fPosition := 0;
end;

procedure TThreadCopy.UpdateProgress;
begin
  fProgressBar.Position := fPosition;
  fLabel.Caption := fTimeLeftText;
end;

----------------- o -----------------

procedure TfrmMain.btnDoItClick(Sender: TObject);
begin
  with TThreadCopy.Create(pbStatus,lStatusText) do
  begin
    Source := eSource.Text;
    Destination := eDestination.Text;
    Resume;
  end;
end;

Jeg kopierer uden problemer.

Der var lige et par fejl i execute:

      if (t2 - t3 > 500) or (fPosition = fFileLength) then
      begin
        fPctDone := fPosition / fFileLength;
        Delta := t2 - t1;
        fETA := Delta / fPctDone - Delta;
        fTimeLeftText := FormatFloat('00ms', fETA);
        t3 := t2;
        Synchronize(UpdateProgress);
      end;

Hej

Tak for det hurtige svar, det ser godt ud og virker
Men vi har arbejdet lidt på det og har lagt det i en dll fil, vi kan fint kalde vores funktion osv men den vil ikke kopierer , der kommer ingen fejl den laver bare en 0kb fil :/

Håber at du lige har et guldkor til os hrc :)

/MB

Hej
Jeg glemte lige at smid noget kode med :)
her er den procedure vi bruger til export af copy på

procedure CopyFile(SourceFile, DestinationFile: string; aProgressBar: TProgressBar; aLabel: TLabel);
begin
With TThreadCopy.Create(aProgressBar,aLabel) do
  begin
  Source := SourceFile;
  Destination := DestinationFile;
  resume;
  end;
end;

og så er den slf med i exports

/MB

Inden jeg kaster mig ud i mere vil jeg godt høre hvorfor følgende spørgsmål blev lukket så brat: http://www.eksperten.dk/spm/833189. Der var flere brugbare input, men du lukker og tager alle pointsene tilbage. I "gamle dage" havde du risikeret dårlig karma. Nu til dags kan det ende med halve svar...

Det må i undskylde, jeg var ved og ryde op og fik lukket dette ved en fejl
Jeg har lagt en post i tråden

/MB

Tjaa. For det første skal du ikke bruge strings i parametrene. Brug pchar. De to komponenter burde være ok.

Se i øvrigt dette link: http://delphi.about.com/od/objectpascalide/a/dlldelphi.htm

procedure CopyFile(aSourceFile, aDestinationFile: pchar; aProgressBar: TProgressBar; aLabel: TLabel); stdcall;
begin
  with TThreadCopy.Create(aProgressBar,aLabel) do
  begin
    Source := string(aSourceFile);
    Destination := string(aDestinationFile);
    resume;
  end;
end;

Jeg tror det er det. Husk at kalde den med "stdcall". Eneste andet sted jeg kan mistænke kan give problemer er bufferen, men den oprettes ikke vha getmem eller lignende. Det burde ikke være et problem.

I øvrigt kan I godt debugge en dll-fil. Hvis I går ind under run og parameters i Delphi, kan i angive en exe-fil der kalder programmet - men det ved I måske.

Det hjalp ikke :(
Jeg har oprettet et nyt spm da jeg har fået svar på dette, så hvis i har lyst så se på det
http://www.eksperten.dk/spm/835331

/MB