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.

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.