AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Form in neuem Thread laufen lassen

Ein Thema von Hobbycoder · begonnen am 17. Apr 2017 · letzter Beitrag vom 27. Jul 2017
Antwort Antwort
Seite 5 von 7   « Erste     345 67   
Delphi-Laie

Registriert seit: 25. Nov 2005
1.474 Beiträge
 
Delphi 10.1 Berlin Starter
 
#41

AW: Form in neuem Thread laufen lassen

  Alt 24. Apr 2017, 14:40
Ist doch total simpel?
Einfach im Thread die entsprechend gewünschten Windowsfunktionen aufrufen?
Anscheinend ja, wenn man weiß, wie es geht. Oder einfach in den VCL-Quelltexten diese Funktionalitäten "ausgraben" und - das Urheberrecht beachtend - übernehmen.

Vielen Dank!
  Mit Zitat antworten Zitat
jus

Registriert seit: 22. Jan 2005
343 Beiträge
 
Delphi 2007 Professional
 
#42

AW: Form in neuem Thread laufen lassen

  Alt 25. Apr 2017, 23:57
braucht man die überhaupt?
Ja, die brauchst du in jedem Falle. Aber ist das IsDialogMessage notwendig? Glaube das kannst du weglassen.
@Zacherl: Danke, ok, das IsDialogMessage habe ich mal rausgenommen.

Ich bräuchte bitte wieder eure Hilfe. Ich bin auf ein seltsames Problem gestossen, und zwar lasse ich mir die Anzahl der Durchläufe vom Thread über OutputDebugString anzeigen.
Delphi-Quellcode:
procedure TDataThread.Execute;
var
  Msg: TMsg;
  i: Cardinal;
begin
  hdlg := CreateDialog(HInstance, MAKEINTRESOURCE(100), Self.Handle, @DlgFunc);
  ShowWindow(hdlg, SW_SHOW);

  i := 0;
  while not terminated do
  begin
    BERECHNE_WAS; // <-------------- ich würde hier gerne was berechnen lassen
    if GetMessage(msg,0,0,0) then
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
    OutputDebugString(PChar('i: '+IntToStr(i)));
    inc(i);
  end;
end;
Das komische daran ist, dass der Thread stehen bleibt, wenn ich auf ein anderes VCL Fenster von Hauptthread wechsle, sprich in meinem Falle auf Form1 von Unit1.pas klicke. Es scheint so zu sein, dass beim Focusverlust der Thread einfach stehen bleibt, weil er nichts mehr zu tun hat. Sobald ich das NonVclThread Fenster bewege oder einfach mit der Maus drüberfahre, läuft die Nachrichtenschleife zwischen "while not terminated do" wieder weiter. Der GUI macht das überhaupt nichts aus. Aber das Problem ist ja, wenn ich dann irgendwelche Berechnungen im gleichen Thread erledigen möchte, geht das dann nicht, sprich ich bräuchte da einen zusätzlichen Thread, wo die Berechnungen erledigt werden und mache die GUI Anzeigesachen in diesem Thread. Ist das so, oder gibt es dazu eine elegantere Lösung?
Eine schlechte Lösung, was ich schon ausprobiert habe, wäre, dass ich mit einer SendMessage in der Schleife dem Thread zwinge weiter zu machen. Was aber auffällt ist, dass anscheinend nicht mehr als ca.30-40 Mal pro Sekunde die While-Schleife durchlaufen wird, was eine erbärmliche Performance ist.

Geändert von jus (26. Apr 2017 um 00:19 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von jaenicke
jaenicke

Registriert seit: 10. Jun 2003
Ort: Berlin
9.288 Beiträge
 
Delphi 11 Alexandria
 
#43

AW: Form in neuem Thread laufen lassen

  Alt 26. Apr 2017, 04:21
Siehe Doku von GetMessage...
https://msdn.microsoft.com/de-de/lib...(v=vs.85).aspx
Zitat:
The function dispatches incoming sent messages until a posted message is available for retrieval.
Was du brauchst ist PeekMessage, denn das kehrt direkt zurück und nicht erst wenn eine Message geholt werden konnte.

Allerdings macht ein weiterer Thread durchaus Sinn. Denn sonst blockiert deine Berechnung ja wieder die GUI.
Sebastian Jänicke
Alle eigenen Projekte sind eingestellt, ebenso meine Homepage, Downloadlinks usw. im Forum bleiben aktiv!
  Mit Zitat antworten Zitat
BrightAngel

Registriert seit: 13. Mär 2007
130 Beiträge
 
#44

AW: Form in neuem Thread laufen lassen

  Alt 26. Apr 2017, 07:47
Siehe auch meinen Beitrag #29 in diesem Thread dazu

Brighty
Do you have the email of god??? --- I have to tell him that I'm happy to be born!
  Mit Zitat antworten Zitat
jus

Registriert seit: 22. Jan 2005
343 Beiträge
 
Delphi 2007 Professional
 
#45

AW: Form in neuem Thread laufen lassen

  Alt 27. Apr 2017, 01:04
Siehe auch meinen Beitrag #29 in diesem Thread dazu
Brighty
@Brighty: ups, sorry, habe dein Link übersehen, Da steht ja genau das drin, was jaenicke erklärt hat, habe ich mir gleich in Evernote gespeichert.

@jaenicke: Danke für den Tipp! Jetzt habe ich aber Gewissheit, dass ich vermutlich meine Berechnungen in einem 2. Thread reingeben soll.

Ich hätte aber im Falle von Peekmessage einfach die Nachrichtenschleife wie folgt gebaut und scheint auch zu funktionieren:
Delphi-Quellcode:
procedure TDataThread.Execute;
var
  Msg: TMsg;
begin
  hdlg := CreateDialog(HInstance, MAKEINTRESOURCE(100), Self.Handle, @DlgFunc);
  ShowWindow(hdlg, SW_SHOW);

  while not terminated do
  begin
    BERECHNE_WAS; // <-------------- ich würde hier gerne was berechnen lassen
    if PeekMessage(msg, hdlg, 0, 0, PM_REMOVE) then
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
  end;
end;
Laut MS Doku in C ist aber gar kein TranslateMessage und DispatchMessage mehr drin.
Code:
fDone = FALSE;
while (!fDone)

    fDone = DoLengthyOperation(); // application-defined function
 
    // Remove any messages that may be in the queue. If the
    // queue contains any mouse or keyboard
    // messages, end the operation.
 
    while (PeekMessage(&msg, hwnd, 0, 0, PM_REMOVE))
    { 
        switch(msg.message)
        { 
            case WM_LBUTTONDOWN:
            case WM_RBUTTONDOWN:
            case WM_KEYDOWN:
                // 
                // Perform any required cleanup.
                // 
                fDone = TRUE;
        } 
    } 
}
Meine Frage wäre aber, wenn ich Peekmessage verwenden möchte, soll ich dann TranslateMessage u. DispatchMessage nicht verwenden, oder kann ich weiterhin TranslateMessage u. DispatchMessage verwenden, wie ich es in vorigen Delphicode gemacht habe?

lg,
jus
  Mit Zitat antworten Zitat
HolgerX

Registriert seit: 10. Apr 2006
Ort: Leverkusen
961 Beiträge
 
Delphi 6 Professional
 
#46

AW: Form in neuem Thread laufen lassen

  Alt 27. Apr 2017, 05:32
Hmm..

Wenn ich in Threads Windows-Messages verarbeiten lassen will, habe ich mir hierfür ein ProcessMessage nachgebaut:

Delphi-Quellcode:
type
  TThreadTerminateBreak = class (TThread);

procedure ThreatProcessRequests(AThread : TThread; WaitForMessage: Boolean);
var
  msg: TMsg;
  Rslt: Boolean;
begin
  while True do
  begin
    if TThreadTerminateBreak(AThread).Terminated and WaitForMessage then break;
    if WaitForMessage then
      Rslt := GetMessage(msg, 0, 0, 0)
    else
      Rslt := PeekMessage(msg, 0, 0, 0, PM_REMOVE);
    if not Rslt then break;
    DispatchMessage(msg);
    Sleep(1);
  end;
end;
Das TranslateMessage ist ja nur für die Konvertierung von Key-Events hilfreich, bei anderen Messages wird es jedoch nicht gebraucht.
  Mit Zitat antworten Zitat
Michael II

Registriert seit: 1. Dez 2012
Ort: CH BE Eriswil
703 Beiträge
 
Delphi 11 Alexandria
 
#47

AW: Form in neuem Thread laufen lassen

  Alt 27. Apr 2017, 14:27
Hallo jus

wenn du dein BERECHNE_WAS; in einen weiteren Thread t2 auslagerst, dann kannst du in deinem jetzigen Thread t1 in den meisten Fällen weiterhin GetMessage verwenden. Es macht ja durchaus Sinn, wenn t1 nix tut, wenn t1 nix zu tun hat.

BERECHNE_WAS;: nur in t1 belassen, wenn BERECHNE_WAS; sehr kurz rechnet, sonst blockierst du nun einfach t1 statt wie früher mit einem VCL Fenster den Hauptthread... .

Und noch eine kleine Verbesserungsmöglichkeit. Du hast zuletzt diesen Code veröffentlicht:

Delphi-Quellcode:
while not terminated do
begin
 BERECHNE_WAS; // <-------------- ich würde hier gerne was berechnen lassen
 if PeekMessage(msg, hdlg, 0, 0, PM_REMOVE) then
 begin
  TranslateMessage(Msg);
  DispatchMessage(Msg);
 end;
end;


Verwende besser while PeekMessage anstatt if. Mit if kann dein Thread immer jeweils nur eine Windowsmeldung abarbeiten und muss danach wieder BERECHNE_WAS; ausführen. Viele Windowsmeldungen in der Warteschlange oder längere Ausführungszeiten von BERECHNE_WAS; wären bei Verwendung von if... also nicht gut für dein Fenster.
Michael Gasser
  Mit Zitat antworten Zitat
jus

Registriert seit: 22. Jan 2005
343 Beiträge
 
Delphi 2007 Professional
 
#48

AW: Form in neuem Thread laufen lassen

  Alt 28. Apr 2017, 01:56
...
Verwende besser while PeekMessage anstatt if. Mit if kann dein Thread immer jeweils nur eine Windowsmeldung abarbeiten und muss danach wieder BERECHNE_WAS; ausführen. Viele Windowsmeldungen in der Warteschlange oder längere Ausführungszeiten von BERECHNE_WAS; wären bei Verwendung von if... also nicht gut für dein Fenster.
Ok, Danke für den Hinweis mit der "if PeekMessage", wieder mal was gelernt. Ich werde wahrscheinlich dieses BERECHNE_WAS; in einen 2.Thread packen.

lg,
jus
  Mit Zitat antworten Zitat
jus

Registriert seit: 22. Jan 2005
343 Beiträge
 
Delphi 2007 Professional
 
#49

AW: Form in neuem Thread laufen lassen

  Alt 29. Apr 2017, 03:06
...
Aber da steckt eigentlich nicht viel dahinter, wenn man es richtig macht.

Das Fenster selbst steckt ja in einer Ressource. Das schöne ist nun, dass nach der Anzeige eines solchen Fensters dessen Controls ja alle da sind. Man findet die also direkt.

Die Klasse für solch einen Dialog ist nun von TThread abgeleitet. Beim Start des Threads zeigt der das Fenster mit ShowWindow an. Danach findet man mit EnumChildWindows die Controls, wobei als Userpointer einfach der eigene Dialog angegeben ist. So bekommt die Threadinstanz einen Methodenaufruf pro gefundenem Control.

Mit GetClassName bekommt man nun den Typ des Controls heraus und erstellt eine passende Wrapperklasse, alle abgeleitet von einer Basisklasse. Die Instanz kann man sich dann direkt merken um über die ID an die entsprechende Wrapperinstanz zu kommen.

Das Basiscontrol braucht sich nur das Fensterhandle usw. zu merken. Und ein Wrapper für ein Edit-Control muss eine property Text haben, die auf WM_GETTEXT, SetDlgItemText usw. geht.
Möchte mal meine spartanische Machbarkeitsstudie von jaenicke's obiger Beschreibung mal reinstellen, wo ein Dialog-Form in einem eigenen Thread unabhängig vom VCL Hauptthread läuft. Habe das komplette Projekt auch als Zip-Anhang angehängt. Vielleicht kanns ja wer mal brauchen. Danke nochmals an alle Helfer!
Was drinnen noch fehlt sind die Wrapper für die Controls.

Die folgende Unit1.pas ist die normale VCL.
Delphi-Quellcode:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  i,j: Integer;
begin
  for I := 0 to 50000 do
  begin
    for j := 0 to 100 do progressBar1.Position:=j;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  DialogThread.Show;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DialogThread := TDialogThread.Create;
  WorkerThread := TWorkerThread.Create;
end;

end.


Die folgende Unit2.pas enthält 2 Threads, TDialogThread und TWorkerThread. TDialogThread ist für die Anzeige des eigenständigen ThreadDialogs zuständig. TWorkerThread berechnet beispielhaft irgendwas und zeigt dann die Ergebnisse in ThreadDialog an.
Delphi-Quellcode:
unit Unit2;

interface

uses classes, windows, Messages,SysUtils;
type
  TDialogThread = class(TThread)
  private
    hdlg: DWORD ;
  protected
    procedure Execute; override;
  public
    constructor Create;
    procedure Show;
    procedure MemoAdd(s:String);
    procedure ProgressBarPosition(Pos: Integer);
    class function GetCompnentHandleByID(ID: Integer): DWORD;
  end;

  TWorkerThread = class(TThread)
  private
    procedure BerechneWas;
  protected
    procedure Execute; override;
  public
    constructor Create;
  end;

  RComponentList = record
    ID: Integer;
    ClassName: String;
    Name: String;
    Handle: DWORD;
  end;
  ARComponentList = array of RComponentList;

  function dlgfunc(hwnd: hwnd; umsg: dword; wparam: wparam; lparam: lparam): bool; stdcall;

var
  ThreadComponentList: ARComponentList;
  DialogThread: TDialogThread;
  WorkerThread: TWorkerThread;

implementation

uses CommCtrl;

{$R main.res} //hier kommt die Dialogresource rein

function dlgfunc(hwnd: hwnd; umsg: dword; wparam: wparam; lparam: lparam): bool; stdcall;
var
  ProgressHandle:DWORD;
begin
  result := true;
  case umsg of
    WM_CLOSE:
      EndDialog(hWnd, 0);
    WM_DESTROY:
      PostQuitMessage(0);
    WM_COMMAND:
      if hiword(wparam) = BN_CLICKED then begin
        case loword(wparam) of
          IDOK:
            begin
              messagebox(hwnd, PChar('OK Button gedrückt. '+IntToStr(ProgressHandle)), 'Meldung', 0);
            end;
        end;
      end;
  else result := false;
  end;
end;

function EnumChildProc(const AhWindow : DWORD;const ADummy : PDWORD) : Boolean; stdcall;
var
  pBuffer : PChar;
  dwSize : DWORD;

begin
  SetLength(ThreadComponentList, Length(ThreadComponentList)+1);
  Result := true;
  dwSize := 255;
  pBuffer := AllocMem(dwSize);
  try
    if GetClassName(AhWindow,pBuffer,dwSize) = 0 then
    begin
      exit;
    end;
    ThreadComponentList[High(ThreadComponentList)].ID := GetDlgCtrlID(AhWindow);
    ThreadComponentList[High(ThreadComponentList)].ClassName := StrPas(pBuffer);
    ThreadComponentList[High(ThreadComponentList)].Handle := AhWindow;
  finally
    FreeMem(pBuffer,dwSize);
  end;
end;


{ TDialogThread }

constructor TDialogThread.Create;
begin
  inherited Create(False);
  FreeOnTerminate := TRUE;
end;

procedure TDialogThread.Execute;
var
  Msg: TMsg;
  ProgressHandle: DWORD;

begin
  hdlg := CreateDialog(HInstance, MAKEINTRESOURCE(100), Self.Handle, @DlgFunc);
  ShowWindow(hdlg, SW_SHOW);

  //hole mal alle Komponenten
  EnumChildWindows(hdlg,@EnumChildProc,0);

  ProgressHandle := GetCompnentHandleByID(3000);
  if ProgressHandle>0 then
  begin
    SendMessage(ProgressHandle,PBM_SETRANGE,0,MAKELPARAM(0,100)); //Setze den Bereich von ProgressBar auf 0..100
    SendMessage(ProgressHandle,PBM_SETSTEP,1,0); //Setze den Bereich von ProgressBar auf 0..100
  end;

  while not terminated do
  begin
    if GetMessage(msg,0,0,0) then
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  end;
end;

class function TDialogThread.GetCompnentHandleByID(ID: Integer): DWORD;
var
  i: Integer;
begin
  result:=0;
  if Length(ThreadComponentList)<1 then exit;
  for i := 0 to High(ThreadComponentList) do
  begin
    if ThreadComponentList[i].ID = ID then
    begin
      result := ThreadComponentList[i].Handle;
      break;
    end;
  end;
end;

procedure TDialogThread.MemoAdd(s: String);
var
  MemoHandle: DWORD;
  MemoCount: Integer;
  SelStart, LineLen: Integer;
  Line: string;
begin
  MemoHandle := GetCompnentHandleByID(4001);
  if MemoHandle>0 then
  begin
    //Bestimme die Count Anzahl
    MemoCount := SendMessage(MemoHandle, EM_GETLINECOUNT, 0, 0);
    if SendMessage(MemoHandle, EM_LINELENGTH, SendMessage(MemoHandle, EM_LINEINDEX, MemoCount - 1, 0), 0) = 0 then Dec(MemoCount);
    if MemoCount >= 0 then
    begin
      SelStart := SendMessage(MemoHandle, EM_LINEINDEX, MemoCount, 0);
      if SelStart >= 0 then Line := S + #13#10 else
      begin
        SelStart := SendMessage(MemoHandle, EM_LINEINDEX, MemoCount - 1, 0);
        if SelStart < 0 then Exit;
        LineLen := SendMessage(MemoHandle, EM_LINELENGTH, SelStart, 0);
        if LineLen = 0 then Exit;
        Inc(SelStart, LineLen);
        Line := #13#10 + s;
      end;
      SendMessage(MemoHandle, EM_SETSEL, SelStart, SelStart);
      SendMessage(MemoHandle, EM_REPLACESEL, 0, Longint(PChar(Line)));
    end;
  end;
end;

procedure TDialogThread.ProgressBarPosition(Pos: Integer);
var
  ProgressHandle: DWORD;
begin
  ProgressHandle := GetCompnentHandleByID(3000);
  if ProgressHandle>0 then
  begin
    SendMessage(ProgressHandle, PBM_SETPOS, Pos, 0);
  end;
end;

procedure TDialogThread.Show;
begin
  ShowWindow(hdlg, SW_SHOW);
end;


{ TWorkerThread }

procedure TWorkerThread.BerechneWas;
begin
  Sleep(800);
end;

constructor TWorkerThread.Create;
begin
  inherited Create(TRUE);
  FreeOnTerminate := TRUE;
  Resume;
end;

procedure TWorkerThread.Execute;
var
  i: Integer;
begin
  inherited;
  i:=0;
  while not terminated do
  begin
    BerechneWas;
    DialogThread.MemoAdd('Test'+IntToStr(i));
    if i<=100 then
    begin
      DialogThread.ProgressBarPosition(i);
      inc(i);
    end
    else i:=0;
  end;
end;

end.
lg,
jus
Miniaturansicht angehängter Grafiken
screenshot1.jpg   screenshot2.jpg  
Angehängte Dateien
Dateityp: zip thread_non_vcl.zip (226,5 KB, 13x aufgerufen)
  Mit Zitat antworten Zitat
Benutzerbild von jaenicke
jaenicke

Registriert seit: 10. Jun 2003
Ort: Berlin
9.288 Beiträge
 
Delphi 11 Alexandria
 
#50

AW: Form in neuem Thread laufen lassen

  Alt 1. Mai 2017, 01:37
Ich habe nun den Quelltext veröffentlicht, er steht unter der MPL 2.0 zur Verfügung:
https://github.com/jaenicke/MTCL
Der Quelltext darf damit auch explizit für kommerzielle Projekte, egal ob open oder closed source, verwendet werden. Die wichtigste Bedingung ist lediglich, dass eure Änderungen am Quelltext auch wieder zur Verfügung gestellt werden müssen.

Ihr seid alle eingeladen euch an dem Projekt zu beteiligen. Push Requests werde ich möglichst schnell bearbeiten.

Was ich prinzipiell noch plane sobald ich privat die Zeit finde:
  • Dynamische Erzeugung der Controls als Alternative zur Nutzung von Ressourcen
  • Zumindest ein paar Basisproperties wie Position und Größe
  • Und im Anschluss neue Controltypen, insbesondere progressbar usw.
Sebastian Jänicke
Alle eigenen Projekte sind eingestellt, ebenso meine Homepage, Downloadlinks usw. im Forum bleiben aktiv!

Geändert von jaenicke ( 1. Mai 2017 um 01:40 Uhr)
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

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 22:59 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