Form in neuem Thread laufen lassen

[jus]

Zitat von jaenicke:

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