Avatar billede megabyte_ Nybegynder
11. juni 2008 - 14:31 Der er 8 kommentarer og
1 løsning

Thread opdatering af label

Hej

Mig og en af min venner har sat os for at rode med thread
Det går sådan set også meget godt, vi har rodet med en funktion til at kopierer filer med.
Den har vi så lagt i en thread, men vi er løbet ind i et problem
Vi har lavet en Gauge som viser progress samt et label som viser rast tid på vors main form
problem er at vi får fejl(forskellige fejl) når vi køre vore funktion og den skal opdatere vores label
Det går fint noget af vejen men så fejler den.

Her er koden til vores thread

unit Unit2;

interface

uses
  Windows, SysUtils, Classes, Gauges, StdCtrls, ExtCtrls;
type
  Ttest = class(TThread)
    Source, Destination: string;
    Gauge: TGauge;
    Timelabel: TLabel;
  private
    { Private declarations }
    Prog: Integer;      //progress for gauge
    TimeLeft: String;  //time left
    procedure UpdateProgress;
  protected
    procedure Execute; override;
  end;

implementation

{ test }

procedure Ttest.Execute;
var
  FromF, ToF: file of byte;
  Buffer: array[0..4096] of char;
  NumRead: integer;
  FileLength: longint;
  t1, t2: DWORD;
  maxi: integer;
begin
  AssignFile(FromF, Source);
  reset(FromF);
  AssignFile(ToF, Destination);
  rewrite(ToF);
  FileLength := FileSize(FromF);
  with Gauge do
  begin
    MinValue  := 0;
    MaxValue  := FileLength;
    t1  := GetTickCount;
    MaxI := MaxValue div 4096;
    while FileLength > 0 do
    begin
      BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
      FileLength := FileLength - NumRead;
      BlockWrite(ToF, Buffer[0], NumRead);
      t2  := GetTickCount;
      MinValue := MinValue + 1;
      TimeLeft := FormatFloat('00.00', ((t2 - t1) / MinValue * maxi - t2 + t1) / 100);
      Synchronize(UpdateProgress);
      Prog := Prog + NumRead;
    end;
    CloseFile(FromF);
    CloseFile(ToF);
    Gauge.Progress := 0;
  end;
end;

procedure Ttest.UpdateProgress;
begin
Gauge.Progress := Prog;
Timelabel.Caption := TimeLeft;
end;

end.

Vi kalder den på denne måde

test := Ttest.Create(true);
with test do
begin
  Source := 'c:\data';
  Destination := 'c:\data2';
  Gauge := Gauge1;
  Timelabel := Label1;
  Resume;

Lige så snart at vi slår Timelabel.Caption := TimeLeft; fra virker det uden problemer
Håbe der er nogen der kan hjælpe og fortælle os hvad der går galt da vi gerne vil vide mere

/MB
Avatar billede nca Juniormester
11. juni 2008 - 15:38 #1
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.
Avatar billede hrc Mester
11. juni 2008 - 15:39 #2
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.
Avatar billede hrc Mester
11. juni 2008 - 21:46 #3
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;
Avatar billede megabyte_ Nybegynder
12. juni 2008 - 11:57 #4
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
Avatar billede megabyte_ Nybegynder
12. juni 2008 - 12:02 #5
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
Avatar billede hrc Mester
12. juni 2008 - 21:23 #6
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...
Avatar billede megabyte_ Nybegynder
13. juni 2008 - 09:35 #7
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
Avatar billede hrc Mester
14. juni 2008 - 20:24 #8
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.
Avatar billede megabyte_ Nybegynder
18. juni 2008 - 09:31 #9
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
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester