Синхронизация потоков и VCL

[zumm]

Приветствую, товарищи! Я хочу попросить у вас помощи в отлове бага. У меня имеется многопоточное приложение, каждый поток которого синхронизирует свой статус с визуальными компонентами на окне VCL. Эти элементы представляют собой 16 картинок (потоков именно 16), при наведении на которые появляется подсказка со статусом. И вот, это приложение иногда виснет. Намертво. Подозреваю, что происходит взаимная блокировка, или, быть может, рассинхронизация, что вероятнее.

Для управления статусами, я использую вот такой класс:

unit ThreadsStatusManager;

interface

...

type
  TThreadStatusMode = (tmNulled, tmStoped, tmPaused, tmStarted);

  TThreadStatus = record
    Title: String;
    Description: String;
    Icon: TThreadStatusMode;
    Image: TImage;
    Status: TThreadStatusMode;
  end;

  TThreadsStatusManager = class
  private
    FHint: TBalloonHint;
    FList: array of TThreadStatus;
    FLock: TRTLCriticalSection;
    FThread: Pointer;
    FFlag: Boolean;
    FTemporary: TThreadStatus;
    FID: Byte;
  protected
    procedure MouseEnter(Sender: TObject);
    procedure MouseLeave(Sender: TObject);

    function GetDefault(const AIndex: Integer): TThreadStatus;
  public
    property List[Index: Integer]: TThreadStatus read GetDefault; default;
    property Temporary: TThreadStatus read FTemporary write FTemporary;
    property Title: String read FTemporary.Title write FTemporary.Title;
    property Description: String read FTemporary.Description write FTemporary.Description;
    property Status: TThreadStatusMode read FTemporary.Status write FTemporary.Status;
    property Icon: TThreadStatusMode read FTemporary.Icon write FTemporary.Icon;

...

    procedure Transaction(const AThread: Pointer); overload;
    procedure Transaction(const AID: Byte); overload;
    procedure Commit;
  end;

implementation

...

procedure TThreadsStatusManager.MouseEnter(Sender: TObject);
var
  Index: Integer;
begin
  EnterCriticalSection(FLock);

  try
  Index := TImage(Sender).Tag;

    with FList[Index] do
    begin
      if Status = tmPaused then
      begin
        FHint.Title := 'Поток приостановлен.';
      end
      else
      begin
        FHint.Title := Title;
      end;

      FHint.Description := Description;
      FHint.ShowHint(TImage(Sender).ClientToScreen(Point(11, 11)));
    end;
  finally
    LeaveCriticalSection(FLock);
  end;
end;

procedure TThreadsStatusManager.MouseLeave(Sender: TObject);
begin
  FHint.HideHint;
end;

function TThreadsStatusManager.GetDefault(const AIndex: Integer): TThreadStatus;
begin
  EnterCriticalSection(FLock);

  try
    Result := FList[AIndex];
  finally
    LeaveCriticalSection(FLock);
  end;
end;

procedure TThreadsStatusManager.Transaction(const AThread: Pointer);
begin
  EnterCriticalSection(FLock);

  with Temporary do
  begin
    Title := 'null';
    Description := 'null';
    Icon := tmNulled;
    Status := tmNulled;
    Image := nil;
  end;

  FFlag := True;
  FThread := AThread;
  FID := TThreadHandler(FThread^).ID;
end;

procedure TThreadsStatusManager.Transaction(const AID: Byte);
begin
  EnterCriticalSection(FLock);

  with Temporary do
  begin
    Title := 'null';
    Description := 'null';
    Icon := tmNulled;
    Status := tmNulled;
    Image := nil;
  end;

  FFlag := True;
  FThread := nil;
  FID := AID;
end;

procedure TThreadsStatusManager.Commit;
var
  ImagePath: String;

  function CompareString(AOld, ANew: String): String;
  begin
    if ANew = 'null' then
    begin
      Result := AOld;
    end
    else
    begin
      Result := ANew;
    end;
  end;
begin
  if FFlag then
  begin
    try
      FFlag := False;

      if FThread = nil then
      begin
        Commit;
      end
      else
      begin
        TThreadHandler(FThread^).CallSynchronize(Commit);
      end;
    finally
      LeaveCriticalSection(FLock);
    end;
  end
  else
  begin
    with FList[FID] do
    begin
      Title := CompareString(Title, Temporary.Title);
      Description := CompareString(Description, Temporary.Description);

      if Temporary.Status <> tmNulled then
      begin
        Status := Temporary.Status;
      end;

      if (Temporary.Icon <> tmNulled) and (Temporary.Icon <> Icon) then
      begin
        Icon := Temporary.Icon;
        ImagePath := ExtractFilePath(ParamStr(0)) + 'Images/';

        case Icon of
          tmStarted:
          begin
            ImagePath := ImagePath + 'ico_started.png';
          end;

...

          end;
        end;

        Image.Picture.LoadFromFile(ImagePath);
      end;
    end;
  end;
end;

initialization
  IsMultiThread := True;

end.

[zumm]

TThreadHandler это классы потоков унаследованные от TThread. Метод CallSynchronize выглядит так:

procedure TThreadHandler.CallSynchronize(AMethod: TThreadMethod);
begin
  inherited Synchronize(AMethod);
end;

Каждому потоку передается указатель на единственный объект
ThreadsStatusManager (Хм, может следует его назвать ThreadStatusesManager?..). Статус меняется внутри потока следующим образом:

with FThreadsStatusManager^ do
begin
  Transaction(@Self);
  Title := 'Somestatus';
  Description := 'Sometext';
  Status := tmStoped;
  Icon := tmStoped;
  Commit;
end;

Для смены статуса из VCL окна все повторяется, только в Transaction передается номер потока (точнее картинки, которая ему соответствует).

Сомневаюсь в реализации перегрузки Transaction, хотя в теории должно работать нормально. Киньте свой опытный взгляд на сей гавнокод, не засела ли тут ошибка?

[zumm]

Немного переусердствовал со ссылками: объекты классов можно было бы передавать и просто так, все равно это указатели. Но виснет оно явно не из за этого...

[zumm]

Выяснилось, что программа виснет на всплывающих подсказках. Видимо, что то не то с критической секцией. Но что?..