AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Projekte [ThreadHelper] Hilfreiche Erweiterungen für TThread
Thema durchsuchen
Ansicht
Themen-Optionen

[ThreadHelper] Hilfreiche Erweiterungen für TThread

Ein Thema von chaosben · begonnen am 7. Sep 2011
Antwort Antwort
Benutzerbild von chaosben
chaosben
Registriert seit: 27. Apr 2005
TThread.Exec
  • Sinn: Mal schnell, ohne großen Aufwand, etwas in einem Extra-Thread ausführen
  • Infos:
    • Über die globale Variable ThreadExecManager.MaxRunningThreads kann man bestimmen, wie viele Exec-Threads gleichzeitig laufen dürfen
    • Innerhalb der Thread-Funktion/Prozedur kann man über MyExecThread den eigenen Thread referenzieren
  • Beispiele:
    Delphi-Quellcode:
    //wartet 1 Sekunde und zeigt dann synchronized die Box an
    TThread.Exec(procedure begin Sleep(1000); end,
                 procedure begin ShowMessage('1 Sekunde gewartet'); end,
                 true);


    //Führt die Funktion "EineLangeBerechnung" threaded aus und gibt deren Resultat synchronized an "ZeigeResultat" weiter
    function EineLangeBerechnung: Int64;
    begin
      Result := 1;
    end;

    procedure ZeigeResultat(AResult : Int64);
    begin
      ShowMessage(IntToStr(AResult));
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
      TThread.Exec<Int64>(EineLangeBerechnung, ZeigeResultat, true);
    end;


    //Eine TNotify-Prozedur threaded aufrufen
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      if GetCurrentThreadId = MainThreadID then
        ShowMessage('Click')
      else
        ShowMessage('Du altes Ferkel! Du greifst mit Thread ' + IntToStr(MyExecThread.ThreadID) + ' auf die VCL zu!');
    end;

    procedure TForm1.Button2Click(Sender: TObject);
    begin
      TThread.Exec(Button1Click, nil, procedure begin Caption := 'Klick erledigt'; end);
    end;


    //sucht rekursiv alle Dateien unterhalb eines Ordners, fügt die gefundenen Dateien in
    //eine Listbox ein und zeigt die aktuelle Anzahl in der Caption des Forms and
    procedure CallBack(AList : TStringList);
    begin
      Form61.ListBox1.items.BeginUpdate;
      try
        Form61.ListBox1.items.AddStrings(AList);
      finally
        Form61.ListBox1.items.EndUpdate;
        AList.Free;
      end;

      Form61.Caption := IntToStr(Form61.ListBox1.Items.Count);
    end;

    function Search(ADir : String) : TStringList;
    var
      sr : TSearchRec;
      lst : TStringList;
    begin
      lst := TStringList.Create;

      if FindFirst(ADir + '\*.*', faAnyFile, sr) = 0 then
      begin
        repeat
          if (sr.Name <> '.') and (sr.Name <> '..') then
          begin
            if faDirectory and sr.Attr = faDirectory then
            begin
              MyExecThread.Synchronize(MyExecThread, procedure begin CallBack(lst) end);
              lst := Search(ADir + '\' + sr.Name);
            end
            else
              lst.Add(ADir + '\' + sr.Name);
          end;
        until FindNext(sr) <> 0;
        FindClose(sr);
      end;

      Result := lst;
    end;

    procedure TForm61.Button4Click(Sender: TObject);
    begin
      tthread.Exec<TStringList>(function : TStringList
                                begin
                                  Result := Search('c:\Program Files');
                                end, CallBack);
    end;


    //sucht rekursiv alle Dateien unterhalb eines Ordners wobei jeder Ordner von einem eigenen Thread durchsucht wird
    //zugegebenermaßen wird das Suchen durchs Multithreading nicht wirklich schneller ... aber man kanns ja mal versuchen :)
    procedure CallBack(AList : TStringList);
    begin
      //Dateiliste weiterverabeiten

      Alist.Free;
    end;

    function Search(ADir : String) : TFunc<TStringList>;
    begin
      Result := function : TStringList
                var
                  sr : TSearchRec;
                begin
                  Result := TStringList.Create;
                  if FindFirst(ADir + '\*.*', faAnyFile, sr) = 0 then
                  begin
                    repeat
                      if (sr.Name <> '.') and (sr.Name <> '..') then
                      begin
                        if faDirectory and sr.Attr = faDirectory then
                          tthread.Exec<TStringList>(Search(ADir + '\' + sr.Name), CallBack)
                        else
                          Result.Add(ADir + '\' + sr.Name);
                      end;
                    until FindNext(sr) <> 0;
                    FindClose(sr);
                  end;
                end;
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
      TThread.Exec<TStringList>(Search('c:\temp'), CallBack);
    end;

Entwickelt und getestet mit D2009. Weitere Ideen sind willkommen.

Download der aktuellesten Version
If I have seen further it is by standing on the shoulders of Giants. (Isaac Newton)

Geändert von chaosben ( 9. Sep 2011 um 12:59 Uhr)
 
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 07:51 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz