Ошибки расчета цветов пикселей при использовании многопоточности в Delphi: поиск и исправление

Delphi , Компоненты и Классы , TImage и TImageList

В данной статье мы рассмотрим проблему, возникающую при параллельном расчете цветов пикселей визуализации множества Мандельброта в Delphi. Мы обсудим причину возникновения ошибок и предложим несколько решений, включая использование критических секций и промежуточных буферов для обеспечения корректной работы многопоточной реализации.

Описание проблемы

При попытке параллельного расчета цветов пикселей множества Мандельброта в Delphi, автор заметил, что некоторые пиксели получают неверные цвета. Эти ошибки возникают только при использовании нескольких потоков, и их расположение и количество изменяются при каждом запуске программы. При использовании одного потока все работает корректно, что указывает на то, что проблема связана с многопоточностью.

Причина проблемы

Основная проблема заключается в том, что несколько потоков одновременно пытаются записать данные в PaintBox1.Canvas.Pixels, что приводит к неожиданным поведениям и ошибкам. Объект PaintBox1.Canvas не является потокобезопасным, и прямое обращение к Pixels из нескольких потоков может привести к нестабильному поведению.

Решение с использованием критических секций

Одним из способов решения проблемы является использование критических секций для защиты доступа к PaintBox1.Canvas.Pixels. Это позволяет предотвратить одновременную запись данных из нескольких потоков.

Пример кода, использующего критическую секцию:

unit Mandelbrot;
{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}
interface
uses
{$IFnDEF FPC}
  Windows,
{$ELSE}
  LCLIntf, LCLType,
{$ENDIF}
  SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,
  MTProcs;

type
  { TForm1 }
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Edit3: TEdit;
    Button1: TButton;
    Panel1: TPanel;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    cs: TRTLCriticalSection;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation
{$IFnDEF FPC}
  {$R *.dfm}
{$ELSE}
  {$R *.lfm}
{$ENDIF}

function RGB2TColor(const R, G, B: byte): integer;
begin
  Result := R + G shl 8 + B shl 16;
end;

procedure ColourSinglePixel(Index: PtrInt; Data: Pointer; Item: TMultiThreadProcItem);
var
  x, y, xx, yy, c, c1, c2: double;
  z, i, j, k: integer;
  myColor: TColor;
  r, g, b: byte;
begin
  c := PDouble(Data)^;
  z := 0;
  i := ((Index - 1) div Form1.PaintBox1.Height) + 1;
  j := ((Index - 1) mod Form1.PaintBox1.Height) + 1;
  x := i / Form1.PaintBox1.Width;
  y := j / Form1.PaintBox1.Height;
  c1 := c * x;
  c2 := c * y;
  k := -1;
  while (z < 65536) and (x < 4) and (y < 4) do
  begin
    xx := x * x - y * y + c1;
    yy := 2 * y * x + c2;
    x := xx;
    y := yy;
    z := z + 1;
  end;
  if z >= 256 then
  begin
    k := z div 256;
    r := z div (k + 10);
    g := z div (k + 15);
    b := z div (k + 20);
  end
  else
  begin
    r := z div 2;
    g := z div 3 + a div 2;
    b := z div 5 + b div 3;
  end;
  myColor := RGB2TColor(r, g, b);
  try
    EnterCriticalSection(cs);
    Form1.PaintBox1.Canvas.Pixels[i, j] := myColor;
  finally
    LeaveCriticalSection(cs);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  c: double;
  pc: PDouble;
begin
  c := StrToFloat(Edit3.Text);
  pc := @c;
  InitCriticalSection(cs);
  ProcThreadPool.MaxThreadCount := StrToInt(Edit1.Text);
  try
    ProcThreadPool.DoParallel(@ColourSinglePixel, 1, PaintBox1.Height * PaintBox1.Width, pc);
  finally
    DoneCriticalSection(cs);
  end;
end;

Решение с использованием промежуточного буфера

Другим подходом является использование промежуточного буфера для хранения результатов расчетов в каждом потоке. После завершения расчетов результаты из промежуточного буфера копируются в PaintBox1.Canvas.

Пример кода, использующего промежуточный буфер:

unit Mandelbrot;
{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}
interface
uses
{$IFnDEF FPC}
  Windows,
{$ELSE}
  LCLIntf, LCLType,
{$ENDIF}
  SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,
  MTProcs;

type
  TMandelGraphic = record
    c: double;
    bm: TBitMap;
  end;
  PMandelGraphic = ^TMandelGraphic;

  { TForm1 }
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Edit3: TEdit;
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation
{$IFnDEF FPC}
  {$R *.dfm}
{$ELSE}
  {$R *.lfm}
{$ENDIF}

function RGB2TColor(const R, G, B: byte): integer;
begin
  Result := R + G shl 8 + B shl 16;
end;

procedure ColourOneLine(Index: PtrInt; Data: Pointer; Item: TMultiThreadProcItem);
type
  Trgb24 = packed record
    b, g, r: byte;
  end;
  Trgb24scanline = array [word] of Trgb24;
  Prgb24scanline = ^Trgb24scanline;

var
  x, y, xx, yy, c, c1, c2: double;
  z, i, k: integer;
  r, g, b: byte;
  line: Prgb24scanline;
  pmg: PMandelGraphic;
begin
  pmg := PMandelGraphic(Data);
  c := pmg^.c;
  line := pmg^.bm.ScanLine[Index];
  for i := 0 to pmg^.bm.Width - 1 do
  begin
    x := (i + 1) / Form1.PaintBox1.Width;
    y := (Index + 1) / Form1.PaintBox1.Height;
    c1 := c * x;
    c2 := c * y;
    z := 0;
    while (z < 65536) and (x < 4) and (y < 4) do
    begin
      xx := x * x - y * y + c1;
      yy := 2 * y * x + c2;
      x := xx;
      y := yy;
      z := z + 1;
    end;
    if z >= 256 then
    begin
      k := z div 256;
      r := z div (k + 10);
      g := z div (k + 15);
      b := z div (k + 20);
    end
    else
    begin
      r := z div 2;
      g := z div 3 + a div 2;
      b := z div 5 + b div 3;
    end;
    line^[i].R := r;
    line^[i].G := g;
    line^[i].B := b;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  c: double;
  MandelGraphic: TMandelGraphic;
  pmg: PMandelGraphic;
begin
  c := StrToFloat(Edit3.Text);
  try
    MandelGraphic.c := c;
    MandelGraphic.bm := TBitMap.Create;
    MandelGraphic.bm.PixelFormat := pf24bit;
    MandelGraphic.bm.Width := PaintBox1.Width;
    MandelGraphic.bm.Height := PaintBox1.Height;
    pmg := @MandelGraphic;
    ProcThreadPool.MaxThreadCount := StrToInt(Edit1.Text);
    ProcThreadPool.DoParallel(@ColourOneLine, 0, PaintBox1.Height - 1, pmg);
    PaintBox1.Canvas.Draw(0, 0, MandelGraphic.bm);
  finally
    MandelGraphic.bm.Free;
  end;
end;

Заключение

В данной статье мы рассмотрели проблему, возникающую при параллельном расчете цветов пикселей множества Мандельброта в Delphi. Мы обсудили причины возникновения ошибок и предложили несколько решений, включая использование критических секций и промежуточных буферов для обеспечения корректной работы многопоточной реализации. Эти решения помогут избежать неожиданных поведений и ошибок при использовании многопоточности в Delphi.

Для дальнейшего чтения и изучения рекомендуем ознакомиться с документацией по многопоточности в Delphi и Lazarus, а также с материалами по графическому программированию на Pascal.

Создано по материалам из источника по ссылке.

Контекст статьи описывает проблему параллельного расчета цветов пикселей множества Мандельброта в Delphi, связанную с непотокобезопасностью доступа к объекту PaintBox1.Canvas, и предлагает решения с использованием критических секций и промежуточных буфер

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: TImage и TImageList ::