Form in neuem Thread laufen lassen

[Delphi-Laie]

Zitat:

Zitat von TiGü (Beitrag 1368871)

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!

[jus]

Zitat:

Zitat von Zacherl (Beitrag 1368770)

Zitat:

Zitat von jus (Beitrag 1368766)

braucht man die überhaupt? :gruebel:

Ja, die brauchst du in jedem Falle. Aber ist das

Delphi-Quellcode:

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? :gruebel:
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. :-(

[jaenicke]

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.

[BrightAngel]

Siehe auch meinen Beitrag #29 in diesem Thread dazu :)

Brighty

[jus]

Zitat:

Zitat von BrightAngel (Beitrag 1369090)

Siehe auch meinen Beitrag #29 in diesem Thread dazu :)
Brighty

@Brighty: ups, sorry, habe dein Link übersehen, :oops: Da steht ja genau das drin, was jaenicke erklärt hat, habe ich mir gleich in Evernote gespeichert. :-D

@jaenicke: Danke für den Tipp! :thumb: 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

[HolgerX]

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.

[Michael II]

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.

[jus]

Zitat:

Zitat von Michael II (Beitrag 1369309)

...
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

[jus]

Zitat:

Zitat von jaenicke (Beitrag 1368035)

...
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! :thumb:
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

[jaenicke]

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.