Send string data from Thread to main form

Question

In Dephi, I create a thread, like this, which will send message to main form from time to time

Procedure TMyThread.SendLog(I: Integer);
Var
  Log: array[0..255] of Char;
Begin
  strcopy(@Log,PChar('Log: current stag is ' + IntToStr(I)));
   PostMessage(Form1.Handle,WM_UPDATEDATA,Integer(PChar(@Log)),0);
End;

procedure TMyThread.Execute;
var
  I: Integer;
begin
  for I := 0 to 1024 * 65536 do
  begin
    if (I mod 65536) == 0 then
    begin
      SendLog(I);
    End;
  End;
end;

where WM_UPDATEDATA is a custom message, defined below:

const
  WM_UPDATEDATA = WM_USER + 100;

And in main form, it will do as follows to update the list:

procedure TForm1.WMUpdateData(var msg : TMessage);
begin
  List1.Items.Add(PChar(msg.WParam));
end;

However, as the Log string sent to the main form is a local variable, which will be destroyed after calling SendLog. While TForm1.WMUpdateData process the message asynchronously, so it is possible that when it is invoked, the Log string has already been destroyed. How to solve this problem?

I think maybe I can allocate the string space in a global system space, and then pass it to the message, then after TForm1.WMUpdateData processes the message, it can destroy the string space in the global space. Is that a workable solution? How to implement this?

Thanks

Answer 1

In addition to the fact that you are posting a local variable, the TWinControl.Handle property is not thread-safe, either. You should use the TApplication.Handle property instead, or use AllocateHWnd() to create your own window.

You do need to dynamically allocate the string on the heap, post that pointer to the main thread, and then free the memory when you are done using it.

For example:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
  // or use a TApplicationEvents component...
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Application.OnMessage := nil;
end;

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
  S: PString;
begin
  if Msg.Message = WM_UPDATEDATA then
  begin
    S := PString(msg.LParam);
    try
      List1.Items.Add(S^);
    finally
      Dispose(S);
    end;
    Handled := True;
  end;
end;

procedure TMyThread.SendLog(I: Integer);
var
  Log: PString;
begin
  New(Log);
  Log^ := 'Log: current stag is ' + IntToStr(I);
  if not PostMessage(Application.Handle, WM_UPDATEDATA, 0, LPARAM(Log)) then
    Dispose(Log);
end;

Alternatively:

var
  hLogWnd: HWND = 0;

procedure TForm1.FormCreate(Sender: TObject);
begin
  hLogWnd := AllocateHWnd(LogWndProc);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if hLogWnd <> 0 then
    DeallocateHWnd(hLogWnd);
end;

procedure TForm1.LogWndProc(var Message: TMessage);
var
  S: PString;
begin
  if Message.Msg = WM_UPDATEDATA then
  begin
    S := PString(msg.LParam);
    try
      List1.Items.Add(S^);
    finally
      Dispose(S);
    end;
  end else
    Message.Result := DefWindowProc(hLogWnd, Message.Msg, Message.WParam, Message.LParam);
end;

procedure TMyThread.SendLog(I: Integer);
var
  Log: PString;
begin
  New(Log);
  Log^ := 'Log: current stag is ' + IntToStr(I);
  if not PostMessage(hLogWnd, WM_UPDATEDATA, 0, LPARAM(Log)) then
    Dispose(Log);
end;

Answer 2

If you have D2009 or later version, there is another way to post messages to your main form. TThread.Queue is an asynchronous call from a thread, where a method or procedure can be executed in the main thread.

The advantage here is that the frame to set up the message passing is less complex. Just pass your callback method when creating your thread. No handles and no explicit handling of string allocation/deallocation.

Type
  TMyCallback = procedure(const s : String) of object;

  TMyThread = class(TThread)
    private
      FCallback : TMyCallback;
      procedure Execute; override;
      procedure SendLog(I: Integer);
    public
      constructor Create(aCallback : TMyCallback);
  end;

constructor TMyThread.Create(aCallback: TMyCallback);
begin
  inherited Create(false);
  FCallback := aCallback;
end;

procedure TMyThread.SendLog(I: Integer);
begin
  if not Assigned(FCallback) then
    Exit;
  Self.Queue(  // Executed later in the main thread
    procedure
    begin
      FCallback( 'Log: current stag is ' + IntToStr(I));
    end
  );
end;

procedure TMyThread.Execute;
var
  I: Integer;
begin
  for I := 0 to 1024 * 65536 do
  begin
    if ((I mod 65536) = 0) then
    begin
      SendLog(I);
    End;
  End;
end;

---

procedure TMyForm.TheCallback(const msg : String);
begin
  // Show msg
end;

procedure TMyForm.StartBackgroundTask(Sender : TObject);
begin
  ... 
  FMyThread := TMyThread.Create(TheCallback);
  ...
end;