1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:

unit lqsThreadSync;

interface

uses
  Windows, Messages, Classes, SysUtils;

type
  PSyncMethod = ^TSyncMethod;
  TSyncMethod = procedure () of object;
  PSyncParamMethod = ^TSyncParamMethod;
  TSyncParamMethod = procedure (pData: Pointer) of object;
  
  TSyncWindow = class(TObject)
  protected
    class procedure SyncWndProc(var Msg: TMessage);
  public
    class procedure SyncMethodCall(const method: TSyncMethod); overload;
    class procedure SyncMethodCall(const method: TSyncParamMethod; param: Pointer); overload;
  end;

  function SyncWindow: HWND;

const
  WM_SYNCMETHODCALL = WM_USER + 1;
  WM_SYNCPARAMMETHODCALL = WM_USER + 2;
  
implementation

var
  _SyncWindow: HWND = 0;
  _PrimaryThreadID: DWord;

function SyncWindow: HWND;
begin
  if _SyncWindow = 0 then
  begin
    if GetCurrentThreadId = _PrimaryThreadID then
      _SyncWindow := AllocateHWnd(TSyncWindow.SyncWndProc)
    else
      raise Exception.Create('SyncWindow must be created in primary thread');
  end;

  Result := _SyncWindow;
end;


////////////////////////////////////////////////////////////////////////////////


{ TSyncWindow }

class procedure TSyncWindow.SyncMethodCall(const method: TSyncMethod);
begin
  SendMessage(SyncWindow, WM_SYNCMETHODCALL, DWord(@@method), 0);
end;


////////////////////////////////////////////////////////////////////////////////


class procedure TSyncWindow.SyncMethodCall(const method: TSyncParamMethod; param: Pointer);
begin
  SendMessage(SyncWindow, WM_SYNCPARAMMETHODCALL, DWord(@@method), DWord(param));
end;


////////////////////////////////////////////////////////////////////////////////


class procedure TSyncWindow.SyncWndProc(var Msg: TMessage);
begin
  Msg.Result := DefWindowProc(_SyncWindow, Msg.Msg, Msg.WParam, Msg.LParam);
  case Msg.Msg of
    WM_SYNCMETHODCALL : PSyncMethod(Msg.WParam)^();
    WM_SYNCPARAMMETHODCALL : PSyncParamMethod(Msg.WParam)^(Pointer(Msg.LParam));
  end;
end;


////////////////////////////////////////////////////////////////////////////////


initialization
  _PrimaryThreadID := GetCurrentThreadId;

finalization
  if _SyncWindow <> 0 then
    DeallocateHWnd(_SyncWindow);
end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

// SetMaxOverallProgress wird direkt aus einem abgespaltenen Thread aufgerufen -> wird also im Kontext dieses Threads ausgeführt -> Synchronisation notwenig
procedure TMainForm.SetMaxOverallProgress(processDataCount: DWord; fileListDataCount: DWord);
begin
  SendMessage(Handle, GM_SETMAXOVERALLPROGRESS, processDataCount, fileListDataCount);
end;

procedure TMainForm.GMSetMaxOverallProgress(var Msg: TMessage);
begin
  TotalProgressBar.Max := (
      Msg.WParam + // ProcessDataCount
      Msg.LParam + // FileListDataCount
    ) * 100;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:

// Diese Methode wird ebenfalls direkt aus dem Thread heraus aufgerufen
procedure TMainForm.UpdateProcessDetails(const details: String; progress: DWord);
begin
  // "details" ist eine Variable vom Typ string -> Delphi kümmert sich selbst um die Speicherverwaltung dieser Strings per Referenzzähler.
  // Ich kann nicht einfach nur einen Zeiger auf diesen String übergeben, da der Referenzzähler sonst nicht erhöht wird und der String freigegeben wird
  // bevor die Message verarbeitet wird. Durch den expliziten Zugriff auf die Adresse des ersten Zeichen des Strings fügt der Compiler automatisch einen Aufruf von
  // UniqueString ein, wodurch ein nagelneuer String mit demselben Inhalt und einem Referenzzähler von 1 erzeugt wird.
  // Details dazu gibts in meinem String-Tutorial unter www.manuel-poeter.de
  PostMessage(Handle, GM_UPDATECURRENTPROCESS, Integer(@details[1]), progress);
end;

procedure TMainForm.GMUpdateCurrentProcess(var Msg: TMessage);
begin
  ProcessDetailsLabel.Caption := PChar(Msg.WParam);
  if Msg.LParam <> -1 then
  begin
    CurrentProgressBar.Position := Msg.LParam;
    TotalProgressBar.Position := ((FActionCount - 1) * 100) + DWord(Msg.LParam);
  end;
end;