Поток и событие класса, затрагивающее VCL-компоненту

Пишу в Delphi 2010.
Есть TVirtualStringTree.
Есть класс TExample, порожденный от TList<T>, где данные TVirtualStringTree и хранятся.
Так же TExample описанно событие OnNotify, чтоб дерево показывало данные.

procedure TExample.OnNotifyTaskCommList(Sender: TObject;
  const Item: PRecord; Action: TCollectionNotification);
begin
  if Assigned(FVST) then
    FVST.RootNodeCount := self.Count; // в лоб
//TDoMainThread.Create(ChangeNodeCount).Start; // Версия №1
//SendMessage(FormHandle, MESS_1, WPARAM(AControl), self.Count); // Версия №2

end;

Но дело в том, что с TExample работает поток.
Т.к. TExample не VCL, то и Synchronize я не делаю в том потоке.
НО!
Ведь в событии дергается свойство VCL компонента.
Понимаю, что надо обойти это, но не хочется вешать Synchronize на процедуру добавления, удаления записи. Всего то надо изменить кол-во нод.
Появились идеи:
1) использовать дополнительный класс от TThread с пустым Execute.
Типо такого:

constructor TDoMainThread.Create(Event: TNotifyEvent);
begin
  inherited Create(True);
  FreeOnTerminate := true;
  Priority        := tplowest;
  Synchronize(self, procedure begin
    Event(self);
  end);
end;

где Event - это процедура изменения нод. И только она выполнится в главном потоке.
2) использовать сообщения, но для этого классу надо будет еще передать и хэндл формы, и номер сообщения. Прям под зависимость попадаем.

Как лучше исполнить этот обход?


Ответы (1 шт):

Автор решения: DelphiCoder

В общем, ничего лучшего пока не придумал, как сделать так:

procedure TExample.OnNotifyTaskCommList(Sender: TObject;
  const Item: PRecord; Action: TCollectionNotification);
begin
  if (Action in [cnRemoved, cnExtracted]) and Assigned(Item) then
    DisposeAndNill(Item);
  if Assigned(FVST) then
    TThread.Synchronize(nil, ChangeNodeCount); // даже не создаю поток, а использую его метод
end;

Upd: Залез в класс TVirtualStringTree и добавил там методы

  private
    // [ME_COMMENT] Эти ф-ии я ввел сам
    procedure RootNodeCount_MSG(var Msg: TMessage);  message MESS_SET_ROOTNODECOUNT;
    procedure ChileNodeCount_MSG(var Msg: TMessage); message MESS_SET_CHILDNODECOUNT;

  public
    // [ME_COMMENT] Эти ф-ии я ввел сам
    procedure RootNodeCount_SM(Count: Cardinal);
    procedure ChileNodeCount_SM(Node: PVirtualNode; Count: Cardinal);

Добавил константы:

Const
// [ME_COMMENT] добавил сам для
  MESS_SET_ROOTNODECOUNT  = WM_USER + 1;
  MESS_SET_CHILDNODECOUNT = WM_USER + 2;

И реализация:

procedure TVirtualStringTree.RootNodeCount_MSG(var Msg: TMessage);  // MESS_SET_ROOTNODECOUNT;
begin
  RootNodeCount := Msg.LParam;
end;

procedure TVirtualStringTree.ChileNodeCount_MSG(var Msg: TMessage); // MESS_SET_CHILDNODECOUNT;
begin
  ChildCount[PVirtualNode(Msg.WParam)] := Msg.LParam;
end;

procedure TVirtualStringTree.RootNodeCount_SM(Count: Cardinal);
begin
  SendMessage(Handle, MESS_SET_ROOTNODECOUNT, 0, Count);
end;

procedure TVirtualStringTree.ChileNodeCount_SM(Node: PVirtualNode; Count: Cardinal);
begin
  SendMessage(Handle, MESS_SET_CHILDNODECOUNT, WPARAM(Node), Count);
end;

Но лезть в чужой класс - это в крайнем случае и неочень правильно.

upd: Попытался решить вопрос с помощью хелпер-а

const
  MESS_SET_ROOTNODECOUNT  = WM_USER + 100;
type
THelperForVST = class helper for TVirtualStringTree
  private
    procedure RootNodeCount_MSG(var Msg: TMessage);  message MESS_SET_ROOTNODECOUNT;
  public
    procedure RootNodeCount_SM(Count: Cardinal);
  end;

//--------------------------------
procedure THelperForVST.RootNodeCount_MSG(var Msg: TMessage);  // MESS_SET_ROOTNODECOUNT;
begin
  RootNodeCount := Msg.LParam;
  TopNode       := GetLast();
end;
//--------------------------------
procedure THelperForVST.RootNodeCount_SM(Count: Cardinal);
begin
  SendMessage(Handle, MESS_SET_ROOTNODECOUNT, 0, Count);
end;
//--------------------------------

Метод появился. Передаю сообщение, а реакции нет. В дебагере даже брекпоинт на RootNodeCount_MSG(var Msg: TMessage) нельзя поставить. Короче, нельзя так сделать для хэлпера.

→ Ссылка