example4

// Original algorithms by slacky, optimized by Janilabo

const
  FLOODFILL_8WAY = True; // Fills TPA bounds (polygon outlines)
  FLOODFILL_COLOR = 65535; // ..with this color.

type
  TFloodFill = (ff4Way, ff8Way);

procedure __TPAFloodFill(var store: array of TBoolArray; skip: array of TBoolArray; X, Y, W, H: Integer; method: TFloodFill);
begin
  if ((X > -1) and (Y > -1) and (X < W) and (Y < H)) then
    if not skip[X][Y] then
      if not store[X][Y] then
      begin
        store[X][Y] := True;
        __TPAFloodFill(store, skip, (X - 1), Y, W, H, method);
        __TPAFloodFill(store, skip, (X + 1), Y, W, H, method);
        __TPAFloodFill(store, skip, X, (Y - 1), W, H, method);
        __TPAFloodFill(store, skip, X, (Y + 1), W, H, method);
        if (method = ff8Way) then
        begin
          __TPAFloodFill(store, skip, (X - 1), (Y - 1), W, H, method);
          __TPAFloodFill(store, skip, (X + 1), (Y + 1), W, H, method);
          __TPAFloodFill(store, skip, (X + 1), (Y - 1), W, H, method);
          __TPAFloodFill(store, skip, (X - 1), (Y + 1), W, H, method);
        end;
      end;
end;

{==============================================================================]
  Explanation: !
[==============================================================================}
function TPAFloodFill(TPA: TPointArray; start: TPoint; method: TFloodFill): TPointArray;
var
  i, l, r, X, Y, W, H: Integer;
  b: TBox;
  store, skip: array of TBoolArray;
  o: Boolean;
begin
  l := Length(TPA);
  if (l > 0) then
  begin
    b := IntToBox(TPA[0].X, TPA[0].Y, TPA[0].X, TPA[0].Y);
    o := ((start.X = TPA[0].X) and (start.Y = TPA[0].Y));
    if (l > 1) then
    for i := 1 to (l - 1) do
    begin
      if not o then
        o := ((start.X = TPA[i].X) and (start.Y = TPA[i].Y));
      if (TPA[i].X < b.X1) then
        b.X1 := TPA[i].X
      else
        if (TPA[i].X > b.X2) then
          b.X2 := TPA[i].X;
      if (TPA[i].Y < b.Y1) then
        b.Y1 := TPA[i].Y
      else
        if (TPA[i].Y > b.Y2) then
          b.Y2 := TPA[i].Y;
    end;
    if ((start.X >= b.X1) and (start.Y >= b.Y1) and (start.X <= b.X2) and (start.Y <= b.Y2)) then
    begin
      W := ((b.X2 - b.X1) + 1);
      H := ((b.Y2 - b.Y1) + 1);
      SetLength(store, W);
      SetLength(skip, W);
      for i := 0 to (W - 1) do
      begin
        SetLength(skip[i], H);
        SetLength(store[i], H);
      end;
      if o then
      begin
        for X := 0 to (W - 1) do
          for Y := 0 to (H - 1) do
            skip[X][Y] := True;
        for i := 0 to (l - 1) do
          skip[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] := False;
      end else
        for i := 0 to (l - 1) do
          skip[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] := True;
      __TPAFloodFill(store, skip, (start.X - b.X1), (start.Y - b.Y1), W, H, method);
      SetLength(skip, 0);
      SetLength(Result, (W * H));
      for Y := 0 to (H - 1) do
        for X := 0 to (W - 1) do
          if store[X][Y] then
          begin
            Result[r] := Point((X + b.X1), (Y + b.Y1));
            Inc(r);
          end;
    end;
  end;
  SetLength(Result, r);
end;

//******* DIRTY EXAMPLE BELLOW: *******//
procedure SetPixels(bmp: Integer; TPA: TPointArray; color: Integer);
var
  a, z, w, h: Integer;
begin
  z := High(TPA);
  if (z > -1) then
  begin
    GetBitmapSize(bmp, w, h);
    for a := 0 to z do
      if ((TPA[a].X >= 0) and (TPA[a].Y >= 0) and (TPA[a].X < w) and (TPA[a].Y < h)) then
        FastSetPixel(bmp, TPA[a].X, TPA[a].Y, color);
  end;
end;

function GetBitmapColorTPA(bmp: Integer; color: Integer): TPointArray;
var
  w, h, x, y, r: Integer;
begin
  try
    GetBitmapSize(bmp, w, h);
  except
  end;
  if ((w > 0) and (h > 0)) then
  begin
    SetLength(Result, (w * h));
    for y := 0 to (h - 1) do
      for x := 0 to (w - 1) do
        if (FastGetPixel(bmp, x, y) = color) then
        begin
          Result[r] := Point(x, y);
          Inc(r);
        end;
  end;
  SetLength(Result, r);
end;

procedure Setup;
var
  shape, TPA: TPointArray;
  bmp, w, h, t: Integer;
  pt: TPoint;
begin
  bmp := BitmapFromString(490, 361, 'meJzt21mSKzkOBdHc/6ajPmSm' +
        '0ouRwQG4APz8dlcKBD1ZyjbrbQMAAAAAAAAAAAAAAAAAAAAAAAAAA' +
        'AAAAAAAAAAAAAAAqPsD1qNq5GNcNZHDC1UjH7Oqrzp3HAAVGGdG1T' +
        'Dgnpn7AKiA1xv5uGfmPgAq4PVGPu6ZuQ+ACni9kY97Zu4DoAJeb+T' +
        'jnpn7AKiA1xv5uGfmPgAq4PVGPu6ZuQ+ACni9kY97Zu4DoAJeb+Tj' +
        'npn7AKiA1xv5uGfmPgAq4PVGPu6ZuQ+ACni9kY97Zu4DoAJeb+Tjn' +
        'pn7AKiA1xv5uGfmPgAq4PVGPu6ZuQ+ACni9kY97Zu4DoAJeb+Tjnp' +
        'n7AKiA1xv5uGfmPgAq4PVGPu6ZuQ+ACni9kY97Zu4DoAJeb+Tjnpn' +
        '7AKiA1xv5uGfmPgAq4PVGPu6ZuQ+ACni9kY97Zu4DoAJeb+Tjnpn7' +
        'AKiA1xv5uGfmPgAq4PVGPu6ZuQ+ACni9kY97Zu4DoAJeb+Tjnpn7A' +
        'KiA1xv5uGfmPgAq4PVGPu6ZuQ+ACni9kY97Zu4DpPRnxfugrXi9E6' +
        'DqHfdp3QeIzizpdt4rOWE8mOweovCL95L3Sk64D+Y+QDjr4lz3k90' +
        'ZT6Jz8CjWtbfuJ7tzn8R9AH3KaSnPdpwz68dFpFyO8mzHOV0+WmQA' +
        'TfrlXNGcPPfHRaHZRgvNyd0X5T6AFKk2ZlE4VLVfKykKAUyncCj31' +
        'bkP4E4hAzNehzVeY7Jb60DV+aoWHMBRkbavWB7feKVFbvAUVWetWn' +
        'AAe5XbvrJ6J7zeq1H1UbKqBQewRN6PFq2I13sdqn6Uo2rBAQyQd4e' +
        '5S+P1no6qO4SuWnCApSh80KwF8npPRNWDglYtOMAi5D3X4D55vaeg' +
        '6rliVS04wHQUvk73bnm9B1H1OlGqFhxgIgq30bFnXu9uVG1Dv2rBA' +
        'WahcGOvFs7r3YeqjSlXLTjAOAp31Lh8Xu+3qNqRZtWCA4ygcBGPF8' +
        'Hr3Y6qRahVfeQ+QDcKV3NzI7zejahajU7VR+4DdODLiayrq+H1fkT' +
        'VskSqvhrMcYC3KFzf8Y54ve9RtT73qq9GchzgFSKP4vh1hdf7ClVH' +
        '4Vv11TyOA7QT2Rja8Xo/oupweL1f0VkX3nK5uxCdUHVcInenX47Cl' +
        'jDI+BL1a6HqBNwvUbwf9/1gFsurFA+GqtPwvUrlhIg8GbMLVW6Gqp' +
        'NxvFDZiog8JZtrlc2GqlPyulbNkIg8MYPL1SyHqhNzuVzBlog8vdV' +
        'XLBgPVadnf8VqORF5EUsvWq0fqi7C+KKliiLyUtZdt1RCVF2K5XVL' +
        'RUXk1ZR6vb0HgZGCrzeR17Ti3nVCouqabO5dJC3+uixrxdWLhETVZ' +
        'dlcvUJaRF7c9AAUWqLq4gwCUKiLyJH49fYdA47Sv958RcE2OwP3nK' +
        'gaW4H/XwOR4yPl6+04AxQkfr2JHL9m9UDV0LGuB8fM+OsSO7OSoGr' +
        'oWJeEQucunw5NaV5vl0+HJl5vVMDrjXySvd5EjivjbVA11Kxog86h' +
        'htcb+aR5vf9+GH809I3nQdVQsyIP386NPxdRhH69jT8XUfB6owJeb' +
        '+TD640KeL2RT4LXm8ivsJZfI51QtQ7W8mtuJ3Qu4u+H9ywSeL0ToO' +
        'odXu9k/g68J5LA6x0aVZ/i9c7kGDmb+eD1jouqr/B6p7Frm8384vU' +
        'Oiqpv8HoncPq1hM384vUOh6of8XpHdxr5xmb+xesdC1W34PUO7bTw' +
        '3X/kMpgaXu9AqLrRitfbxZT5A3k8ftnNnBrZhlHBZ6bvQdzj8ctu5' +
        'tT0bRhlfTBr/hBazl5zM1cGt2EU8cHcJYhrOXvNzVyJvo3o83do/O' +
        '0uuJkbsbYRa9opqLpD9G1En/+VV1/MSm3mUaxtxJp2EFV3i76N6PO' +
        '3exX5VmkzLWJtI9a0I6h6RPRtRJ+/0avCd//I0sGiiLWNWNN2o+pB' +
        '0bcRff5Hb7+cHP/BdbMFEmsbsabtQNVTRN9G9Pnv9RW++2dXDBZOr' +
        'G3EmvYtqp4lwTYSHOGo+8vJ8SdMny2ciKuIOPMjqp4oxypynOLXeO' +
        'RbxrV0i7iKiDPfo+q5cqwixym+xgv//TmzpgotYiERZ75B1dPZF7L' +
        'i42aF4W7Kl5PdT5syWGgGeVD1DapewT6Pv4PpP3nWD7S3IvLQC5nF' +
        '5umm6lNUvYj9Ko6dzxog+rVO/92PvpCJ7F9vqv6g6nUcX+/tovlZP' +
        'zyQ6b/yux876wcGZbAHqj6i6qW89nD80FnBR7zZRZFvMbexgs0eqP' +
        'oXVa/m+3qffu5g8IuCWWfpwLFWsYhZElT9RdWrOSbR8rndwUe53O7' +
        'f5Y6PWPHDozBbAlVvVG3Fdwkd3bZXoX+/BpFvEfawmvEGqJqqDbhv' +
        'oGOA9uANEhphNp7yEgzYZ0DVVL2aQgYjA7QE737AUy2/pCs+bvUHa' +
        'bI/PlVT9Woixx+c4bT27w+0zKmR/UhqG7DkFQBVm32izcdJ0Qlg1h' +
        'hXwQue1HgYkePbc7x6qjb7XLNPFKFz9duCW9Ds3HESheO7cDw4VZt' +
        '9tOWHKlA7+KJhdGoX+XT7j3bkfmqqtvl0+492JHjq1SM5Bu/+K7ZJ' +
        '3vhq7jvfqNpqBpdPd+G+81NmIxkHrxD5Vq9zhZ1vVL2Y+wDGFHZ+x' +
        'XKqq9rnDqCzbZExbOisfaPqlUTGsKGz9lMusy0Kft3vzuA83oMsJ7' +
        'X2japX0plkNam1n/Idb2LwapFv3rs1o7b2zXvzVJ2A2tqvKEw4GLz' +
        'mqgVHmk5z8xtVLyM40nSamz8lNefb4Dt+KcxoTjWR7OY3seVTdSCy' +
        'mz8lOOpN7b9zKke+SS52IuXNb5LLp2p9ypu/IjvtffDiexYfr1uI5' +
        'W9UvYb4eN1CLP+U/szhIt8ibLVDiM1/6M9J1SJCbP5KoMmjRL6F2m' +
        'qLQJv/iDiq/sAhhmwXaPM3Qg+vKXoSv4JGHmvaEMI1cCNo1UcJjqA' +
        'mx0r/DrwneiHizOJyrDR01Uc5TiElwUqjFx53clkJVhq96lOZzqIg' +
        'dB5pvpyEHl5Q6B7SVH2U70S+gu4zWeE5TqEj6D6TVX2U9Vxewu0zZ' +
        'eGZzqIg3D5TVn0q9+mMBarlWHiIsRslO46vQHnkrvqowhnNhFhmhc' +
        'KznstFiGVWqPqozkkNiC+zTuG5T2dMfJl1qj5V7bzraMZzmrfakNN' +
        'VOKMNzWBqVn1U9uDTqW2ycuGlDruU2iYrV31U/PgTiWySvDeZu0hA' +
        'ZJNUfYU9TOFb1FXeZW+28tknompxLGQK+zXetM1tsocpqFocm5nCZ' +
        'o33bXOPX2xjCqrWx37GrcuMtvuwmXFUrY91jZu4w5awua9HbGkcVe' +
        'tjb+P6dtieNHf0FhsbR9UhsMNBHcUS9moscBBVh8BWBxG2IFY6iKp' +
        'DYMmDSFoQex5E1VGw+RFsTxP3MoLtRcG/OkewOk1UPYLVRUHnI1id' +
        'JqoeweoC4bK6sTpZXE03VhcIX1S6sTdZVN2NvQVC593Ymyyq7sbeY' +
        'uG++vBEKONq+lB1LNxXN1Yni6vpxuoC4bJG/P3wngX/41JGUHUgXN' +
        'MgUhfEjQyi6hC4pnF8XVHDdYyjan1c0CxsUgd3MQubFMftzELqOri' +
        'IWahaGbczEX9viuAWJqJqWdzLdKzUHVcwHSvVxKVMx9cVdyx/OqoW' +
        'xI0swmIdsfxFWKwUrmMdduuFza/DbqVwF+vw96YXdr4OVevgIlZjw' +
        '/bY+WpsWAG3YICvK8bYtgGqVsD+bZC6JVZtg6odsXxLbNsGe7bEtl' +
        '2wdnv8vbka67VH1cbYtiOWvwiLdcTyzbBnX3xdWYF9+qJqA6xXBKl' +
        'PxCZFUPU67FYK1zEFa5TCdazAVgXx9+YgtieIqqdjmbJIvRt7k0XV' +
        's7BGcXxd6cC6xFH1OBYYBTfVjl1FwU11Y3WxcF8t2FIs3FcflhYOf' +
        '28+YjnhUPVb7CouUr/CWuKi6kYsKjq+rhyxkOio+hH7SYOr/GIVaX' +
        'CVN9hMJqT+wRIyoepT7CQf/t6sfPasqHqHbSRW9nLLHrwCLveDPaR' +
        'X8OtKtfMWVLDqo9DHDz28sVKphz5p6OGNlap6J/TB+ZfvW0XWFfqM' +
        'VP1WzXVFP/Xfv7zHiSH9xqKfjqo7VNtYgsP+HXhPFEbWjSU4F1V3q' +
        '7OxBMc8dh79RJZSLi3Bcah6RIWl5Tjd7zVVuLUVMi0tx0Goelzipa' +
        'U52vEg1N4i5Ve7NGeh6j4pq97JdLTTs+S+vhHHvNNsKf1Zkt3XRIm' +
        'rPsp0tKubSn+Jr1TIO9OJqLpFhap3kh3w5sqKXOiVq7ZTbiPZuaj6' +
        'Sqmqd5Kd9PHuSl3uR8G2k52Rqo8KVr2T78gtJypy12XzzndSqv4qW' +
        '/VRvoM33mbieyfvfOelaqreSXn89mvN1MBV2wmO9lbKU1N18ap3su' +
        '7h1bmi90DbO1k3QNVBz7JC4oW8PVrEPMj7VOI9UDW+Eq+l49KjpEL' +
        'e9xJvg6rxkXs5fbcvmw1tN8q9FqrGlvqvy4/uA0pVRN6vpN8PVaPC' +
        'ukbO6F4UeXeosCWqRoWlDbZhX9dV2+lvapYKu6Lq4oqsbjwSm9Joe' +
        '4oiS6PqyoqsceIxF7VH3hMV2R5VV1ZnmXNPOrFDl7xzXzpVD/40qg' +
        '6hznmn9zPS5FXbS+/C/rfJS+Kj7VB1nap36px0W/N9rCMYy9hufps' +
        'SX33iox1RdZGqd0oddlt23lfZGGT22HbuzhMf7RRVV6h6p85Jv9Yd' +
        'ubEcmwEeq07cedZz3aDqV9PmUOSYv5Zebks8cwd41fa6MaRkPdcNq' +
        'l4xhrIix9xZfb+PqQ9+emPY9x/R+F+LKOWhHlF1y5BpFDnmkcHB7y' +
        'vq+PTxsK9+4Ksx9GU91yOq3srcfpFjnrI5+1V+7Z8+ve3H2aJLeah' +
        'GVJ216qMKZ7xidsWnOd1/9Lq2Tz9l8OeoSXmoRlSdteqdCme8MrGW' +
        'vo87zd6g7dOpJv5Md/lO1I6qt6RV71Q44w3747eXvC7s03kW/XwXK' +
        'Q/VjqorBNC9c3EdG1i35JsPnXiQ8WEMPsvGzJKUdGxg3ZJvPnTiQc' +
        'aHMfgsLzPbEvN2A0v3fPO53ZNPH8Pyc5dalZSAtxtYuuebz+2efPo' +
        'Ylp9rb1E/jkJ0vmk05j7AIlRN1SGuFTuv7q7yRSv8oqERVTei6uja' +
        'r6/yRVc+e0RU3aLy2dOg83t8RYmIqu9RdRotl1j2rssePDqqvlH24' +
        'Pm0XGXZ6y578Oio+kbZg6dE56dqnjoNqj5V89S53V9ozRuveepMqP' +
        'qo5qlzu7nTmtdd89TJUPVOzVNXcHWzNW+85qnzoepfNU9dBJ1//P3' +
        'wngWjqPqDqnM7vdyCN17wyIlR9UfBI1dzvOJql85XlHyomqqLoPNS' +
        '5y2Cqkudt7Lfiy5173xFSYyqi5y3uN+7LnXvpQ5bDVV7DwIjfwfeE' +
        '1koddiCqBrpETnyoWrkVrPwj4JHLoKqSx25JiKvduoKqLraqaupXP' +
        'hH2YMnRtVlD14EhW98RUmHqjeqTo3Cv9hAGlT9xQayIvIvlpAGVX+' +
        'xhJQofIc9JEDVO+whGQo/xTZCo+pTbCMTCj/FQkKj6lMsJA2+nNxg' +
        'J0FR9Q12kgCF32MzEVH1PTYTHYW3YDmxUHULlhMakbdgP7FQdQv2E' +
        'xeFt2NFUVB1O1YUEYW/wqJCoOpXWFQ4FN6BXYmj6g7sKhYi78O6lF' +
        'F1H9YVBYV3Y2myqLobSwuBwsexOjVUPY7ViaPwKdihFKqegh3K4sv' +
        'JXKxRAVXPxRrVUPgi7NMRVS/CPkVQ+FIs1gVVL8ViFRC5AXZrjKoN' +
        'sFsFpL4au7VH1auxWxHH1LmRudiqPapeja3qOK2dq5mCfXqh6nXYp' +
        'xpqX4RlOqLqRVimJmqfjjW6o+rpWKMsap+IHYqg6onYobjT2rmsDq' +
        'xOB1XPwur0Ufs49qaGqsext0CofQQb00TVI9hYLHxp6cauZFF1N3Y' +
        'VDrV3YFHiqLoDi4qL2l9hRSFQ9SusKDRqb8R+AqHqRuwngdPaudAd' +
        '1hILVbdgLTlQ+z12EhFV32MnyVD7FRYSF1VfYSH58KXlFHsIjapPs' +
        'YeUqH2HJSRA1TssITdq/yp+/Eyo+qv48Ssg9Y0vKulQ9UbVZZB65b' +
        'NnRdWVz14NqZc9e2JUXfbs1VS+6+K/5olVvlaqrqP4RRc/flbFr7X' +
        '48esoftF8UUmp+J1SdRHcMhvIhztlAxXwr2k2kA93ygaK4JZJPR8u' +
        'lKor4Io3lpAOF7qxhAK44o0vKulwmxtVF8D9frCHTLjND/aQm++/o' +
        'P8u+E5i/+mYS6clnUnsPx0GvO73KvJ7BvOs+wiYoerdPOs+Ao5idb' +
        '60f1JPg6qPI035aZDicrn3H+rV//RfHHih6tPPnXFKCLG/2e5PnNj' +
        '/1afTeQ5UPWU2iHu8+hAfN/dXgNSjo2qqLsLsZu0rovOyqJqqK7C5' +
        'WamE6Dw9qqbqCgxuNlA/IYbEI6r+FWJIdLDsfN1HAL+oGhWs/gpB5' +
        'LBH1ShiXYqB/rpEMlSNChalSORwRNWoYEWNRA5fVI0KpgdJ5HBH1a' +
        'hgbpNEDgVUjSImlknkEEHVqGBWnEQOHVSNCqb0yV+XkELVqGC8TyK' +
        'HGqpGBYOJEjkEUTWK6A6VyCGLqlHBeOcrpgJGUDUq6MuVyKGMqlFB' +
        'R7FEDnFUjQreRsv/MAh9VI0i2rslckRB1aigMV0iRyBUjQpa6iVyx' +
        'ELVqOBV52ZTASOoGhU8NkzkCIeqUcRNyfx1iaCoGhVclUzkiIuqUc' +
        'FpzESO0KgaFRx7JnJER9WoYJc0kSMBqkYRv2ETOXKgalTwd+A9ETC' +
        'KqlEBnSMfqkYFRI58qBoVEDnyoWoUQeTIh6oBAAAAAAAAAAAAAB3+' +
        'A9qZhKc=');
  GetBitmapSize(bmp, w, h);
  TPA := GetBitmapColorTPA(bmp, 0);
  pt := TPA[0];
  t := GetSystemTime;
  if FLOODFILL_8WAY then
    shape := TPAFloodFill(TPA, pt, ff8Way)
  else
    shape := TPAFloodFill(TPA, pt, ff4Way);
  WriteLn('TPAFloodFill() finished in ' + IntToStr(GetSystemTime - t) + ' ms.');
  SetPixels(bmp, shape, FLOODFILL_COLOR);
  DisplayDebugImgWindow(w, h);
  DrawBitmapDebugImg(bmp);
  FreeBitmap(bmp);
  SetLength(TPA, 0);
end;

begin
  Setup;
end.