Voronoi-Diagramme

[timog]

Dieser Ansatz dürfte langsamer als die Polygon Methode von RosettaCode.org sein, aber sie tut's - glaube ich

Delphi-Quellcode:

procedure TformMain.DrawVoronoi(AImage: TImage; const AP, ACells: Integer; ADistanceType: TDistanceType);
var
  px, py: array of Integer;
  LColor: array of TColor;
  LImg: TBitmap;
  n, i, x, y, j: Integer;
  d1, d2: Double;

  function GetDistance(const x1, x2, y1, y2, AP: Integer; const ADistanceType: TDistanceType): Double;
  begin
    case ADistanceType of
      dtManhattan: Result := Abs(x1 - x2) + Abs(y1 - y2);
      dtMinkovski: Result := Power(Power(Abs(x1 - x2), AP) + Power(Abs(y1 - y2), AP), (1 / AP));
    else
      Result := Sqrt((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2)); // dtEuclidian
    end;
  end;

begin
  LImg := nil;
  try
    LImg := TBitmap.Create;
    LImg.Width := AImage.Width;
    LImg.Height := AImage.Height;

    SetLength(px, ACells);
    SetLength(py, ACells);
    SetLength(LColor, ACells);

    // Zufällige Zellen/Sites erzeugen
    for i := 0 to ACells - 1 do
    begin
      px[i] := RandomRange(1, AImage.Width-1);  // nicht direkt auf dem Rand
      py[i] := RandomRange(1, AImage.Height-1);
      LColor[i] := GenerateRandomColor;
    end;

    // In x und y Richtung die Entfernungen ermitteln, Farbe der am nächsten liegenden Zelle bestimmen
    for x := 0 to AImage.Width - 1 do
    begin
      for y := 0 to AImage.Height - 1 do
      begin
        n := 0;
        for i := 0 to ACells - 1 do
        begin
          d1 := GetDistance(px[i], x, py[i], y, AP, ADistanceType);
          d2 := GetDistance(px[n], x, py[n], y, AP, ADistanceType);
          if d1 < d2 then n := i;
        end;
        LImg.Canvas.Pixels[x, y]:=LColor[n];
      end;
    end;

    // Zelle/Site zeichnen
    for j := 0 to ACells - 1 do
    begin
      LImg.Canvas.Pen.Color := clBlack;
      LImg.Canvas.Brush.Color := clBlack;
      LImg.Canvas.Rectangle(px[j] - 2, py[j] - 2, px[j] + 2, py[j] + 2);
    end;

    AImage.Picture.Assign(LImg);
  finally
    LImg.Free;
  end;
end;