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.

zusammenfalten · markieren

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.

zusammenfalten · markieren

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

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.

Hallo Sebastian, vielen Dank für die Veröffentlichung Deines Projektes! Anscheinend konntst Du in Deinem Unternehmen "gewissen Genehmigungen" einholen.

Der einzige Wermuthstropfen ist für mich, daß es eine ziemlich hohe Delphiversion erfordert. Auch nach "Unitbereinigung" war Turbo-Delphi außerstande, es zu compilieren. Es erfordert wohl als Minimum irgendein Delphi der XE-Reihe, nicht wahr? Ich fand dazu keine explizite Aussage.

Zitat von Delphi-Laie:

Hallo Sebastian, vielen Dank für die Veröffentlichung Deines Projektes! Anscheinend konntst Du in Deinem Unternehmen "gewissen Genehmigungen" einholen.

Der einzige Wermuthstropfen ist für mich, daß es eine ziemlich hohe Delphiversion erfordert. Auch nach "Unitbereinigung" war Turbo-Delphi außerstande, es zu compilieren. Es erfordert wohl als Minimum irgendein Delphi der XE-Reihe, nicht wahr? Ich fand dazu keine explizite Aussage.

Ich habe den SourceCode nur kurz überflogen und mir auch nur das angeschaut, was er hier im Forum gepostet hat. Mir sind dabei Generics ins Auge gesprungen. Die gab es soweit ich weiß erst ab Delphi 2009 oder Delphi 2010. Ohne die Generics könntest du es zwar auch machen indem du die einfach auflöst, aber dann müsstest du jede Komponente selbst handlen bzw. eine sehr weit übergeordnete Basisklasse (TComponent oder so) verwenden.

Aber wie gesagt ... nur kurz überflogen. Wie viel Aufwand das wäre kann ich so nicht sagen.

Es sollte mit der kostenlosen 10.2 Starter funktionieren.

Generics gehen ab Delphi 2009, aber ob die Unitnamen da schon alle so waren, weiß ich nicht.

Ohne Generics geht es leider bei weitem nicht so elegant. Es sollte da aber reichen die generischen Dictionaries und den generischen Getter zu ersetzen. Ich bin gerade unterwegs, deshalb kann ich grad schlecht schauen.

Danke Euch beiden!

Nein, Sebastian, wegen meiner fühle Dich bitte nicht genötigt, Deine kostbare Zeit dafür zu ver(sch)wenden, Generics womöglich aufzulösen.

Dann bleibt mir eben nur die Verwendung ab Delphi mit Generics oder Verzicht, wenn die Generics eben so elegant sind.

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

@jaenicke: Danke!

lg,
jus

Hat sich schon jemand das Projekt genauer angeschaut? Die dynamische Erzeugung von Controls ist nun implementiert, genauso wie die Positionierung der Controls zur Laufzeit.
Die dynamische Erzeugung des Fensters an sich steht noch aus, genauso wie Properties wie Font usw. und dann natürlich noch ein paar weitere Controls.

Ich würde mich freuen, wenn sich auch jemand anderes beteiligen würde.

Ich habe mal noch eine rudimentäre Progressbar hinzugefügt.

Zitat von jaenicke:

Ich habe mal noch eine rudimentäre Progressbar hinzugefügt.

Cool, ich muss werde mich mal in den Code reinlesen. Das Problem bei mir aktuell ist halt, dass ich noch Delphi 2007 verwende und somit den Code nicht direkt kompilieren kann. Erschwerend kommt noch hinzu, dass ich keine Ahnung von Generics habe. Gibt es eigentlich ein gutes Tutorial wie Generics funktionieren?

lg,
jus