Avatar billede kennethv Nybegynder
27. juli 2009 - 14:54 Der er 32 kommentarer og
1 løsning

Flere processer kørenede samtidig.

Har et spørgsmål om man kan køre flere opgaver samtidig?

Jeg har lavet et program som under opstart enabler en timer som bare står og tjekker en database hvert 15 minut. Den udfører så noget hvert 15 minut. I mens alt det foregår vil jeg gerne have muligheden at kunne lave andre ting via progrmmet. F.eks. at trykke på en knap. den åbner så et vindue, hvor jeg har så har mulighed for at opdatere, selv samme db med, nogle records som bliver tilføjet.

Hvordan gøres dette?
Avatar billede arne_v Ekspert
27. juli 2009 - 15:05 #1
Starter en traad ?
Avatar billede michael-schou Novice
27. juli 2009 - 15:15 #2
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.
Avatar billede kennethv Nybegynder
27. juli 2009 - 15:54 #3
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?
Avatar billede kennethv Nybegynder
27. juli 2009 - 15:59 #4
Hov, en tanke torsk. Glemte liige at label1.caption skulle være "not Pause". Så nu skete der noget.
Avatar billede kennethv Nybegynder
27. juli 2009 - 16:02 #5
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.
Avatar billede hrc Mester
27. juli 2009 - 21:41 #6
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.
Avatar billede hrc Mester
27. juli 2009 - 22:16 #7
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;
Avatar billede kennethv Nybegynder
28. juli 2009 - 10:09 #8
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.
Avatar billede hrc Mester
28. juli 2009 - 10:57 #9
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.
Avatar billede kennethv Nybegynder
28. juli 2009 - 12:11 #10
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;
Avatar billede hrc Mester
28. juli 2009 - 12:48 #11
Godt det kom til at virke. Jeg ville bruge sleep() og putte det ind i while-løkken i Execute.

const
  PollTicks = 5000; // ms = 5s

  // Powernap til tråden. Ikke smart at lade den sove i 5 sekunder.
  // Den blunder mange gange indtil de 5s er gået.
  PowerNap = 50; // ms = 1/20s

procedure TMyThread.Execute;
var
  TickToPoll: cardinal;
begin
  TickToPoll := 0;
  while not Terminated do
  begin
    sleep(PowerNap);

    if TickToPoll <= GetTickCount then
    begin
      DoPollTable;

      // Ignorér den tid det tager af afvikle DoPollTable. 5s når den er færdig!
      // Alternativt kan man lave det sådan at hvis DoPollTable tager 3s sker
      // næste opdatering allerede 2s senere.
      TickToPoll := GetTickCount + PollTicks;

      // Håndtér skift til ny dag
      if TimeToPoll > MSecsPerDay then
        dec(TimeToPoll,MSecsPerDay);
    end;
  end;
end;
Avatar billede hrc Mester
28. juli 2009 - 12:50 #12
Hvis du ikke havde powernappene på 50ms, skulle du vente maksimalt 5s før programmet ville lukke.
Avatar billede kennethv Nybegynder
28. juli 2009 - 13:26 #13
Jeg går udfra at "DoPollTable" er den kode jeg har der skal sættes ind her, ikk?

TimeToPoll giver en undecleared identifier.
Avatar billede hrc Mester
28. juli 2009 - 14:42 #14
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.
Avatar billede kennethv Nybegynder
28. juli 2009 - 15:18 #15
Sorry, hvis man kunne lave en smiley der rødmer. Så fik du den. :)
Avatar billede kennethv Nybegynder
28. juli 2009 - 15:41 #16
Du må lige ligge et svar.
Avatar billede hrc Mester
28. juli 2009 - 18:26 #17
Beklager når der flyver en finke fra panden, for nu at bruge det politikerudtryk. Jeg lægger et svar.
Avatar billede kennethv Nybegynder
28. juli 2009 - 20:47 #18
LOL
Avatar billede kennethv Nybegynder
28. juli 2009 - 21:38 #19
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.
Avatar billede kennethv Nybegynder
28. juli 2009 - 21:50 #20
Og det skulle sættes igang ved at bruge checkbox'en.
Avatar billede kennethv Nybegynder
28. juli 2009 - 22:04 #21
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.
Avatar billede hrc Mester
29. juli 2009 - 10:35 #22
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.

interface

uses
  .., Messages;

const
  WM_MYTHREADSTATUS = WM_USER + 1;

implementation

uses
  Windows, Math;

const
  PollTicks = 600000; // ms = 10 min
  StatusTicks = 1000; // ms = 1 s

  // Powernap til tråden. Ikke smart at lade den sove i 5 sekunder.
  // Den blunder mange gange indtil de 5s er gået.
  PowerNap = 50; // ms = 1/20s

procedure TMyThread.Execute;
var
  TickToPoll: cardinal;
  TickToStatus: cardinal;
  TickNow: cardinal;
begin
  TickToPoll := 0;
  TickToStatus := 0;
  while not Terminated do
  begin
    sleep(PowerNap);

    TickNow := GetTickCount;

    if TickToStatus <= TickNow then
    begin
      PostMessage(Application.Mainform.Handle,WM_MYTHREADSTATUS,min(TickToPoll - TickNow,0),0);
      TickToStatus:= GetTickCount + StatusTicks;
      if TickToStatus > MSecsPerDay then
        dec(TickToStatus,MSecsPerDay);
    end;

    if TickToPoll <= TickNow then
    begin
      DoPollTable;

      // Ignorér den tid det tager af afvikle DoPollTable. 5s når den er færdig!
      // Alternativt kan man lave det sådan at hvis DoPollTable tager 3s sker
      // næste opdatering allerede 2s senere.
      TickToPoll := GetTickCount + PollTicks;

      // Håndtér skift til ny dag
      if TimeToPoll > MSecsPerDay then
        dec(TimeToPoll,MSecsPerDay);
    end;
  end;
end;


I mainformen har du denne:

type
  TfrmMain = class(TForm)
    procedure ThreadMessage(var aMsg: TMessage); message WM_MYTHREADSTATUS;

implementation

procedure TfrmMain.ThreadMessage(var aMsg: TMessage);
var
  m, s: integer;
begin
  m := aMsg.WParam div 60000;
  s := aMsg.WParam mod 60000;
  lStatus.Caption := format('Næste opdatering om %d:%d',[m,s]);
  Application.ProcessMessages;
end;


Bemærk: Det er ikke testet.
Avatar billede kennethv Nybegynder
30. juli 2009 - 13:18 #23
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
Avatar billede hrc Mester
30. juli 2009 - 13:21 #24
Mon ikke du har glemt denne her?

uses
  Windows;
Avatar billede kennethv Nybegynder
30. juli 2009 - 13:40 #25
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
Avatar billede hrc Mester
02. august 2009 - 21:32 #26
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?
Avatar billede kennethv Nybegynder
03. august 2009 - 13:57 #27
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.
Avatar billede hrc Mester
03. august 2009 - 20:36 #28
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

procedure TMyThread.Execute;
var
  TickToPoll: cardinal;
  TickToStatus: cardinal;
  TickNow: cardinal;
  DeltaTickToPoll: cardinal;
begin
  TickToPoll := 0;
  TickToStatus := 0;
  while not Terminated do
  begin
    sleep(PowerNap);

    TickNow := GetTickCount mod MSecsPerDay;

    if TickToStatus <= TickNow then
    begin
      DeltaTickToPoll := max(min(TickToPoll - TickNow,PollTicks),0);
      PostMessage(Application.Mainform.Handle,MYTHREADMESSAGE,integer(DeltaTickToPoll),0);
      TickToStatus:= GetTickCount mod MSecsPerDay + StatusTicks;
      if TickToStatus > MSecsPerDay then
        dec(TickToStatus,MSecsPerDay);
    end;

    if TickToPoll <= TickNow then
    begin
      DoPollTable;

      // Ignorér den tid det tager af afvikle DoPollTable. 5s når den er færdig!
      // Alternativt kan man lave det sådan at hvis DoPollTable tager 3s sker
      // næste opdatering allerede 2s senere.
      TickToPoll := GetTickCount mod MSecsPerDay + PollTicks; // alt. TickNow

      // Håndtér skift til ny dag
      if TickToPoll > MSecsPerDay then
        dec(TickToPoll,MSecsPerDay);
    end;
  end;
end;

Her kommer mainformens procedure som messagen kalder:

procedure TfrmMain.ThreadMessage(var aMsg: TMessage);
var
  m, s: integer;
begin
  // Paranteser for en sikkerheds skyld. Multiplicér er stærkere end div og mod
  m := aMsg.WParam div (SecsPerMin * MSecsPerSec);
  s := (aMsg.WParam mod (SecsPerMin * MSecsPerSec)) div MSecsPerSec;
  lStatus.Caption := format('Næste opdatering om %d:%0.2d',[m,s]);
  Application.ProcessMessages;
end;
Avatar billede hrc Mester
03. august 2009 - 20:38 #29
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.
Avatar billede hrc Mester
03. august 2009 - 21:01 #30
Nå, hov. Troede jeg havde din mail. Klebager
Avatar billede kennethv Nybegynder
03. august 2009 - 22:59 #31
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?
Avatar billede hrc Mester
04. august 2009 - 08:06 #32
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.
Avatar billede kennethv Nybegynder
04. august 2009 - 08:42 #33
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. :)
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