Проезд по памяти в VCL

procedure TControlCanvas.CreateHandle;
...
 
  if FControl = nil then
    inherited CreateHandle
  else
  begin
    // Creation of a window could trigger messages that require
    // the canvas to have a valid handle. Prevents creating two DCs.
    if (FDeviceContext = 0) and (FControl is TWinControl) then
      TWinControl(FControl).HandleNeeded;
    if FDeviceContext = 0 then
    begin
      with CanvasList.LockList do
      try
        if Count >= CanvasListCacheSize then FreeDeviceContext;
        FDeviceContext := FControl.GetDeviceContext(FWindowHandle);
        if (IndexOf(Self) < 0) then {V} // - это я добавил
         Add(Self);
      finally
        CanvasList.UnlockList;
      end;
    end;
    Handle := FDeviceContext;
    UpdateTextFlags;
  end;
...
end;

Без этого падает тут:

// Free the first available device context
procedure FreeDeviceContext;
var
  I: Integer;
begin
  with CanvasList.LockList do
  try
    for I := 0 to Count-1 do
      with TControlCanvas(Items[I]) do
        if TryLock then
        try
          FreeHandle; // - тут
          Exit;
        finally
          Unlock;
        end;
  finally
    CanvasList.UnlockList;
  end;
end;

Или тут:

procedure FreeDeviceContexts;
var
  I: Integer;
begin
  with CanvasList.LockList do
  try
    for I := Count-1 downto 0 do
      with TControlCanvas(Items[I]) do
        if TryLock then
        try
          FreeHandle; // - тут
        finally
          Unlock;
        end;
  finally
    CanvasList.UnlockList;
  end;
end;

Как повезёт.

Что в общем-то и понятно - одна канва может несколько раз попасть в CanvasList.

Сейчас попробую найти рафинированный сценарий повторения ошибки.

Поправил я эту ошибку 18 апреля 2002 года. 11-ть лет назад. Я тогда искал её ДВЕ НЕДЕЛИ. Выпуск даже затягивался. Весь мозг себе сломал. В Delphi XE3 - она до сих пор присутствует.

Вот в частности для этого и нужны автоматические тесты. Чтобы за повторяемостью таких непростых ошибок следить.

Сегодня эту ошибку под XE3 показали именно - автоматические тесты.