Поток и событие класса, затрагивающее 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 шт):
В общем, ничего лучшего пока не придумал, как сделать так:
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) нельзя поставить. Короче, нельзя так сделать для хэлпера.