Flere processer kørenede samtidig.

Starter en traad ?

TRÅD EKS!

-----------------------------------------------------------------
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, 
Forms, Dialogs, ComCtrls, StdCtrls;

type
  TMyThread = class(TThread) //Tråden
  private
  protected //Protected indsat
  procedure Execute; override;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1 : TForm1;
  T : TMyThread; //T = Den tråd man har oprettet

implementation

{$R *.DFM}

//Tråden man har oprettet blive exekvieret
procedure TMyThread.Execute;
begin
FreeOnTerminate := True;
//KODE HER
end;

//Starter TmyThread som T Variabel
procedure TForm1.Button1Click(Sender: TObject);
begin
  T := TMyThread.Create(True); //Her skabes tråden
  //KODE HER
end;

//Pauser TmyThread som T Variabel
procedure TForm1.Button2Click(Sender: TObject);
begin
If (Form1.Label1.Caption = 'Not Pause') Then
Begin
  T.Suspended := True;
  ShowMessage('Progress Paused');
  Form1.Label1.Caption := 'Pause';
end;
end;

//Starter TmyThread fra Pause som T Variabel
procedure TForm1.Button3Click(Sender: TObject);
begin
If (Form1.Label1.Caption = 'Pause') Then
Begin
  T.Resume;
  ShowMessage('Progress started agin!');
  Form1.Label1.Caption := 'Not Pause';
end;
end;
end.
-----------------------------------------------------------------

Det er nemmest med tråde til at styre de forskellig handlinger du vil køre.

Du kan oprette så mange tråde du vil og pause dem hvis der er brug for dette.

Jeg har prøvet at dit eksempel, men intet sker. Går udfra at jeg trykker på knap 1 og derefter knap 2 og tilsidst knap 3, ikk?

Hov, en tanke torsk. Glemte liige at label1.caption skulle være "not Pause". Så nu skete der noget.

Hmm, det fejler når jeg trykker på knap 1, derefter knap 2 og bagefter knap 3 og tilsidst knap 2 igen. Så fejler den.

Ville ikke anbefale at bruge FreeOnTerminate. Det har givet mig problemer når jeg forsøgte stoppe den ved programslut - WaitFor fejler.

Giver her mit besyv med et eksempel på en tråd. Eksemplet består af en form med en TCheckBox og en TProgressBar samt en unit som indeholder trådklassen. Det eneste tråden gør er, at tælle progressbaren op mens du kan lave alt muligt andet. Placér f.eks. en TMemo på mainformen.

Der er nogle discipliner som demonstreres:
- Suspend, not suspend
- Brugen af call-back procedurer
- Brugen as Synchronize til at kalde proceduren
- Måden at stoppe og frigive tråden ved programslut.
- En måde at aktivere callback-proceduren med jævne mellemrum.
- Brugen af Default på properties

unit UThread;

interface

uses
  SysUtils, Classes, Windows;

type
  TThreadCallbackEvent = procedure(const aPosition: integer; const aText: string) of object;

  TMyThread = class(TThread)
  private
    fCallbackEvent: TThreadCallbackEvent;
    fValue: integer;
    fMin: integer;
    fMax: integer;
  public
    constructor Create(aCallbackEvent: TThreadCallbackEvent); reintroduce;
    procedure Execute; override;
    procedure DoCallback;
    property Min: integer read fMin write fMin default 0;
    property Max: integer read fMax write fMax default 100;
  end;

implementation

const
  UpdateInterval = 500; // ms

{ TMyThread }

constructor TMyThread.Create(aCallbackEvent: TThreadCallbackEvent);
begin
  inherited Create(true); // Start med at sove
  fCallbackEvent := aCallbackEvent; // Sæt callback proceduren op
  fValue := 0; // Standard værdier
end;

procedure TMyThread.DoCallback;
begin
  // Skal kun kaldes hvis der er defineret en callback procedure
  if assigned(fCallbackEvent) then
    fCallbackEvent(fValue,'Hello world');
end;

procedure TMyThread.Execute;
var
  TickCount: cardinal;
begin
  inherited;

  TickCount := 0;
  while not Terminated do
  begin
    // Opdatér med jævne mellemrum
    if TickCount + UpdateInterval < GetTickCount then
    begin
      Synchronize(DoCallback);
      TickCount := GetTickCount;
    end;

    inc(fValue);
    if fValue > fMax then
      fValue := fMin;

    sleep(50);
  end;
  Synchronize(DoCallback); // Få det sidste med
end;

end.

Mainformen ser således ud:

unit FMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, UThread, ComCtrls;

type
  TfrmMain = class(TForm)
    chbThread: TCheckBox;
    pbStatus: TProgressBar;
    procedure chbThreadClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);

    procedure ThreadCallback(const aPosition: integer; const aText: string); // TThreadCallbackEvent
  private
    fMyThread: TMyThread;
  public
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.chbThreadClick(Sender: TObject);
begin
  fMyThread.Suspended := not (Sender as TCheckBox).Checked;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  fMyThread := TMyThread.Create(ThreadCallback);

  pbStatus.Min := 0;
  pbStatus.Max := 1000;

  fMyThread.Min := pbStatus.Min;
  fMyThread.Max := pbStatus.Max;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  fMyThread.Terminate; // Fortæl at den skal afslutte while'n
  fMyThread.WaitFor; // Vent på dette
  fMyThread.Free; // Frigiv tråden
end;

procedure TfrmMain.ThreadCallback(const aPosition: integer; const aText: string);
begin
  pbStatus.Position := aPosition;
  Application.ProcessMessages; // Opdatér skærmen - egentlig ikke nødv.
end;

end.

Når man kigger på denne side kan det se ud til at Synchronize og WaitFor er en dårlig kombination: http://www.finalbuilder.com/Resources/Blogs/tabid/77/EntryId/259/Delphi-Workaround-for-TThread-Synchronize-WaitFor-Deadlock.aspx

Jeg har sjældent mere end en af hver slags tråd kørende så deadlocks er ikke forekommende.

I stedet foreslås det at lave en message der sendes til main-formen:

const
  MYTHREADMESSAGE = WM_USER + 1;

I stedet for callback
procedure TMyThread.Execute;
var
  TickCount: cardinal;
begin
  inherited;

  TickCount := 0;
  while not Terminated do
  begin
    // Opdatér med jævne mellemrum
    if TickCount + UpdateInterval < GetTickCount then
    begin
      PostMessage(Application.Mainform.Handle,MYTHREADMESSAGE,fValue,0);
      TickCount := GetTickCount;
    end;

    inc(fValue);
    if fValue > fMax then
      fValue := fMin;

    sleep(25);
  end;
  PostMessage(Application.Mainform.Handle,MYTHREADMESSAGE,fValue,0); // Få det hele med
end;

I Main-formen har man en procedure der reagerer på denne message:

procedure ThreadMessage(var aMsg: TMessage); message MYTHREADMESSAGE;

procedure TfrmMain.ThreadMessage(var aMsg: TMessage);
begin
  pbStatus.Position := aMsg.WParam;
  Application.ProcessMessages;
end;

Der var en lille fejl i eksemplet. Hvis tråden er suspended skal den startes for at kunne stoppes:

  if fMyThread.Suspended then
    fMyThread.Suspended := false;
  fMyThread.Terminate;
  fMyThread.WaitFor;
  fMyThread.Free;

HRC: Det eksempel du er kommet med er jeg lidt i tvivl om hvad jeg skal bruge. Jeg har lavet det første du er kommet med. Status på det er, at TProgressBar ikke "flytter" sig. Jeg kan godt skrive i en memo, men ved ikke om tråden er sat igang, hvilket jeg tror den er. Jeg ved ikke hvad checkbox er til for, men jeg gætter det er for at vise at man godt kan sætte flueben i den og fjerne det igen. Hvis jeg lukker programmet, sker der absolute intet. Jeg bliver nødt til at afbryde programmet med CTRL-F2.

Jeg ved ikke om det andet du er kommet med skal med ind i eksempel.

Jeg har kørt og testet begge versioner inden jeg postede det. Skal gerne sende dig koden (lavet i D2009 - men burde kunne indlæses uden de store problemer)

Checkboksene var til at starte og stoppe tråden. Kig i form-koden. Her finder du proceduren som skal kobles på TCheckboksen.

Det at du må afbryde med <ctrl-F2> har jeg nævnt i den sidste post. Det skyldes vi prøver at stoppe en tråd der sover. Den skal lige vækkes før den kan dø - også ubehøvlet at slå noget ihjel når det sover!

En lille rettelse til dette er, at jeg bytter rundt på linjerne:

  fMyThread.Terminate;
  if fMyThread.Suspended then
    fMyThread.Suspended := false;
  fMyThread.WaitFor;
  fMyThread.Free;

Ved at bytte rundt, sikrer du at while-løkken i execute ikke risikerer at loope en eller flere gange.

Ja, jeg tog udgangspunkt i at du bare havde brugt standard komponentnavne, så nu hvad det var jeg skulle gøre i forbindelse med Checkbox. Og har fået det til at virke.

Super, fantatisk. det spiller bare.

Lige tilsidst. Jeg har noget kode som tjekker en db, på et ikke bestemt tidspunkt endnu, men hvor skal jeg ligge det ind henne?

Jeg er osse en lille smule i tvivl om det skal være en TTimer eller "løkke" som det skal køre i. Måske du kan kaste lidt lys over det.

Koden til løkken er:

// Lige nu tjekker den hvert 10 sec
procedure TForm1.Button1Click(Sender: TObject);
const
  SecBetweenRuns = 10;
var
  Count: Integer;
begin
  Count := 0;
  while not Application.Terminated do
  begin
    inc(Count);
    if count >= SecBetweenRuns then
    begin
      Count := 0;
      CheckForUserToDelete;
    end;
    Sleep(1000);
    Application.ProcessMessages();
  end;
end;

Godt det kom til at virke. Jeg ville bruge sleep() og putte det ind i while-løkken i Execute.

Hvis du ikke havde powernappene på 50ms, skulle du vente maksimalt 5s før programmet ville lukke.

Jeg går udfra at "DoPollTable" er den kode jeg har der skal sættes ind her, ikk?

TimeToPoll giver en undecleared identifier.

Det er korrekt. Det er her du placerer din kode.

Mon ikke, hvis du kiggede lidt på koden, du ikke havde behøvet nævne det her. Det er givetvis en omdøbning der ikke er kommet hele vejen rundt. Prøv med TickToPoll i stedet.

Sorry, hvis man kunne lave en smiley der rødmer. Så fik du den. :)

Du må lige ligge et svar.

Beklager når der flyver en finke fra panden, for nu at bruge det politikerudtryk. Jeg lægger et svar.

LOL

HRC. Dine eksempler giver anledning til andre ideer. :)

Jeg kunne godt tænke mig at man kunne bruge procesbaren til at den vise hvor lang tid der er igen før den laver et nyt tjek af min db. Hvordan skulle man sætte det sammen? Jeg opretter gerne et nyt spørgsmål på det punkt.

Og det skulle sættes igang ved at bruge checkbox'en.

Jeg har nu testet det du har lavet. Jeg synes nu at den afvilker min kode heletiden. Ville gerne kunne sætte en tid på hvornår det skulle gøres. Du ved efter x-antal minutter skal den udføre min kode.

Har du rettet konstanten? Jeg har p.t. sat den til at køre hver 5 sekund (5000ms). Skal den vente 10 minutter bliver værdien 600.000ms

I eksemplet sendes der en message til mainformen hvor WParam indeholder antallet af milisekunder indtil næste opdatering.



I mainformen har du denne:



Bemærk: Det er ikke testet.

Jeg får en fejl i:

PostMessage(Application.Mainform.Handle,WM_MYTHREADSTATUS,min(TickToPoll - TickNow,0),0);

hvor den siger at application er:

undeclared indentifier

Mon ikke du har glemt denne her?

uses
  Windows;

Nope.

unit UThread;

interface

uses
  SysUtils, Classes, Windows, Dialogs, Messages, Math;

type
  TThreadCallbackEvent = procedure(const aPosition: integer; const aText: string) of object;

  TMyThread = class(TThread)
  private
    fCallbackEvent: TThreadCallbackEvent;
    fValue: integer;
    fMin: integer;
    fMax: integer;
  public
    constructor Create(aCallbackEvent: TThreadCallbackEvent); reintroduce;
    procedure Execute; override;
    procedure DoCallback;
    property Min: integer read fMin write fMin default 0;
    property Max: integer read fMax write fMax default 100;
  end;

implementation

Opretter du tråden før du opretter formen (i DPR-filen) eller er dit program ikke et med forme, f.eks en service, COM eller kommandolinje?

Jeg opretter tråden efter at formen er oprettet. Det er ikke en service, COM eller kommandolinje.

De eksempler du har skrevet her, med checkbox og en processbar, er det jeg vil bruge. Når processbaren komemr tilslut (har talt op) skal den udføre min kode.

nåe ja. Testet var det jo ikke blevet.

Sender lige testprogrammet til dig på mailen. Hos mig virker det som det skal med at sende messages til mainformen. Det er ikke sådan at der er flere konstanter med WM_USER + 1?

Her er de rettede procedurer


Her kommer mainformens procedure som messagen kalder:

Der var flere fejl. Jeg må have fortolket GetTickCount til at være antallet af ms fra kl. 24:00, men det er antallet af ticks fra maskinen startes. Det forsøger jeg håndtere for nu. Er ikke helt sikker på "roll-over", når cardinalen ikke kan rumme mere, er korrekt.

Desuden var der lidt galt med statusvisningen.

Nå, hov. Troede jeg havde din mail. Klebager

valnurat@gmail.com

Et lille og måske et dumt spørgsmål.

Det du vil sende er det sådan at jeg "sætter" det igang med checkbox og kan se at processbar "tæller" op også udfører min kode?

Nej, tråd 2 (tråd 1 opdaterer processbaren vha. synchronize og callback) opdaterer ikke baren. Via en message tælles der ned i en TLabel (lStatus). Har også fjernet min/max propertiene i den

Du må vente med koden til i aften. Ligger på den anden PC.

Kom lige til at tænke på en enkelt ting. Dit poll-interval skal være mindre end 1 dag. Kommer den over (24*60*60*1000 ms) vil DoPollTable aldrig blive kaldt.

Mit poll-interval blive mindre end 1 dag, sikkert nok ved hver time.

Vil du have mod på at kunne lave det sådan, at processbaren "tæller" op til max og derefter køre den kode jeg har?

Flere point vil blive tildelt, hvis ønskes. :)