SRL Archive - Discussions and Debates

Well, Maybe some of you have notice. (I don't know)
But i haven't really been around.

Why:

1. Lost of interest.
2. Busy (work).
3. Friends.
4. Other communities online.
5. I have started doing C# programming and i often program that instead. :)



I really want my work to live on.
So i decided to release my source.


I doubt you'll figure out how it works the first time you read it.
It's a bit different then just writing a FindBank function in scar.

It's rather messy because it was going to be closed source and i didn't think that i would be releasing it.

I haven't got around to making fast as possible just only making it work.

Anyway, Hopefully you can learn from my work as i did with pups work.

library Skyplugin;



uses
  FastShareMem,
  SysUtils,
  Classes,
  Windows,
  Math,
  Graphics;

{$R *.res}


const
   ax : array[0..7] of ShortInt = (1, 0,-1, 0, 1, 1,-1,-1);
   ay : array[0..7] of ShortInt = (0, 1, 0,-1,-1, 1, 1,-1);
   mox: array[0..2] of Integer = (50, 130, 210);
   moy: array[0..2] of Integer = (45, 125, 205);


type
  TSCARPlugFunc = record
    Name: string;
    Ptr: Pointer;
  end;


  TOneStrProc = procedure(s: string);
  TSCARWindowHandle = function(): Integer;

type
  TRGB32 = packed record
    B, G, R, A: Byte;
  end;
  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32) - 1] of TRGB32;
  PRGB32Array = ^TRGB32Array;

  TPointArray = array of TPoint;

  TFill = record
    Width, Height, Area,
    MidX, MidY, x1, y1, groups,
    x2, y2: Integer;
   end;

var
  Writeln: TOneStrProc;
  GetClientWindowHandle: TSCARWindowHandle;

var
  c, a: array of array of Integer;
  b: array of array of Boolean;
  area, bitsize, bgcolor, fillcolor,
  w, h, x1, y1, x2, y2: Integer;
  Fill: TFill;
  FillInfo: Boolean;






{
  Flood Fill algorithms
}

procedure ScanFill(x, y: Integer); stdcall;
var
   i, xx, yy: integer;
begin
  if (c[x][y] <> bgcolor) then exit;
  c[x][y] := fillcolor;
  b[x][y] := True;
  area := area + 1;
  xx := 0;
  yy := 0;

  (* Shift Right *)
  xx := x + 1;
  while (xx < W) and (C[xx][y] = bgColor)and
  (not(B[xx][y])) do
  begin
    c[xx][y] := fillcolor;
    b[xx][y] := True;
    Area := area + 1;
    xx := xx + 1;
   end;
  if (xx - x > 1) then ScanFill(xx, y);

(* Shift Left *)
  xx := x - 1;
  while (xx > 1) and (C[xx][y] = bgColor) and
  (not(B[xx][y])) do
  begin
    c[xx][y] := fillcolor;
    b[xx][y] := True;
    Area := area + 1;
    xx := xx - 1;
   end;
  if  (x - xx > 1) then ScanFill(xx, y);

(* Shift Up *)
  yy := y + 1;
  while (yy < H) and (C[x][yy] = bgColor) and
  (not(B[x][yy])) do
  begin
    c[x][yy] := fillcolor;
    b[x][yy] := True;
    Area := area + 1;
    yy := yy + 1;
   end;
  if (yy - y > 1) then ScanFill(x, yy);

  (* Shift Down *)
  yy := y - 1;
  while (yy > 1) and (C[x][yy] = bgColor) and
  (not(B[x][yy])) do
  begin
    c[x][yy] := fillcolor;
    b[x][yy] := True;
    Area := area + 1;
    yy := yy - 1;
   end;
  if (y - yy > 1) then ScanFill(x, yy);

  for i:= 0 to bitsize do
   if (x + ax[i] > 0) and (x + ax[i] < w) and
      (y + ay[i] > 0) and (y + ay[i] < h) then
       if (not(B[x + ax[i]][y + ay[i]])) and
       (c[x + ax[i]][y + ay[i]] = bgcolor) then
    ScanFill(x + ax[i], y + ay[i]);
end;



function Max(const A, B, C: Integer): Integer; overload;
asm
      CMP       EDX,EAX
      db $0F,$4F,$C2           /// CMOVG     EAX,EDX
      CMP       ECX,EAX
      db $0F,$4F,$C1           /// CMOVG     EAX,ECX
end;

function Min(const A, B, C: Integer): Integer; overload;
asm
      CMP       EDX,EAX
      db $0F,$4C,$C2           /// CMOVL     EAX,EDX
      CMP       ECX,EAX
      db $0F,$4C,$C1           /// CMOVL     EAX,ECX
end;



procedure FFillBg(x, y: Integer); stdcall;
var
   i: integer;
begin
  c[x][y] := fillcolor;
  area := area + 1;

  if (FillInfo) then
  begin
    Inc(Fill.Area);
    Fill.MidX := Fill.MidX + x;
    Fill.MidY := Fill.MidY + y;
    Fill.x1 := Min(Fill.x1, x);
    Fill.y1 := Min(Fill.y1, y);
    Fill.x2 := Max(Fill.x2, x);
    Fill.y2 := Max(Fill.y2, y);
  end;

  for i:= 0 to bitsize do
   if (x + ax[i] > 0) and (x + ax[i] < w) and
      (y + ay[i] > 0) and (y + ay[i] < h) then
      if (c[x + ax[i]][y + ay[i]] = bgcolor) then
    FFillBg(x + ax[i], y + ay[i]);

end;



procedure FFill(x, y: Integer); stdcall;
var
   i: integer;
begin
  c[x][y] := fillcolor;
  b[x][y] := True;
  area := area + 1;
  for i:= 0 to bitsize do
   if (x + ax[i] > 0) and (x + ax[i] < w) and
      (y + ay[i] > 0) and (y + ay[i] < h) then
    if (not(b[x+ ax[i]][y + ay[i]])) and
    (c[x + ax[i]][y + ay[i]] = bgcolor) then
          FFill(x + ax[i], y + ay[i]);
end;


{

   Leo Solver
   By: SKy Scripter

}

var
 Data, Item: array [1..9] of record
          x1, y1, x2, y2, Parts,
          Area, Parm, mx, my, Holes,
          MinDist:Integer;
        end;








{
  Solving Coffins :)
}
procedure SolveParamerter;
var x, y, xx, yy, nic: Integer;
begin
  nic := 0;
  bgcolor := clwhite;
  fillcolor := clred;
  for y := 0 to 2 do
   for x := 0 to 2 do
   begin
    inc(nic);
    Data[nic].x1 := mox[x] + 35;
    Data[nic].y1 := moy[y] + 35;
    Data[nic].x2 := mox[x] - 35;
    Data[nic].y2 := moy[y] - 35;
    Data[nic].Parts := 0;
    Data[nic].Area := 0;
    Data[nic].MinDist := 500;
    Data[nic].mx := 0;
    Data[nic].my := 0;

    for yy := Data[nic].y2 to Data[nic].y1 do
     for xx := Data[nic].x2 to Data[nic].x1 do
      if (Sqrt(Sqr(xx - mox[x]) + Sqr(yy - moy[y])) <= 20) then
       if (c[xx][yy] = clwhite) then
       begin
          FFillBg(xx, yy);
          inc(Data[nic].Parts);
       end;

   for yy := max(moy[y] - 50, 0) to min(moy[y] + 50, h) do
     for xx := max(mox[x] - 50, 0) to min(mox[x] + 50, w) do
      if (c[xx][yy] = clred) then
      begin
         if (Data[nic].x1 > xx) then Data[nic].x1 := Max(xx - 5, 0);
         if (Data[nic].y1 > yy) then Data[nic].y1 := Max(yy - 5, 0);
         if (Data[nic].x2 < xx) then Data[nic].x2 := Min(xx + 5, w);
         if (Data[nic].y2 < yy) then Data[nic].y2 := Min(yy + 5, h);
         Data[nic].mx := Data[nic].mx + xx;
         Data[nic].my := Data[nic].my + yy;
         inc(Data[nic].Area);
         c[xx][yy] := clblue;
      end;
     Data[nic].Parm := (Data[nic].x2 - Data[nic].x1) + (Data[nic].y2 - Data[nic].y1);

        if (Data[nic].Area > 0) then
        begin
          Data[nic].mx := round(Data[nic].mx / Data[nic].Area);
          Data[nic].my := round(Data[nic].my / Data[nic].Area);
          c[Data[nic].mx][Data[nic].my] := $FF00;
       end;
   end;
end;

function CoffinAnswer: string;
var i, maxparts, holes, thickitems, thinitems: integer;

begin
  maxparts := 0;
  thickitems := 0;
  thinitems := 0;
  holes := 0;
  for i := 1 to 9 do
  begin
    maxparts := max(maxparts, item[i].Parts);
    if (item[i].Area < 1700) and (item[i].Area > 530) then
    holes := holes + item[i].Holes;
    if (item[i].MinDist >= 20) then inc(thickitems) else
    if (item[i].MinDist > 5) then inc(Thinitems);
  end;

   result := 'error';
   if (maxparts > 3) then
     result := 'mining'
   else
   if (holes > 1) and (thickitems = 0) then
     result := 'farming'
   else          
   if (thickitems = 0) and (thinitems = 2) then
    result := 'woodcutting'
   else
   if (thickitems = 1) and (thinitems = 3) then
    result := 'cooking'
   else
   if (thickitems > 1) then
    result := 'crafting';

end;

{   Here Goes Detecting Coffins :)      }

function Leo_AnalyzeCoffin(var CoffinName: string; ClientHDC: HDC): Boolean; stdcall;
var
  BMP: TBitmap;
  x, y, nic, i, dist: Integer;
  sRGB, bRGB, Hue, st: Extended;
  Line: PRGB32Array;


label Lab1;

function RGBMin: Integer;
begin
  Result := Min(Min(Line[x].r, Line[x].g), Line[x].b);
end;

function RGBMax: Integer;
begin
  Result := Max(Max(Line[x].r, Line[x].g), Line[x].b);
end;

procedure Maskit;
begin
   sRGB := RGBMin / 255;
    bRGB := RGBMax / 255;
    Hue := 0.0;
    if (not(sRGB = bRGB)) then
    begin
       if (Line[x].r = bRGB) then
       Hue := (Line[x].g - Line[x].b) / (bRGB - sRGB)
     else if (Line[x].g = bRGB) then
       Hue := 2.0 + (Line[x].b - Line[x].r) / (bRGB - sRGB)
     else Hue := 4.0 + (Line[x].r - Line[x].g) / (bRGB - sRGB);
          Hue := Hue / 6.0;
        if (Hue < 0.0) then Hue := Hue + 1;
     end;
    if (Hue < 13.0) then
        c[x][y] := 0
    else
        c[x][y] := clwhite;
end;

begin
  Result := False;
  CoffinName := 'error';
  w := 240; h := 237;
  Bmp := TBitmap.Create;
  Bmp.Width := w;
  Bmp.Height:= h;
  Bmp.PixelFormat := pf32bit;
   for nic := 1 to 9 do
     Item[nic].Parm := 0;
  SetLength(c, w + 1, h + 1);
  SetLength(b, w + 1, h + 1);
  bitsize := 7;
  st := now;

 repeat
    BitBlt(Bmp.Canvas.Handle, 0, 0, w, h, ClientHDC, 145, 50, SRCCOPY);

 {    Filter Pixels (Get Mask)      }
 Area := 0;
  for y := 0 to h-1 do
  begin
    Line := bmp.ScanLine[y];
   for x := 0 to w-1 do
   begin
     c[x][y] := RGB(Line[x].R, Line[x].G, Line[x].B);
     b[x][y] := false;
     Maskit;
   end;
 end;

 SolveParamerter;
  for y := 0 to h do
  for x := 0 to w do
   Bmp.Canvas.Pixels[x, y] := c[x][y];
   Bmp.Canvas.Brush.Color := 10;
   Bmp.Canvas.FloodFill(2, 2, 0, fsSurface);
   Bmp.Canvas.FloodFill(w - 2, h - 2, 0, fsSurface);
 for y := 0 to h do
  for x := 0 to w do
   c[x][y] := bmp.Canvas.Pixels[x, y];

 for nic := 1 to 9 do
   if (Data[nic].Parm > Item[nic].Parm) then
   begin
     Item[nic] := Data[nic];
     Item[nic].Holes := 0;

          // Corners
      for y := Item[nic].y1 to Item[nic].y2 do
       for x := Item[nic].x1 to Item[nic].x2 do
        if (c[x][y] = clblue) then
        begin
        for i := 0 to 7 do
        if (X + ax[i] > 0) and (X + ax[i] < w) and
           (Y + ay[i] > 0) and (Y + ay[i] < h) then
             if (c[x + ax[i]][y + ay[i]] = 10) then
             begin
                 c[x][y] := $CCFF;
                 break;
             end;
       end;
      Item[nic].MinDist := 500;
      fillcolor := clpurple;
      bgcolor := 0;
       for y := Item[nic].y1 to Item[nic].y2 do
        for x := Item[nic].x1 to Item[nic].x2 do
        begin
         if (c[x][y] = 0) then
         begin
           Area := 0;
           FFillBg(x, y);
           if (Area > 5) then inc(Item[nic].Holes);
         end;
         if (c[x][y] = $CCFF) then
         begin
            Dist := round(Sqrt(Sqr(1.0 * (x - Item[nic].mx)) + Sqr(1.0 * (y - Item[nic].my))));
            if (Item[nic].MinDist > Dist) then Item[nic].MinDist := Dist;
         end;
     end;
   end;
 Sleep(150 + random(50));
until (((Now - st) * 86400000) > 10000);

  CoffinName := CoffinAnswer;

Lab1:

 bmp.free;
end;


{   Here Goes Detecting GraveStones :)      }


function Leo_AnalyzeGraveStone( var StoneName: string; ClientHDC: HDC): Boolean; stdcall;
var
  BMP2: TBitmap;
  x, y, MaxArea, Pixels, i,
  fx, fy, Holes, MinDist,
  mx, my, Dist, HistoArea: Integer;
  HG: array [0..1000] of Integer;
  Done: Boolean;
  st, lum: Extended;
  Line: PRGB32Array;
label Lab1;
begin
  Result := False;
  StoneName := 'error';
  w := 350; h := 270;
  Bmp2 := TBitmap.Create;
  Bmp2.Width := w;
  Bmp2.Height:= h;
  Bmp2.PixelFormat := pf32bit;
  SetLength(c, w + 1, h + 1);
  SetLength(b, w + 1, h + 1);
  bitsize := 7;
  st := Now;
  Done := false;
  fx := 0; fy := 0;
  dec(w); dec(h);
repeat
  { Copy Canvas From Screen }
  BitBlt(Bmp2.Canvas.Handle, 0, 0, w, h, ClientHDC, 100, 50, SRCCOPY);
  fillchar(HG, sizeof(HG), 0);

 {    Get Pixels      }

  for y := 0 to h do
  begin
     Line := bmp2.ScanLine[y];

   for x := 0 to w do
   begin
     c[x][y] := RGB(Line[x].R, Line[x].G, Line[x].B);
     b[x][y] := false;
     Lum := (Line[x].R + Line[x].G + Line[x].B) / 765;
    if (lum < 0.3) then c[x][y] := 0;

  with Line[x] do
    inc(HG[round(Sqrt(R*R + G*G + B*B))]);

   end;
 end;



 { Delete Large Mass of Pixels (The Background) }
 try
 for y := 0 to h do
   for x := 0 to w do
    if (not(b[x][y])) and (c[x][y] <> 0) then
   begin
     bgcolor := c[x][y];
     fillcolor := c[x][y];
     Area := 0;
     ScanFill(x, y);
    if (Area > 180) then
    begin
      fillcolor := 0;
      FFillBg(x, y);
    end;
   end;
  except end;

 x1 := w;
 y1 := h;
 x2 := 0;
 y2 := 0;
  { Measure The Box Coords }
 for y := 5 to h-5 do
  for x := 5 to w-5 do
   if (c[x][y] <> 0) then
   begin
       if (x < x1) then x1 := x - 15;
       if (y < y1) then y1 := y;
       if (x > x2) then x2 := x + 15;
       if (y > y2) then y2 := y;
   end;
 if ((x2 - x1) >= 180) and ((y2 - y1) >= 180) then Done := True;
 Sleep(100);
until (((Now - st) * 86400000) > 15000) or (Done);
 if (not(done)) then goto lab1;


 // Paint All Object Pixels White
 for y := y1 to y2 do
  for x := x1 to x2 do
   if (c[x][y] > 0) then
   begin
     b[x][y] := false;
     c[x][y] := clwhite;
   end;

  bgcolor := clwhite;
  fillcolor := clblue;
  MaxArea := 0;
  fx := 0;
  fy := 0;
 
 for y := y1 to y2 do
  for x := x1 to x2 do
   if (c[x][y] = clwhite) then 
   begin
      Area := 0;
      FFillBg(x, y);
     if (MaxArea < Area) then
     begin                 // Find Biggest Object and paint it red
       MaxArea := Area;
       fx := x;
       fy := y;
     end;
   end;


  Area := 0;
  bgcolor := clblue;
  fillcolor := clred;
  FFillBg(fx, fy);
  Pixels := Area;
  if (Pixels < 3000) then goto lab1;

 bmp2.canvas.brush.color := 0;
 bmp2.Canvas.Brush.Style := bsSolid;
 bmp2.Canvas.Rectangle(0, 0, w, h);

 for y := 0 to h do
  for x := 0 to w do
  begin
    if (C[x][y] = clblue) then c[x][y] := 0;
    if (c[x][y] = 255) then bmp2.Canvas.Pixels[x, y] := c[x][y];
  end;

   bmp2.Canvas.Brush.Color := 10;
   bmp2.Canvas.FloodFill(3, 3, 0, fsSurface);
   bmp2.Canvas.FloodFill(w - 3, h - 3, 0, fsSurface);

 for y := 0 to h do
   for x := 0 to w do
    c[x][y] := bmp2.Canvas.Pixels[x, y];

    { Farm / Cook Detect }

 Holes := 0;
 BgColor := 0;
 FillColor := clpurple;
  // Count Holes
 for y := y1 to y2 do
  for x := x1 to x2 do
   if (c[x][y] = 0) then
   begin
        Area := 0;
        FFillBg(x, y);
     if (Area > 100) then
         Holes := Holes + 1;
   end;

  x := 0;
  HistoArea := 0;

   for i:= 1000 downto 0 do
    if (HG[i] > 0) then
    begin
       HistoArea := HistoArea + HG[i];
       inc(x);
       if x > 20 then
        break;
    end;

   HistoArea := round(HistoArea / 10);

  if (Pixels > 10000) and (HistoArea > 1000) then
   StoneName := 'cooking'
else
  if (Holes > 0) and (Pixels < 10000) then
    StoneName := 'farming';


 if (not(StoneName = 'error')) then
 begin
   Result := True;
   goto Lab1;
 end;

 if (Holes > 0) then goto Lab1;

// Here Is WoodCutting, Mining and Crafting
 { Bold Object to make it fit better }
 for y := y1 to y2 do
  for x := x1 to x2 do
   if (c[x][y] = clred) and (not(b[x][y])) then
    for i := 0 to 7 do
     begin
        c[x + ax[i]][y + ay[i]] := clred;
        b[x + ax[i]][y + ay[i]] := true;
     end;

  mx := 0;
  my := 0;
  area := 0;

  { Detect Edges And Get the center point of the object }
  for y := y1 to y2 do
  for x := x1 to x2 do
   if (c[x][y] = clred) then
   begin
    for i := 0 to 7 do
     if (c[x + ax[i]][y + ay[i]] = 10) then
      c[x + ax[i]][y + ay[i]] := clwhite;

     mx := mx + x;
     my := my + y;
     area := area + 1;
    end;

 mx := round(mx / area);
 my := round(my / area);

 c[mx][my] := clgreen;
  for i := 0 to 7 do
   c[mx + ax[i]][my + ay[i]] := clgreen;

  MinDist := 500;
  for y := y1 to y2 do
   for x := x1 to x2 do
    if (c[x][y] = clwhite) then
    begin
       Dist := Round(Sqrt(Sqr(x - mx) + Sqr(y - my)));
       if (MinDist > Dist) then
       begin
           MinDist := Dist;
           fx := x;
           fy := y;
       end;
    end;

   c[fx][fy] := clpurple;
   for i := 0 to 7 do
    if (c[fx + ax[i]][fy + ay[i]] <> 0) then
     c[fx + ax[i]][fy + ay[i]] := clpurple;

   if (MinDist >= 20) then
   begin
      StoneName := 'crafting';
     result := true;
     goto lab1;
  end;


    x := 0;
  HistoArea := 0;

   for i:= 1000 downto 0 do
    if (HG[i] > 0) then
    begin
       HistoArea := HistoArea + HG[i];
       inc(x);
       if x > 15 then
        break;
    end;


  if (MinDist > 0) then
  begin

   if ((HistoArea > 3300) and (MinDist > 4)) or (HistoArea > 3900) then StoneName := 'mining'
 else
    if ((HistoArea < 2700) and (MinDist < 6)) or (HistoArea < 2000) then StoneName := 'woodcutting'
 end;

 

   if (not(StoneName = 'error')) then Result := True;
Lab1:

{  for y := 0 to h do
   for x := 0 to w do
   canvas.pixels[x, y] := c[x][y];
}
 bmp2.free;
end;




{

  Quiz Solver
  by: SKy Scripter
}
var
  q_Items: array [0..2] of record
     name: string;
     mx, my, param, holes,
     mindist, maxdist, count, parea: Integer;
   end;

function q_ItemBounds(I: Integer): Integer;
var
  xs, ys, xe, ye, x, y: Integer;
begin
  x1 := w;    x2 := 0;
  y1 := h;    y2 := 0;
  xs := (I * 160) + 4; ys := 4;
  xe := (xs + 160) - 4;  ye := 114;
  result := 0;

  for y := ys to ye do
   for x := xs to xe do
   begin
     if (y = ys) or (y = ye) or
        (x = xs) or (x = xe) then
        c[x][y] := clblue;
   if (c[x][y] = clred) then
   begin
       if (x2 < x) then x2 := x;
       if (y2 < y) then y2 := y;
       if (x1 > x) then x1 := x;
       if (y1 > y) then y1 := y;

   end;
  end;

   if (x2 > x1) then
   Result:= (x2 - x1) + (y2 - y1);

end;

procedure q_InitializeItem(I: Integer);
var
  xs, ys, xe, ye,
  x, y, n, dist, parea: Integer;
begin
  xs := (I * 160) + 4; ys := 4;
  xe := (xs + 160) - 4;  ye := 114;
  q_Items[I].name := '';
  q_Items[I].holes := 0;
  q_Items[I].mindist := 500;
  q_Items[I].maxdist := 0;
  bgcolor := 0;
  fillcolor := clpurple;
  q_Items[I].parea := 0;
  q_Items[I].mx := 0;
  q_Items[I].my := 0;
  q_Items[I].count := 0;

  for y := ys to ye do
   for x := xs to xe do
   if (c[x][y] = clred) then
   begin
     Inc(q_Items[I].count);
     q_Items[I].mx := q_Items[I].mx + x;
     q_Items[I].my := q_Items[I].my + y;
   end;
  if  (q_Items[I].count < 5) then exit;
 q_Items[I].mx := round(q_Items[I].mx / q_Items[I].Count);
 q_Items[I].my := round(q_Items[I].my / q_Items[I].Count);

 if (c[q_Items[I].mx][q_Items[I].my] < 11) then
  inc(q_Items[i].holes);

  for y := ys to ye do
   for x := xs to xe do
   begin
    if (c[x][y] = clred) then
    begin
     for n := 0 to 3 do
      if (c[x + ax[n]][y + ay[n]] = 10) then
      begin
        c[x][y] := clblue;
         dist := round(Sqrt(Sqr(x - q_Items[I].mx) + Sqr(y - q_Items[I].my)));
      if (q_Items[I].maxdist < Dist) then
        q_Items[I].maxdist := Dist;
      if (q_Items[I].mindist > Dist) then
        q_Items[I].mindist := Dist;
        inc(q_Items[I].parea);
        break;
      end;
    end;
    if (c[x][y] = 0) then
    begin
      Area := 0;
      FFillBg(x, y);
      if (Area > 10) then
       Inc(q_Items[I].holes);
    end;
   end;

    C[q_Items[I].mx][q_Items[I].my] := $CCFF;
    for n := 0 to 3 do
     C[q_Items[I].mx + ax[n]][q_Items[I].my + ay[n]] := $CCFF;
end;


function Quiz_AnalyzeQuiz(var canvas: tcanvas; ClientHDC: HDC; var objx, objy: Integer; var nameresult: string): Boolean;   stdcall;
var
  BMP: TBitmap;
  Line: PRGB32Array;
  x, y, I, n, fishcount, b, cnt: Integer;
  st: Extended;
  sR, bR: integer;
  Parms: array [0..2] of Integer;


function InR(ssR, bsR, sbR, bbR: Integer): boolean;
begin
  result := (sR <= bsR) and (sR >= ssR) and
            (bR >= sbR) and (bR <= bbR);
end;

label leave;
 // every 164 pixels
begin
  w := 492; h := 118;
  try
  Bmp := TBitmap.Create;
  Bmp.Width := w;
  Bmp.Height:= h;
  Bmp.PixelFormat := pf32bit;
  SetLength(c, w + 1, h + 1);
  bitsize := 7;
  b := 0;
  Result := false;
  b := b + 1;
   if (b > 2) then goto leave;
  st := now;
  for i := 0 to 2 do
   q_items[i].param := 0;
repeat

  BitBlt(Bmp.Canvas.Handle, 0, 0, w, h, ClientHDC, 19, 357, SRCCOPY);
  cnt := 0;
  for y := 0 to h-1 do begin
    Line := bmp.ScanLine[y];
   for x := 0 to w-1 do  begin
     c[x][y] := 0;
     if (Line[x].B > 0) and (Line[x].B < 99) then
     c[x][y] := clred;
     if (Line[x].b = 0) then inc(cnt);
    Line[x].B := 0; Line[x].R := 0; Line[x].G := 0;
     if (c[x][y] = clred) then
        Line[x].R := 255;
   end;
 end;

 if (Abs(cnt - 431) >= 30) then goto Leave;
    cnt := 0;

  for i := 0 to 2 do begin
    Parms[I] := q_ItemBounds(I);
   if (Parms[I] > q_Items[I].param) then inc(cnt);
 end;

 if (cnt > 0) then begin
   Bmp.Canvas.Brush.Color := 10;
   Bmp.Canvas.FloodFill(2, 2, 0, fsSurface);
   Bmp.Canvas.FloodFill(w-2, h-2, 0, fsSurface);

 for y := 0 to h-1 do begin
    Line := bmp.ScanLine[y];
   for x := 0 to w-1 do  begin
     c[x][y] := rgb(Line[x].r, Line[x].g, Line[x].b);
   end;
 end;
end;

  bgcolor := clwhite;
  fillcolor := clblue;

  for i := 0 to 2 do
   if (Parms[I] > q_Items[I].param) then
   begin
     q_Items[I].param := parms[i];
     q_InitializeItem(I);
   end;
   
 Sleep(100);
until (((Now - st) * 86400000) > 10000);
fishcount := 0;

for i := 0 to 2 do begin
q_items[i].name := 'non fish';
sR := round(q_Items[i].mindist / q_Items[i].parea * 100);
bR := round(q_Items[i].maxdist / q_Items[i].parea * 100);

if (q_Items[i].holes < 1) and (q_Items[i].param > 100) and (q_Items[i].param < 111) then
if InR(4, 8, 20, 28) or  InR(4, 8, 14, 21) then begin
  q_items[i].name := 'fish';
  inc(fishcount);
 end;
end;
  i := -1;

case fishcount of
 0: begin   // there are other groups but tools seem to be most common.
       Writeln('Found no fish. Finding non tool.. ');

       for i := 0 to 2 do begin
       q_items[i].name := 'non tool';
        if (q_items[i].count < 320) or ((q_items[i].count > 1000) and (q_items[i].count < 1350) and
        (q_items[i].param >= 114) and (q_items[i].param <= 120)) then
         q_items[i].name := 'tool';
       end;

     for i := 0 to 2 do 
     if (q_items[i].name = 'non tool') then begin
      nameresult := 'non tool';
      break;
     end;
       if (nameresult = '') then
         i := random(3);
  end;

 3:   i := random(3);
 1:  nameresult := 'fish';
 2:  nameresult := 'non fish';
end;

result := (i > -1);

 if (result) and (nameresult = '') then begin
  nameresult := 'guess';
  writeln('Found something wrong. Guessing....');
 end;

 if (i = -1) then
  for i := 0 to 2 do
   if (q_items[i].name = nameresult) then  begin
     result := true;
      break;
  end;

if (Result) then
begin
  objx := q_items[i].mx + random(10);
  objy := q_items[i].my + 357 + random(10) - 5;
  Writeln('found a '+nameresult +' In slot #'+inttostr(i+1) + ' at ('+inttostr(objx)+','+inttostr(objy)+')');
end;

leave:
 for y := 0 to h do
  for x := 0 to w do
   canvas.Pixels[x, y] := c[x][y];
finally
  Bmp.Free;


end;

end;


{
   Certer Solver
   by: Sky Scripter

}

procedure Certer_CountCerterPixels(Canvas: TCanvas; width, height: Integer; var wi, hi: integer); stdcall;
var
   x, y, c: Integer;
begin
  BgColor := Canvas.Pixels[5, 5];
  hi := 0;
  wi := 0;
  x1 := width;
  y1 := height;
  x2 := 0;
  y2 := 0;
  for y := 0 to height do
   for x := 0 to width do
   begin
     c := Canvas.Pixels[x, y];
     if (c <> BgColor) and (c > 0) then
     begin
       if (x1 > x) then x1 := x;
       if (y1 > y) then y1 := y;
       if (x2 < x) then x2 := x;
       if (y2 < y) then y2 := y;
     end;
   end;
   wi := (x2 - x1);
   hi := (y2 - y1);
end;



function Certer_DistinguishPicture(Canvas: TCanvas; var Item: string; width, height: Integer; Debug: Boolean): Boolean; stdcall;
var
  x, y, MaxArea, mx, my,
  i, MinDist, MaxDist, Dist: Integer;
 
function MinDR(mi, ma: integer): Boolean;
begin
  Result := (MinDist >= Mi) and (MinDist <= Ma);
end;
 
function MaxDR(mi, ma: integer): Boolean;
begin
  Result := (MaxDist >= Mi) and (MaxDist <= Ma);
end;
 
label label1;
begin
  w := width - 1;
  h := height - 1;
  bitsize := 7;
  Result := False;
  SetLength(c, w + 1, h + 1);
  SetLength(b, w + 1, h + 1);
 
  BgColor := Canvas.Pixels[2, 2];
  Canvas.Brush.Color := 0;
  Canvas.FloodFill(2, 2, BgColor, fsSurface);
 
  { Load Pixels }
  Area := 0;
  mx := 0;
  my := 0;
  x1 := w;
  y1 := h;
  x2 := 0;
  y2 := 0;
 
  for y := 0 to h do
   for x := 0 to w do
   begin
     C[x][y] := Canvas.Pixels[x, y];
     if (C[x][y] <> BgColor) and (C[x][y] > 0) then
     begin
       C[x][y] := Clwhite;
       Area := Area + 1;
       mx := mx + x;
       my := my + y;
 
       if (x1 > x) then x1 := x - 2;
       if (y1 > y) then y1 := y - 2;
       if (x2 < x) then x2 := x + 2;
       if (y2 < y) then y2 := y + 2;
     end;
     B[x][y] := False;
   end;
 
   if (Area < 10) then Exit;
    mx := round(mx / area);
    my := round(my / area);
 
 
 
   {
     Find Holes
     Shovel, Shears and Ring.
   }
  MaxArea := 0;
  fillcolor := clpurple;
  for y := y1 to y2 do
   for x := x1 to x2 do
   begin
    if (x = x1) or (x = x2) or
       (y = y1) or (y = y2) then
       c[x][y] := clSkyBlue;
 
    if (c[x][y] = bgColor) then
    begin
        Area := 0;
        FFillBg(x, y);
     if (Area > MaxArea) then
     MaxArea := Area;
    end;
 
    if (c[x][y] = clwhite) then
     for i := 0 to 3 do
      if (c[x + ax[i]][y + ay[i]] = 0) then
      c[x][y] := clred;
 
  end;
 
   if (MaxArea > 10) then
   begin
     if (MaxArea > 150) then
       Item := 'ring'
    else
       if ((x2 - x1) + (y2 - y1) > 100) then
       Item := 'spade'
    else
       Item := 'pair';
   end;
 
 
   if (Item <> '') then
   begin
     Result := True;
     goto Label1;
   end else
  if (c[mx][my] = 0) then
   begin
    Result := True;
     Item := 'pair';
     goto Label1;
    end;
 
   MinDist := 500;
   MaxDist := 0;
 
  for y := y1 to y2 do
   for x := x1 to x2 do
     if (c[x][y] = clred) then
     begin
       Dist := Round(Sqrt(Sqr(x - mx) + Sqr(y - my)));
       if (MinDist > Dist) then MinDist := Dist;
       if (MaxDist < Dist) then MaxDist := Dist;
     end;
 
     { Special Thanks to Pups.. This is his data
      and it happen to save me a lot of time. }
 
 if MaxDR(30, 40) and MinDR(-1, 3) then
    Item := 'pair';
  if MaxDR(65, 100) and MinDR(5, 20) then
    Item := 'fish';
  if MaxDR(50, 65) and MinDR(1, 8) then
    Item := 'axe';
  if MaxDR(42, 54) and MinDR(0, 4) then
    Item := 'sword';
  if MaxDR(21, 29) and MinDR(7, 20) then
    Item := 'helmet';
  if MaxDR(40, 50) and MinDR(20, 30) then
    Item := 'shield';
  if MaxDR(28, 40) and MinDR(28, 40) then
    Item := 'bowl';
 
 
   if (Item <> '') then
    begin
      Result := True;
      goto label1;
    end;
 
label1:
 if (Debug) then
 begin
   c[mx][my] := clblue;
     for i := 0 to 7 do
      c[mx + ax[i]][my + ay[i]] := clblue;
 
  for y := 0 to h do
   for x := 0 to w do
    Canvas.Pixels[x, y] := C[x][y];
 end;
end;


function FindTail234(TailSize: Integer): Boolean;
var
   x, y, fx, fy, i, count: Integer;
   mx, my, dx, dy, ad, dist, cornercount, maxdist: Integer;
   tailfound, bc, greenarea: Integer;

procedure Clear;
begin
      fill.Area := 0;
      Fill.MidX := 0; Fill.MidY := 0;
      Fill.x1 := w; Fill.y1 := H;
      Fill.x2 := 0; Fill.y2 := 0;
end;

label db, db2;
begin

 Result := false;

  for y := 0 to H do
   for x := 0 to W do
    if (c[x][y] = clred) then
    begin
      area := 0;
      Clear;
      FillInfo := True;
      bgcolor := clred;
      fillcolor := clwhite;
      bitsize := 7;
      FFillBg(x, y);
      if (Fill.x1 = w) and (Fill.y1 = h) then continue;

      Fill.x1 := Max(Fill.x1 - 5, 2);   Fill.y1 := Max(Fill.y1 - 5, 2);
      Fill.x2 := Min(Fill.x2 + 5, w-2); Fill.y2 := Min(Fill.y2 + 5, h-2);

      if Area > 20 then
      begin

      count := 0;
      area := 0;
      dx := 0;
      dy := 0;
          for fy := Fill.y1 to Fill.y2 do
           for fx := Fill.x1 to Fill.x2 do
           begin
             if (c[fx][fy] = clblue) then
             begin
                c[fx][fy] := 0;
                dx := dx + fx;
                dy := dy + fy;
                inc(area);
             end;

             if (c[fx][fy] = clred) then
             begin
               count := count + 1;
               goto db;
             end;
          end;

      db:
        if (Count > 0) or (area < 1) then
      Break;

      dx := round(dx / area);
      dy := round(dy / area);

     for fy := Fill.y1 to Fill.y2 do
       for fx := Fill.x1 to Fill.x2 do
         if (c[fx][fy] = clwhite) then
          begin
             Clear;
              area := 0;
              FillInfo := True;
              bgcolor := clwhite;
              fillcolor := clLime;
              FFillBg(fx, fy);
             goto db2;
          end;

    db2:
     Fill.x1 := Max(Fill.x1 - 5, 2);   Fill.y1 := Max(Fill.y1 - 5, 2);
     Fill.x2 := Min(Fill.x2 + 5, w-2); Fill.y2 := Min(Fill.y2 + 5, h-2);


    for fy := Fill.y1 to Fill.y2 do
      for fx := Fill.x1 to Fill.x2 do
        if (c[fx][fy] > 0) then
         if (sqrt(sqr(fx - dx) + sqr(fy - dy)) < 12) then
          c[fx][fy] := 0;


    if area < 1 then break;
    mx := round(fill.MidX / area);
    my := round(fill.MidY / area);
    area := 0;
    ad := 0;
    maxdist := 0;
     for fy := Fill.y1 to Fill.y2 do
       for fx := Fill.x1 to Fill.x2 do
        begin
          if (c[fx][fy] = clLime) then
          begin
            for i := 0 to 3 do
             if (c[fx + ax[i]][fy + ay[i]] = 0) then
              begin
              dist := round(sqrt(sqr(mx - fx) + sqr(my - fy)));
               ad := ad + dist;
               if (maxdist < dist) then
                 maxdist := dist;
               inc(area);
               c[fx][fy] := $CCFF;
               break;
             end;
          end;
       end;

      if area < 1 then exit;
      ad := round(ad / area);
      // Make corners blue
       for fy := Fill.y1 to Fill.y2 do
         for fx := Fill.x1 to Fill.x2 do
         if (c[fx][fy] > 0) then
           if (sqrt(sqr(mx - fx) + sqr(my - fy)) >= ad) then
            c[fx][fy] := clblue;

    // Fill In corners
     for fy := Fill.y1 to Fill.y2 do
      for fx := Fill.x1 to Fill.x2 do
       if (c[fx][fy] = clblue) and (not(b[fx][fy])) then
        for i := 0 to 7 do
         if (c[fx + ax[i]][fy + ay[i]] <> 0) then
         begin
           c[fx + ax[i]][fy + ay[i]] := clblue;
           b[fx + ax[i]][fy + ay[i]] := true;
         end;

     cornercount := 0;
     bgColor := clblue;
     fillcolor := clpurple;
     FillInfo := false;
     bc := 0;
     mx := 0;
     my := 0;
     dist := 0;
    for fy := Fill.y1 to Fill.y2 do
      for fx := Fill.x1 to Fill.x2 do
      begin
       if (c[fx][fy] = clblue) then
       begin
         area := 0;
         ffillbg(fx, fy);
       if (area > 1) then
        inc(cornercount)
       else
         inc(bc);
      end;

      if (a[fx][fy] = 255) then
      begin
       mx := mx + fx;
       my := my + fy;
       inc(dist);
      end;
    end;



      if (bc > 0) then break;
      greenarea := 0;
    for fy := Fill.y1 to Fill.y2 do
      for fx := Fill.x1 to Fill.x2 do
       if (c[fx][fy] = cllime) then
        inc(greenarea);

        (* just in case, sometimes the 4 feather can by in the way *)
      if (cornercount = 1) and (greenarea < 5) and (maxdist > 12) then
          tailfound := 1
     else
      if (cornercount = 2) and (greenarea < 11) and (maxdist > 11) then
        tailfound := 2
     else
       if (cornercount = 3) and (greenarea > 9) and (maxdist > 10)  then
         tailfound := 3
     else
       if (cornercount > 3) then
         tailfound := 4;


      if (tailfound = tailsize) then
       begin
        result := true;
         fill.MidX := round(mx / dist);
         fill.MidY := round(my / dist);
        exit;
       end;
     end;
   // exit;
   end;
end;






function forest_FindPheasant(var px, py: Integer; TailSize: Integer; ClientHDC: HDC): Boolean;  stdcall;
var
  BMP: TBitmap;
  Line: PRGB32Array;
  x, y, i, count: Integer;
  Hue, Lum, srgb, brgb: extended;


function RGBMin: Integer;
begin
  Result := Min(Min(Line[x].r, Line[x].g), Line[x].b);
end;

function RGBMax: Integer;
begin
  Result := Max(Max(Line[x].r, Line[x].g), Line[x].b);
end;

procedure Maskit;
begin
    sRGB := RGBMin / 255;
    bRGB := RGBMax / 255;
    Hue := 0.0;
    if (not(sRGB = bRGB)) then
    begin
       if (Line[x].r = bRGB) then
       Hue := (Line[x].g - Line[x].b) / (bRGB - sRGB)
     else if (Line[x].g = bRGB) then
       Hue := 2.0 + (Line[x].b - Line[x].r) / (bRGB - sRGB)
     else Hue := 4.0 + (Line[x].r - Line[x].g) / (bRGB - sRGB);
          Hue := Hue / 6.0;
        if (Hue < 0.0) then Hue := Hue + 1;
     end;

   if (Hue > 15.0) and (Hue < 19.0)then
   begin
     Lum := (srgb + brgb) / 2;
     if (lum > 0.22) then
       c[x][y] := clred;
   end;

   if (Hue > 20.0) and (Hue < 21.0) then
   begin
     if (a[x][y] > 7000000) then
     c[x][y] := clred
   else
     c[x][y] := clblue;
   end;

end;


begin
try
  w := 510; h := 333;
  Bmp := TBitmap.Create;
  Bmp.Width := w;
  Bmp.Height:= h;
  Bmp.PixelFormat := pf32bit;
  SetLength(c, w + 1, h + 1);
  SetLength(a, w + 1, h + 1);
  SetLength(b, w + 1, h + 1);
  //SetLength(b, w + 1, h + 1);
  bitsize := 7;
  BitBlt(Bmp.Canvas.Handle, 0, 0, w, h, ClientHDC, 4, 4, SRCCOPY);
  Result := False;

  for y := 4 to h-4 do
  begin
    Line := bmp.ScanLine[y];
   for x := 4 to w-2 do
   begin
     a[x][y] := RGB(Line[x].R, Line[x].G, Line[x].B);;
     c[x][y] := 0;
     Maskit;
     a[x][y] := c[x][y];
     b[x][y] := false;
   end;
 end;

 // Fill Pixels
for y := 4 to h - 4 do
 for x := 4 to w - 4 do
 if (a[x][y] = 0) then
  begin
   count := 0;
   for i := 0 to 3 do
    begin
    if (a[x + ax[i]][y + ay[i]] = clred) then
    inc(count);
     if (count > 2) then
      c[x][y] := clred;
    end;
 end;


case TailSize of
 1, 2, 3, 4: Result := FindTail234(TailSize);
end;

 if (Result) then
  begin
    px := fill.midx;
    py := fill.Midy;
  end;

  
finally
    Bmp.Free;

end;

end;

function pillory_solvequestion(var px, py: Integer; var Canvas: Tcanvas; ClientHDC: HDC): Boolean;  stdcall;
var
  BMP: TBitmap;
  Line: PRGB32Array;
  x, y, maxarea, mx, my: Integer;
  Hue, Lum, srgb, brgb: extended;
  mir: record
         maxparam, cornercount, mx, my: Integer;
    end;

// 205. 205


function RGBMin: Integer;
begin
  Result := Min(Min(Line[x].r, Line[x].g), Line[x].b);
end;

function RGBMax: Integer;
begin
  Result := Max(Max(Line[x].r, Line[x].g), Line[x].b);
end;

procedure Maskit;
begin
    sRGB := RGBMin / 255;
    bRGB := RGBMax / 255;
    Hue := 0.0;
    if (not(sRGB = bRGB)) then
    begin
       if (Line[x].r = bRGB) then
       Hue := (Line[x].g - Line[x].b) / (bRGB - sRGB)
     else if (Line[x].g = bRGB) then
       Hue := 2.0 + (Line[x].b - Line[x].r) / (bRGB - sRGB)
     else Hue := 4.0 + (Line[x].r - Line[x].g) / (bRGB - sRGB);
          Hue := Hue / 6.0;
        if (Hue < 0.0) then Hue := Hue + 1;
     end;

     if (Hue < 18.0) or (Hue > 20.0) then c[x][y] := 0
     else
     begin
       Lum := (srgb + brgb) / 2;
       if Lum > 0.20 then
       c[x][y] := 0 else c[x][y] := clwhite;
     end;


end;


begin
try
  w := 510; h := 333;
  Bmp := TBitmap.Create;
  Bmp.Width := w;
  Bmp.Height:= h;
  Bmp.PixelFormat := pf32bit;
  SetLength(c, w + 1, h + 1);

  bitsize := 7;
  dec(w); dec(h);
  Result := False;

  BitBlt(Bmp.Canvas.Handle, 0, 0, w + 1, h + 1, ClientHDC, 4, 4, SRCCOPY);

  for y := 0 to h do
  begin
    Line := bmp.ScanLine[y];
     for x := 0 to w do
      begin
        c[x][y] := RGB(Line[x].r, Line[x].g, Line[x].b);
        MaskIt;
        if (x < 40) then
            c[x][y] := 0;
      end;
  end;

  bgcolor := clwhite;
  fillcolor := clred;
  maxarea := 0;
  mx := 0; my := 0;
 for y := 5 to 205 do
   for x := 5 to 205 do
    if (c[x][y] = clwhite) then
     begin
       area := 0;
         FFillBg(x, y);
      if (maxarea < area) then
      begin
         mx := x;
         my := y;
         maxarea := area;
      end;
     end;

  bgcolor := clred;
  fillcolor := clwhite;
  FillInfo := True;
  FFillBg(mx, my);


 for y := 0 to h do
   for x := 0 to w do
    Canvas.Pixels[x, y] := c[x][y];


finally
    Bmp.Free;

end;

end;


//********************************
//  Change this accordingly to your function count

function GetFunctionCount(): Integer; stdcall; export;
begin
  Result := 7;
end;

//*******************************
//  Change this accordingly to your function definitions

function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
  case x of
    0:
      begin
        ProcAddr := @Leo_AnalyzeGraveStone;
        StrPCopy(ProcDef, 'function Leo_AnalyzeGraveStone(var StoneName: string; ClientHDC: HDC): Boolean;');
      end;
   1:
      begin
        ProcAddr := @Leo_AnalyzeCoffin;
        StrPCopy(ProcDef, 'function Leo_AnalyzeCoffin(var StoneName: string; ClientHDC: HDC): Boolean;');
      end;
      
    2: begin
         ProcAddr := @Quiz_AnalyzeQuiz;
        StrPCopy(ProcDef, 'function Quiz_AnalyzeQuiz(var canvas: tcanvas; ClientHDC: HDC; var objx, objy: Integer; var nameresult: string): Boolean;');
       end;

    3: begin
         ProcAddr := @Certer_CountCerterPixels;
        StrPCopy(ProcDef, 'procedure Certer_CountCerterPixels(Canvas: TCanvas; width, height: Integer; var wi, hi: integer);');
      end;

    4: begin
         ProcAddr := @Certer_DistinguishPicture;
         StrPCopy(ProcDef, 'function Certer_DistinguishPicture(Canvas: TCanvas; var Item: string; width, height: Integer; Debug: Boolean): Boolean;');
      end;

    5: begin
         ProcAddr := @forest_FindPheasant;
         StrPCopy(ProcDef, 'function forest_FindPheasant(var px, py: Integer; TailSize: Integer; ClientHDC: HDC): Boolean;');
       end;

    6: begin
         ProcAddr := @pillory_solvequestion;
         StrPCopy(ProcDef, 'function pillory_solvequestion(var px, py: Integer; var Canvas: Tcanvas; ClientHDC: HDC): Boolean;');
       end;


  else
    x := -1;
  end;
  Result := x;
end;




//*******************************
//  Retrieve pointers to some of SCAR's internal functions


procedure SetFunctions(Funcs: array of TSCARPlugFunc); stdcall;
var
  i: Integer;
begin
  for i := 0 to Length(Funcs) - 1 do
  begin
    if Funcs[i].Name = 'Writeln' then
      Writeln := Funcs[i].Ptr;
    if Funcs[i].Name = 'GetClientWindowHandle' then
      GetClientWindowHandle := Funcs[i].Ptr;
  end;
  FillInfo := false;
end;

//***************************
// Don't change below this
exports GetFunctionCount;
exports GetFunctionInfo;
exports SetFunctions;

end.

You are the sex.
I may look through it later.
(BTW, canvases = slow)

Bautiful, thanks a lot.

You've done a lot for SRL forums, I hope you regain interest soon.

Thanks for releasing this, SKy. Good luck with your C# programming and come visit us every once in a while. :)

Nice code and thanks for releasing it, I can learn some stuff from it;)

-Tsn.

were do i put this code? and save it as>?

From: Scaper
were do i put this code? and save it as>?

You don't "put" it anywhere. It's already in your Plugins folder in SCAR (and has been for quite some time).

Oooo i see lol silly me haha thanks method

Meh. Show-off!

//SCAR Plugin. Created for SCAR Divi by Kaitnieks & Freddy1990
// currently you can't call SCAR functions from plugin
library XFindRock;

uses
  FastShareMem,
  SysUtils,
  Windows,
  Dialogs,
  Math,
  PngImage,
  Graphics;


{$R *.res}
type
  TPoint = Record
    x,y : integer;
  end;
  TPointArray = Array of TPoint;
  TMaskRay = Record
    xOff, yOff : Integer;
    Width,Height:Integer;
    CheckPoint : TPoint;
    WhiteArray : TPointArray;
    BlackArray : TPointArray;
  end;
  T2DPointArray = Array of Array of TPoint;

type
  TCharInfo = record
    W,H,Area,L : Integer;
    IsChar : Char;
    Points : TPointArray;
  end;
  TCharInfoArray = Array of TCharInfo;
  THandles = Packed record
    Bitmap : HBitmap;
    Client : HDC;
  end;
  TRGB32 = packed record
    B, G, R, A: Byte;
  end;
  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32) - 1] of TRGB32;
  PRGB32Array = ^TRGB32Array;
type
  TIntegerArray = array of Integer;

type
  TBox = Record
    x1,y1,x2,y2:Integer;
  end;
  TBoxArray = Array of TBox;
type
  TSCARPlugFunc = record
    Name: string;
    Ptr: Pointer;
  end;

  TNumbers = record
    n1, n2: Integer;
  end;
  TCharRay = Record
    
    Something:  integer;
  end;
Const
  Radix = 10;  //I can't really explain.. Radix 10 is used the most.. It stands for 0,1,2,3,4,5,6,7,8,9.. And if your using negative numbers to, its -9..9
Type
  TOneStrProc = procedure(s: string);

var
   Bmp : TBitmap;
   LineLength : LongInt;
   ScanLinePointer : PRGB32Array;

var
  Writeln: TOneStrProc;


Function IntToBox(x1,y1,x2,y2 : integer) : TBox;
begin;
  Result.x1 := x1;
  Result.y1 := y1;
  Result.x2 := x2;
  Result.y2 := y2;
end;
Procedure PNGToBitmap(LoadPath,SavePath : String);stdcall;
var
  PnGImg : TPNGObject;
  Bmp : TBitmap;
begin
  PnGImg := TPNGObject.Create;
  PnGImg.LoadFromFile(LoadPath);
  Bmp := TBitmap.Create;
  Bmp.Assign(PnGImg);
  Bmp.SaveToFile(SavePath);
  Bmp.Free;
  PnGImg.Free;
end;
//Credits to original maker!
//http://www.swissdelphicenter.ch/torry/showcode.php?id=1616
Procedure SortTPointArray(var Counts: TIntegerArray;var Points : TPointArray);
var
  Len, i, j, k,h: LongInt;
  Temp : TPoint;
begin
  Len := High(Counts);
  k := Len shr 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Counts[j] > Counts[j + k]) do
      begin
        h := Counts[j];
        Temp := Points[j];
        Counts[j] := Counts[j + k];
        Points[j] := Points[J + K];
        Points[J+K] := Temp;
        Counts[j + k] := h;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;
    k := k shr 1;
  end;
end;

//Credits to original maker!
//http://www.swissdelphicenter.ch/torry/showcode.php?id=1616
Procedure SortTPointArrayE(var Counts: Array of Extended;var Points : TPointArray);
var
  Len, i, j, k: LongInt;
  H : Extended;
  Temp : TPoint;
begin
  Len := High(Counts);
  k := Len shr 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Counts[j] > Counts[j + k]) do
      begin
        h := Counts[j];
        Temp := Points[j];
        Counts[j] := Counts[j + k];
        Points[j] := Points[J + K];
        Points[J+K] := Temp;
        Counts[j + k] := h;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;
    k := k shr 1;
  end;
end;



//Credits to original maker!
//http://www.swissdelphicenter.ch/torry/showcode.php?id=1616
procedure SortColorsCount(var Colors,  Counts: TIntegerArray);
var
  Len, i, j, k,h,tmp: LongInt;
begin
  Len := High(Counts);
  k := Len shr 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Counts[j] < Counts[j + k]) do
      begin
        h := Counts[j];
        tmp := Colors[j];
        Counts[j] := Counts[j + k];
        Counts[j + k] := h;
        Colors[j] := Colors[J + k];
        Colors[J + K] :=tmp;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;
    k := k shr 1;
  end;
end;

Function GetTPABounds(TPA: TPointArray): TBox; stdcall;
var
  I,L : Integer;
begin;
  L := High(TPA);
  if L < 0 then exit;
  Result.x1 := TPA[0].x;
  Result.y1 := TPA[0].y;
  Result.x2 := TPA[0].x;
  Result.y2 := TPA[0].y;
  For I:= 1 to L do
  begin;
    if TPA[i].x > Result.x2 then
      Result.x2 := TPA[i].x
    else if TPA[i].x < Result.x1 then
      Result.x1 := TPA[i].x;
    if TPA[i].y > Result.y2 then
      Result.y2 := TPA[i].y
    else if TPA[i].y < Result.y1 then
      Result.y1 := TPA[i].y;
  end;
end;

Function FindTPAinTPA(SearchTPA, TotalTPA : TPointArray; var Matches : TPointArray) : Boolean;stdcall;
var
  Len, I,II,LenSearch,xOff,yOff : integer;
  tx,ty,MatchCount : integer;
  Screen : Array of Array of Boolean;
  ScreenBox,SearchBox : TBox;
  Bool : Boolean;
begin;
  Result := False;
  Len := High(TotalTPA);
  LenSearch := High(SearchTPA);
  if LenSearch < 0 then Exit;
  if Len < LenSearch then Exit;
  MatchCount := 0;
  ScreenBox := GetTPABounds(TotalTPA);
  SearchBox := GetTPABounds(SearchTPA);
  Try
    SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1);
  Except
    Exit;
  end;
  if (SearchBox.x1 > 0) or (SearchBox.y1 > 0) then
  begin;
    For I := 0 to LenSearch do
    begin;
      SearchTPA[I].x := SearchTPA[I].x - SearchBox.x1;
      SearchTPA[I].y := SearchTPA[I].y - SearchBox.y1;
    end;
    SearchBox.x2 := SearchBox.x2 - SearchBox.x1;
    SearchBox.y2 := SearchBox.y2 - SearchBox.y1;
    SearchBox.x1 := 0;
    SearchBox.y1 := 0;
  end;
  xOff := SearchBox.x2;
  yOff := SearchBox.y2;
  For I := 0 to LenSearch do
  begin;
    if SearchTPA[I].x = 0 then
      if SearchTPA[I].y < yOff then
        yOff := SearchTPA[I].y;
    if SearchTPA[I].y = 0 then
      if SearchTPA[I].x < xOff then
        xOff := SearchTPA[I].x;
  end;
  For I := 0 to Len do
    Screen[TotalTPA[I].x][TotalTPA[I].y] := True;
  For I := 0 to Len do
  begin;
    tx := TotalTPA[I].x - xOff;
    ty := TotalTPA[I].y;// - yOff;
    if tx > 0 then
      if ty > 0 then
        if (SearchBox.x2 + tx) <= ScreenBox.x2 then
          if (SearchBox.y2 + ty) <= ScreenBox.y2 then
          begin;
            Bool := True;
            For II := 0 to LenSearch do
              if Screen[tx + SearchTPA[II].x ][ty + SearchTPA[II].y] = False then
              begin;
                Bool := False;
                Break;
              end;
            if bool then
            begin;
              MatchCount := MatchCount + 1;
              SetLength(Matches,MatchCount);
              Matches[MatchCount - 1].x := TotalTPA[I].x;
              Matches[MatchCount - 1].y := TotalTPA[I].y;
            end;
          end;
  end;
  if MatchCount > 0 then
    Result := True;
end;

Function FindGapsTPA( TPA : TPointArray; MinPixels : Integer) :T2DPointArray;stdcall;
var
  Len,TotalLen,LenRes,I,II,III : integer;
  Screen : Array of Array of Boolean;
  Height,Width : Integer;
  Box : TBox;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  Box := GetTPABounds(TPA);
  Height := Box.y2 - Box.y1;
  Width := Box.x2 - Box.x1;
  LenRes := 0;
  III := 0;
  Try
    SetLength(Screen,Width + 1,Height + 1);
  Except
    Exit;
  end;
  For I := 0 to Len do
    Screen[TPA[I].x - Box.x1][TPA[I].y - Box.y1] := True;
  SetLength(result,1);
  SetLength(Result[0],Len+1);
  TotalLen := 0;
  For I := 0 to Width do
  begin;
    For II := 0 to Height do
      if Screen[I][II]=True then
      begin;
        Result[TotalLen][LenRes].x := I + Box.x1;
        Result[TotalLen][LenRes].y := II + Box.y1;
        LenRes := LenRes + 1;
        III := I;
      end;
    if LenRes = 0 then
      III := I
    else
    if (I - III) > MinPixels then
    begin;
      III := I;
      SetLength(Result[TotalLen],LenRes);
      LenRes := 0;
      TotalLen := TotalLen + 1;
      SetLength(Result,TotalLen + 1);
      SetLength(Result[TotalLen],Len + 1);
    end;
  end;
  SetLength(Result[TotalLen],LenRes);
end;

Procedure EditToBounds( var TPA : TPointArray);stdcall;
var
  I : Integer;
  L : Integer;
  Box : TBox;
begin;
  Box := GetTPABounds(TPA);
  if (Box.x1 = 0) and (Box.y1 = 0) then
    exit;
  L := High(TPA);
  For I := 0 to L do
  begin;
    Tpa[I].x := TPA[I].x - Box.x1;
    TPA[I].y := TPA[I].y - Box.y1;
  end;
end;

Function GayBounds(Points: TPointArray): TBox; stdcall;

Var
   L, I: Integer;

Begin
  Result.X1 := 0 xor 0;
  Result.Y1 := 0 xor 0;
  Result.X2 := 1 shl 20;
  Result.Y2 := 1 shl 20;
  L := High(Points);
  For I := 0 To L Do
  Begin
    Result.X1 := Min(Result.X1, Points[I].X);
    Result.Y1 := Min(Result.Y1, Points[I].Y);
    Result.X2 := Max(Result.X2, Points[I].X);
    Result.Y2 := Max(Result.Y2, Points[I].Y);
  End;
End;

Function RemoveTPADistEachother(Dist : Integer; TPA : TPointArray) : TPointArray;stdcall;
var
  I, II, C,HighTPA: Integer;
  Keep: Boolean;
begin
  C:= 0;
  HighTPA := High(TPA);
  SetLength(Result, HighTPA + 1);
  for I:= 0 to HighTPA do
  begin
    Keep:= True;
    for II:= (I + 1) to HighTPA do
      if sqrt ( (TPA[II].x - TPA[I].x) * (TPA[II].x - TPA[I].x) + (TPA[II].y - TPA[I].y) * (TPA[II].y - TPA[I].y)) <= Dist then
      begin
        Keep:= False;
        break;
      end;
    if keep then
    begin
      Result[C].x:= TPA[I].x;
      Result[C].y := TPA[I].y;
      C := C + 1;
    end;
  end;
  SetLength(Result, C);
end;
Procedure CleanATPA(MinLength,MaxLength : Integer; var ATPA : T2DPointArray);Stdcall;
var
  L,LL,Count : integer;
  I : integer;
begin;
  L := High(ATPA);
  Count := -1;
  For I:= 0 to L do
  begin;
    LL := Length(ATPA[I]);
    if LL > MinLength then
      if LL < MaxLength then
      begin;
        Count := Count + 1;
        if I <> Count then
          ATPA[Count] := ATPA[I];
      end;
  end;
  SetLength(ATPA,Count+1);
end;

function RemoveTPASameRange(dist : integer; TPA : TPointArray) : TPointArray;stdcall;
var
  L, HighTPA,I,II : Integer;
  Bool : boolean;
begin;
  L := -1;
  HighTPA := High(TPA);
  SetLength(Result,HighTPA + 1);
  For I:= 0 to HighTPA do
  begin;
    Bool := False;
    For II := 0 to L do
      if sqrt ( (Result[II].x - TPA[I].x) * (Result[II].x - TPA[I].x) + (Result[II].y - TPA[I].y) * (Result[II].y - TPA[I].y)) <= Dist then
      begin;
        Bool := True;
        Break;
      end;
    if not Bool then
    begin;
      L := L + 1;
      Result[L].x := TPA[I].x;
      Result[L].y := Tpa[I].y;
    end;
  end;
  SetLength(Result,L+1);
end;
Function ColorToRGBASM( Color : integer;var R,G,B : integer): integer; stdcall;
asm
  pop edx
  mov eax,[edx]
{  mov [edx],eax
  and [edx],$FF
  shr eax,8
  mov [ecx],eax
  and [ecx],$FF
  shr eax,8
  mov [edx-8],eax
  and [edx-8],$FF}
//  mov [edx-16],$FF
//  mov eax, color
end;
Function AbsoluteInt ( SomeNumber : integer) : integer;assembler;stdcall;
asm
//  mov eax,edx
  mov eax,edx
  mov ecx, edx
  sar ecx, 31
  add eax, ecx
  xor eax, ecx
end;

Function FindCommonPoint(ArrayTPA : T2DPointArray) : TPointArray;stdcall;
var
  L, HighTPA,I,II,III : Integer;
  Lengths : TIntegerArray;
  Bool : boolean;
begin;
  Bool := False;
  L := -1;
  HighTPA := High(ArrayTPA);
  if HighTPA < 1 then exit;
  SetLength(Lengths,HighTPA +  1);
  For I:= 0 to HighTPA do
    Lengths[I] := High(ArrayTPA[I]);
  For I:= 0 to Lengths[0] do
  begin;
    For II := 1 to HighTPA do
    begin;
      Bool := False;
      For III := 0 to Lengths[II] do
        if ArrayTPA[0][I].x = ArrayTPA[II][III].x then
          if ArrayTPA[0][I].y = ArrayTPA[II][III].y then
          begin;
            Bool := True;
            Break;
          end;
      if not Bool then Break;
    end;
    if Bool then
    begin;
      L := L + 1;
      SetLength(Result,L+1);
      Result[L] := ArrayTPA[0][I];
    end;
  end;
end;

Function FloodFillTPA(TPA : TPointArray) : T2DPointArray;stdcall;
var
  x,y,i,CurrentArray, LengthTPA,CurrentStack : integer;
  TempBox : TBox;
  PointsToFill : Array of Array of Boolean;
  Lengths : TIntegerArray;
  TempTPA : TPointArray;
  Stack : TPointArray;
  fx,fy : integer;
begin;
  LengthTPA := High(TPA);
  if LengthTPA < 1 then
  begin;
    if LengthTPA = 0 then
    begin;
      SetLength(Result,1,1);
      Result[0][0] := TPA[0];
    end else
      SetLength(Result,0);
    exit;
  end;
  TempBox := GetTPABounds(TPA);
  SetLength(PointsToFill,TempBox.x2 - TempBox.x1+3,TempBox.y2 - TempBox.y1+3);
  x := TempBox.x1 - 1;
  y := TempBox.y1 - 1;
  CurrentArray := -1;
  CurrentStack := 0;
  SetLength(Stack   , LengthTPA * 2);//Just to be sure ^^.
  SetLength(Lengths , LengthTPA + 1);
  SetLength(TempTPA , LengthTPA + 1);
  For I := 0 to LengthTPA do
  begin;
    TempTPA[I].x := TPA[I].x - x;
    TempTPA[I].y := TPA[I].y - y;
  end;
  For I := 0 to LengthTPA do
    PointsToFill[TempTPA[I].x][TempTPA[I].y] := True;
  For I := 0 to LengthTPA do
    if PointsToFill[TempTPA[I].x][TempTPA[I].y] then
    begin;
      CurrentArray := CurrentArray + 1;
      SetLength(Result,CurrentArray + 1);
      SetLength(Result[CurrentArray],LengthTPA - I + 1);
      fx := TempTPA[I].x;
      fy := TempTPA[I].y;
      CurrentStack := CurrentStack + 1;
      Stack[CurrentStack].x := fx;
      Stack[Currentstack].y := fy;
      While CurrentStack > 0 do
      begin;
        if PointsToFill[fx][fy] then
        begin;
          PointsToFill [fx][fy] := false;
          Result[CurrentArray][Lengths[CurrentArray]].x := fx + x;
          Result[CurrentArray][Lengths[CurrentArray]].y := fy + y;
          Lengths[CurrentArray] := Lengths[CurrentArray] + 1;
        end;
        if PointsToFill[fx+1][fy] then
        begin
          fx := fx + 1;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx][fy+1] then
        begin
          fx := fx;fy := fy + 1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx-1][fy] then
        begin
          fx := fx - 1;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx][fy-1] then
        begin
          fx := fx;fy := fy - 1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx+1][fy+1] then
        begin
          fx := fx+1;fy := fy+1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx-1][fy-1] then
        begin
          fx := fx-1;fy := fy-1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx-1][fy + 1] then
        begin
          fx := fx-1;fy := fy+1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx+1][fy-1] then
        begin
          fx := fx+1;fy := fy-1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        fx := Stack[CurrentStack].x;
        fy := Stack[CurrentStack].y;
        CurrentStack := CurrentStack - 1;
      end;
      SetLength(Result[CurrentArray],Lengths[CurrentArray]);
    end;
  SetLength(Stack,0);
  SetLength(TempTPA,0);
  SetLength(Lengths,0);
end;

Function FloodFillTPADistance(Dist : Integer; TPA : TPointArray) : T2DPointArray;stdcall;
var
  x,y,i,CurrentArray, LengthTPA,CurrentStack,DistMin : integer;
  TempBox : TBox;
  PointsToFill : Array of Array of Boolean;
  Lengths : TIntegerArray;
  TempTPA : TPointArray;
  Stack : TPointArray;
  fx,fy,ii,iii : integer;
label
  Start;
begin;
  if Dist < 1 then
    Dist := 1;
  DistMin := Dist - 1;
  LengthTPA := High(TPA);
  if LengthTPA < 1 then
  begin;
    if LengthTPA = 0 then
    begin;
      SetLength(Result,1,1);
      Result[0][0] := TPA[0];
    end else
      SetLength(Result,0);
    exit;
  end;
  TempBox := GetTPABounds(TPA);
  SetLength(PointsToFill,TempBox.x2 - TempBox.x1+(Dist*2) + 1,TempBox.y2 - TempBox.y1+(Dist *2) + 1);
  x := TempBox.x1 - Dist;
  y := TempBox.y1 - Dist;
  CurrentArray := -1;
  CurrentStack := 0;
  SetLength(Stack   , LengthTPA * Dist * 2);//Just to be sure ^^.
  SetLength(Lengths , LengthTPA + 1);
  SetLength(TempTPA , LengthTPA + 1);
  For I := 0 to LengthTPA do
  begin;
    TempTPA[I].x := TPA[I].x - x;
    TempTPA[I].y := TPA[I].y - y;
  end;
  For I := 0 to LengthTPA do
    PointsToFill[TempTPA[I].x][TempTPA[I].y] := True;
  For I := 0 to LengthTPA do
    if PointsToFill[TempTPA[I].x][TempTPA[I].y] then
    begin;
      CurrentArray := CurrentArray + 1;
      SetLength(Result,CurrentArray + 1);
      SetLength(Result[CurrentArray],LengthTPA - I + 1);
      fx := TempTPA[I].x;
      fy := TempTPA[I].y;
      CurrentStack := CurrentStack + 1;
      Stack[CurrentStack].x := fx;
      Stack[Currentstack].y := fy;
      While CurrentStack > 0 do
      begin;
        Start:
        if PointsToFill[fx][fy] then
        begin;
          PointsToFill [fx][fy] := false;
          Result[CurrentArray][Lengths[CurrentArray]].x := fx + x;
          Result[CurrentArray][Lengths[CurrentArray]].y := fy + y;
          Lengths[CurrentArray] := Lengths[CurrentArray] + 1;
        end;
        For II := 1 to Dist do
        begin;
          if PointsToFill[fx+II][fy] then
          begin
            fx := fx + II;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx][fy+II] then
          begin
            fx := fx;fy := fy + II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx-II][fy] then
          begin
            fx := fx - II;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx][fy-II] then
          begin
            fx := fx;fy := fy - II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx+II][fy+II] then
          begin
            fx := fx+II;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx-II][fy-II] then
          begin
            fx := fx-II;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx-II][fy + II] then
          begin
            fx := fx-II;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx+II][fy-II] then
          begin
            fx := fx+II;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if II > 1 then
          begin;
            For III := 1 to DistMin do
            begin;
               if PointsToFill[fx+II][fy+III] then
               begin;
                 fx := fx+II;fy := fy+III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto Start;
               end;
               if PointsToFill[fx+II][fy-III] then
               begin;
                 fx := fx+II;fy := fy-III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto Start;
               end;
               if PointsToFill[fx-II][fy+III] then
               begin;
                 fx := fx-II;fy := fy+III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
               end;
               if PointsToFill[fx-II][fy-III] then
               begin;
                 fx := fx-II;fy := fy-III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
               end;
               if PointsToFill[fx-III][fy+II] then
               begin;
                 fx := fx-III;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
               if  PointsToFill[fx+III][fy+II] then
               begin;
                 fx := fx+III;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
               if PointsToFill[fx-III][fy-II] then
               begin;
                 fx := fx-III;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
               if PointsToFill[fx+III][fy-II] then
               begin;
                 fx := fx+III;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
            end;
          end;
        end;
        fx := Stack[CurrentStack].x;
        fy := Stack[CurrentStack].y;
        CurrentStack := CurrentStack - 1;
      end;
      SetLength(Result[CurrentArray],Lengths[CurrentArray]);
    end;
  SetLength(Stack,0);
  SetLength(TempTPA,0);
  SetLength(Lengths,0);
end;
Function MergeATPA(ATPA : T2DPointArray)  : TPointArray;stdcall;
var
  I,II, Len, TempL,CurrentL : integer;
begin;
  Len := High(ATPA);
  CurrentL := 0;
  For I:= 0 to Len do
  begin;
    TempL := High(ATPA[I]);
    if TempL < 0 then
    begin;
      Continue;
    end;
    TempL := Templ + CurrentL + 1;
    Setlength(Result, TempL+1);
    Try
      For II := CurrentL to TempL do
        Result[II] := ATPA[I][II - CurrentL];
    except
    end;
    CurrentL := TempL;
  end;
  SetLength(Result,CurrentL);
end;

Function FindTPAEdgePoints ( MaxW,MaxH : integer; TPA : TPointArray): TPointArray;stdcall;
var
  Bounds : TBox;
  I : Integer;
  x,y,len,width, height,tmp  : integer;
  Points :  Array of Array of Boolean;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  Bounds := GetTPABounds(TPA);
  SetLength(Points,Bounds.x2 - Bounds.x1 + 1,Bounds.y2 - Bounds.y1 + 1);
  SetLength(Result,len + 1);
  Width := Bounds.x2 - Bounds.x1;
  Height := Bounds.y2 - Bounds.y1;
  For I := 0 to Len do
    Points[TPA[I].x - Bounds.x1][TPA[I].y - Bounds.y1] := True;
  I := -1;
//  Showmessage(inttostr(len)+ '-' +inttostr(Width) + '- ' +inttostr(Height) );
  Tmp := 0;
  For Y:= 0 to  Height do
  Begin;
    For x := 0 to Width do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Tmp := x + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
    For X := Width Downto tmp do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
  end;
  Tmp := 0;
  For x := 0 to Width do
  Begin;
    For y:= 0 to Height do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Tmp := y + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
    For y := Width Downto tmp do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
  end;
  SetLength(Result, I + 1);
end;
Function SortTPAMiddles ( w,h : integer; TPA : TPointArray) : TPointArray;stdcall;
var
  Lengths : TIntegerArray;
  Middles : TPointArray;
  TempSorted : TPointArray;
  Bool : Boolean;
  Temp,I,II,LengthTPA : Integer;
begin;
  Temp := Length(TPA);
  if Temp < 1 then Exit;
  SetLength(Middles,Temp);
  SetLength(Lengths,Temp);
  SetLength(TempSorted,Temp);
  Temp := Temp - 1;
  LengthTPA := -1;
  For I:= 0 to Temp do
  begin;
    Bool := True;
    For II := 0 to LengthTPA do
      if Abs(TPA[I].x - TempSorted[II].x) < w then
        if Abs(TPA[I].y - TempSorted[II].y) < h then
        Begin;
          Bool := False;
          Break;
        end;
    if bool then
    begin;
      LengthTPA := LengthTPA + 1;
      TempSorted[LengthTPA] := Tpa[I];
      Lengths[LengthTPA] := 1;
      Inc(Middles[LengthTPA].x,TPA[I].x);
      Inc(Middles[LengthTPA].y,TPA[I].y);
    end else
    begin;
      Lengths[II] := Lengths[II] + 1;
      Inc(Middles[II].x,TPA[I].x);
      Inc(Middles[II].y,TPA[I].y);
    end;
  end;
  SetLength(TempSorted,0);
  SetLength(Middles,LengthTPA + 1);
  SetLength(Lengths,LengthTPA + 1);
  SetLength(Result, LengthTPA + 1);
  For I := 0 to LengthTPA do
  begin;
    Result[I].x := Middles[I].x div Lengths[I];
    Result[I].y := Middles[I].y div Lengths[I];
  end;
end;

Function BoxTPAToATPA(w,h : integer; Points : TPointArray) : T2DPointArray;stdcall;
var
  I,II,L,LL,III : integer;
  TempDist,Temp : Array of TBox;
  SwapTPA : TPointArray;
  Counts : TIntegerArray;
  Bool : Boolean;
begin;
  L := Length(Points);
  SetLength(Temp,L);
  SetLength(TempDist,L);
  SetLength(Counts,L);
  SetLength(Result,0);
  L := L - 1;
  LL := -1;
  if L < 1 then
    exit;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (Points[I].x >= TempDist[II].x1) and (Points[I].x <= TempDist[II].x2) then
        if (Points[I].y >= TempDist[II].y1) and (Points[I].y <= TempDist[II].y2) then
        begin;
          if (Points[I].x < Temp[II].x1) then
          begin;
            Temp[II].x1 := Points[I].x;
            TempDist[II].x1 := Points[I].x - W;
          end;
          if (Points[I].y < Temp[II].y1) then
          begin;
            Temp[II].y1 := Points[I].y;
            TempDist[II].y1 := Points[I].y - H;
          end;
          if (Points[I].x > Temp[II].x2) then
          begin;
            Temp[II].x2 := Points[I].x;
            TempDist[II].x2 := Points[I].x + W;
          end;
          if (Points[I].y > Temp[II].y2) then
          begin;
            Temp[II].y2 := Points[I].y;
            TempDist[II].y2 := Points[I].y + H;
          end;
          Bool := True;
          Counts[II] := Counts[II] + 1;
          Result[II][Counts[II]] := Points[I];
          Break;
        end;
    if not Bool then
    begin;
      LL := LL + 1;
      TempDist[LL] := IntToBox(Points[I].x-W,Points[I].y-H,Points[I].x+W,Points[I].y+H);
      Temp[LL] := IntToBox(Points[I].x,Points[I].y,Points[I].x,Points[I].y);
      SetLength(Result,LL+1);
      SetLength(Result[LL],L - I + 1);
      Result[LL][0] := Points[I];
    end;
  end;
  For I := 0 to LL do
    SetLength(Result[I],Counts[I] + 1);
  Bool := True;
  SetLength(TempDist,1);
  While Bool do
  begin;
    Bool := False;
    For I := 0 to LL do
      For II := 0 to (I-1) do
        if ((Temp[I].x1 >= Temp[II].x1) and (Temp[I].x1 <= Temp[II].x2)) or ((Temp[I].x2 >= Temp[II].x1) and (Temp[I].x2 <= Temp[II].x2)) then
          if ((Temp[I].y1 >= Temp[II].y1) and (Temp[I].y1 <= Temp[II].y2)) or ((Temp[I].y2 >= Temp[II].y1) and (Temp[I].y2 <= Temp[II].y2)) then
          begin;
            Bool := True;
            L := Counts[I] + 1;
            Setlength(Result[I], Counts[II] + L+ 1);
            For III := 0 to Counts[II] do
              Result[I][III + L] := Result[II][III];
            Counts[II] := Counts[LL];
            Result[II] := Result[LL];
            Temp[II]   := Temp[LL];
            LL := LL - 1;
            Break;
          end;
  end;
  SetLength(Result,LL+1);
end;

Function SortTPAToATPA (w,h : integer; TPA : TPointArray) : T2DPointArray;stdcall;
var
  Lengths : TIntegerArray;
  Bool : Boolean;
  Temp,I,II,LengthTPA : Integer;
begin;
  Temp := Length(TPA);
  SetLength(Lengths,Temp);
  Temp := Temp - 1;
  LengthTPA := -1;
  For I:= 0 to Temp do
  begin;
    Bool := True;
    For II := 0 to LengthTPA do
      if Abs(TPA[I].x - Result[II][0].x) < w then
        if Abs(TPA[I].y - Result[II][0].y) < h then
        Begin;
          Bool := False;
          Break;
        end;
    if bool then
    begin;
      LengthTPA := LengthTPA + 1;
      SetLength(Result,LengthTPA+1);
      SetLength(Result[LengthTPA],1);
      Result[LengthTPA][0] := Tpa[I];
      Lengths[LengthTPA] := 1;
    end else
    begin;
      Lengths[II] := Lengths[II] + 1;
      SetLength(Result[II],Lengths[II]);
      Result[II][Lengths[II]-1] := Tpa[I];
    end;
  end;
end;


Function GetHBitmap(var CanvasHandle : LongWord) : LongWord; stdcall;
var
  Bmp : Bitmap;
  TempDC : HDC;
begin;
  TempDC := CreateCompatibleDC(CanvasHandle);
  GetObject(GetCurrentObject(CanvasHandle,Obj_Bitmap),Sizeof(bitmap),@Bmp);
  Result := CreateCompatibleBitmap( CanvasHandle,Bmp.bmwidth,bmp.bmHeight);
  SelectObject(TempDC,Result);
end;

Procedure ChangeSize(Width,Height : integer); stdcall;
begin;
  Bmp.PixelFormat := pf32bit;
  Bmp.Width := Width;
  Bmp.Height := Height;
  ScanLinePointer := Bmp.Scanline[0];
  LineLength := (Longint(Bmp.Scanline[1]) - Longint(ScanLinePointer)) div 4;
end;

Procedure CreateSearchingBitmap(Width,Height : Integer);stdcall;
begin;
  ChangeSize(Width,Height);
end;

function LargestTPAInATPA(ATPA: T2DPointArray): Integer;stdcall;
var
  I, L, W,Len: Integer;
begin
  Result := -1;
  Len := High(ATPA);
  if Len < 0 then exit;
  L:= Length(ATPA[0]);
  W:= 0;
  for I:= 1 to Len do
    if Length(ATPA[I]) > L then
    begin
      L:= Length(ATPA[I]);
      W:= I;
    end;
  Result := W;
end;

Procedure FreeSearchingBitmap;stdcall;
begin;
end;

Procedure SortColorsSaveCounts(var Colors,Counts: TintegerArray);stdcall;
var
  I,II,LenResult,Len : integer;
  TempColors : TIntegerArray;
  Found : Boolean;
begin
  Len := High(Colors);
  SetLength(Counts,Len +1);
  SetLength(TempColors,Len+1);
  LenResult := -1;
  For I:= 0 to Len do
  begin;
    Found := False;
    For II := 0 to LenResult do
      if TempColors[II] = Colors[I] then
      begin;
        Found := True;
        Counts[II] := Counts[II] + 1;
      end;
    if Not found then
    begin;
      LenResult := LenResult + 1;
      TempColors[LenResult] := Colors[I];
    end;
  end;
  SetLength(TempColors,LenResult+1);
  SetLength(Counts,LenResult+1);
  SortColorsCount(TempColors,Counts);
  Colors := TempColors;
end;
Function SortTPABoxes( Boxes : TBoxArray; TPA: TPointArray) : T2DPointArray; stdcall;
Var
  Len, I , II, L : integer;
  Counts : TIntegerArray;
begin;
  Len := High(TPA);
  L := Length(Boxes);
  SetLength(Result, L,Len+1 );
  SetLength(Counts,L);
  Dec(L);
  For I:= 0 to Len do
    For II := 0 to L do
      if (TPA[I].x >= Boxes[II].x1) then
        if (TPA[I].x <= Boxes[II].x2) then
          if (TPA[I].y >= Boxes[II].y1) then
            if (TPA[I].y <= Boxes[II].y2) then
            begin;
              Result[II][Counts[II]] := TPA[I];
              Counts[II] := Counts[II] + 1;
              Break;
            end;
  For I:= 0 to L do
    SetLength(Result[I], Counts[I]);
end;
Function SortTPAToATPADist (Dist : Integer; TPA :TPointArray) : T2DPointArray;stdcall;
var
  Lengths : TIntegerArray;
  Bool : Boolean;
  Temp,I,II,III,LengthTPA : Integer;
begin;
  Temp := Length(TPA);
  SetLength(Lengths,Temp);
  Temp := Temp - 1;
  LengthTPA := -1;
  For I:= 0 to Temp do
  begin;
    Bool := True;
    For II := 0 to LengthTPA do
    begin;
      For III := 0 to Lengths[II]-1 do
        if sqrt((Result[II][III].x - TPA[I].x) * (Result[II][III].x - TPA[I].x) + (Result[II][III].y - TPA[I].y) * (Result[II][III].y - TPA[I].y)) <= Dist then
        Begin;
          Bool := False;
          Break;
        end;
      if not bool then break;
    end;
    if bool then
    begin;
      LengthTPA := LengthTPA + 1;
      SetLength(Result,LengthTPA+1);
      SetLength(Result[LengthTPA],1);
      Result[LengthTPA][0] := Tpa[I];
      Lengths[LengthTPA] := 1;
    end else
    begin;
      Lengths[II] := Lengths[II] + 1;
      SetLength(Result[II],Lengths[II]);
      Result[II][Lengths[II]-1] := Tpa[I];
    end;
  end;
end;
{
20,042957042957  ms   Mine
180,679320679321 ms   WizzyPlugin
}
Function SortTPADistance(x,y : integer; TPA : TPointArray) : TPointArray;stdcall;
var
  Distances : Array of Extended;
  I,Len : Integer;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  SetLength(Result,Len+1);
  SetLength(Distances,Len+1);
  For I:= 0 to Len do
  begin;
    Result[I] := TPA[I];
    Distances[I] := sqrt((x - TPA[I].x) * (x - TPA[I].x) + (y - TPA[I].y) * (y - TPA[I].y));
  end;
  SortTPointArrayE(Distances,Result);
end;

function SortATPADistFirstPoint(x,y : integer ; ATPA : T2DPointArray) : T2DPointArray;stdcall;
var
  Distances : Array of Extended;
  I,Len,K,J : Integer;
  H : extended;
begin;
  Len := High(ATPA);
  if Len < 0 then exit;
  SetLength(Result,Len+2);
  SetLength(Distances,Len+1);
  For I:= 0 to Len do
    if High(ATPA[I]) >= 0 then
    begin;
      Result[I] := ATPA[I];
      Distances[I] := sqrt((x - ATPA[I][0].x) * (x - ATPA[I][0].x) + (y - ATPA[I][0].y) * (y - ATPA[I][0].y));
    end;
  k := Len shr 1;
  if k = 0 then
    K := 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Distances[j] > Distances[j + k]) do
      begin
        h := Distances[j];
        Result[Len+1] := Result[j];
        Distances[j] := Distances[j + k];
        Result[j] := Result[J + K];
        Result[J+K] := Result[Len+1];
        Distances[j + k] := h;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;
    k := k shr 1;
  end;
  SetLength(Result,Len+1);
end;

function CenterBounds(Arr: TpointArray):Tpoint;stdcall;
var
  Len,xmin,xmax,ymin,ymax, I : Integer;
begin;
  Len := High(Arr);
  if Len < 0 then exit;
  xmin := arr[0].x;
  xmax := arr[0].x;
  ymin := arr[0].y;
  ymax := arr[0].y;
  For I := 1 to Len do
  begin;
    if Arr[I].x < xmin then
      xmin := Arr[I].x
    else if  Arr[I].x > xmax then
      xmax := Arr[I].x;
    if Arr[I].y < ymin then
      ymin := Arr[I].y
    else if  Arr[I].y > ymax then
      ymax := Arr[I].y;
  end;
  Result.x := Round((xmin + xmax) / 2);
  Result.y := Round((ymin + ymax) / 2);
end;

function MiddlePT(P1, P2: TPoint): TPoint;stdcall;
begin
  result.x:= (P1.x + P2.x) div 2;
  result.y:= (P1.y + P2.y) div 2;
end;
Procedure CenterTPAEx(var x,y : integer; tpa : TPointArray); stdcall;
var
  Len : integer;
  XCount,YCount : integer;
  I : integer;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  XCount := 0;
  YCount := 0;
  For I:= 0 to Len do
  begin;
    XCount := XCount + TPA[I].x;
    YCount := YCount + TPA[I].y;
  end;
  X := XCount div (Len + 1);
  Y := YCount div (Len + 1);
end;

function CenterATPA(ATPA : T2DPointArray) : TPointArray;stdcall;
var
  XCount,YCount : int64;
  I,II,L,LL : integer;
begin;
  L := High(ATPA);
  SetLength(Result,L+1);
  For I:= 0 to L do
  begin;
    LL := High(ATPA[I]);
    XCount := 0;
    YCount := 0;
    For II := 0 to LL do
    begin;
      XCount := XCount + ATPA[I][II].x;
      YCount := YCount + ATPA[I][II].y;
    end;
    result[I].x:= XCount div (LL+1);
    result[I].y:= YCount div (LL+1);
  end;
end;

function CenterTPA(TPA: TPointArray): TPoint;stdcall;
var
  l, xCount, yCount: Int64;
  i: integer;
begin
  L := High(TPA);
  xCount:= 0;
  yCount:= 0;
  for i:= 0 to L do
  begin
    xCount:= xCount + TPA[I].x;
    yCount:= yCount + TPA[I].y;
  end;
  result.x:= xCount div (L+1);
  result.y:= yCount div (L+1);
end;

Function SortColors( Colors : TIntegerArray): TIntegerArray;stdcall;
var
  I,II,LenResult,Len : integer;
  Counts : TIntegerArray;
  Found : Boolean;
begin
  Len := High(Colors);
  SetLength(counts,Len +1);
  SetLength(result,Len+1);
  LenResult := -1;
  For I:= 0 to Len do
  begin;
    Found := False;
    For II := 0 to LenResult do
      if Result[II] = Colors[I] then
      begin;
        Found := True;
        Counts[II] := Counts[II] + 1;
      end;
    if Not found then
    begin;
          LenResult := LenResult + 1;
      Result[LenResult] := Colors[I];
    end;
  end;
  SetLength(Result,LenResult+1);
  SetLength(Counts,LenResult+1);
  SortColorsCount(Result,Counts);
end;

Procedure XYZToRGBRay(X,Y,Z : Double;var R,G,B: integer);stdcall;
var
  TempR,TempG,TempB,Tempx,tempy,tempz : double;
begin;
  Tempx := X / 100;
  tempy := Y / 100;
  tempz := Z / 100;

  TempR := Tempx *  3.2406 + tempy * -1.5372 + tempz * -0.4986;
  TempG := Tempx * -0.9689 + tempy *  1.8758 + tempz *  0.0415;
  TempB := Tempx *  0.0557 + tempy * -0.2040 + tempz *  1.0570;

  if TempR > 0.0031308  then
    TempR := 1.055 * ( Power(TempR, ( 1 / 2.4 )) ) - 0.055
  else
    TempR := 12.92 * TempR;
  if TempG > 0.0031308 then
    TempG := 1.055 * ( Power(TempG, ( 1 / 2.4 )) ) - 0.055
  else
    TempG := 12.92 * TempG;
  if  TempB > 0.0031308 then
    TempB := 1.055 * ( Power(TempB , ( 1 / 2.4 )) ) - 0.055
  else
    TempB := 12.92 * TempB;

  R := Round(TempR * 255);
  G := Round(TempG * 255);
  B := Round(TempB * 255);
end;

Procedure RGBToXYZRay(R,G,B : integer;var x,y,z : double);stdcall;
var
  Red,Green,Blue : double;
begin;
  Red := R / 255;
  Green := G / 255;
  Blue := B / 255;
  if Red > 0.04045  then
    Red := Power( ( Red + 0.055 ) / 1.055  , 2.4)
  else
    Red := Red / 12.92;
  if Green > 0.04045  then
    Green := Power( ( Green + 0.055 ) / 1.055 , 2.4)
  else
    Green := Green / 12.92;
  if  Blue > 0.04045 then
    Blue := Power(  ( Blue + 0.055 ) / 1.055  , 2.4)
  else
    Blue := Blue / 12.92;

  Red := Red * 100;
  Green := Green * 100;
  Blue := Blue * 100;
  X := Red * 0.4124 + Green * 0.3576 + Blue * 0.1805;
  Y := Red * 0.2126 + Green * 0.7152 + Blue * 0.0722;
  Z := Red * 0.0193 + Green * 0.1192 + Blue * 0.9505;
end;

Procedure RGBToHSLRay(RR,GG,BB : integer;var H,S,L : Double);stdcall;
var
  R,  G,  B,   D,  Cmax, Cmin: Double;

begin
  R := RR / 255;
  G := GG / 255;
  B := BB / 255;
  CMin := R;
  if G < Cmin then Cmin := G;
  if B  < Cmin then Cmin := B;
  CMax := R;
  if G > Cmax then Cmax := G;
  if B  > Cmax then Cmax := B;
  L := 0.5 * (Cmax + Cmin);
  if Cmax = Cmin then
  begin
    H := 0;
    S := 0;
  end else
  begin;
    D := Cmax - Cmin;
    if L < 0.5 then
      S := D / (Cmax + Cmin)
    else
      S := D / (2 - Cmax - Cmin);
    if R = Cmax then
      H := (G - B) / D
    else
      if G = Cmax then
        H  := 2 + (B - R) / D
      else
        H := 4 +  (R - G) / D;
    H := H / 6;
    if H < 0 then
      H := H + 1;
  end;
end;
Procedure RGBToHSLRayInt(RR,GG,BB : integer;var H,S,L : Integer);stdcall;
var
  R,  G,  B,   D,  Cmax, Cmin: Integer;

begin
  R := RR * 10000 div 255;
  G := GG * 10000 div 255;
  B := BB * 10000 div 255;
  CMin := R;
  if G < Cmin then Cmin := G;
  if B  < Cmin then Cmin := B;
  CMax := R;
  if G > Cmax then Cmax := G;
  if B  > Cmax then Cmax := B;
  L := (Cmax + Cmin) div 2;
  if Cmax = Cmin then
  begin
    H := 0;
    S := 0;
  end else
  begin;
    D := Cmax - Cmin;
    if L < 5000 then
      S := D div (Cmax + Cmin)
    else
      S := D div (20000 - Cmax - Cmin);
    if R = Cmax then
      H := (G - B) div D
    else
      if G = Cmax then
        H  := 20000 + (B - R) div D
      else
        H := 40000 +  (R - G) div D;
    H := H div 60000;
    if H < 0 then
      H := H + 10000;
  end;
end;

Procedure RGBToCMYKRay(R,G,B : integer;var C,M,Y,K : Double);stdcall;
begin;
  C := 1 - R / 255;
  M := 1 - G / 255;
  Y := 1 - B / 255;
  K := 1;
  if ( C < 1 ) then  K := C;
  if ( M < K ) then  K := M;
  if ( Y < K ) then  K := Y;
  if K = 1  then
  begin;
     C := 0;
     M := 0;
     Y := 0;
  end else
  begin;
     C:= ( C - K ) / ( 1 - K );
     M:= ( M - K ) / ( 1 - K );
     Y:= ( Y - K ) / ( 1 - K );
  end;
end;

Function FindColorsCMYK(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;CTol,MTol,YTol,KTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  CC,  MC,  YC, KC ,  TmpC,TmpM,TmpY ,TmpK: Double;
begin
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  RGBToCMYKRay((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),CC,MC,YC,KC);
  CTol := CTol / 100;
  MTol := MTol / 100;
  YTol := YTol / 100;
  KTol := KTol / 100;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TmpC := 1 - (ScanLinePointer[x].R / 255);
      TmpM := 1 - (ScanLinePointer[x].G / 255);
      TmpY := 1 - (ScanLinePointer[x].B / 255);
      TmpK := 1;
      if  TmpC < 1     then  TmpK := TmpC;
      if  TmpM < TmpK  then  TmpK := TmpM;
      if  TmpY < TmpK  then  TmpK := TmpY;
      if Abs(KC - TmpK) <= KTol then
      begin;
        if TmpK = 1  then
        begin;
          if (CC <= CTol) then
            if (MC <= MTol) then
              if (YC <= YTol) then
              begin;
                Len := Len + 1;
                Points[Len].x := x-Startnum+xs;
                Points[Len].y := y+ys;
              end;
        end else
        begin;
          if Abs((TmpC - TmpK) / (1 - TmpK) - CC) <= CTol then
            if Abs(( TmpM - TmpK ) / ( 1 - TmpK)  - MC) <= MTol then
              if Abs(( TmpY - TmpK ) / ( 1 -  TmpK) - YC) <= YTol then
              begin;
                Len := Len + 1;
                Points[Len].x := x-Startnum+xs;
                Points[Len].y := y+ys;
              end;
        end;
      end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;
Function FindColorsHSLInt(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  H,  S,  L,TempR,TempG,TempB,  TmpH,TmpS,TmpL , D,  Cmax, Cmin: Integer;
begin
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  RGBToHSLRayInt((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),H,S,L);
{  HTol := HTol * 100;
  STol := STol * 100;
  LTol := LTol * 100;}
  H := H div 100;
  S := S div 100;
  L := L div 100;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TempR := (ScanLinePointer[x].R * 100 div 255);
      TempG := (ScanLinePointer[x].G * 100 div 255);
      TempB := (ScanLinePointer[x].B * 100 div 255);
      CMin := TempR;
      CMax := TempR;
      if TempG  < Cmin then CMin := TempG;
      if TempB  < Cmin then CMin := TempB;
      if TempG  > Cmax then CMax := TempG;
      if TempB  > Cmax then CMax := TempB;
      TmpL := (CMax + CMin) div 2;
      if Abs(L - TmpL) <= LTol then
      begin;
        if Cmax = Cmin then
        begin
          if (H <= HTol) and (S <= STol) then
          begin;
            Len := Len + 1;
            Points[Len].x := x-Startnum+xs;
            Points[Len].y := y+ys;
          end;
        end else
        begin;
          D := Cmax - Cmin;
          if Tmpl < 50 then
            TmpS := D div (Cmax + Cmin)
          else
            TmpS := D div (200 - Cmax - Cmin);
          if Abs(S - TmpS) <= STol then
          begin;
            if TempR = Cmax then
              TmpH := (TempG - TempB) div D
            else
            if TempG = Cmax then
              TmpH  := 200 + (TempB - TempR) div D
            else
              TmpH := 400 +  (TempR - TempG) div D;
            TmpH := TmpH div 600;
            if TmpH < 0 then
              TmpH := TmpH + 100;
            if Abs(H - TmpH) <= HTol then
            begin;
              Len := Len + 1;
              Points[Len].x := x-Startnum+xs;
              Points[Len].y := y+ys;
            end;
          end;
        end;
      end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;
Function FindColorsHSL(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  H,  S,  L,TempR,TempG,TempB,  TmpH,TmpS,TmpL , D,  Cmax, Cmin: Double;
begin
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  RGBToHSLRay((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),H,S,L);
  HTol := HTol / 100;
  STol := STol / 100;
  LTol := LTol / 100;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TempR := (ScanLinePointer[x].R / 255);
      TempG := (ScanLinePointer[x].G / 255);
      TempB := (ScanLinePointer[x].B / 255);
      CMin := TempR;
      CMax := TempR;
      if TempG  < Cmin then CMin := TempG;
      if TempB  < Cmin then CMin := TempB;
      if TempG  > Cmax then CMax := TempG;
      if TempB  > Cmax then CMax := TempB;
      TmpL := 0.5 * (CMax + CMin);
      if Abs(L - TmpL) <= LTol then
      begin;
        if Cmax = Cmin then
        begin
          if (H <= HTol) and (S <= STol) then
          begin;
            Len := Len + 1;
            Points[Len].x := x-Startnum+xs;
            Points[Len].y := y+ys;
          end;
        end else
        begin;
          D := Cmax - Cmin;
          if Tmpl < 0.5 then
            TmpS := D / (Cmax + Cmin)
          else
            TmpS := D / (2 - Cmax - Cmin);
          if Abs(S - TmpS) <= STol then
          begin;
            if TempR = Cmax then
              TmpH := (TempG - TempB) / D
            else
            if TempG = Cmax then
              TmpH  := 2 + (TempB - TempR) / D
            else
              TmpH := 4 +  (TempR - TempG) / D;
            TmpH := TmpH / 6;
            if TmpH < 0 then
              TmpH := TmpH + 1;
            if Abs(H - TmpH) <= HTol then
            begin;
              Len := Len + 1;
              Points[Len].x := x-Startnum+xs;
              Points[Len].y := y+ys;
            end;
          end;
        end;
      end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;

Function FindColorsXYZ(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;XTol,YTol,ZTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  OX,  OY,  OZ,TempR,TempG,TempB : Double;
begin
  RGBToXYZRay((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),OX,OY,OZ);
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TempR := (ScanLinePointer[x].R / 255);
      TempG := (ScanLinePointer[x].G / 255);
      TempB := (ScanLinePointer[x].B / 255);
      if TempR > 0.04045  then
       TempR := Power( ( TempR + 0.055 ) / 1.055  , 2.4)
      else
       TempR := TempR / 12.92;
      if TempG > 0.04045  then
        TempG := Power( ( TempG + 0.055 ) / 1.055 , 2.4)
      else
        TempG := TempG / 12.92;
      if  TempB > 0.04045 then
        TempB := Power(  ( TempB + 0.055 ) / 1.055  , 2.4)
      else
        TempB := TempB / 12.92;
      TempR := TempR * 100;
      TempG := TempG * 100;
      TempB := TempB * 100;
      if Abs((TempR * 0.4124 + TempG * 0.3576 + TempB * 0.1805) - OX) <= XTol then
        if Abs((TempR * 0.2126 + TempG * 0.7152 + TempB * 0.0722) - OY) <= YTol then
          if Abs((TempR * 0.0193 + TempG * 0.1192 + TempB * 0.9505) - OZ) <= ZTol then
          begin;
            Len := Len + 1;
            Points[Len].x := x-startnum+xs;
            Points[Len].y := y+ys;
          end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;

Function FindColorsRGB(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;stdcall;
var
  L,X,Y,W,H,StartNum,EndNum: integer;
  R,G,B : Byte;
begin;
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  L := -1;
  W := Xe - Xs+1;
  H := Ye - Ys+1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, W,H, DC, xs, ys, SRCCOPY);
  R := Color and $ff;
  G := Color shr 8 and $ff;
  B := Color shr 16 and $ff;
  SetLength(Points,(W * H));
  W := W-1;
  H := H-1;
  For Y := 0 to H do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + w;
    For x := StartNum to EndNum do
    begin;
      if Abs(ScanLinePointer[x].R - R) <= RTol then
        if Abs(ScanLinePointer[x].G - G) <= GTol then
          if Abs(ScanLinePointer[x].B - B) <= BTol then
          begin;
            L := L + 1;
            Points[L].x := x-startnum+xs;
            Points[L].y := y+ys;
          end;
    end;
  end;
  SetLength(Points,L+1);
  Result := L + 1;
end;

Function FindColorsRay(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;stdcall;
var
  L,X,Y,W,H,TmpR,TmpG,TmpB ,StartNum,EndNum: integer;
  Tol : Extended;
  R,G,B : Byte;
begin;
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  L := -1;
  W := Xe - Xs+1;
  H := Ye - Ys+1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, W,H, DC, xs, ys, SRCCOPY);
  R := Color and $ff;
  G := Color shr 8 and $ff;
  B := Color shr 16 and $ff;
  Tol := (RTol + GTol + BTol) / 3;
  SetLength(Points,(W * H));
  W := W-1;
  H := H-1;
  For Y := 0 to H do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + w;
    For x := StartNum to EndNum do
    begin;
      TmpR := Abs(ScanLinePointer[x].R - R);
      if TmpR <= RTol then
      begin;
        TmpG := Abs(ScanLinePointer[x].G - G);
        if TmpG <= GTol then
        begin;
          TmpB := Abs(ScanLinePointer[x].B - B);
          if TmpB <= BTol then
            if sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) <= Tol then
            begin;
              L := L + 1;
              Points[L].x := x-Startnum+xs;
              Points[L].y := y+ys;
            end;
        end;
      end;
    end;
  end;
  SetLength(Points,L+1);
  Result := L + 1;
end;
Function CreateMaskFromBMP( BmpDC : HDC) :  TMaskRay;Stdcall;
var
  x,y,L,LL : Integer;
  Bmp : Windows.TBitmap;
  Bitmappie : TBitmap;
  HBmp : Windows.HBitmap;
  LengthLine : LongInt;
  ScanLine : PRGB32Array;
begin;
  HBmp := GetCurrentObject(BmpDC,OBJ_BITMAP);
  GetObject(HBmp,SizeOf(Bmp),@Bmp);
  Bitmappie := TBitmap.Create;
  Bitmappie.PixelFormat := pf32bit;
  Bitmappie.Width := Bmp.bmWidth;
  Bitmappie.Height := Bmp.bmHeight;
  SetLength(Result.WhiteArray,Bmp.bmWidth * Bmp.bmHeight);
  SetLength(Result.BlackArray,Bmp.bmWidth * Bmp.bmHeight);
  BitBlt(Bitmappie.Canvas.Handle, 0, 0, Bmp.bmWidth,Bmp.bmHeight, BmpDC, 0, 0, SRCCOPY);
  ScanLine := Bitmappie.Scanline[0];
  LengthLine := (Longint(Bitmappie.Scanline[1]) - Longint(ScanLine)) div 4;
  L := -1;
  LL := -1;
  Bmp.bmWidth := Bmp.bmWidth - 1;
  Bmp.bmHeight := Bmp.bmHeight - 1;
  Result.Width := Bmp.bmWidth;
  Result.Height := Bmp.bmHeight;
  For y := 0 to Bmp.bmHeight do
    For x := 0 to Bmp.bmWidth do
    begin;
      if Scanline[y * LengthLine + x].r = 255 then
      begin;
        L := L + 1;
        Result.WhiteArray[L].x := x;
        Result.WhiteArray[L].y := y;
      end else
      begin;
        LL := LL + 1;
        Result.BlackArray[LL].x := x;
        Result.BlackArray[LL].y := y;
      end;
  end;
  SetLength(Result.WhiteArray,L + 1);
  SetLength(Result.BlackArray,LL + 1);
  Result.CheckPoint := Result.BlackArray[LL];
  For x := 0 to Bmp.bmWidth do
    For Y := 0 to Bmp.bmHeight do
      if Scanline[y * LengthLine + x].r = 255 then
      begin;
        Result.xOff := x;
        Result.yOff := y;
        Bitmappie.Free;
        Exit;
      end;
end;

Function FindMaskTolRay(xs,ys : integer; const xe,ye,Tol,ContourTol : integer;Const BackgroundAllColors : Boolean; Const Mask : TMaskRay; Const ClientDC : HDC; var mx,my : integer) : Boolean;stdcall;
var
  PrecalcedNumbers : TIntegerArray;
  L,LL,X,Y,W,H,I,II,TmpR,TmpG,TmpB ,StartNum: integer;
  R,G,B,RR,GG,BB : Byte;
  Bmp : TBitmap;
  LengthLine : LongInt;
  ScanLine : PRGB32Array;
  StartPT : TPoint;
Label
  NoMatch;
begin;
  Result := False;
  Bmp := TBitmap.Create;
  Bmp.PixelFormat := pf32bit;
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  L  := High(Mask.WhiteArray);
  LL := High(Mask.BlackArray);
  if L = 0 then exit;
  W := Xe - Xs+1;
  H := Ye - Ys+1;
  Bmp.Width := W;
  Bmp.Height:= H;
  BitBlt(Bmp.Canvas.Handle, 0, 0,W,H, ClientDC, xs, ys, SRCCOPY);
  ScanLine := Bmp.Scanline[0];
  LengthLine := (Longint(Bmp.Scanline[1]) - Longint(ScanLine)) div 4;
  SetLength(PrecalcedNumbers,H);
  For I := 0 to (H - 1) do
    PrecalcedNumbers[I] := I * LengthLine;
  W := W-Mask.Width-1;
  H := H-Mask.Height-1;
  For Y := Mask.yOff to H do
    For x := Mask.xOff to W do
    begin;
      R := ScanLine[PrecalcedNumbers[Y] + x].r;
      G := ScanLine[PrecalcedNumbers[Y] + x].g;
      B := ScanLine[PrecalcedNumbers[Y] + x].b;
      StartPT.x := x - Mask.xOff;
      StartPT.y := y - Mask.yOff;
      StartNum := PrecalcedNumbers[ Mask.CheckPoint.y + StartPT.y] + Mask.CheckPoint.x + StartPT.x;
      if sqrt((ScanLine[StartNum].R - R) * (ScanLine[StartNum].R - R)
             +(ScanLine[StartNum].G - G) * (ScanLine[StartNum].G - G)
             +(ScanLine[StartNum].B - B) * (ScanLine[StartNum].B - B)) <= ContourTol then
               Continue;
      For I := 0 to L do
      begin;
        StartNum := PrecalcedNumbers[Mask.WhiteArray[I].y + StartPT.y] + StartPT.x + Mask.WhiteArray[I].x;
        TmpR := ScanLine[StartNum].R - R;
        TmpG := ScanLine[StartNum].G - G;
        TmpB := ScanLine[StartNum].B - B;
        if (sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) > Tol) then
          Goto NoMatch;
        if BackgroundAllColors then
        begin;
          RR := ScanLine[StartNum].R;
          GG := ScanLine[StartNum].G;
          BB := ScanLine[StartNum].B;
          For II := 0 to LL do
          begin;
            StartNum := PrecalcedNumbers[Mask.BlackArray[II].y + StartPT.y] + StartPT.x + Mask.BlackArray[II].x;
            TmpR := ScanLine[StartNum].R - RR;
            TmpG := ScanLine[StartNum].G - GG;
            TmpB := ScanLine[StartNum].B - BB;
            if (sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) <= ContourTol) then
              goto NoMatch;
          end;
        end;
      end;
      if not BackgroundAllColors then
        For I := 0 to LL do
        begin;
          StartNum := PrecalcedNumbers[Mask.BlackArray[I].y + StartPT.y] + StartPT.x + Mask.BlackArray[I].x;
          TmpR := ScanLine[StartNum].R - R;
          TmpG := ScanLine[StartNum].G - G;
          TmpB := ScanLine[StartNum].B - B;
          if (sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) <= ContourTol) then
            goto NoMatch;
        end;
      Result := True;
      mx :=  x+xs-Mask.xOff;
      my :=  y+ys-Mask.yOff;
      Bmp.Free;
      ScanLine := Nil;
      Exit;
      NoMatch:
  end;
  Bmp.Free;
  Scanline := nil;
end;

Function IsMaskAt(x,y : integer; mask : TMaskRay; Tol,ContourTol : Integer; Bmp : TBitmap) : Boolean;
//var
//  I, II : integer;
begin;
  Result := True;
end;

{Function FindRocks(PointsDist,BoxDist,LastBoxDist : Integer;var Points : TPointArray;Color,RTol,GTol,BTol,xs, ys, xe, ye : Integer; DC : LongWord) : Boolean;stdcall;
var
  I,II,L,LL,X,Y : integer;
  R,G,B : Byte;
  TempDist,Temp : Array of TBox;
  TempPoints,TempPoints2 : TPointArray;
  Counts : TIntegerArray;
  Bool : Boolean;
  Bmp : TBitmap;
  Line : PRGB32Array;
begin;
  Result := False;
  L := -1;
  Bmp := TBitmap.Create;
  Bmp.Width := xe - xs+1;
  Bmp.Height := ye - ys+1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, DC, xs, ys, SRCCOPY);
  Bmp.PixelFormat := pf32bit;
  R := Color and $ff;
  G := Color shr 8 and $ff;
  B := Color shr 16 and $ff;
  SetLength(TempPoints,(Bmp.Width * Bmp.Height));
  I := Bmp.Height-1;
  II := Bmp.Width-1;
  for y := 0 to I do
  begin
    Line := Bmp.ScanLine[y];
    for x := 0 to II do
    begin
      if (Abs(Line[x].R - R) <= RTol) then
        if (Abs(Line[x].G - G) <= GTol) then
          if (Abs(Line[x].B - B) <= Btol) then
          begin
            L := L + 1;
            TempPoints[L].x := x+xs;
            TempPoints[L].y := y+ys;
         end;
    end;
  end;
  L := L + 1;
  SetLength(TempPoints,L);
  Line := nil;
  Bmp.Free;
  if L < 2 then Exit;
  SetLength(Temp,L);
  SetLength(TempDist,L);
  SetLength(Counts,L);
  L := L -1;
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (TempPoints[I].x >= TempDist[II].x1) and (TempPoints[I].x <= TempDist[II].x2) then
        if (TempPoints[I].y >= TempDist[II].y1) and (TempPoints[I].y <= TempDist[II].y2) then
        begin;
          if (TempPoints[I].x < Temp[II].x1) then
          begin;
            Temp[II].x1 := TempPoints[I].x;
            TempDist[II].x1 := TempPoints[I].x - PointsDist;
          end;
          if (TempPoints[I].y < Temp[II].y1) then
          begin;
            Temp[II].y1 := TempPoints[I].y;
            TempDist[II].y1 := TempPoints[I].y - PointsDist;
          end;
          if (TempPoints[I].x > Temp[II].x2) then
          begin;
            Temp[II].x2 := TempPoints[I].x;
            TempDist[II].x2 := TempPoints[I].x + PointsDist;
          end;
          if (TempPoints[I].y > Temp[II].y2) then
          begin;
            Temp[II].y2 := TempPoints[I].y;
            TempDist[II].y2 := TempPoints[I].y + PointsDist;
          end;
          Bool := True;
          Counts[II] := Counts[II] + 1;
          Break;
        end;
    if not Bool then
    begin;
      LL := LL + 1;
      TempDist[LL] := IntToBox(TempPoints[I].x-PointsDist,TempPoints[I].y-PointsDist,TempPoints[I].x+PointsDist,TempPoints[I].y+PointsDist);
      Temp[LL] := TempDist[LL];
    end;
  end;
  if LL < 0 then exit;
  SetLength(TempDist,0);
  SetLength(TempPoints,LL+1);
  SetLength(Counts,LL+1);
  For I:= 0 to LL do
  begin;
    TempPoints[I].x := (Temp[I].x1 + Temp[I].x2) div 2;
    TempPoints[I].y := (Temp[I].y1 + Temp[I].y2) div 2;
  end;
  SetLength(Temp,0);
  SortTPointArray(Counts,TempPoints);
  SetLength(TempPoints2,LL+1);
  L := -1;
  For I:= LL downto 0 do
  begin;
    Bool := False;
    For II := 0 to L do
      if (Abs(TempPoints[I].x - TempPoints2[II].x) <= BoxDist) and (Abs(TempPoints[I].y - TempPoints2[II].y) <= BoxDist) then
      begin;
        TempPoints2[II].x := (TempPoints2[II].x + TempPoints[I].x) div 2;
        TempPoints2[II].y := (TempPoints2[II].y + TempPoints[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      L := L + 1;
      TempPoints2[L] := TempPoints[I];
    end;
  end;
  if L < 0 then exit;
  SetLength(TempPoints2,L+1);
  SetLength(Points,L+1);
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (Abs(TempPoints2[I].x - Points[II].x) <= LastBoxDist) and (Abs(TempPoints2[I].y - Points[II].y) <= LastBoxDist) then
      begin;
        Points[II].x := (TempPoints2[II].x + Points[I].x) div 2;
        Points[II].y := (TempPoints2[II].y + Points[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      LL := LL + 1;
      Points[LL] := TempPoints2[I];
    end;
  end;
  if LL < 0 then
    exit
  else
    Result := True;
  SetLength(Points,LL+1);
end;    }


Procedure RadixSort(Integers : TIntegerArray; Digits : Integer; Negative : Boolean);stdcall;
var
  Dump : Array[0..9] of TIntegerArray; //We store them temporary here
  Counts : Array[0..9] of Integer; //Counts, for the length of the Dump
  Len,Divider,I,II,III,Temporary,Counter : Integer;
  TotalCleaning,TotalDump,TotalBack,TotalInit,Temp,Destroy : integer;
begin
  Divider := 1; //We use this, to sort all the digits time by time ;).
  Len := High(Integers);
  TotalDump := 0;
  TotalCleaning := 0;
  TotalBack := 0;
  TotalInit := 0;
  Temp := GetTickCount;
  For I := 0 to 9 do
    SetLength(Dump[I],Len + 1);
  TotalInit := TotalInit + Integer(GetTickCount) - Temp;
  For I := 1 to Digits do //Digits!
  begin;
    Temp := GetTickCount;
    For II := 0 to 9 do
      Counts[II] := -1; //Reset the counts
    TotalCleaning := TotalCleaning + Integer(GetTickCount) - Temp;
    Temp := Integer(GetTickCount);
    For II := 0 to Len do
    begin;
      Temporary := (Integers[II] div Divider) mod 10; // We get the single digit of the number..
      //Counts[Temporary] := Counts[Temporary] + 1; //Increase the Counts ;)
      Inc(Counts[Temporary]);
      Dump[Temporary][Counts[Temporary]] := Integers[II]; //Store the whole number in in its own digit 'dump', 0 to Radix - 1.. E.G. : Dump[0][0] := Integers[II];
    end;
    TotalDump := TotalDump + Integer(GetTickCount) - Temp;
    Temp := GetTickCount;
    Counter := -1;
    For II := 0 to 9 do
      For III := 0 to  Counts[II] do
      begin;
        Inc(Counter);//Counter := Counter + 1;
        Integers[Counter] := Dump[II][III]; //Place back the orignal var, "Integers"
      end;
    TotalBack := TotalBack + Integer(GetTickCount) - Temp;
    Divider := Divider * 10; //So that we go to the next Digit
  end;
  Writeln(inttostr(TotalCleaning) + ' Cleaning');
  Writeln(inttostr(TotalDump) + ' Dump');
  Writeln(inttostr(TotalBack) + ' Back');
  Writeln(inttostr(TotalInit) + ' Init');
  Destroy := GetTickCount;
  For I := 0 to 9 do
    SetLength(Dump[I],0);
  Writeln(IntToStr(Integer(GetTickCount) - Destroy) + ' DeInit');

end;



procedure QuickSort(var arr: TIntegerArray; s, e: integer); stdcall;
var
  cs, ce: Integer;
  pivot, swap: INteger;
begin
  cs:= s;
  ce:= e;
  pivot:= arr[(s + e) div 2];
  repeat
    while arr[cs] < pivot do cs:= cs + 1;
    while arr[ce] > pivot do ce:= ce - 1;
    if cs <= ce then
    begin
      swap:= arr[cs];
      arr[cs]:= arr[ce];
      arr[ce]:= swap;
      cs:= cs + 1;
      ce:= ce - 1;
    end;
  until cs > ce;
  if ce > s then QuickSort(arr, s, ce);
  if cs < e then QuickSort(arr, cs, e);
end;
Procedure RandomArray(var Ints : TIntegerArray; MinRandom,PlusRandom : Integer; Len : Integer);stdcall;
var
  I : integer;
begin;
  SetLength(Ints,Len+1);
  For I := 0 to len do
    INts[I] := Random(PlusRandom);
  if MinRandom > 0 then
  For I := 0 to len do
    Ints[I] := Ints[I] - Random(MinRandom);
end;
Function FindRocksOld(PointsDist,BoxDist,LastBoxDist : Integer;var Points : TPointArray) : Boolean;stdcall;
var
  I,II,L,LL,X,Y : integer;
  TempDist,Temp : Array of TBox;
  TempPoints,TempPoints2 : TPointArray;
  Counts : TIntegerArray;
  Bool : Boolean;
begin;
  Result := False;
  L := Length(Points);
  if L < 2 then Exit;
  SetLength(Temp,L);
  SetLength(TempDist,L);
  SetLength(Counts,L);
  L := L - 1;
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := LL downto 0 do
      if (Points[I].x >= TempDist[II].x1) and (Points[I].x <= TempDist[II].x2) then
        if (Points[I].y >= TempDist[II].y1) and (Points[I].y <= TempDist[II].y2) then
        begin;
          if (Points[I].x < Temp[II].x1) then
          begin;
            Temp[II].x1 := Points[I].x;
            TempDist[II].x1 := Points[I].x - PointsDist;
          end;
          if (Points[I].y < Temp[II].y1) then
          begin;
            Temp[II].y1 := Points[I].y;
            TempDist[II].y1 := Points[I].y - PointsDist;
          end;
          if (Points[I].x > Temp[II].x2) then
          begin;
            Temp[II].x2 := Points[I].x;
            TempDist[II].x2 := Points[I].x + PointsDist;
          end;
          if (Points[I].y > Temp[II].y2) then
          begin;
            Temp[II].y2 := Points[I].y;
            TempDist[II].y2 := Points[I].y + PointsDist;
          end;
          Bool := True;
          Counts[II] := Counts[II] + 1;
          Break;
        end;
    if not Bool then
    begin;
      LL := LL + 1;
      TempDist[LL] := IntToBox(Points[I].x-PointsDist,Points[I].y-PointsDist,Points[I].x+PointsDist,Points[I].y+PointsDist);
      Temp[LL] := IntToBox(Points[I].x,Points[I].y,Points[I].x,Points[I].y);
    end;
  end;
  if LL < 0 then exit;
  SetLength(TempDist,0);
  SetLength(TempPoints,LL+1);
  SetLength(Counts,LL+1);
  For I:= 0 to LL do
  begin;
    TempPoints[I].x := (Temp[I].x1 + Temp[I].x2) div 2;
    TempPoints[I].y := (Temp[I].y1 + Temp[I].y2) div 2;
  end;
  SetLength(Temp,0);
  SortTPointArray(Counts,TempPoints);
  SetLength(TempPoints2,LL+1);
  L := -1;
  For I:= LL downto 0 do
  begin;
    Bool := False;
    For II := 0 to L do
      if (Abs(TempPoints[I].x - TempPoints2[II].x) <= BoxDist) and (Abs(TempPoints[I].y - TempPoints2[II].y) <= BoxDist) then
      begin;
        TempPoints2[II].x := (TempPoints2[II].x + TempPoints[I].x) div 2;
        TempPoints2[II].y := (TempPoints2[II].y + TempPoints[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      L := L + 1;
      TempPoints2[L] := TempPoints[I];
    end;
  end;
  if L < 0 then exit;
  SetLength(TempPoints2,L+1);
  SetLength(Points,L+1);
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (Abs(TempPoints2[I].x - Points[II].x) <= LastBoxDist) and (Abs(TempPoints2[I].y - Points[II].y) <= LastBoxDist) then
      begin;
        Points[II].x := (TempPoints2[II].x + Points[I].x) div 2;
        Points[II].y := (TempPoints2[II].y + Points[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      LL := LL + 1;
      Points[LL] := TempPoints2[I];
    end;
  end;
  if LL < 0 then
    exit
  else
    Result := True;
  SetLength(Points,LL+1);
end;

function FindTextTPAinTPARay(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; stdcall;
var
  Len, I,II,LenSearch,LenTPA,xOff,yOff,x,y: integer;
  tx,ty,MatchCount : integer;
  Screen : Array of Array of Boolean;
  ScreenBox,SearchBox : TBox;
  InversedTPA : TPointArray;
begin;
  Result := False;
  Len := High(TotalTPA);
  LenSearch := High(SearchTPA);
  if LenSearch < 0 then Exit;
  if Len < LenSearch then Exit;
  MatchCount := 0;
  xOff := -5;
  yOff := 0;
  ScreenBox := GetTPABounds(TotalTPA);
  SearchBox := GetTPABounds(SearchTPA);
  SearchBox.y2 := Height;
  SetLength(Screen, SearchBox.x2 + 1,Searchbox.y2 + 1);
  SetLength(InversedTPA,(SearchBox.x2 + 1) * (Searchbox.y2 + 1));
  for I := 0 to LenSearch do
    Screen[ SearchTPA[I].x][SearchTPA[I].y] := True;
  LenTPA := -1;
  for y := 0 to SearchBox.y2 do
    for x := 0 to SearchBox.x2 do
      if Screen[X][Y] = False then
      begin;
        LenTPA := LenTPA + 1;
        InversedTPA[LenTPA].x := x;
        InversedTPA[LenTPA].y := y;
      end;
  for x := 0 to SearchBox.x2 do
  begin;
    for y := 0 to SearchBox.y2 do
      if Screen[x][y] = True then
      begin;
        xOff := x;
        yOff := y;
        Break;
      end;
    if xOff >= 0 then
      Break;
  end;
  try
    SetLength(Screen,0);
    SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1);
  except
    Exit;
  end;
  for I := 0 to Len do
    Screen[TotalTPA[I].x][TotalTPA[I].y] := True;
  for I := 0 to Len do
  begin;
    tx := TotalTPA[I].x - xOff;
    ty := TotalTPA[I].y - yOff;
    if tx > 0 then
      if ty > 0 then
        if ((SearchBox.x2 + tx) <= ScreenBox.x2) and ((SearchBox.y2 + ty) <= ScreenBox.y2) then
          begin;
            For II := 0 to LenSearch do
              if Screen[tx + SearchTPA[II].x ][ty + SearchTPA[II].y] = False then
                Break;
            if (II > LenSearch) then
            begin;
              For II := 0 to LenTPA do
                if Screen[tx + InversedTPA[II].x ][ty + InversedTPA[II].y] = True then
                  Break;
              if (II > LenTPA) then
              begin;
                MatchCount := MatchCount + 1;
                SetLength(Matches,MatchCount);
                Matches[MatchCount - 1].x := TotalTPA[I].x;
                Matches[MatchCount - 1].y := TotalTPA[I].y;
              end;
            end;
          end;
  end;
  if (MatchCount > 0) then
    Result := True;
end;

function TPAFromBox(var Box : TBox) : TPointArray; stdcall;
var
  x,y : integer;
  l : integer;
begin;
  ShowMessage(Inttostr(Box.x2) + '-' + inttostr(box.x1) + '-' + inttostr(box.y2) + '-' + inttostr(box.y1));
  ShowMessage(inttostr((Box.x2 - Box.x1 + 1) * (Box.y2 - Box.y1 + 1)));
  SetLength(Result, (Box.x2 - Box.x1 + 1) * (Box.y2 - Box.y1 + 1));
  ShowMessage('Jemoeder');
  l := 0;
  For x := box.x1 to Box.x2 do
    for y := box.y1 to box.y2 do
    begin;
      Result[l].x := x;
      Result[l].y := y;
      inc(l);
    end;
end;

Function FindText(var Chars : TCharInfoArray; var TPA : TPointArray) : String;
var
  I,II : integer;
begin;
end;
function GetFunctionCount(): Integer; stdcall; export;
begin
  Result := 52;
end;

function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
  case x of
    0:
       begin;
         ProcAddr := @RemoveTPADistEachother;
         StrPCopy(ProcDef, 'Function RemoveTPADistEachother(Dist : Integer; TPA : TPointArray) : TPointArray;');
       end;
    1:
       begin;
         ProcAddr := @FindRocksOld;
         StrPCopy(ProcDef, 'Function FindRocksOld(PointsDist,BoxDist,LastBoxDist : Integer;var Points : TPointArray) : Boolean;');
       end;
    2:
       begin;
         ProcAddr := @FindColorsRay;
         StrPCopy(ProcDef, 'Function FindColorsRay(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;');
       end;
    3:
       begin;
         ProcAddr := @GetHBitmap;
         StrPCopy(ProcDef, 'Function GetHBitmap(CanvasHandle : LongWord) : LongWord;');
       end;
    4:
       begin;
         ProcAddr := @ChangeSize;
         StrPCopy(ProcDef, 'Procedure ChangeSize(Width,Height : integer);');
       end;
    5:
       begin;
         ProcAddr := @FreeSearchingBitmap;
         StrPCopy(ProcDef, 'Procedure FreeSearchingBitmap;');
       end;
    6:
       begin;
         ProcAddr := @CreateSearchingBitmap;
         StrPCopy(ProcDef, 'Procedure CreateSearchingBitmap(Width,Height : Integer);');
       end;
    7:
       begin;
         ProcAddr := @RGBToHSLRay;
         StrPCopy(ProcDef, ' Procedure RGBToHSLRay(R,G,B : integer;var H,S,L : double);');
       end;
    8:
       begin;
         ProcAddr := @CreateSearchingBitmap;
         StrPCopy(ProcDef, 'Procedure CreateSearchingBitmap(Width,Height : Integer);');
       end;
    9:
       begin;
         ProcAddr := @FindColorsHSL;
         StrPCopy(ProcDef, 'Function FindColorsHSL(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;');
       end;
    10:
       begin;
         ProcAddr := @SortColors;
         StrPCopy(ProcDef, 'Function SortColors( Colors : TIntegerArray): TIntegerArray;');
       end;
    11:
       begin;
         ProcAddr := @SortColorsSaveCounts;
         StrPCopy(ProcDef, 'Procedure SortColorsSaveCounts(var Colors,Counts: TintegerArray);');
       end;
    12:
       begin;
         ProcAddr := @SortTPAMiddles;
         StrPCopy(ProcDef, 'Function SortTPAMiddles ( w,h : integer; TPA : TPointArray) : TPointArray;');
       end;
    13:
       begin;
         ProcAddr := @SortTPAToATPA;
         StrPCopy(ProcDef, 'Function SortTPAToATPA (w,h : integer; TPA : TPointArray) : T2DPointArray;');
       end;
    14:
       begin;
         ProcAddr := @BoxTPAToATPA;
         StrPCopy(ProcDef, 'Function BoxTPAToATPA(w,h : integer; Points : TPointArray) : T2DPointArray;');
       end;
    15:
       begin;
         ProcAddr := @GetTPABounds;
         StrPCopy(ProcDef, 'Function GetTPABounds(TPA: TPointArray): TBox;');
       end;
    16:
       begin;
         ProcAddr := @FloodFillTPA;
         StrPCopy(ProcDef, 'Function FloodFillTPA(TPA : TPointArray) : T2DPointArray;');
       end;
    17:
       begin;
         ProcAddr := @FloodFillTPADistance;
         StrPCopy(ProcDef, 'Function FloodFillTPADistance(Dist : Integer; TPA : TPointArray) : T2DPointArray;');
       end;
    18:
       begin;
         ProcAddr := @FindCommonPoint;
         StrPCopy(ProcDef, 'Function FindCommonPoint(ArrayTPA : T2DPointArray) : TPointArray;');
       end;
    19:
       begin;
         ProcAddr := @FindColorsXYZ;
         StrPCopy(ProcDef, 'Function FindColorsXYZ(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;XTol,YTol,ZTol : Double;const DC : LongWord) : Integer;');
       end;
    20:
       begin;
         ProcAddr := @RGBToXYZRay;
         StrPCopy(ProcDef, 'Procedure RGBToXYZRay(R,G,B : integer;var x,y,z : double);');
       end;
    21:
       begin;
         ProcAddr := @XYZToRGBRay;
         StrPCopy(ProcDef, 'Procedure XYZToRGBRay(X,Y,Z : Double;var R,G,B: integer);');
       end;
    22:
       begin;
         ProcAddr := @LargestTPAInATPA;
         StrPCopy(ProcDef, 'function LargestTPAInATPA(ATPA: T2DPointArray): Integer;');
       end;
    23:
       begin;
         ProcAddr := @RemoveTPASameRange;
         StrPCopy(ProcDef, 'Function RemoveTPASameRange(Dist : Integer; TPA : TPointArray) : TPointArray;');
       end;
    24:
       begin;
         ProcAddr := @FindTPAEdgePoints;
         StrPCopy(ProcDef, 'Function FindTPAEdgePoints ( MaxW,MaxH : integer; TPA : TPointArray): TPointArray;');
       end;
    25:
       begin;
         ProcAddr := @RGBToCMYKRay;
         StrPCopy(ProcDef, 'Procedure RGBToCMYKRay(R,G,B : integer;var C,M,Y,K : Double);');
       end;
    26:
       begin;
         ProcAddr := @FindColorsCMYK;
         StrPCopy(ProcDef, 'Function FindColorsCMYK(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;CTol,MTol,YTol,KTol : Double;const DC : LongWord) : Integer;');
       end;
    27:
       begin;
         ProcAddr := @SortTPABoxes;
         StrPCopy(ProcDef, 'Function SortTPABoxes( Boxes : TBoxArray; TPA: TPointArray) : T2DPointArray;');
       end;
    28:
       begin;
         ProcAddr := @SortTPADistance;
         StrPCopy(ProcDef, 'Function SortTPADistance(x,y : integer; TPA : TPointArray) : TPointArray;');
       end;
    29:
       begin;
         ProcAddr := @FindColorsRGB;
         StrPCopy(ProcDef, 'Function FindColorsRGB(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;');
       end;
    30:
       begin;
         ProcAddr := @CenterTPA;
         StrPCopy(ProcDef, 'function CenterTPA(TPA: TPointArray): TPoint;');
       end;
    31:
       begin;
         ProcAddr := @CenterBounds;
         StrPCopy(ProcDef, 'function CenterBounds(Arr: TpointArray):Tpoint;');
       end;
    32:
       begin;
         ProcAddr := @MiddlePT;
         StrPCopy(ProcDef, 'function MiddlePT(P1, P2: TPoint): TPoint;');
       end;
    33:
       begin;
         ProcAddr := @MergeATPA;
         StrPCopy(ProcDef, 'Function MergeATPA(ATPA : T2DPointArray)  : TPointArray;');
       end;
    34:
       begin;
         ProcAddr := @AbsoluteInt;
         StrPCopy(ProcDef, 'Function AbsoluteInt ( SomeNumber : integer) : integer;');
       end;
    35:
       begin;
         ProcAddr := @ColorToRGBASM;
         StrPCopy(ProcDef, 'Function ColorToRGBASM( Color : integer;var R,G,B : integer):integer;');
       end;
    36:
       begin;
         ProcAddr := @FindColorsHSLInt;
         StrPCopy(ProcDef, 'Function FindColorsHSLInt(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;');
       end;
    37:
       begin;
         ProcAddr := @CleanATPA;
         StrPCopy(ProcDef, 'Procedure CleanATPA(MinLength,MaxLength : Integer; var ATPA : T2DPointArray);');
       end;
    38:
       begin;
         ProcAddr := @SortATPADistFirstPoint;
         StrPCopy(ProcDef, 'function SortATPADistFirstPoint(x,y : integer ; ATPA : T2DPointArray) : T2DPointArray;');
       end;
    39:
       begin;
         ProcAddr := @CenterTPAEx;
         StrPCopy(ProcDef, 'Procedure CenterTPAEx(var x,y : integer; tpa : TPointArray);');
       end;
    40:
       begin;
         ProcAddr := @SortTPAToATPADist;
         StrPCopy(ProcDef, 'Function SortTPAToATPADist(Dist : Integer; TPA :TPointArray) : T2DPointArray;');
       end;
    41:
       begin;
         ProcAddr := @FindTPAinTPA;
         StrPCopy(ProcDef, 'Function FindTPAinTPA(SearchTPA, TotalTPA : TPointArray; var Matches : TPointArray) : Boolean;');
       end;
    42:
       begin;
         ProcAddr := @GayBounds;
         StrPCopy(ProcDef, 'Function GayBounds(Points: TPointArray): TBox; ');
       end;
    43:
       begin;
         ProcAddr := @FindGapsTPA;
         StrPCopy(ProcDef, 'Function FindGapsTPA( TPA : TPointArray; MinPixels : Integer) :T2DPointArray;');
       end;
    44:
       begin;
         ProcAddr := @EditToBounds;
         StrPCopy(ProcDef, 'Procedure EditToBounds( var TPA : TPointArray);');
       end;
    45:
       begin;
         ProcAddr := @FindMaskTolRay;
         StrPCopy(ProcDef, 'Function FindMaskTolRay(xs,ys : integer; const xe,ye,Tol,ContourTol : integer;Const BackgroundAllColors : Boolean; Const Mask : TMaskRay; Const ClientDC : HDC; var mx,my : integer) : Boolean;');
       end;
    46:
       begin;
         ProcAddr := @CreateMaskFromBMP;
         StrPCopy(ProcDef, 'Function CreateMaskFromBMP( BmpDC : HDC) :  TMaskRay;');
       end;
    47:
       begin;
         ProcAddr := @RadixSort;
         StrPCopy(ProcDef, 'Procedure RadixSort(Integers : TIntegerArray; Digits : Integer; Negative : Boolean);');
       end;
    48:
       begin;
         ProcAddr := @QuickSort;
         StrPCopy(ProcDef, 'procedure QuickSort2(var arr: TIntegerArray; s, e: integer);');
       end;
    49:
       begin;
         ProcAddr := @RandomArray;
         StrPCopy(ProcDef, 'Procedure RandomArray(var Ints : TIntegerArray; MinRandom,PlusRandom : Integer; Len : Integer);');
       end;
     50:
       begin;
         ProcAddr := @PNGToBitmap;
         StrPCopy(ProcDef, 'Procedure PNGToBitmap(LoadPath,SavePath : String);');
       end;
    51:
       begin;
         ProcAddr := @TPAFromBox;
         StrPCopy(ProcDef, 'function TPAFromBox242424242(var Box : TBox) : TPointArray;');
       end;
    else
     x := -1;
  end;
  Result := x;
end;

function GetTypeCount(): Integer; stdcall; export;
begin
  Result := 1;
end;

//*******************************
//  Types you want to add

function GetTypeInfo(x: Integer; var sType, sTypeDef: string): Integer; stdcall;
begin
  case x of
    0:
      begin
        sType := 'TMaskRay';
        sTypeDef := 'Record xOff, yOff : Integer;Width,Height:Integer;CheckPoint : TPoint;WhiteArray : TPointArray;BlackArray : TPointArray;end;';
      end;
    1:
      begin
        sType := 'TNumbers';
        sTypeDef := 'record n1, n2: Integer; end;';
      end;
  else
    x := -1;
  end;
  Result := x;
end;


procedure SetFunctions(Funcs: array of TSCARPlugFunc); stdcall;
var
  i: Integer;
begin
  for i := 0 to Length(Funcs) - 1 do
    if Funcs[i].Name = 'Writeln' then
      Writeln := Funcs[i].Ptr;
end;
exports SetFunctions;

exports GetFunctionCount;
exports GetFunctionInfo;
exports GetTypeCount;
exports GetTypeInfo;

procedure DllMain(reason: integer);
begin
   case reason of
     DLL_PROCESS_ATTACH: begin;
                           Bmp := TBitmap.Create;
                           CreateSearchingBitmap(775,525);
                         end;
     DLL_PROCESS_DETACH: begin;
                           Bmp.free;
                           ScanLinePointer := nil;
                         end;
   end;
end;

begin
   DllProc := @DllMain;
   DllProc(DLL_PROCESS_ATTACH) ;
end.

Looks nice SkyScripter, cheers.

Meh. Show-off!

//SCAR Plugin. Created for SCAR Divi by Kaitnieks & Freddy1990
// currently you can't call SCAR functions from plugin
library XFindRock;

uses
  FastShareMem,
  SysUtils,
  Windows,
  Dialogs,
  Math,
  PngImage,
  Graphics;


{$R *.res}
type
  TPoint = Record
    x,y : integer;
  end;
  TPointArray = Array of TPoint;
  TMaskRay = Record
    xOff, yOff : Integer;
    Width,Height:Integer;
    CheckPoint : TPoint;
    WhiteArray : TPointArray;
    BlackArray : TPointArray;
  end;
  T2DPointArray = Array of Array of TPoint;

type
  TCharInfo = record
    W,H,Area,L : Integer;
    IsChar : Char;
    Points : TPointArray;
  end;
  TCharInfoArray = Array of TCharInfo;
  THandles = Packed record
    Bitmap : HBitmap;
    Client : HDC;
  end;
  TRGB32 = packed record
    B, G, R, A: Byte;
  end;
  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32) - 1] of TRGB32;
  PRGB32Array = ^TRGB32Array;
type
  TIntegerArray = array of Integer;

type
  TBox = Record
    x1,y1,x2,y2:Integer;
  end;
  TBoxArray = Array of TBox;
type
  TSCARPlugFunc = record
    Name: string;
    Ptr: Pointer;
  end;

  TNumbers = record
    n1, n2: Integer;
  end;
  TCharRay = Record
    
    Something:  integer;
  end;
Const
  Radix = 10;  //I can't really explain.. Radix 10 is used the most.. It stands for 0,1,2,3,4,5,6,7,8,9.. And if your using negative numbers to, its -9..9
Type
  TOneStrProc = procedure(s: string);

var
   Bmp : TBitmap;
   LineLength : LongInt;
   ScanLinePointer : PRGB32Array;

var
  Writeln: TOneStrProc;


Function IntToBox(x1,y1,x2,y2 : integer) : TBox;
begin;
  Result.x1 := x1;
  Result.y1 := y1;
  Result.x2 := x2;
  Result.y2 := y2;
end;
Procedure PNGToBitmap(LoadPath,SavePath : String);stdcall;
var
  PnGImg : TPNGObject;
  Bmp : TBitmap;
begin
  PnGImg := TPNGObject.Create;
  PnGImg.LoadFromFile(LoadPath);
  Bmp := TBitmap.Create;
  Bmp.Assign(PnGImg);
  Bmp.SaveToFile(SavePath);
  Bmp.Free;
  PnGImg.Free;
end;
//Credits to original maker!
//http://www.swissdelphicenter.ch/torry/showcode.php?id=1616
Procedure SortTPointArray(var Counts: TIntegerArray;var Points : TPointArray);
var
  Len, i, j, k,h: LongInt;
  Temp : TPoint;
begin
  Len := High(Counts);
  k := Len shr 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Counts[j] > Counts[j + k]) do
      begin
        h := Counts[j];
        Temp := Points[j];
        Counts[j] := Counts[j + k];
        Points[j] := Points[J + K];
        Points[J+K] := Temp;
        Counts[j + k] := h;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;
    k := k shr 1;
  end;
end;

//Credits to original maker!
//http://www.swissdelphicenter.ch/torry/showcode.php?id=1616
Procedure SortTPointArrayE(var Counts: Array of Extended;var Points : TPointArray);
var
  Len, i, j, k: LongInt;
  H : Extended;
  Temp : TPoint;
begin
  Len := High(Counts);
  k := Len shr 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Counts[j] > Counts[j + k]) do
      begin
        h := Counts[j];
        Temp := Points[j];
        Counts[j] := Counts[j + k];
        Points[j] := Points[J + K];
        Points[J+K] := Temp;
        Counts[j + k] := h;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;
    k := k shr 1;
  end;
end;



//Credits to original maker!
//http://www.swissdelphicenter.ch/torry/showcode.php?id=1616
procedure SortColorsCount(var Colors,  Counts: TIntegerArray);
var
  Len, i, j, k,h,tmp: LongInt;
begin
  Len := High(Counts);
  k := Len shr 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Counts[j] < Counts[j + k]) do
      begin
        h := Counts[j];
        tmp := Colors[j];
        Counts[j] := Counts[j + k];
        Counts[j + k] := h;
        Colors[j] := Colors[J + k];
        Colors[J + K] :=tmp;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;
    k := k shr 1;
  end;
end;

Function GetTPABounds(TPA: TPointArray): TBox; stdcall;
var
  I,L : Integer;
begin;
  L := High(TPA);
  if L < 0 then exit;
  Result.x1 := TPA[0].x;
  Result.y1 := TPA[0].y;
  Result.x2 := TPA[0].x;
  Result.y2 := TPA[0].y;
  For I:= 1 to L do
  begin;
    if TPA[i].x > Result.x2 then
      Result.x2 := TPA[i].x
    else if TPA[i].x < Result.x1 then
      Result.x1 := TPA[i].x;
    if TPA[i].y > Result.y2 then
      Result.y2 := TPA[i].y
    else if TPA[i].y < Result.y1 then
      Result.y1 := TPA[i].y;
  end;
end;

Function FindTPAinTPA(SearchTPA, TotalTPA : TPointArray; var Matches : TPointArray) : Boolean;stdcall;
var
  Len, I,II,LenSearch,xOff,yOff : integer;
  tx,ty,MatchCount : integer;
  Screen : Array of Array of Boolean;
  ScreenBox,SearchBox : TBox;
  Bool : Boolean;
begin;
  Result := False;
  Len := High(TotalTPA);
  LenSearch := High(SearchTPA);
  if LenSearch < 0 then Exit;
  if Len < LenSearch then Exit;
  MatchCount := 0;
  ScreenBox := GetTPABounds(TotalTPA);
  SearchBox := GetTPABounds(SearchTPA);
  Try
    SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1);
  Except
    Exit;
  end;
  if (SearchBox.x1 > 0) or (SearchBox.y1 > 0) then
  begin;
    For I := 0 to LenSearch do
    begin;
      SearchTPA[I].x := SearchTPA[I].x - SearchBox.x1;
      SearchTPA[I].y := SearchTPA[I].y - SearchBox.y1;
    end;
    SearchBox.x2 := SearchBox.x2 - SearchBox.x1;
    SearchBox.y2 := SearchBox.y2 - SearchBox.y1;
    SearchBox.x1 := 0;
    SearchBox.y1 := 0;
  end;
  xOff := SearchBox.x2;
  yOff := SearchBox.y2;
  For I := 0 to LenSearch do
  begin;
    if SearchTPA[I].x = 0 then
      if SearchTPA[I].y < yOff then
        yOff := SearchTPA[I].y;
    if SearchTPA[I].y = 0 then
      if SearchTPA[I].x < xOff then
        xOff := SearchTPA[I].x;
  end;
  For I := 0 to Len do
    Screen[TotalTPA[I].x][TotalTPA[I].y] := True;
  For I := 0 to Len do
  begin;
    tx := TotalTPA[I].x - xOff;
    ty := TotalTPA[I].y;// - yOff;
    if tx > 0 then
      if ty > 0 then
        if (SearchBox.x2 + tx) <= ScreenBox.x2 then
          if (SearchBox.y2 + ty) <= ScreenBox.y2 then
          begin;
            Bool := True;
            For II := 0 to LenSearch do
              if Screen[tx + SearchTPA[II].x ][ty + SearchTPA[II].y] = False then
              begin;
                Bool := False;
                Break;
              end;
            if bool then
            begin;
              MatchCount := MatchCount + 1;
              SetLength(Matches,MatchCount);
              Matches[MatchCount - 1].x := TotalTPA[I].x;
              Matches[MatchCount - 1].y := TotalTPA[I].y;
            end;
          end;
  end;
  if MatchCount > 0 then
    Result := True;
end;

Function FindGapsTPA( TPA : TPointArray; MinPixels : Integer) :T2DPointArray;stdcall;
var
  Len,TotalLen,LenRes,I,II,III : integer;
  Screen : Array of Array of Boolean;
  Height,Width : Integer;
  Box : TBox;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  Box := GetTPABounds(TPA);
  Height := Box.y2 - Box.y1;
  Width := Box.x2 - Box.x1;
  LenRes := 0;
  III := 0;
  Try
    SetLength(Screen,Width + 1,Height + 1);
  Except
    Exit;
  end;
  For I := 0 to Len do
    Screen[TPA[I].x - Box.x1][TPA[I].y - Box.y1] := True;
  SetLength(result,1);
  SetLength(Result[0],Len+1);
  TotalLen := 0;
  For I := 0 to Width do
  begin;
    For II := 0 to Height do
      if Screen[I][II]=True then
      begin;
        Result[TotalLen][LenRes].x := I + Box.x1;
        Result[TotalLen][LenRes].y := II + Box.y1;
        LenRes := LenRes + 1;
        III := I;
      end;
    if LenRes = 0 then
      III := I
    else
    if (I - III) > MinPixels then
    begin;
      III := I;
      SetLength(Result[TotalLen],LenRes);
      LenRes := 0;
      TotalLen := TotalLen + 1;
      SetLength(Result,TotalLen + 1);
      SetLength(Result[TotalLen],Len + 1);
    end;
  end;
  SetLength(Result[TotalLen],LenRes);
end;

Procedure EditToBounds( var TPA : TPointArray);stdcall;
var
  I : Integer;
  L : Integer;
  Box : TBox;
begin;
  Box := GetTPABounds(TPA);
  if (Box.x1 = 0) and (Box.y1 = 0) then
    exit;
  L := High(TPA);
  For I := 0 to L do
  begin;
    Tpa[I].x := TPA[I].x - Box.x1;
    TPA[I].y := TPA[I].y - Box.y1;
  end;
end;

Function GayBounds(Points: TPointArray): TBox; stdcall;

Var
   L, I: Integer;

Begin
  Result.X1 := 0 xor 0;
  Result.Y1 := 0 xor 0;
  Result.X2 := 1 shl 20;
  Result.Y2 := 1 shl 20;
  L := High(Points);
  For I := 0 To L Do
  Begin
    Result.X1 := Min(Result.X1, Points[I].X);
    Result.Y1 := Min(Result.Y1, Points[I].Y);
    Result.X2 := Max(Result.X2, Points[I].X);
    Result.Y2 := Max(Result.Y2, Points[I].Y);
  End;
End;

Function RemoveTPADistEachother(Dist : Integer; TPA : TPointArray) : TPointArray;stdcall;
var
  I, II, C,HighTPA: Integer;
  Keep: Boolean;
begin
  C:= 0;
  HighTPA := High(TPA);
  SetLength(Result, HighTPA + 1);
  for I:= 0 to HighTPA do
  begin
    Keep:= True;
    for II:= (I + 1) to HighTPA do
      if sqrt ( (TPA[II].x - TPA[I].x) * (TPA[II].x - TPA[I].x) + (TPA[II].y - TPA[I].y) * (TPA[II].y - TPA[I].y)) <= Dist then
      begin
        Keep:= False;
        break;
      end;
    if keep then
    begin
      Result[C].x:= TPA[I].x;
      Result[C].y := TPA[I].y;
      C := C + 1;
    end;
  end;
  SetLength(Result, C);
end;
Procedure CleanATPA(MinLength,MaxLength : Integer; var ATPA : T2DPointArray);Stdcall;
var
  L,LL,Count : integer;
  I : integer;
begin;
  L := High(ATPA);
  Count := -1;
  For I:= 0 to L do
  begin;
    LL := Length(ATPA[I]);
    if LL > MinLength then
      if LL < MaxLength then
      begin;
        Count := Count + 1;
        if I <> Count then
          ATPA[Count] := ATPA[I];
      end;
  end;
  SetLength(ATPA,Count+1);
end;

function RemoveTPASameRange(dist : integer; TPA : TPointArray) : TPointArray;stdcall;
var
  L, HighTPA,I,II : Integer;
  Bool : boolean;
begin;
  L := -1;
  HighTPA := High(TPA);
  SetLength(Result,HighTPA + 1);
  For I:= 0 to HighTPA do
  begin;
    Bool := False;
    For II := 0 to L do
      if sqrt ( (Result[II].x - TPA[I].x) * (Result[II].x - TPA[I].x) + (Result[II].y - TPA[I].y) * (Result[II].y - TPA[I].y)) <= Dist then
      begin;
        Bool := True;
        Break;
      end;
    if not Bool then
    begin;
      L := L + 1;
      Result[L].x := TPA[I].x;
      Result[L].y := Tpa[I].y;
    end;
  end;
  SetLength(Result,L+1);
end;
Function ColorToRGBASM( Color : integer;var R,G,B : integer): integer; stdcall;
asm
  pop edx
  mov eax,[edx]
{  mov [edx],eax
  and [edx],$FF
  shr eax,8
  mov [ecx],eax
  and [ecx],$FF
  shr eax,8
  mov [edx-8],eax
  and [edx-8],$FF}
//  mov [edx-16],$FF
//  mov eax, color
end;
Function AbsoluteInt ( SomeNumber : integer) : integer;assembler;stdcall;
asm
//  mov eax,edx
  mov eax,edx
  mov ecx, edx
  sar ecx, 31
  add eax, ecx
  xor eax, ecx
end;

Function FindCommonPoint(ArrayTPA : T2DPointArray) : TPointArray;stdcall;
var
  L, HighTPA,I,II,III : Integer;
  Lengths : TIntegerArray;
  Bool : boolean;
begin;
  Bool := False;
  L := -1;
  HighTPA := High(ArrayTPA);
  if HighTPA < 1 then exit;
  SetLength(Lengths,HighTPA +  1);
  For I:= 0 to HighTPA do
    Lengths[I] := High(ArrayTPA[I]);
  For I:= 0 to Lengths[0] do
  begin;
    For II := 1 to HighTPA do
    begin;
      Bool := False;
      For III := 0 to Lengths[II] do
        if ArrayTPA[0][I].x = ArrayTPA[II][III].x then
          if ArrayTPA[0][I].y = ArrayTPA[II][III].y then
          begin;
            Bool := True;
            Break;
          end;
      if not Bool then Break;
    end;
    if Bool then
    begin;
      L := L + 1;
      SetLength(Result,L+1);
      Result[L] := ArrayTPA[0][I];
    end;
  end;
end;

Function FloodFillTPA(TPA : TPointArray) : T2DPointArray;stdcall;
var
  x,y,i,CurrentArray, LengthTPA,CurrentStack : integer;
  TempBox : TBox;
  PointsToFill : Array of Array of Boolean;
  Lengths : TIntegerArray;
  TempTPA : TPointArray;
  Stack : TPointArray;
  fx,fy : integer;
begin;
  LengthTPA := High(TPA);
  if LengthTPA < 1 then
  begin;
    if LengthTPA = 0 then
    begin;
      SetLength(Result,1,1);
      Result[0][0] := TPA[0];
    end else
      SetLength(Result,0);
    exit;
  end;
  TempBox := GetTPABounds(TPA);
  SetLength(PointsToFill,TempBox.x2 - TempBox.x1+3,TempBox.y2 - TempBox.y1+3);
  x := TempBox.x1 - 1;
  y := TempBox.y1 - 1;
  CurrentArray := -1;
  CurrentStack := 0;
  SetLength(Stack   , LengthTPA * 2);//Just to be sure ^^.
  SetLength(Lengths , LengthTPA + 1);
  SetLength(TempTPA , LengthTPA + 1);
  For I := 0 to LengthTPA do
  begin;
    TempTPA[I].x := TPA[I].x - x;
    TempTPA[I].y := TPA[I].y - y;
  end;
  For I := 0 to LengthTPA do
    PointsToFill[TempTPA[I].x][TempTPA[I].y] := True;
  For I := 0 to LengthTPA do
    if PointsToFill[TempTPA[I].x][TempTPA[I].y] then
    begin;
      CurrentArray := CurrentArray + 1;
      SetLength(Result,CurrentArray + 1);
      SetLength(Result[CurrentArray],LengthTPA - I + 1);
      fx := TempTPA[I].x;
      fy := TempTPA[I].y;
      CurrentStack := CurrentStack + 1;
      Stack[CurrentStack].x := fx;
      Stack[Currentstack].y := fy;
      While CurrentStack > 0 do
      begin;
        if PointsToFill[fx][fy] then
        begin;
          PointsToFill [fx][fy] := false;
          Result[CurrentArray][Lengths[CurrentArray]].x := fx + x;
          Result[CurrentArray][Lengths[CurrentArray]].y := fy + y;
          Lengths[CurrentArray] := Lengths[CurrentArray] + 1;
        end;
        if PointsToFill[fx+1][fy] then
        begin
          fx := fx + 1;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx][fy+1] then
        begin
          fx := fx;fy := fy + 1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx-1][fy] then
        begin
          fx := fx - 1;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx][fy-1] then
        begin
          fx := fx;fy := fy - 1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx+1][fy+1] then
        begin
          fx := fx+1;fy := fy+1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx-1][fy-1] then
        begin
          fx := fx-1;fy := fy-1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx-1][fy + 1] then
        begin
          fx := fx-1;fy := fy+1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx+1][fy-1] then
        begin
          fx := fx+1;fy := fy-1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        fx := Stack[CurrentStack].x;
        fy := Stack[CurrentStack].y;
        CurrentStack := CurrentStack - 1;
      end;
      SetLength(Result[CurrentArray],Lengths[CurrentArray]);
    end;
  SetLength(Stack,0);
  SetLength(TempTPA,0);
  SetLength(Lengths,0);
end;

Function FloodFillTPADistance(Dist : Integer; TPA : TPointArray) : T2DPointArray;stdcall;
var
  x,y,i,CurrentArray, LengthTPA,CurrentStack,DistMin : integer;
  TempBox : TBox;
  PointsToFill : Array of Array of Boolean;
  Lengths : TIntegerArray;
  TempTPA : TPointArray;
  Stack : TPointArray;
  fx,fy,ii,iii : integer;
label
  Start;
begin;
  if Dist < 1 then
    Dist := 1;
  DistMin := Dist - 1;
  LengthTPA := High(TPA);
  if LengthTPA < 1 then
  begin;
    if LengthTPA = 0 then
    begin;
      SetLength(Result,1,1);
      Result[0][0] := TPA[0];
    end else
      SetLength(Result,0);
    exit;
  end;
  TempBox := GetTPABounds(TPA);
  SetLength(PointsToFill,TempBox.x2 - TempBox.x1+(Dist*2) + 1,TempBox.y2 - TempBox.y1+(Dist *2) + 1);
  x := TempBox.x1 - Dist;
  y := TempBox.y1 - Dist;
  CurrentArray := -1;
  CurrentStack := 0;
  SetLength(Stack   , LengthTPA * Dist * 2);//Just to be sure ^^.
  SetLength(Lengths , LengthTPA + 1);
  SetLength(TempTPA , LengthTPA + 1);
  For I := 0 to LengthTPA do
  begin;
    TempTPA[I].x := TPA[I].x - x;
    TempTPA[I].y := TPA[I].y - y;
  end;
  For I := 0 to LengthTPA do
    PointsToFill[TempTPA[I].x][TempTPA[I].y] := True;
  For I := 0 to LengthTPA do
    if PointsToFill[TempTPA[I].x][TempTPA[I].y] then
    begin;
      CurrentArray := CurrentArray + 1;
      SetLength(Result,CurrentArray + 1);
      SetLength(Result[CurrentArray],LengthTPA - I + 1);
      fx := TempTPA[I].x;
      fy := TempTPA[I].y;
      CurrentStack := CurrentStack + 1;
      Stack[CurrentStack].x := fx;
      Stack[Currentstack].y := fy;
      While CurrentStack > 0 do
      begin;
        Start:
        if PointsToFill[fx][fy] then
        begin;
          PointsToFill [fx][fy] := false;
          Result[CurrentArray][Lengths[CurrentArray]].x := fx + x;
          Result[CurrentArray][Lengths[CurrentArray]].y := fy + y;
          Lengths[CurrentArray] := Lengths[CurrentArray] + 1;
        end;
        For II := 1 to Dist do
        begin;
          if PointsToFill[fx+II][fy] then
          begin
            fx := fx + II;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx][fy+II] then
          begin
            fx := fx;fy := fy + II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx-II][fy] then
          begin
            fx := fx - II;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx][fy-II] then
          begin
            fx := fx;fy := fy - II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx+II][fy+II] then
          begin
            fx := fx+II;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx-II][fy-II] then
          begin
            fx := fx-II;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx-II][fy + II] then
          begin
            fx := fx-II;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx+II][fy-II] then
          begin
            fx := fx+II;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if II > 1 then
          begin;
            For III := 1 to DistMin do
            begin;
               if PointsToFill[fx+II][fy+III] then
               begin;
                 fx := fx+II;fy := fy+III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto Start;
               end;
               if PointsToFill[fx+II][fy-III] then
               begin;
                 fx := fx+II;fy := fy-III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto Start;
               end;
               if PointsToFill[fx-II][fy+III] then
               begin;
                 fx := fx-II;fy := fy+III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
               end;
               if PointsToFill[fx-II][fy-III] then
               begin;
                 fx := fx-II;fy := fy-III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
               end;
               if PointsToFill[fx-III][fy+II] then
               begin;
                 fx := fx-III;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
               if  PointsToFill[fx+III][fy+II] then
               begin;
                 fx := fx+III;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
               if PointsToFill[fx-III][fy-II] then
               begin;
                 fx := fx-III;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
               if PointsToFill[fx+III][fy-II] then
               begin;
                 fx := fx+III;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
            end;
          end;
        end;
        fx := Stack[CurrentStack].x;
        fy := Stack[CurrentStack].y;
        CurrentStack := CurrentStack - 1;
      end;
      SetLength(Result[CurrentArray],Lengths[CurrentArray]);
    end;
  SetLength(Stack,0);
  SetLength(TempTPA,0);
  SetLength(Lengths,0);
end;
Function MergeATPA(ATPA : T2DPointArray)  : TPointArray;stdcall;
var
  I,II, Len, TempL,CurrentL : integer;
begin;
  Len := High(ATPA);
  CurrentL := 0;
  For I:= 0 to Len do
  begin;
    TempL := High(ATPA[I]);
    if TempL < 0 then
    begin;
      Continue;
    end;
    TempL := Templ + CurrentL + 1;
    Setlength(Result, TempL+1);
    Try
      For II := CurrentL to TempL do
        Result[II] := ATPA[I][II - CurrentL];
    except
    end;
    CurrentL := TempL;
  end;
  SetLength(Result,CurrentL);
end;

Function FindTPAEdgePoints ( MaxW,MaxH : integer; TPA : TPointArray): TPointArray;stdcall;
var
  Bounds : TBox;
  I : Integer;
  x,y,len,width, height,tmp  : integer;
  Points :  Array of Array of Boolean;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  Bounds := GetTPABounds(TPA);
  SetLength(Points,Bounds.x2 - Bounds.x1 + 1,Bounds.y2 - Bounds.y1 + 1);
  SetLength(Result,len + 1);
  Width := Bounds.x2 - Bounds.x1;
  Height := Bounds.y2 - Bounds.y1;
  For I := 0 to Len do
    Points[TPA[I].x - Bounds.x1][TPA[I].y - Bounds.y1] := True;
  I := -1;
//  Showmessage(inttostr(len)+ '-' +inttostr(Width) + '- ' +inttostr(Height) );
  Tmp := 0;
  For Y:= 0 to  Height do
  Begin;
    For x := 0 to Width do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Tmp := x + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
    For X := Width Downto tmp do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
  end;
  Tmp := 0;
  For x := 0 to Width do
  Begin;
    For y:= 0 to Height do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Tmp := y + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
    For y := Width Downto tmp do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
  end;
  SetLength(Result, I + 1);
end;
Function SortTPAMiddles ( w,h : integer; TPA : TPointArray) : TPointArray;stdcall;
var
  Lengths : TIntegerArray;
  Middles : TPointArray;
  TempSorted : TPointArray;
  Bool : Boolean;
  Temp,I,II,LengthTPA : Integer;
begin;
  Temp := Length(TPA);
  if Temp < 1 then Exit;
  SetLength(Middles,Temp);
  SetLength(Lengths,Temp);
  SetLength(TempSorted,Temp);
  Temp := Temp - 1;
  LengthTPA := -1;
  For I:= 0 to Temp do
  begin;
    Bool := True;
    For II := 0 to LengthTPA do
      if Abs(TPA[I].x - TempSorted[II].x) < w then
        if Abs(TPA[I].y - TempSorted[II].y) < h then
        Begin;
          Bool := False;
          Break;
        end;
    if bool then
    begin;
      LengthTPA := LengthTPA + 1;
      TempSorted[LengthTPA] := Tpa[I];
      Lengths[LengthTPA] := 1;
      Inc(Middles[LengthTPA].x,TPA[I].x);
      Inc(Middles[LengthTPA].y,TPA[I].y);
    end else
    begin;
      Lengths[II] := Lengths[II] + 1;
      Inc(Middles[II].x,TPA[I].x);
      Inc(Middles[II].y,TPA[I].y);
    end;
  end;
  SetLength(TempSorted,0);
  SetLength(Middles,LengthTPA + 1);
  SetLength(Lengths,LengthTPA + 1);
  SetLength(Result, LengthTPA + 1);
  For I := 0 to LengthTPA do
  begin;
    Result[I].x := Middles[I].x div Lengths[I];
    Result[I].y := Middles[I].y div Lengths[I];
  end;
end;

Function BoxTPAToATPA(w,h : integer; Points : TPointArray) : T2DPointArray;stdcall;
var
  I,II,L,LL,III : integer;
  TempDist,Temp : Array of TBox;
  SwapTPA : TPointArray;
  Counts : TIntegerArray;
  Bool : Boolean;
begin;
  L := Length(Points);
  SetLength(Temp,L);
  SetLength(TempDist,L);
  SetLength(Counts,L);
  SetLength(Result,0);
  L := L - 1;
  LL := -1;
  if L < 1 then
    exit;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (Points[I].x >= TempDist[II].x1) and (Points[I].x <= TempDist[II].x2) then
        if (Points[I].y >= TempDist[II].y1) and (Points[I].y <= TempDist[II].y2) then
        begin;
          if (Points[I].x < Temp[II].x1) then
          begin;
            Temp[II].x1 := Points[I].x;
            TempDist[II].x1 := Points[I].x - W;
          end;
          if (Points[I].y < Temp[II].y1) then
          begin;
            Temp[II].y1 := Points[I].y;
            TempDist[II].y1 := Points[I].y - H;
          end;
          if (Points[I].x > Temp[II].x2) then
          begin;
            Temp[II].x2 := Points[I].x;
            TempDist[II].x2 := Points[I].x + W;
          end;
          if (Points[I].y > Temp[II].y2) then
          begin;
            Temp[II].y2 := Points[I].y;
            TempDist[II].y2 := Points[I].y + H;
          end;
          Bool := True;
          Counts[II] := Counts[II] + 1;
          Result[II][Counts[II]] := Points[I];
          Break;
        end;
    if not Bool then
    begin;
      LL := LL + 1;
      TempDist[LL] := IntToBox(Points[I].x-W,Points[I].y-H,Points[I].x+W,Points[I].y+H);
      Temp[LL] := IntToBox(Points[I].x,Points[I].y,Points[I].x,Points[I].y);
      SetLength(Result,LL+1);
      SetLength(Result[LL],L - I + 1);
      Result[LL][0] := Points[I];
    end;
  end;
  For I := 0 to LL do
    SetLength(Result[I],Counts[I] + 1);
  Bool := True;
  SetLength(TempDist,1);
  While Bool do
  begin;
    Bool := False;
    For I := 0 to LL do
      For II := 0 to (I-1) do
        if ((Temp[I].x1 >= Temp[II].x1) and (Temp[I].x1 <= Temp[II].x2)) or ((Temp[I].x2 >= Temp[II].x1) and (Temp[I].x2 <= Temp[II].x2)) then
          if ((Temp[I].y1 >= Temp[II].y1) and (Temp[I].y1 <= Temp[II].y2)) or ((Temp[I].y2 >= Temp[II].y1) and (Temp[I].y2 <= Temp[II].y2)) then
          begin;
            Bool := True;
            L := Counts[I] + 1;
            Setlength(Result[I], Counts[II] + L+ 1);
            For III := 0 to Counts[II] do
              Result[I][III + L] := Result[II][III];
            Counts[II] := Counts[LL];
            Result[II] := Result[LL];
            Temp[II]   := Temp[LL];
            LL := LL - 1;
            Break;
          end;
  end;
  SetLength(Result,LL+1);
end;

Function SortTPAToATPA (w,h : integer; TPA : TPointArray) : T2DPointArray;stdcall;
var
  Lengths : TIntegerArray;
  Bool : Boolean;
  Temp,I,II,LengthTPA : Integer;
begin;
  Temp := Length(TPA);
  SetLength(Lengths,Temp);
  Temp := Temp - 1;
  LengthTPA := -1;
  For I:= 0 to Temp do
  begin;
    Bool := True;
    For II := 0 to LengthTPA do
      if Abs(TPA[I].x - Result[II][0].x) < w then
        if Abs(TPA[I].y - Result[II][0].y) < h then
        Begin;
          Bool := False;
          Break;
        end;
    if bool then
    begin;
      LengthTPA := LengthTPA + 1;
      SetLength(Result,LengthTPA+1);
      SetLength(Result[LengthTPA],1);
      Result[LengthTPA][0] := Tpa[I];
      Lengths[LengthTPA] := 1;
    end else
    begin;
      Lengths[II] := Lengths[II] + 1;
      SetLength(Result[II],Lengths[II]);
      Result[II][Lengths[II]-1] := Tpa[I];
    end;
  end;
end;


Function GetHBitmap(var CanvasHandle : LongWord) : LongWord; stdcall;
var
  Bmp : Bitmap;
  TempDC : HDC;
begin;
  TempDC := CreateCompatibleDC(CanvasHandle);
  GetObject(GetCurrentObject(CanvasHandle,Obj_Bitmap),Sizeof(bitmap),@Bmp);
  Result := CreateCompatibleBitmap( CanvasHandle,Bmp.bmwidth,bmp.bmHeight);
  SelectObject(TempDC,Result);
end;

Procedure ChangeSize(Width,Height : integer); stdcall;
begin;
  Bmp.PixelFormat := pf32bit;
  Bmp.Width := Width;
  Bmp.Height := Height;
  ScanLinePointer := Bmp.Scanline[0];
  LineLength := (Longint(Bmp.Scanline[1]) - Longint(ScanLinePointer)) div 4;
end;

Procedure CreateSearchingBitmap(Width,Height : Integer);stdcall;
begin;
  ChangeSize(Width,Height);
end;

function LargestTPAInATPA(ATPA: T2DPointArray): Integer;stdcall;
var
  I, L, W,Len: Integer;
begin
  Result := -1;
  Len := High(ATPA);
  if Len < 0 then exit;
  L:= Length(ATPA[0]);
  W:= 0;
  for I:= 1 to Len do
    if Length(ATPA[I]) > L then
    begin
      L:= Length(ATPA[I]);
      W:= I;
    end;
  Result := W;
end;

Procedure FreeSearchingBitmap;stdcall;
begin;
end;

Procedure SortColorsSaveCounts(var Colors,Counts: TintegerArray);stdcall;
var
  I,II,LenResult,Len : integer;
  TempColors : TIntegerArray;
  Found : Boolean;
begin
  Len := High(Colors);
  SetLength(Counts,Len +1);
  SetLength(TempColors,Len+1);
  LenResult := -1;
  For I:= 0 to Len do
  begin;
    Found := False;
    For II := 0 to LenResult do
      if TempColors[II] = Colors[I] then
      begin;
        Found := True;
        Counts[II] := Counts[II] + 1;
      end;
    if Not found then
    begin;
      LenResult := LenResult + 1;
      TempColors[LenResult] := Colors[I];
    end;
  end;
  SetLength(TempColors,LenResult+1);
  SetLength(Counts,LenResult+1);
  SortColorsCount(TempColors,Counts);
  Colors := TempColors;
end;
Function SortTPABoxes( Boxes : TBoxArray; TPA: TPointArray) : T2DPointArray; stdcall;
Var
  Len, I , II, L : integer;
  Counts : TIntegerArray;
begin;
  Len := High(TPA);
  L := Length(Boxes);
  SetLength(Result, L,Len+1 );
  SetLength(Counts,L);
  Dec(L);
  For I:= 0 to Len do
    For II := 0 to L do
      if (TPA[I].x >= Boxes[II].x1) then
        if (TPA[I].x <= Boxes[II].x2) then
          if (TPA[I].y >= Boxes[II].y1) then
            if (TPA[I].y <= Boxes[II].y2) then
            begin;
              Result[II][Counts[II]] := TPA[I];
              Counts[II] := Counts[II] + 1;
              Break;
            end;
  For I:= 0 to L do
    SetLength(Result[I], Counts[I]);
end;
Function SortTPAToATPADist (Dist : Integer; TPA :TPointArray) : T2DPointArray;stdcall;
var
  Lengths : TIntegerArray;
  Bool : Boolean;
  Temp,I,II,III,LengthTPA : Integer;
begin;
  Temp := Length(TPA);
  SetLength(Lengths,Temp);
  Temp := Temp - 1;
  LengthTPA := -1;
  For I:= 0 to Temp do
  begin;
    Bool := True;
    For II := 0 to LengthTPA do
    begin;
      For III := 0 to Lengths[II]-1 do
        if sqrt((Result[II][III].x - TPA[I].x) * (Result[II][III].x - TPA[I].x) + (Result[II][III].y - TPA[I].y) * (Result[II][III].y - TPA[I].y)) <= Dist then
        Begin;
          Bool := False;
          Break;
        end;
      if not bool then break;
    end;
    if bool then
    begin;
      LengthTPA := LengthTPA + 1;
      SetLength(Result,LengthTPA+1);
      SetLength(Result[LengthTPA],1);
      Result[LengthTPA][0] := Tpa[I];
      Lengths[LengthTPA] := 1;
    end else
    begin;
      Lengths[II] := Lengths[II] + 1;
      SetLength(Result[II],Lengths[II]);
      Result[II][Lengths[II]-1] := Tpa[I];
    end;
  end;
end;
{
20,042957042957  ms   Mine
180,679320679321 ms   WizzyPlugin
}
Function SortTPADistance(x,y : integer; TPA : TPointArray) : TPointArray;stdcall;
var
  Distances : Array of Extended;
  I,Len : Integer;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  SetLength(Result,Len+1);
  SetLength(Distances,Len+1);
  For I:= 0 to Len do
  begin;
    Result[I] := TPA[I];
    Distances[I] := sqrt((x - TPA[I].x) * (x - TPA[I].x) + (y - TPA[I].y) * (y - TPA[I].y));
  end;
  SortTPointArrayE(Distances,Result);
end;

function SortATPADistFirstPoint(x,y : integer ; ATPA : T2DPointArray) : T2DPointArray;stdcall;
var
  Distances : Array of Extended;
  I,Len,K,J : Integer;
  H : extended;
begin;
  Len := High(ATPA);
  if Len < 0 then exit;
  SetLength(Result,Len+2);
  SetLength(Distances,Len+1);
  For I:= 0 to Len do
    if High(ATPA[I]) >= 0 then
    begin;
      Result[I] := ATPA[I];
      Distances[I] := sqrt((x - ATPA[I][0].x) * (x - ATPA[I][0].x) + (y - ATPA[I][0].y) * (y - ATPA[I][0].y));
    end;
  k := Len shr 1;
  if k = 0 then
    K := 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Distances[j] > Distances[j + k]) do
      begin
        h := Distances[j];
        Result[Len+1] := Result[j];
        Distances[j] := Distances[j + k];
        Result[j] := Result[J + K];
        Result[J+K] := Result[Len+1];
        Distances[j + k] := h;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;
    k := k shr 1;
  end;
  SetLength(Result,Len+1);
end;

function CenterBounds(Arr: TpointArray):Tpoint;stdcall;
var
  Len,xmin,xmax,ymin,ymax, I : Integer;
begin;
  Len := High(Arr);
  if Len < 0 then exit;
  xmin := arr[0].x;
  xmax := arr[0].x;
  ymin := arr[0].y;
  ymax := arr[0].y;
  For I := 1 to Len do
  begin;
    if Arr[I].x < xmin then
      xmin := Arr[I].x
    else if  Arr[I].x > xmax then
      xmax := Arr[I].x;
    if Arr[I].y < ymin then
      ymin := Arr[I].y
    else if  Arr[I].y > ymax then
      ymax := Arr[I].y;
  end;
  Result.x := Round((xmin + xmax) / 2);
  Result.y := Round((ymin + ymax) / 2);
end;

function MiddlePT(P1, P2: TPoint): TPoint;stdcall;
begin
  result.x:= (P1.x + P2.x) div 2;
  result.y:= (P1.y + P2.y) div 2;
end;
Procedure CenterTPAEx(var x,y : integer; tpa : TPointArray); stdcall;
var
  Len : integer;
  XCount,YCount : integer;
  I : integer;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  XCount := 0;
  YCount := 0;
  For I:= 0 to Len do
  begin;
    XCount := XCount + TPA[I].x;
    YCount := YCount + TPA[I].y;
  end;
  X := XCount div (Len + 1);
  Y := YCount div (Len + 1);
end;

function CenterATPA(ATPA : T2DPointArray) : TPointArray;stdcall;
var
  XCount,YCount : int64;
  I,II,L,LL : integer;
begin;
  L := High(ATPA);
  SetLength(Result,L+1);
  For I:= 0 to L do
  begin;
    LL := High(ATPA[I]);
    XCount := 0;
    YCount := 0;
    For II := 0 to LL do
    begin;
      XCount := XCount + ATPA[I][II].x;
      YCount := YCount + ATPA[I][II].y;
    end;
    result[I].x:= XCount div (LL+1);
    result[I].y:= YCount div (LL+1);
  end;
end;

function CenterTPA(TPA: TPointArray): TPoint;stdcall;
var
  l, xCount, yCount: Int64;
  i: integer;
begin
  L := High(TPA);
  xCount:= 0;
  yCount:= 0;
  for i:= 0 to L do
  begin
    xCount:= xCount + TPA[I].x;
    yCount:= yCount + TPA[I].y;
  end;
  result.x:= xCount div (L+1);
  result.y:= yCount div (L+1);
end;

Function SortColors( Colors : TIntegerArray): TIntegerArray;stdcall;
var
  I,II,LenResult,Len : integer;
  Counts : TIntegerArray;
  Found : Boolean;
begin
  Len := High(Colors);
  SetLength(counts,Len +1);
  SetLength(result,Len+1);
  LenResult := -1;
  For I:= 0 to Len do
  begin;
    Found := False;
    For II := 0 to LenResult do
      if Result[II] = Colors[I] then
      begin;
        Found := True;
        Counts[II] := Counts[II] + 1;
      end;
    if Not found then
    begin;
          LenResult := LenResult + 1;
      Result[LenResult] := Colors[I];
    end;
  end;
  SetLength(Result,LenResult+1);
  SetLength(Counts,LenResult+1);
  SortColorsCount(Result,Counts);
end;

Procedure XYZToRGBRay(X,Y,Z : Double;var R,G,B: integer);stdcall;
var
  TempR,TempG,TempB,Tempx,tempy,tempz : double;
begin;
  Tempx := X / 100;
  tempy := Y / 100;
  tempz := Z / 100;

  TempR := Tempx *  3.2406 + tempy * -1.5372 + tempz * -0.4986;
  TempG := Tempx * -0.9689 + tempy *  1.8758 + tempz *  0.0415;
  TempB := Tempx *  0.0557 + tempy * -0.2040 + tempz *  1.0570;

  if TempR > 0.0031308  then
    TempR := 1.055 * ( Power(TempR, ( 1 / 2.4 )) ) - 0.055
  else
    TempR := 12.92 * TempR;
  if TempG > 0.0031308 then
    TempG := 1.055 * ( Power(TempG, ( 1 / 2.4 )) ) - 0.055
  else
    TempG := 12.92 * TempG;
  if  TempB > 0.0031308 then
    TempB := 1.055 * ( Power(TempB , ( 1 / 2.4 )) ) - 0.055
  else
    TempB := 12.92 * TempB;

  R := Round(TempR * 255);
  G := Round(TempG * 255);
  B := Round(TempB * 255);
end;

Procedure RGBToXYZRay(R,G,B : integer;var x,y,z : double);stdcall;
var
  Red,Green,Blue : double;
begin;
  Red := R / 255;
  Green := G / 255;
  Blue := B / 255;
  if Red > 0.04045  then
    Red := Power( ( Red + 0.055 ) / 1.055  , 2.4)
  else
    Red := Red / 12.92;
  if Green > 0.04045  then
    Green := Power( ( Green + 0.055 ) / 1.055 , 2.4)
  else
    Green := Green / 12.92;
  if  Blue > 0.04045 then
    Blue := Power(  ( Blue + 0.055 ) / 1.055  , 2.4)
  else
    Blue := Blue / 12.92;

  Red := Red * 100;
  Green := Green * 100;
  Blue := Blue * 100;
  X := Red * 0.4124 + Green * 0.3576 + Blue * 0.1805;
  Y := Red * 0.2126 + Green * 0.7152 + Blue * 0.0722;
  Z := Red * 0.0193 + Green * 0.1192 + Blue * 0.9505;
end;

Procedure RGBToHSLRay(RR,GG,BB : integer;var H,S,L : Double);stdcall;
var
  R,  G,  B,   D,  Cmax, Cmin: Double;

begin
  R := RR / 255;
  G := GG / 255;
  B := BB / 255;
  CMin := R;
  if G < Cmin then Cmin := G;
  if B  < Cmin then Cmin := B;
  CMax := R;
  if G > Cmax then Cmax := G;
  if B  > Cmax then Cmax := B;
  L := 0.5 * (Cmax + Cmin);
  if Cmax = Cmin then
  begin
    H := 0;
    S := 0;
  end else
  begin;
    D := Cmax - Cmin;
    if L < 0.5 then
      S := D / (Cmax + Cmin)
    else
      S := D / (2 - Cmax - Cmin);
    if R = Cmax then
      H := (G - B) / D
    else
      if G = Cmax then
        H  := 2 + (B - R) / D
      else
        H := 4 +  (R - G) / D;
    H := H / 6;
    if H < 0 then
      H := H + 1;
  end;
end;
Procedure RGBToHSLRayInt(RR,GG,BB : integer;var H,S,L : Integer);stdcall;
var
  R,  G,  B,   D,  Cmax, Cmin: Integer;

begin
  R := RR * 10000 div 255;
  G := GG * 10000 div 255;
  B := BB * 10000 div 255;
  CMin := R;
  if G < Cmin then Cmin := G;
  if B  < Cmin then Cmin := B;
  CMax := R;
  if G > Cmax then Cmax := G;
  if B  > Cmax then Cmax := B;
  L := (Cmax + Cmin) div 2;
  if Cmax = Cmin then
  begin
    H := 0;
    S := 0;
  end else
  begin;
    D := Cmax - Cmin;
    if L < 5000 then
      S := D div (Cmax + Cmin)
    else
      S := D div (20000 - Cmax - Cmin);
    if R = Cmax then
      H := (G - B) div D
    else
      if G = Cmax then
        H  := 20000 + (B - R) div D
      else
        H := 40000 +  (R - G) div D;
    H := H div 60000;
    if H < 0 then
      H := H + 10000;
  end;
end;

Procedure RGBToCMYKRay(R,G,B : integer;var C,M,Y,K : Double);stdcall;
begin;
  C := 1 - R / 255;
  M := 1 - G / 255;
  Y := 1 - B / 255;
  K := 1;
  if ( C < 1 ) then  K := C;
  if ( M < K ) then  K := M;
  if ( Y < K ) then  K := Y;
  if K = 1  then
  begin;
     C := 0;
     M := 0;
     Y := 0;
  end else
  begin;
     C:= ( C - K ) / ( 1 - K );
     M:= ( M - K ) / ( 1 - K );
     Y:= ( Y - K ) / ( 1 - K );
  end;
end;

Function FindColorsCMYK(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;CTol,MTol,YTol,KTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  CC,  MC,  YC, KC ,  TmpC,TmpM,TmpY ,TmpK: Double;
begin
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  RGBToCMYKRay((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),CC,MC,YC,KC);
  CTol := CTol / 100;
  MTol := MTol / 100;
  YTol := YTol / 100;
  KTol := KTol / 100;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TmpC := 1 - (ScanLinePointer[x].R / 255);
      TmpM := 1 - (ScanLinePointer[x].G / 255);
      TmpY := 1 - (ScanLinePointer[x].B / 255);
      TmpK := 1;
      if  TmpC < 1     then  TmpK := TmpC;
      if  TmpM < TmpK  then  TmpK := TmpM;
      if  TmpY < TmpK  then  TmpK := TmpY;
      if Abs(KC - TmpK) <= KTol then
      begin;
        if TmpK = 1  then
        begin;
          if (CC <= CTol) then
            if (MC <= MTol) then
              if (YC <= YTol) then
              begin;
                Len := Len + 1;
                Points[Len].x := x-Startnum+xs;
                Points[Len].y := y+ys;
              end;
        end else
        begin;
          if Abs((TmpC - TmpK) / (1 - TmpK) - CC) <= CTol then
            if Abs(( TmpM - TmpK ) / ( 1 - TmpK)  - MC) <= MTol then
              if Abs(( TmpY - TmpK ) / ( 1 -  TmpK) - YC) <= YTol then
              begin;
                Len := Len + 1;
                Points[Len].x := x-Startnum+xs;
                Points[Len].y := y+ys;
              end;
        end;
      end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;
Function FindColorsHSLInt(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  H,  S,  L,TempR,TempG,TempB,  TmpH,TmpS,TmpL , D,  Cmax, Cmin: Integer;
begin
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  RGBToHSLRayInt((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),H,S,L);
{  HTol := HTol * 100;
  STol := STol * 100;
  LTol := LTol * 100;}
  H := H div 100;
  S := S div 100;
  L := L div 100;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TempR := (ScanLinePointer[x].R * 100 div 255);
      TempG := (ScanLinePointer[x].G * 100 div 255);
      TempB := (ScanLinePointer[x].B * 100 div 255);
      CMin := TempR;
      CMax := TempR;
      if TempG  < Cmin then CMin := TempG;
      if TempB  < Cmin then CMin := TempB;
      if TempG  > Cmax then CMax := TempG;
      if TempB  > Cmax then CMax := TempB;
      TmpL := (CMax + CMin) div 2;
      if Abs(L - TmpL) <= LTol then
      begin;
        if Cmax = Cmin then
        begin
          if (H <= HTol) and (S <= STol) then
          begin;
            Len := Len + 1;
            Points[Len].x := x-Startnum+xs;
            Points[Len].y := y+ys;
          end;
        end else
        begin;
          D := Cmax - Cmin;
          if Tmpl < 50 then
            TmpS := D div (Cmax + Cmin)
          else
            TmpS := D div (200 - Cmax - Cmin);
          if Abs(S - TmpS) <= STol then
          begin;
            if TempR = Cmax then
              TmpH := (TempG - TempB) div D
            else
            if TempG = Cmax then
              TmpH  := 200 + (TempB - TempR) div D
            else
              TmpH := 400 +  (TempR - TempG) div D;
            TmpH := TmpH div 600;
            if TmpH < 0 then
              TmpH := TmpH + 100;
            if Abs(H - TmpH) <= HTol then
            begin;
              Len := Len + 1;
              Points[Len].x := x-Startnum+xs;
              Points[Len].y := y+ys;
            end;
          end;
        end;
      end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;
Function FindColorsHSL(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  H,  S,  L,TempR,TempG,TempB,  TmpH,TmpS,TmpL , D,  Cmax, Cmin: Double;
begin
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  RGBToHSLRay((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),H,S,L);
  HTol := HTol / 100;
  STol := STol / 100;
  LTol := LTol / 100;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TempR := (ScanLinePointer[x].R / 255);
      TempG := (ScanLinePointer[x].G / 255);
      TempB := (ScanLinePointer[x].B / 255);
      CMin := TempR;
      CMax := TempR;
      if TempG  < Cmin then CMin := TempG;
      if TempB  < Cmin then CMin := TempB;
      if TempG  > Cmax then CMax := TempG;
      if TempB  > Cmax then CMax := TempB;
      TmpL := 0.5 * (CMax + CMin);
      if Abs(L - TmpL) <= LTol then
      begin;
        if Cmax = Cmin then
        begin
          if (H <= HTol) and (S <= STol) then
          begin;
            Len := Len + 1;
            Points[Len].x := x-Startnum+xs;
            Points[Len].y := y+ys;
          end;
        end else
        begin;
          D := Cmax - Cmin;
          if Tmpl < 0.5 then
            TmpS := D / (Cmax + Cmin)
          else
            TmpS := D / (2 - Cmax - Cmin);
          if Abs(S - TmpS) <= STol then
          begin;
            if TempR = Cmax then
              TmpH := (TempG - TempB) / D
            else
            if TempG = Cmax then
              TmpH  := 2 + (TempB - TempR) / D
            else
              TmpH := 4 +  (TempR - TempG) / D;
            TmpH := TmpH / 6;
            if TmpH < 0 then
              TmpH := TmpH + 1;
            if Abs(H - TmpH) <= HTol then
            begin;
              Len := Len + 1;
              Points[Len].x := x-Startnum+xs;
              Points[Len].y := y+ys;
            end;
          end;
        end;
      end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;

Function FindColorsXYZ(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;XTol,YTol,ZTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  OX,  OY,  OZ,TempR,TempG,TempB : Double;
begin
  RGBToXYZRay((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),OX,OY,OZ);
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TempR := (ScanLinePointer[x].R / 255);
      TempG := (ScanLinePointer[x].G / 255);
      TempB := (ScanLinePointer[x].B / 255);
      if TempR > 0.04045  then
       TempR := Power( ( TempR + 0.055 ) / 1.055  , 2.4)
      else
       TempR := TempR / 12.92;
      if TempG > 0.04045  then
        TempG := Power( ( TempG + 0.055 ) / 1.055 , 2.4)
      else
        TempG := TempG / 12.92;
      if  TempB > 0.04045 then
        TempB := Power(  ( TempB + 0.055 ) / 1.055  , 2.4)
      else
        TempB := TempB / 12.92;
      TempR := TempR * 100;
      TempG := TempG * 100;
      TempB := TempB * 100;
      if Abs((TempR * 0.4124 + TempG * 0.3576 + TempB * 0.1805) - OX) <= XTol then
        if Abs((TempR * 0.2126 + TempG * 0.7152 + TempB * 0.0722) - OY) <= YTol then
          if Abs((TempR * 0.0193 + TempG * 0.1192 + TempB * 0.9505) - OZ) <= ZTol then
          begin;
            Len := Len + 1;
            Points[Len].x := x-startnum+xs;
            Points[Len].y := y+ys;
          end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;

Function FindColorsRGB(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;stdcall;
var
  L,X,Y,W,H,StartNum,EndNum: integer;
  R,G,B : Byte;
begin;
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  L := -1;
  W := Xe - Xs+1;
  H := Ye - Ys+1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, W,H, DC, xs, ys, SRCCOPY);
  R := Color and $ff;
  G := Color shr 8 and $ff;
  B := Color shr 16 and $ff;
  SetLength(Points,(W * H));
  W := W-1;
  H := H-1;
  For Y := 0 to H do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + w;
    For x := StartNum to EndNum do
    begin;
      if Abs(ScanLinePointer[x].R - R) <= RTol then
        if Abs(ScanLinePointer[x].G - G) <= GTol then
          if Abs(ScanLinePointer[x].B - B) <= BTol then
          begin;
            L := L + 1;
            Points[L].x := x-startnum+xs;
            Points[L].y := y+ys;
          end;
    end;
  end;
  SetLength(Points,L+1);
  Result := L + 1;
end;

Function FindColorsRay(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;stdcall;
var
  L,X,Y,W,H,TmpR,TmpG,TmpB ,StartNum,EndNum: integer;
  Tol : Extended;
  R,G,B : Byte;
begin;
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  L := -1;
  W := Xe - Xs+1;
  H := Ye - Ys+1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, W,H, DC, xs, ys, SRCCOPY);
  R := Color and $ff;
  G := Color shr 8 and $ff;
  B := Color shr 16 and $ff;
  Tol := (RTol + GTol + BTol) / 3;
  SetLength(Points,(W * H));
  W := W-1;
  H := H-1;
  For Y := 0 to H do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + w;
    For x := StartNum to EndNum do
    begin;
      TmpR := Abs(ScanLinePointer[x].R - R);
      if TmpR <= RTol then
      begin;
        TmpG := Abs(ScanLinePointer[x].G - G);
        if TmpG <= GTol then
        begin;
          TmpB := Abs(ScanLinePointer[x].B - B);
          if TmpB <= BTol then
            if sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) <= Tol then
            begin;
              L := L + 1;
              Points[L].x := x-Startnum+xs;
              Points[L].y := y+ys;
            end;
        end;
      end;
    end;
  end;
  SetLength(Points,L+1);
  Result := L + 1;
end;
Function CreateMaskFromBMP( BmpDC : HDC) :  TMaskRay;Stdcall;
var
  x,y,L,LL : Integer;
  Bmp : Windows.TBitmap;
  Bitmappie : TBitmap;
  HBmp : Windows.HBitmap;
  LengthLine : LongInt;
  ScanLine : PRGB32Array;
begin;
  HBmp := GetCurrentObject(BmpDC,OBJ_BITMAP);
  GetObject(HBmp,SizeOf(Bmp),@Bmp);
  Bitmappie := TBitmap.Create;
  Bitmappie.PixelFormat := pf32bit;
  Bitmappie.Width := Bmp.bmWidth;
  Bitmappie.Height := Bmp.bmHeight;
  SetLength(Result.WhiteArray,Bmp.bmWidth * Bmp.bmHeight);
  SetLength(Result.BlackArray,Bmp.bmWidth * Bmp.bmHeight);
  BitBlt(Bitmappie.Canvas.Handle, 0, 0, Bmp.bmWidth,Bmp.bmHeight, BmpDC, 0, 0, SRCCOPY);
  ScanLine := Bitmappie.Scanline[0];
  LengthLine := (Longint(Bitmappie.Scanline[1]) - Longint(ScanLine)) div 4;
  L := -1;
  LL := -1;
  Bmp.bmWidth := Bmp.bmWidth - 1;
  Bmp.bmHeight := Bmp.bmHeight - 1;
  Result.Width := Bmp.bmWidth;
  Result.Height := Bmp.bmHeight;
  For y := 0 to Bmp.bmHeight do
    For x := 0 to Bmp.bmWidth do
    begin;
      if Scanline[y * LengthLine + x].r = 255 then
      begin;
        L := L + 1;
        Result.WhiteArray[L].x := x;
        Result.WhiteArray[L].y := y;
      end else
      begin;
        LL := LL + 1;
        Result.BlackArray[LL].x := x;
        Result.BlackArray[LL].y := y;
      end;
  end;
  SetLength(Result.WhiteArray,L + 1);
  SetLength(Result.BlackArray,LL + 1);
  Result.CheckPoint := Result.BlackArray[LL];
  For x := 0 to Bmp.bmWidth do
    For Y := 0 to Bmp.bmHeight do
      if Scanline[y * LengthLine + x].r = 255 then
      begin;
        Result.xOff := x;
        Result.yOff := y;
        Bitmappie.Free;
        Exit;
      end;
end;

Function FindMaskTolRay(xs,ys : integer; const xe,ye,Tol,ContourTol : integer;Const BackgroundAllColors : Boolean; Const Mask : TMaskRay; Const ClientDC : HDC; var mx,my : integer) : Boolean;stdcall;
var
  PrecalcedNumbers : TIntegerArray;
  L,LL,X,Y,W,H,I,II,TmpR,TmpG,TmpB ,StartNum: integer;
  R,G,B,RR,GG,BB : Byte;
  Bmp : TBitmap;
  LengthLine : LongInt;
  ScanLine : PRGB32Array;
  StartPT : TPoint;
Label
  NoMatch;
begin;
  Result := False;
  Bmp := TBitmap.Create;
  Bmp.PixelFormat := pf32bit;
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  L  := High(Mask.WhiteArray);
  LL := High(Mask.BlackArray);
  if L = 0 then exit;
  W := Xe - Xs+1;
  H := Ye - Ys+1;
  Bmp.Width := W;
  Bmp.Height:= H;
  BitBlt(Bmp.Canvas.Handle, 0, 0,W,H, ClientDC, xs, ys, SRCCOPY);
  ScanLine := Bmp.Scanline[0];
  LengthLine := (Longint(Bmp.Scanline[1]) - Longint(ScanLine)) div 4;
  SetLength(PrecalcedNumbers,H);
  For I := 0 to (H - 1) do
    PrecalcedNumbers[I] := I * LengthLine;
  W := W-Mask.Width-1;
  H := H-Mask.Height-1;
  For Y := Mask.yOff to H do
    For x := Mask.xOff to W do
    begin;
      R := ScanLine[PrecalcedNumbers[Y] + x].r;
      G := ScanLine[PrecalcedNumbers[Y] + x].g;
      B := ScanLine[PrecalcedNumbers[Y] + x].b;
      StartPT.x := x - Mask.xOff;
      StartPT.y := y - Mask.yOff;
      StartNum := PrecalcedNumbers[ Mask.CheckPoint.y + StartPT.y] + Mask.CheckPoint.x + StartPT.x;
      if sqrt((ScanLine[StartNum].R - R) * (ScanLine[StartNum].R - R)
             +(ScanLine[StartNum].G - G) * (ScanLine[StartNum].G - G)
             +(ScanLine[StartNum].B - B) * (ScanLine[StartNum].B - B)) <= ContourTol then
               Continue;
      For I := 0 to L do
      begin;
        StartNum := PrecalcedNumbers[Mask.WhiteArray[I].y + StartPT.y] + StartPT.x + Mask.WhiteArray[I].x;
        TmpR := ScanLine[StartNum].R - R;
        TmpG := ScanLine[StartNum].G - G;
        TmpB := ScanLine[StartNum].B - B;
        if (sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) > Tol) then
          Goto NoMatch;
        if BackgroundAllColors then
        begin;
          RR := ScanLine[StartNum].R;
          GG := ScanLine[StartNum].G;
          BB := ScanLine[StartNum].B;
          For II := 0 to LL do
          begin;
            StartNum := PrecalcedNumbers[Mask.BlackArray[II].y + StartPT.y] + StartPT.x + Mask.BlackArray[II].x;
            TmpR := ScanLine[StartNum].R - RR;
            TmpG := ScanLine[StartNum].G - GG;
            TmpB := ScanLine[StartNum].B - BB;
            if (sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) <= ContourTol) then
              goto NoMatch;
          end;
        end;
      end;
      if not BackgroundAllColors then
        For I := 0 to LL do
        begin;
          StartNum := PrecalcedNumbers[Mask.BlackArray[I].y + StartPT.y] + StartPT.x + Mask.BlackArray[I].x;
          TmpR := ScanLine[StartNum].R - R;
          TmpG := ScanLine[StartNum].G - G;
          TmpB := ScanLine[StartNum].B - B;
          if (sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) <= ContourTol) then
            goto NoMatch;
        end;
      Result := True;
      mx :=  x+xs-Mask.xOff;
      my :=  y+ys-Mask.yOff;
      Bmp.Free;
      ScanLine := Nil;
      Exit;
      NoMatch:
  end;
  Bmp.Free;
  Scanline := nil;
end;

Function IsMaskAt(x,y : integer; mask : TMaskRay; Tol,ContourTol : Integer; Bmp : TBitmap) : Boolean;
//var
//  I, II : integer;
begin;
  Result := True;
end;

{Function FindRocks(PointsDist,BoxDist,LastBoxDist : Integer;var Points : TPointArray;Color,RTol,GTol,BTol,xs, ys, xe, ye : Integer; DC : LongWord) : Boolean;stdcall;
var
  I,II,L,LL,X,Y : integer;
  R,G,B : Byte;
  TempDist,Temp : Array of TBox;
  TempPoints,TempPoints2 : TPointArray;
  Counts : TIntegerArray;
  Bool : Boolean;
  Bmp : TBitmap;
  Line : PRGB32Array;
begin;
  Result := False;
  L := -1;
  Bmp := TBitmap.Create;
  Bmp.Width := xe - xs+1;
  Bmp.Height := ye - ys+1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, DC, xs, ys, SRCCOPY);
  Bmp.PixelFormat := pf32bit;
  R := Color and $ff;
  G := Color shr 8 and $ff;
  B := Color shr 16 and $ff;
  SetLength(TempPoints,(Bmp.Width * Bmp.Height));
  I := Bmp.Height-1;
  II := Bmp.Width-1;
  for y := 0 to I do
  begin
    Line := Bmp.ScanLine[y];
    for x := 0 to II do
    begin
      if (Abs(Line[x].R - R) <= RTol) then
        if (Abs(Line[x].G - G) <= GTol) then
          if (Abs(Line[x].B - B) <= Btol) then
          begin
            L := L + 1;
            TempPoints[L].x := x+xs;
            TempPoints[L].y := y+ys;
         end;
    end;
  end;
  L := L + 1;
  SetLength(TempPoints,L);
  Line := nil;
  Bmp.Free;
  if L < 2 then Exit;
  SetLength(Temp,L);
  SetLength(TempDist,L);
  SetLength(Counts,L);
  L := L -1;
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (TempPoints[I].x >= TempDist[II].x1) and (TempPoints[I].x <= TempDist[II].x2) then
        if (TempPoints[I].y >= TempDist[II].y1) and (TempPoints[I].y <= TempDist[II].y2) then
        begin;
          if (TempPoints[I].x < Temp[II].x1) then
          begin;
            Temp[II].x1 := TempPoints[I].x;
            TempDist[II].x1 := TempPoints[I].x - PointsDist;
          end;
          if (TempPoints[I].y < Temp[II].y1) then
          begin;
            Temp[II].y1 := TempPoints[I].y;
            TempDist[II].y1 := TempPoints[I].y - PointsDist;
          end;
          if (TempPoints[I].x > Temp[II].x2) then
          begin;
            Temp[II].x2 := TempPoints[I].x;
            TempDist[II].x2 := TempPoints[I].x + PointsDist;
          end;
          if (TempPoints[I].y > Temp[II].y2) then
          begin;
            Temp[II].y2 := TempPoints[I].y;
            TempDist[II].y2 := TempPoints[I].y + PointsDist;
          end;
          Bool := True;
          Counts[II] := Counts[II] + 1;
          Break;
        end;
    if not Bool then
    begin;
      LL := LL + 1;
      TempDist[LL] := IntToBox(TempPoints[I].x-PointsDist,TempPoints[I].y-PointsDist,TempPoints[I].x+PointsDist,TempPoints[I].y+PointsDist);
      Temp[LL] := TempDist[LL];
    end;
  end;
  if LL < 0 then exit;
  SetLength(TempDist,0);
  SetLength(TempPoints,LL+1);
  SetLength(Counts,LL+1);
  For I:= 0 to LL do
  begin;
    TempPoints[I].x := (Temp[I].x1 + Temp[I].x2) div 2;
    TempPoints[I].y := (Temp[I].y1 + Temp[I].y2) div 2;
  end;
  SetLength(Temp,0);
  SortTPointArray(Counts,TempPoints);
  SetLength(TempPoints2,LL+1);
  L := -1;
  For I:= LL downto 0 do
  begin;
    Bool := False;
    For II := 0 to L do
      if (Abs(TempPoints[I].x - TempPoints2[II].x) <= BoxDist) and (Abs(TempPoints[I].y - TempPoints2[II].y) <= BoxDist) then
      begin;
        TempPoints2[II].x := (TempPoints2[II].x + TempPoints[I].x) div 2;
        TempPoints2[II].y := (TempPoints2[II].y + TempPoints[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      L := L + 1;
      TempPoints2[L] := TempPoints[I];
    end;
  end;
  if L < 0 then exit;
  SetLength(TempPoints2,L+1);
  SetLength(Points,L+1);
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (Abs(TempPoints2[I].x - Points[II].x) <= LastBoxDist) and (Abs(TempPoints2[I].y - Points[II].y) <= LastBoxDist) then
      begin;
        Points[II].x := (TempPoints2[II].x + Points[I].x) div 2;
        Points[II].y := (TempPoints2[II].y + Points[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      LL := LL + 1;
      Points[LL] := TempPoints2[I];
    end;
  end;
  if LL < 0 then
    exit
  else
    Result := True;
  SetLength(Points,LL+1);
end;    }


Procedure RadixSort(Integers : TIntegerArray; Digits : Integer; Negative : Boolean);stdcall;
var
  Dump : Array[0..9] of TIntegerArray; //We store them temporary here
  Counts : Array[0..9] of Integer; //Counts, for the length of the Dump
  Len,Divider,I,II,III,Temporary,Counter : Integer;
  TotalCleaning,TotalDump,TotalBack,TotalInit,Temp,Destroy : integer;
begin
  Divider := 1; //We use this, to sort all the digits time by time ;).
  Len := High(Integers);
  TotalDump := 0;
  TotalCleaning := 0;
  TotalBack := 0;
  TotalInit := 0;
  Temp := GetTickCount;
  For I := 0 to 9 do
    SetLength(Dump[I],Len + 1);
  TotalInit := TotalInit + Integer(GetTickCount) - Temp;
  For I := 1 to Digits do //Digits!
  begin;
    Temp := GetTickCount;
    For II := 0 to 9 do
      Counts[II] := -1; //Reset the counts
    TotalCleaning := TotalCleaning + Integer(GetTickCount) - Temp;
    Temp := Integer(GetTickCount);
    For II := 0 to Len do
    begin;
      Temporary := (Integers[II] div Divider) mod 10; // We get the single digit of the number..
      //Counts[Temporary] := Counts[Temporary] + 1; //Increase the Counts ;)
      Inc(Counts[Temporary]);
      Dump[Temporary][Counts[Temporary]] := Integers[II]; //Store the whole number in in its own digit 'dump', 0 to Radix - 1.. E.G. : Dump[0][0] := Integers[II];
    end;
    TotalDump := TotalDump + Integer(GetTickCount) - Temp;
    Temp := GetTickCount;
    Counter := -1;
    For II := 0 to 9 do
      For III := 0 to  Counts[II] do
      begin;
        Inc(Counter);//Counter := Counter + 1;
        Integers[Counter] := Dump[II][III]; //Place back the orignal var, "Integers"
      end;
    TotalBack := TotalBack + Integer(GetTickCount) - Temp;
    Divider := Divider * 10; //So that we go to the next Digit
  end;
  Writeln(inttostr(TotalCleaning) + ' Cleaning');
  Writeln(inttostr(TotalDump) + ' Dump');
  Writeln(inttostr(TotalBack) + ' Back');
  Writeln(inttostr(TotalInit) + ' Init');
  Destroy := GetTickCount;
  For I := 0 to 9 do
    SetLength(Dump[I],0);
  Writeln(IntToStr(Integer(GetTickCount) - Destroy) + ' DeInit');

end;



procedure QuickSort(var arr: TIntegerArray; s, e: integer); stdcall;
var
  cs, ce: Integer;
  pivot, swap: INteger;
begin
  cs:= s;
  ce:= e;
  pivot:= arr[(s + e) div 2];
  repeat
    while arr[cs] < pivot do cs:= cs + 1;
    while arr[ce] > pivot do ce:= ce - 1;
    if cs <= ce then
    begin
      swap:= arr[cs];
      arr[cs]:= arr[ce];
      arr[ce]:= swap;
      cs:= cs + 1;
      ce:= ce - 1;
    end;
  until cs > ce;
  if ce > s then QuickSort(arr, s, ce);
  if cs < e then QuickSort(arr, cs, e);
end;
Procedure RandomArray(var Ints : TIntegerArray; MinRandom,PlusRandom : Integer; Len : Integer);stdcall;
var
  I : integer;
begin;
  SetLength(Ints,Len+1);
  For I := 0 to len do
    INts[I] := Random(PlusRandom);
  if MinRandom > 0 then
  For I := 0 to len do
    Ints[I] := Ints[I] - Random(MinRandom);
end;
Function FindRocksOld(PointsDist,BoxDist,LastBoxDist : Integer;var Points : TPointArray) : Boolean;stdcall;
var
  I,II,L,LL,X,Y : integer;
  TempDist,Temp : Array of TBox;
  TempPoints,TempPoints2 : TPointArray;
  Counts : TIntegerArray;
  Bool : Boolean;
begin;
  Result := False;
  L := Length(Points);
  if L < 2 then Exit;
  SetLength(Temp,L);
  SetLength(TempDist,L);
  SetLength(Counts,L);
  L := L - 1;
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := LL downto 0 do
      if (Points[I].x >= TempDist[II].x1) and (Points[I].x <= TempDist[II].x2) then
        if (Points[I].y >= TempDist[II].y1) and (Points[I].y <= TempDist[II].y2) then
        begin;
          if (Points[I].x < Temp[II].x1) then
          begin;
            Temp[II].x1 := Points[I].x;
            TempDist[II].x1 := Points[I].x - PointsDist;
          end;
          if (Points[I].y < Temp[II].y1) then
          begin;
            Temp[II].y1 := Points[I].y;
            TempDist[II].y1 := Points[I].y - PointsDist;
          end;
          if (Points[I].x > Temp[II].x2) then
          begin;
            Temp[II].x2 := Points[I].x;
            TempDist[II].x2 := Points[I].x + PointsDist;
          end;
          if (Points[I].y > Temp[II].y2) then
          begin;
            Temp[II].y2 := Points[I].y;
            TempDist[II].y2 := Points[I].y + PointsDist;
          end;
          Bool := True;
          Counts[II] := Counts[II] + 1;
          Break;
        end;
    if not Bool then
    begin;
      LL := LL + 1;
      TempDist[LL] := IntToBox(Points[I].x-PointsDist,Points[I].y-PointsDist,Points[I].x+PointsDist,Points[I].y+PointsDist);
      Temp[LL] := IntToBox(Points[I].x,Points[I].y,Points[I].x,Points[I].y);
    end;
  end;
  if LL < 0 then exit;
  SetLength(TempDist,0);
  SetLength(TempPoints,LL+1);
  SetLength(Counts,LL+1);
  For I:= 0 to LL do
  begin;
    TempPoints[I].x := (Temp[I].x1 + Temp[I].x2) div 2;
    TempPoints[I].y := (Temp[I].y1 + Temp[I].y2) div 2;
  end;
  SetLength(Temp,0);
  SortTPointArray(Counts,TempPoints);
  SetLength(TempPoints2,LL+1);
  L := -1;
  For I:= LL downto 0 do
  begin;
    Bool := False;
    For II := 0 to L do
      if (Abs(TempPoints[I].x - TempPoints2[II].x) <= BoxDist) and (Abs(TempPoints[I].y - TempPoints2[II].y) <= BoxDist) then
      begin;
        TempPoints2[II].x := (TempPoints2[II].x + TempPoints[I].x) div 2;
        TempPoints2[II].y := (TempPoints2[II].y + TempPoints[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      L := L + 1;
      TempPoints2[L] := TempPoints[I];
    end;
  end;
  if L < 0 then exit;
  SetLength(TempPoints2,L+1);
  SetLength(Points,L+1);
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (Abs(TempPoints2[I].x - Points[II].x) <= LastBoxDist) and (Abs(TempPoints2[I].y - Points[II].y) <= LastBoxDist) then
      begin;
        Points[II].x := (TempPoints2[II].x + Points[I].x) div 2;
        Points[II].y := (TempPoints2[II].y + Points[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      LL := LL + 1;
      Points[LL] := TempPoints2[I];
    end;
  end;
  if LL < 0 then
    exit
  else
    Result := True;
  SetLength(Points,LL+1);
end;

function FindTextTPAinTPARay(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; stdcall;
var
  Len, I,II,LenSearch,LenTPA,xOff,yOff,x,y: integer;
  tx,ty,MatchCount : integer;
  Screen : Array of Array of Boolean;
  ScreenBox,SearchBox : TBox;
  InversedTPA : TPointArray;
begin;
  Result := False;
  Len := High(TotalTPA);
  LenSearch := High(SearchTPA);
  if LenSearch < 0 then Exit;
  if Len < LenSearch then Exit;
  MatchCount := 0;
  xOff := -5;
  yOff := 0;
  ScreenBox := GetTPABounds(TotalTPA);
  SearchBox := GetTPABounds(SearchTPA);
  SearchBox.y2 := Height;
  SetLength(Screen, SearchBox.x2 + 1,Searchbox.y2 + 1);
  SetLength(InversedTPA,(SearchBox.x2 + 1) * (Searchbox.y2 + 1));
  for I := 0 to LenSearch do
    Screen[ SearchTPA[I].x][SearchTPA[I].y] := True;
  LenTPA := -1;
  for y := 0 to SearchBox.y2 do
    for x := 0 to SearchBox.x2 do
      if Screen[X][Y] = False then
      begin;
        LenTPA := LenTPA + 1;
        InversedTPA[LenTPA].x := x;
        InversedTPA[LenTPA].y := y;
      end;
  for x := 0 to SearchBox.x2 do
  begin;
    for y := 0 to SearchBox.y2 do
      if Screen[x][y] = True then
      begin;
        xOff := x;
        yOff := y;
        Break;
      end;
    if xOff >= 0 then
      Break;
  end;
  try
    SetLength(Screen,0);
    SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1);
  except
    Exit;
  end;
  for I := 0 to Len do
    Screen[TotalTPA[I].x][TotalTPA[I].y] := True;
  for I := 0 to Len do
  begin;
    tx := TotalTPA[I].x - xOff;
    ty := TotalTPA[I].y - yOff;
    if tx > 0 then
      if ty > 0 then
        if ((SearchBox.x2 + tx) <= ScreenBox.x2) and ((SearchBox.y2 + ty) <= ScreenBox.y2) then
          begin;
            For II := 0 to LenSearch do
              if Screen[tx + SearchTPA[II].x ][ty + SearchTPA[II].y] = False then
                Break;
            if (II > LenSearch) then
            begin;
              For II := 0 to LenTPA do
                if Screen[tx + InversedTPA[II].x ][ty + InversedTPA[II].y] = True then
                  Break;
              if (II > LenTPA) then
              begin;
                MatchCount := MatchCount + 1;
                SetLength(Matches,MatchCount);
                Matches[MatchCount - 1].x := TotalTPA[I].x;
                Matches[MatchCount - 1].y := TotalTPA[I].y;
              end;
            end;
          end;
  end;
  if (MatchCount > 0) then
    Result := True;
end;

function TPAFromBox(var Box : TBox) : TPointArray; stdcall;
var
  x,y : integer;
  l : integer;
begin;
  ShowMessage(Inttostr(Box.x2) + '-' + inttostr(box.x1) + '-' + inttostr(box.y2) + '-' + inttostr(box.y1));
  ShowMessage(inttostr((Box.x2 - Box.x1 + 1) * (Box.y2 - Box.y1 + 1)));
  SetLength(Result, (Box.x2 - Box.x1 + 1) * (Box.y2 - Box.y1 + 1));
  ShowMessage('Jemoeder');
  l := 0;
  For x := box.x1 to Box.x2 do
    for y := box.y1 to box.y2 do
    begin;
      Result[l].x := x;
      Result[l].y := y;
      inc(l);
    end;
end;

Function FindText(var Chars : TCharInfoArray; var TPA : TPointArray) : String;
var
  I,II : integer;
begin;
end;
function GetFunctionCount(): Integer; stdcall; export;
begin
  Result := 52;
end;

function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
  case x of
    0:
       begin;
         ProcAddr := @RemoveTPADistEachother;
         StrPCopy(ProcDef, 'Function RemoveTPADistEachother(Dist : Integer; TPA : TPointArray) : TPointArray;');
       end;
    1:
       begin;
         ProcAddr := @FindRocksOld;
         StrPCopy(ProcDef, 'Function FindRocksOld(PointsDist,BoxDist,LastBoxDist : Integer;var Points : TPointArray) : Boolean;');
       end;
    2:
       begin;
         ProcAddr := @FindColorsRay;
         StrPCopy(ProcDef, 'Function FindColorsRay(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;');
       end;
    3:
       begin;
         ProcAddr := @GetHBitmap;
         StrPCopy(ProcDef, 'Function GetHBitmap(CanvasHandle : LongWord) : LongWord;');
       end;
    4:
       begin;
         ProcAddr := @ChangeSize;
         StrPCopy(ProcDef, 'Procedure ChangeSize(Width,Height : integer);');
       end;
    5:
       begin;
         ProcAddr := @FreeSearchingBitmap;
         StrPCopy(ProcDef, 'Procedure FreeSearchingBitmap;');
       end;
    6:
       begin;
         ProcAddr := @CreateSearchingBitmap;
         StrPCopy(ProcDef, 'Procedure CreateSearchingBitmap(Width,Height : Integer);');
       end;
    7:
       begin;
         ProcAddr := @RGBToHSLRay;
         StrPCopy(ProcDef, ' Procedure RGBToHSLRay(R,G,B : integer;var H,S,L : double);');
       end;
    8:
       begin;
         ProcAddr := @CreateSearchingBitmap;
         StrPCopy(ProcDef, 'Procedure CreateSearchingBitmap(Width,Height : Integer);');
       end;
    9:
       begin;
         ProcAddr := @FindColorsHSL;
         StrPCopy(ProcDef, 'Function FindColorsHSL(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;');
       end;
    10:
       begin;
         ProcAddr := @SortColors;
         StrPCopy(ProcDef, 'Function SortColors( Colors : TIntegerArray): TIntegerArray;');
       end;
    11:
       begin;
         ProcAddr := @SortColorsSaveCounts;
         StrPCopy(ProcDef, 'Procedure SortColorsSaveCounts(var Colors,Counts: TintegerArray);');
       end;
    12:
       begin;
         ProcAddr := @SortTPAMiddles;
         StrPCopy(ProcDef, 'Function SortTPAMiddles ( w,h : integer; TPA : TPointArray) : TPointArray;');
       end;
    13:
       begin;
         ProcAddr := @SortTPAToATPA;
         StrPCopy(ProcDef, 'Function SortTPAToATPA (w,h : integer; TPA : TPointArray) : T2DPointArray;');
       end;
    14:
       begin;
         ProcAddr := @BoxTPAToATPA;
         StrPCopy(ProcDef, 'Function BoxTPAToATPA(w,h : integer; Points : TPointArray) : T2DPointArray;');
       end;
    15:
       begin;
         ProcAddr := @GetTPABounds;
         StrPCopy(ProcDef, 'Function GetTPABounds(TPA: TPointArray): TBox;');
       end;
    16:
       begin;
         ProcAddr := @FloodFillTPA;
         StrPCopy(ProcDef, 'Function FloodFillTPA(TPA : TPointArray) : T2DPointArray;');
       end;
    17:
       begin;
         ProcAddr := @FloodFillTPADistance;
         StrPCopy(ProcDef, 'Function FloodFillTPADistance(Dist : Integer; TPA : TPointArray) : T2DPointArray;');
       end;
    18:
       begin;
         ProcAddr := @FindCommonPoint;
         StrPCopy(ProcDef, 'Function FindCommonPoint(ArrayTPA : T2DPointArray) : TPointArray;');
       end;
    19:
       begin;
         ProcAddr := @FindColorsXYZ;
         StrPCopy(ProcDef, 'Function FindColorsXYZ(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;XTol,YTol,ZTol : Double;const DC : LongWord) : Integer;');
       end;
    20:
       begin;
         ProcAddr := @RGBToXYZRay;
         StrPCopy(ProcDef, 'Procedure RGBToXYZRay(R,G,B : integer;var x,y,z : double);');
       end;
    21:
       begin;
         ProcAddr := @XYZToRGBRay;
         StrPCopy(ProcDef, 'Procedure XYZToRGBRay(X,Y,Z : Double;var R,G,B: integer);');
       end;
    22:
       begin;
         ProcAddr := @LargestTPAInATPA;
         StrPCopy(ProcDef, 'function LargestTPAInATPA(ATPA: T2DPointArray): Integer;');
       end;
    23:
       begin;
         ProcAddr := @RemoveTPASameRange;
         StrPCopy(ProcDef, 'Function RemoveTPASameRange(Dist : Integer; TPA : TPointArray) : TPointArray;');
       end;
    24:
       begin;
         ProcAddr := @FindTPAEdgePoints;
         StrPCopy(ProcDef, 'Function FindTPAEdgePoints ( MaxW,MaxH : integer; TPA : TPointArray): TPointArray;');
       end;
    25:
       begin;
         ProcAddr := @RGBToCMYKRay;
         StrPCopy(ProcDef, 'Procedure RGBToCMYKRay(R,G,B : integer;var C,M,Y,K : Double);');
       end;
    26:
       begin;
         ProcAddr := @FindColorsCMYK;
         StrPCopy(ProcDef, 'Function FindColorsCMYK(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;CTol,MTol,YTol,KTol : Double;const DC : LongWord) : Integer;');
       end;
    27:
       begin;
         ProcAddr := @SortTPABoxes;
         StrPCopy(ProcDef, 'Function SortTPABoxes( Boxes : TBoxArray; TPA: TPointArray) : T2DPointArray;');
       end;
    28:
       begin;
         ProcAddr := @SortTPADistance;
         StrPCopy(ProcDef, 'Function SortTPADistance(x,y : integer; TPA : TPointArray) : TPointArray;');
       end;
    29:
       begin;
         ProcAddr := @FindColorsRGB;
         StrPCopy(ProcDef, 'Function FindColorsRGB(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;');
       end;
    30:
       begin;
         ProcAddr := @CenterTPA;
         StrPCopy(ProcDef, 'function CenterTPA(TPA: TPointArray): TPoint;');
       end;
    31:
       begin;
         ProcAddr := @CenterBounds;
         StrPCopy(ProcDef, 'function CenterBounds(Arr: TpointArray):Tpoint;');
       end;
    32:
       begin;
         ProcAddr := @MiddlePT;
         StrPCopy(ProcDef, 'function MiddlePT(P1, P2: TPoint): TPoint;');
       end;
    33:
       begin;
         ProcAddr := @MergeATPA;
         StrPCopy(ProcDef, 'Function MergeATPA(ATPA : T2DPointArray)  : TPointArray;');
       end;
    34:
       begin;
         ProcAddr := @AbsoluteInt;
         StrPCopy(ProcDef, 'Function AbsoluteInt ( SomeNumber : integer) : integer;');
       end;
    35:
       begin;
         ProcAddr := @ColorToRGBASM;
         StrPCopy(ProcDef, 'Function ColorToRGBASM( Color : integer;var R,G,B : integer):integer;');
       end;
    36:
       begin;
         ProcAddr := @FindColorsHSLInt;
         StrPCopy(ProcDef, 'Function FindColorsHSLInt(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;');
       end;
    37:
       begin;
         ProcAddr := @CleanATPA;
         StrPCopy(ProcDef, 'Procedure CleanATPA(MinLength,MaxLength : Integer; var ATPA : T2DPointArray);');
       end;
    38:
       begin;
         ProcAddr := @SortATPADistFirstPoint;
         StrPCopy(ProcDef, 'function SortATPADistFirstPoint(x,y : integer ; ATPA : T2DPointArray) : T2DPointArray;');
       end;
    39:
       begin;
         ProcAddr := @CenterTPAEx;
         StrPCopy(ProcDef, 'Procedure CenterTPAEx(var x,y : integer; tpa : TPointArray);');
       end;
    40:
       begin;
         ProcAddr := @SortTPAToATPADist;
         StrPCopy(ProcDef, 'Function SortTPAToATPADist(Dist : Integer; TPA :TPointArray) : T2DPointArray;');
       end;
    41:
       begin;
         ProcAddr := @FindTPAinTPA;
         StrPCopy(ProcDef, 'Function FindTPAinTPA(SearchTPA, TotalTPA : TPointArray; var Matches : TPointArray) : Boolean;');
       end;
    42:
       begin;
         ProcAddr := @GayBounds;
         StrPCopy(ProcDef, 'Function GayBounds(Points: TPointArray): TBox; ');
       end;
    43:
       begin;
         ProcAddr := @FindGapsTPA;
         StrPCopy(ProcDef, 'Function FindGapsTPA( TPA : TPointArray; MinPixels : Integer) :T2DPointArray;');
       end;
    44:
       begin;
         ProcAddr := @EditToBounds;
         StrPCopy(ProcDef, 'Procedure EditToBounds( var TPA : TPointArray);');
       end;
    45:
       begin;
         ProcAddr := @FindMaskTolRay;
         StrPCopy(ProcDef, 'Function FindMaskTolRay(xs,ys : integer; const xe,ye,Tol,ContourTol : integer;Const BackgroundAllColors : Boolean; Const Mask : TMaskRay; Const ClientDC : HDC; var mx,my : integer) : Boolean;');
       end;
    46:
       begin;
         ProcAddr := @CreateMaskFromBMP;
         StrPCopy(ProcDef, 'Function CreateMaskFromBMP( BmpDC : HDC) :  TMaskRay;');
       end;
    47:
       begin;
         ProcAddr := @RadixSort;
         StrPCopy(ProcDef, 'Procedure RadixSort(Integers : TIntegerArray; Digits : Integer; Negative : Boolean);');
       end;
    48:
       begin;
         ProcAddr := @QuickSort;
         StrPCopy(ProcDef, 'procedure QuickSort2(var arr: TIntegerArray; s, e: integer);');
       end;
    49:
       begin;
         ProcAddr := @RandomArray;
         StrPCopy(ProcDef, 'Procedure RandomArray(var Ints : TIntegerArray; MinRandom,PlusRandom : Integer; Len : Integer);');
       end;
     50:
       begin;
         ProcAddr := @PNGToBitmap;
         StrPCopy(ProcDef, 'Procedure PNGToBitmap(LoadPath,SavePath : String);');
       end;
    51:
       begin;
         ProcAddr := @TPAFromBox;
         StrPCopy(ProcDef, 'function TPAFromBox242424242(var Box : TBox) : TPointArray;');
       end;
    else
     x := -1;
  end;
  Result := x;
end;

function GetTypeCount(): Integer; stdcall; export;
begin
  Result := 1;
end;

//*******************************
//  Types you want to add

function GetTypeInfo(x: Integer; var sType, sTypeDef: string): Integer; stdcall;
begin
  case x of
    0:
      begin
        sType := 'TMaskRay';
        sTypeDef := 'Record xOff, yOff : Integer;Width,Height:Integer;CheckPoint : TPoint;WhiteArray : TPointArray;BlackArray : TPointArray;end;';
      end;
    1:
      begin
        sType := 'TNumbers';
        sTypeDef := 'record n1, n2: Integer; end;';
      end;
  else
    x := -1;
  end;
  Result := x;
end;


procedure SetFunctions(Funcs: array of TSCARPlugFunc); stdcall;
var
  i: Integer;
begin
  for i := 0 to Length(Funcs) - 1 do
    if Funcs[i].Name = 'Writeln' then
      Writeln := Funcs[i].Ptr;
end;
exports SetFunctions;

exports GetFunctionCount;
exports GetFunctionInfo;
exports GetTypeCount;
exports GetTypeInfo;

procedure DllMain(reason: integer);
begin
   case reason of
     DLL_PROCESS_ATTACH: begin;
                           Bmp := TBitmap.Create;
                           CreateSearchingBitmap(775,525);
                         end;
     DLL_PROCESS_DETACH: begin;
                           Bmp.free;
                           ScanLinePointer := nil;
                         end;
   end;
end;

begin
   DllProc := @DllMain;
   DllProc(DLL_PROCESS_ATTACH) ;
end.

From: mastaraymond
Meh. Show-off!

//SCAR Plugin. Created for SCAR Divi by Kaitnieks & Freddy1990
// currently you can't call SCAR functions from plugin
library XFindRock;

uses
  FastShareMem,
  SysUtils,
  Windows,
  Dialogs,
  Math,
  PngImage,
  Graphics;


{$R *.res}
type
  TPoint = Record
    x,y : integer;
  end;
  TPointArray = Array of TPoint;
  TMaskRay = Record
    xOff, yOff : Integer;
    Width,Height:Integer;
    CheckPoint : TPoint;
    WhiteArray : TPointArray;
    BlackArray : TPointArray;
  end;
  T2DPointArray = Array of Array of TPoint;

type
  TCharInfo = record
    W,H,Area,L : Integer;
    IsChar : Char;
    Points : TPointArray;
  end;
  TCharInfoArray = Array of TCharInfo;
  THandles = Packed record
    Bitmap : HBitmap;
    Client : HDC;
  end;
  TRGB32 = packed record
    B, G, R, A: Byte;
  end;
  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32) - 1] of TRGB32;
  PRGB32Array = ^TRGB32Array;
type
  TIntegerArray = array of Integer;

type
  TBox = Record
    x1,y1,x2,y2:Integer;
  end;
  TBoxArray = Array of TBox;
type
  TSCARPlugFunc = record
    Name: string;
    Ptr: Pointer;
  end;

  TNumbers = record
    n1, n2: Integer;
  end;
  TCharRay = Record
    
    Something:  integer;
  end;
Const
  Radix = 10;  //I can't really explain.. Radix 10 is used the most.. It stands for 0,1,2,3,4,5,6,7,8,9.. And if your using negative numbers to, its -9..9
Type
  TOneStrProc = procedure(s: string);

var
   Bmp : TBitmap;
   LineLength : LongInt;
   ScanLinePointer : PRGB32Array;

var
  Writeln: TOneStrProc;


Function IntToBox(x1,y1,x2,y2 : integer) : TBox;
begin;
  Result.x1 := x1;
  Result.y1 := y1;
  Result.x2 := x2;
  Result.y2 := y2;
end;
Procedure PNGToBitmap(LoadPath,SavePath : String);stdcall;
var
  PnGImg : TPNGObject;
  Bmp : TBitmap;
begin
  PnGImg := TPNGObject.Create;
  PnGImg.LoadFromFile(LoadPath);
  Bmp := TBitmap.Create;
  Bmp.Assign(PnGImg);
  Bmp.SaveToFile(SavePath);
  Bmp.Free;
  PnGImg.Free;
end;
//Credits to original maker!
//http://www.swissdelphicenter.ch/torry/showcode.php?id=1616
Procedure SortTPointArray(var Counts: TIntegerArray;var Points : TPointArray);
var
  Len, i, j, k,h: LongInt;
  Temp : TPoint;
begin
  Len := High(Counts);
  k := Len shr 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Counts[j] > Counts[j + k]) do
      begin
        h := Counts[j];
        Temp := Points[j];
        Counts[j] := Counts[j + k];
        Points[j] := Points[J + K];
        Points[J+K] := Temp;
        Counts[j + k] := h;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;
    k := k shr 1;
  end;
end;

//Credits to original maker!
//http://www.swissdelphicenter.ch/torry/showcode.php?id=1616
Procedure SortTPointArrayE(var Counts: Array of Extended;var Points : TPointArray);
var
  Len, i, j, k: LongInt;
  H : Extended;
  Temp : TPoint;
begin
  Len := High(Counts);
  k := Len shr 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Counts[j] > Counts[j + k]) do
      begin
        h := Counts[j];
        Temp := Points[j];
        Counts[j] := Counts[j + k];
        Points[j] := Points[J + K];
        Points[J+K] := Temp;
        Counts[j + k] := h;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;
    k := k shr 1;
  end;
end;



//Credits to original maker!
//http://www.swissdelphicenter.ch/torry/showcode.php?id=1616
procedure SortColorsCount(var Colors,  Counts: TIntegerArray);
var
  Len, i, j, k,h,tmp: LongInt;
begin
  Len := High(Counts);
  k := Len shr 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Counts[j] < Counts[j + k]) do
      begin
        h := Counts[j];
        tmp := Colors[j];
        Counts[j] := Counts[j + k];
        Counts[j + k] := h;
        Colors[j] := Colors[J + k];
        Colors[J + K] :=tmp;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;

    k := k shr 1;
  end;
end;

Function GetTPABounds(TPA: TPointArray): TBox; stdcall;
var
  I,L : Integer;
begin;
  L := High(TPA);
  if L < 0 then exit;
  Result.x1 := TPA[0].x;
  Result.y1 := TPA[0].y;
  Result.x2 := TPA[0].x;
  Result.y2 := TPA[0].y;
  For I:= 1 to L do
  begin;
    if TPA[i].x > Result.x2 then
      Result.x2 := TPA[i].x
    else if TPA[i].x < Result.x1 then
      Result.x1 := TPA[i].x;
    if TPA[i].y > Result.y2 then
      Result.y2 := TPA[i].y
    else if TPA[i].y < Result.y1 then
      Result.y1 := TPA[i].y;
  end;
end;

Function FindTPAinTPA(SearchTPA, TotalTPA : TPointArray; var Matches : TPointArray) : Boolean;stdcall;
var
  Len, I,II,LenSearch,xOff,yOff : integer;
  tx,ty,MatchCount : integer;
  Screen : Array of Array of Boolean;
  ScreenBox,SearchBox : TBox;
  Bool : Boolean;
begin;
  Result := False;
  Len := High(TotalTPA);
  LenSearch := High(SearchTPA);
  if LenSearch < 0 then Exit;
  if Len < LenSearch then Exit;
  MatchCount := 0;
  ScreenBox := GetTPABounds(TotalTPA);
  SearchBox := GetTPABounds(SearchTPA);
  Try
    SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1);
  Except
    Exit;
  end;
  if (SearchBox.x1 > 0) or (SearchBox.y1 > 0) then
  begin;
    For I := 0 to LenSearch do
    begin;
      SearchTPA[I].x := SearchTPA[I].x - SearchBox.x1;
      SearchTPA[I].y := SearchTPA[I].y - SearchBox.y1;
    end;
    SearchBox.x2 := SearchBox.x2 - SearchBox.x1;
    SearchBox.y2 := SearchBox.y2 - SearchBox.y1;
    SearchBox.x1 := 0;
    SearchBox.y1 := 0;
  end;
  xOff := SearchBox.x2;
  yOff := SearchBox.y2;
  For I := 0 to LenSearch do
  begin;
    if SearchTPA[I].x = 0 then
      if SearchTPA[I].y < yOff then
        yOff := SearchTPA[I].y;
    if SearchTPA[I].y = 0 then
      if SearchTPA[I].x < xOff then
        xOff := SearchTPA[I].x;
  end;
  For I := 0 to Len do
    Screen[TotalTPA[I].x][TotalTPA[I].y] := True;
  For I := 0 to Len do
  begin;
    tx := TotalTPA[I].x - xOff;
    ty := TotalTPA[I].y;// - yOff;
    if tx > 0 then
      if ty > 0 then
        if (SearchBox.x2 + tx) <= ScreenBox.x2 then
          if (SearchBox.y2 + ty) <= ScreenBox.y2 then
          begin;
            Bool := True;
            For II := 0 to LenSearch do
              if Screen[tx + SearchTPA[II].x ][ty + SearchTPA[II].y] = False then
              begin;
                Bool := False;
                Break;
              end;
            if bool then
            begin;
              MatchCount := MatchCount + 1;
              SetLength(Matches,MatchCount);
              Matches[MatchCount - 1].x := TotalTPA[I].x;
              Matches[MatchCount - 1].y := TotalTPA[I].y;
            end;
          end;
  end;
  if MatchCount > 0 then
    Result := True;
end;

Function FindGapsTPA( TPA : TPointArray; MinPixels : Integer) :T2DPointArray;stdcall;
var
  Len,TotalLen,LenRes,I,II,III : integer;
  Screen : Array of Array of Boolean;
  Height,Width : Integer;
  Box : TBox;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  Box := GetTPABounds(TPA);
  Height := Box.y2 - Box.y1;
  Width := Box.x2 - Box.x1;
  LenRes := 0;
  III := 0;
  Try
    SetLength(Screen,Width + 1,Height + 1);
  Except
    Exit;
  end;
  For I := 0 to Len do
    Screen[TPA[I].x - Box.x1][TPA[I].y - Box.y1] := True;
  SetLength(result,1);
  SetLength(Result[0],Len+1);
  TotalLen := 0;
  For I := 0 to Width do
  begin;
    For II := 0 to Height do
      if Screen[I][II]=True then
      begin;
        Result[TotalLen][LenRes].x := I + Box.x1;
        Result[TotalLen][LenRes].y := II + Box.y1;
        LenRes := LenRes + 1;
        III := I;
      end;
    if LenRes = 0 then
      III := I
    else
    if (I - III) > MinPixels then
    begin;
      III := I;
      SetLength(Result[TotalLen],LenRes);
      LenRes := 0;
      TotalLen := TotalLen + 1;
      SetLength(Result,TotalLen + 1);
      SetLength(Result[TotalLen],Len + 1);
    end;
  end;
  SetLength(Result[TotalLen],LenRes);
end;

Procedure EditToBounds( var TPA : TPointArray);stdcall;
var
  I : Integer;
  L : Integer;
  Box : TBox;
begin;
  Box := GetTPABounds(TPA);
  if (Box.x1 = 0) and (Box.y1 = 0) then
    exit;
  L := High(TPA);
  For I := 0 to L do
  begin;
    Tpa[I].x := TPA[I].x - Box.x1;
    TPA[I].y := TPA[I].y - Box.y1;
  end;
end;

Function GayBounds(Points: TPointArray): TBox; stdcall;

Var
   L, I: Integer;

Begin
  Result.X1 := 0 xor 0;
  Result.Y1 := 0 xor 0;
  Result.X2 := 1 shl 20;
  Result.Y2 := 1 shl 20;
  L := High(Points);
  For I := 0 To L Do
  Begin
    Result.X1 := Min(Result.X1, Points[I].X);
    Result.Y1 := Min(Result.Y1, Points[I].Y);
    Result.X2 := Max(Result.X2, Points[I].X);
    Result.Y2 := Max(Result.Y2, Points[I].Y);
  End;
End;

Function RemoveTPADistEachother(Dist : Integer; TPA : TPointArray) : TPointArray;stdcall;
var
  I, II, C,HighTPA: Integer;
  Keep: Boolean;
begin
  C:= 0;
  HighTPA := High(TPA);
  SetLength(Result, HighTPA + 1);
  for I:= 0 to HighTPA do
  begin
    Keep:= True;
    for II:= (I + 1) to HighTPA do
      if sqrt ( (TPA[II].x - TPA[I].x) * (TPA[II].x - TPA[I].x) + (TPA[II].y - TPA[I].y) * (TPA[II].y - TPA[I].y)) <= Dist then
      begin
        Keep:= False;
        break;
      end;
    if keep then
    begin
      Result[C].x:= TPA[I].x;
      Result[C].y := TPA[I].y;
      C := C + 1;
    end;
  end;
  SetLength(Result, C);
end;
Procedure CleanATPA(MinLength,MaxLength : Integer; var ATPA : T2DPointArray);Stdcall;
var
  L,LL,Count : integer;
  I : integer;
begin;
  L := High(ATPA);
  Count := -1;
  For I:= 0 to L do
  begin;
    LL := Length(ATPA[I]);
    if LL > MinLength then
      if LL < MaxLength then
      begin;
        Count := Count + 1;
        if I <> Count then
          ATPA[Count] := ATPA[I];
      end;
  end;
  SetLength(ATPA,Count+1);
end;

function RemoveTPASameRange(dist : integer; TPA : TPointArray) : TPointArray;stdcall;
var
  L, HighTPA,I,II : Integer;
  Bool : boolean;
begin;
  L := -1;
  HighTPA := High(TPA);
  SetLength(Result,HighTPA + 1);
  For I:= 0 to HighTPA do
  begin;
    Bool := False;
    For II := 0 to L do
      if sqrt ( (Result[II].x - TPA[I].x) * (Result[II].x - TPA[I].x) + (Result[II].y - TPA[I].y) * (Result[II].y - TPA[I].y)) <= Dist then
      begin;
        Bool := True;
        Break;
      end;
    if not Bool then
    begin;
      L := L + 1;
      Result[L].x := TPA[I].x;
      Result[L].y := Tpa[I].y;
    end;
  end;
  SetLength(Result,L+1);
end;
Function ColorToRGBASM( Color : integer;var R,G,B : integer): integer; stdcall;
asm
  pop edx
  mov eax,[edx]
{  mov [edx],eax
  and [edx],$FF
  shr eax,8
  mov [ecx],eax
  and [ecx],$FF
  shr eax,8
  mov [edx-8],eax
  and [edx-8],$FF}
//  mov [edx-16],$FF
//  mov eax, color
end;
Function AbsoluteInt ( SomeNumber : integer) : integer;assembler;stdcall;
asm
//  mov eax,edx
  mov eax,edx
  mov ecx, edx
  sar ecx, 31
  add eax, ecx
  xor eax, ecx
end;

Function FindCommonPoint(ArrayTPA : T2DPointArray) : TPointArray;stdcall;
var
  L, HighTPA,I,II,III : Integer;
  Lengths : TIntegerArray;
  Bool : boolean;
begin;
  Bool := False;
  L := -1;
  HighTPA := High(ArrayTPA);
  if HighTPA < 1 then exit;
  SetLength(Lengths,HighTPA +  1);
  For I:= 0 to HighTPA do
    Lengths[I] := High(ArrayTPA[I]);
  For I:= 0 to Lengths[0] do
  begin;
    For II := 1 to HighTPA do
    begin;
      Bool := False;
      For III := 0 to Lengths[II] do
        if ArrayTPA[0][I].x = ArrayTPA[II][III].x then
          if ArrayTPA[0][I].y = ArrayTPA[II][III].y then
          begin;
            Bool := True;
            Break;
          end;
      if not Bool then Break;
    end;
    if Bool then
    begin;
      L := L + 1;
      SetLength(Result,L+1);
      Result[L] := ArrayTPA[0][I];
    end;
  end;
end;

Function FloodFillTPA(TPA : TPointArray) : T2DPointArray;stdcall;
var
  x,y,i,CurrentArray, LengthTPA,CurrentStack : integer;
  TempBox : TBox;
  PointsToFill : Array of Array of Boolean;
  Lengths : TIntegerArray;
  TempTPA : TPointArray;
  Stack : TPointArray;
  fx,fy : integer;
begin;
  LengthTPA := High(TPA);
  if LengthTPA < 1 then
  begin;
    if LengthTPA = 0 then
    begin;
      SetLength(Result,1,1);
      Result[0][0] := TPA[0];
    end else
      SetLength(Result,0);
    exit;
  end;
  TempBox := GetTPABounds(TPA);
  SetLength(PointsToFill,TempBox.x2 - TempBox.x1+3,TempBox.y2 - TempBox.y1+3);
  x := TempBox.x1 - 1;
  y := TempBox.y1 - 1;
  CurrentArray := -1;
  CurrentStack := 0;
  SetLength(Stack   , LengthTPA * 2);//Just to be sure ^^.
  SetLength(Lengths , LengthTPA + 1);
  SetLength(TempTPA , LengthTPA + 1);
  For I := 0 to LengthTPA do
  begin;
    TempTPA[I].x := TPA[I].x - x;
    TempTPA[I].y := TPA[I].y - y;
  end;
  For I := 0 to LengthTPA do
    PointsToFill[TempTPA[I].x][TempTPA[I].y] := True;
  For I := 0 to LengthTPA do
    if PointsToFill[TempTPA[I].x][TempTPA[I].y] then
    begin;
      CurrentArray := CurrentArray + 1;
      SetLength(Result,CurrentArray + 1);
      SetLength(Result[CurrentArray],LengthTPA - I + 1);
      fx := TempTPA[I].x;
      fy := TempTPA[I].y;
      CurrentStack := CurrentStack + 1;
      Stack[CurrentStack].x := fx;
      Stack[Currentstack].y := fy;
      While CurrentStack > 0 do
      begin;
        if PointsToFill[fx][fy] then
        begin;
          PointsToFill [fx][fy] := false;
          Result[CurrentArray][Lengths[CurrentArray]].x := fx + x;
          Result[CurrentArray][Lengths[CurrentArray]].y := fy + y;
          Lengths[CurrentArray] := Lengths[CurrentArray] + 1;
        end;
        if PointsToFill[fx+1][fy] then
        begin
          fx := fx + 1;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx][fy+1] then
        begin
          fx := fx;fy := fy + 1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx-1][fy] then
        begin
          fx := fx - 1;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx][fy-1] then
        begin
          fx := fx;fy := fy - 1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx+1][fy+1] then
        begin
          fx := fx+1;fy := fy+1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx-1][fy-1] then
        begin
          fx := fx-1;fy := fy-1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx-1][fy + 1] then
        begin
          fx := fx-1;fy := fy+1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx+1][fy-1] then
        begin
          fx := fx+1;fy := fy-1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        fx := Stack[CurrentStack].x;
        fy := Stack[CurrentStack].y;
        CurrentStack := CurrentStack - 1;
      end;
      SetLength(Result[CurrentArray],Lengths[CurrentArray]);
    end;
  SetLength(Stack,0);
  SetLength(TempTPA,0);
  SetLength(Lengths,0);
end;

Function FloodFillTPADistance(Dist : Integer; TPA : TPointArray) : T2DPointArray;stdcall;
var
  x,y,i,CurrentArray, LengthTPA,CurrentStack,DistMin : integer;
  TempBox : TBox;
  PointsToFill : Array of Array of Boolean;
  Lengths : TIntegerArray;
  TempTPA : TPointArray;
  Stack : TPointArray;
  fx,fy,ii,iii : integer;
label
  Start;
begin;
  if Dist < 1 then
    Dist := 1;
  DistMin := Dist - 1;
  LengthTPA := High(TPA);
  if LengthTPA < 1 then
  begin;
    if LengthTPA = 0 then
    begin;
      SetLength(Result,1,1);
      Result[0][0] := TPA[0];
    end else
      SetLength(Result,0);
    exit;
  end;
  TempBox := GetTPABounds(TPA);
  SetLength(PointsToFill,TempBox.x2 - TempBox.x1+(Dist*2) + 1,TempBox.y2 - TempBox.y1+(Dist *2) + 1);
  x := TempBox.x1 - Dist;
  y := TempBox.y1 - Dist;
  CurrentArray := -1;
  CurrentStack := 0;
  SetLength(Stack   , LengthTPA * Dist * 2);//Just to be sure ^^.
  SetLength(Lengths , LengthTPA + 1);
  SetLength(TempTPA , LengthTPA + 1);
  For I := 0 to LengthTPA do
  begin;
    TempTPA[I].x := TPA[I].x - x;
    TempTPA[I].y := TPA[I].y - y;
  end;
  For I := 0 to LengthTPA do
    PointsToFill[TempTPA[I].x][TempTPA[I].y] := True;
  For I := 0 to LengthTPA do
    if PointsToFill[TempTPA[I].x][TempTPA[I].y] then
    begin;
      CurrentArray := CurrentArray + 1;
      SetLength(Result,CurrentArray + 1);
      SetLength(Result[CurrentArray],LengthTPA - I + 1);
      fx := TempTPA[I].x;
      fy := TempTPA[I].y;
      CurrentStack := CurrentStack + 1;
      Stack[CurrentStack].x := fx;
      Stack[Currentstack].y := fy;
      While CurrentStack > 0 do
      begin;
        Start:
        if PointsToFill[fx][fy] then
        begin;
          PointsToFill [fx][fy] := false;
          Result[CurrentArray][Lengths[CurrentArray]].x := fx + x;
          Result[CurrentArray][Lengths[CurrentArray]].y := fy + y;
          Lengths[CurrentArray] := Lengths[CurrentArray] + 1;
        end;
        For II := 1 to Dist do
        begin;
          if PointsToFill[fx+II][fy] then
          begin
            fx := fx + II;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx][fy+II] then
          begin
            fx := fx;fy := fy + II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx-II][fy] then
          begin
            fx := fx - II;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx][fy-II] then
          begin
            fx := fx;fy := fy - II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx+II][fy+II] then
          begin
            fx := fx+II;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx-II][fy-II] then
          begin
            fx := fx-II;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx-II][fy + II] then
          begin
            fx := fx-II;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx+II][fy-II] then
          begin
            fx := fx+II;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if II > 1 then
          begin;
            For III := 1 to DistMin do
            begin;
               if PointsToFill[fx+II][fy+III] then
               begin;
                 fx := fx+II;fy := fy+III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto Start;
               end;
               if PointsToFill[fx+II][fy-III] then
               begin;
                 fx := fx+II;fy := fy-III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto Start;
               end;
               if PointsToFill[fx-II][fy+III] then
               begin;
                 fx := fx-II;fy := fy+III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
               end;
               if PointsToFill[fx-II][fy-III] then
               begin;
                 fx := fx-II;fy := fy-III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
               end;
               if PointsToFill[fx-III][fy+II] then
               begin;
                 fx := fx-III;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
               if  PointsToFill[fx+III][fy+II] then
               begin;
                 fx := fx+III;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
               if PointsToFill[fx-III][fy-II] then
               begin;
                 fx := fx-III;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
               if PointsToFill[fx+III][fy-II] then
               begin;
                 fx := fx+III;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
            end;
          end;
        end;
        fx := Stack[CurrentStack].x;
        fy := Stack[CurrentStack].y;
        CurrentStack := CurrentStack - 1;
      end;
      SetLength(Result[CurrentArray],Lengths[CurrentArray]);
    end;
  SetLength(Stack,0);
  SetLength(TempTPA,0);
  SetLength(Lengths,0);
end;
Function MergeATPA(ATPA : T2DPointArray)  : TPointArray;stdcall;
var
  I,II, Len, TempL,CurrentL : integer;
begin;
  Len := High(ATPA);
  CurrentL := 0;
  For I:= 0 to Len do
  begin;
    TempL := High(ATPA[I]);
    if TempL < 0 then
    begin;
      Continue;
    end;
    TempL := Templ + CurrentL + 1;
    Setlength(Result, TempL+1);
    Try
      For II := CurrentL to TempL do
        Result[II] := ATPA[I][II - CurrentL];
    except
    end;
    CurrentL := TempL;
  end;
  SetLength(Result,CurrentL);
end;

Function FindTPAEdgePoints ( MaxW,MaxH : integer; TPA : TPointArray): TPointArray;stdcall;
var
  Bounds : TBox;
  I : Integer;
  x,y,len,width, height,tmp  : integer;
  Points :  Array of Array of Boolean;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  Bounds := GetTPABounds(TPA);
  SetLength(Points,Bounds.x2 - Bounds.x1 + 1,Bounds.y2 - Bounds.y1 + 1);
  SetLength(Result,len + 1);
  Width := Bounds.x2 - Bounds.x1;
  Height := Bounds.y2 - Bounds.y1;
  For I := 0 to Len do
    Points[TPA[I].x - Bounds.x1][TPA[I].y - Bounds.y1] := True;
  I := -1;
//  Showmessage(inttostr(len)+ '-' +inttostr(Width) + '- ' +inttostr(Height) );
  Tmp := 0;
  For Y:= 0 to  Height do
  Begin;
    For x := 0 to Width do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Tmp := x + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
    For X := Width Downto tmp do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
  end;
  Tmp := 0;
  For x := 0 to Width do
  Begin;
    For y:= 0 to Height do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Tmp := y + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
    For y := Width Downto tmp do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
  end;
  SetLength(Result, I + 1);
end;
Function SortTPAMiddles ( w,h : integer; TPA : TPointArray) : TPointArray;stdcall;
var
  Lengths : TIntegerArray;
  Middles : TPointArray;
  TempSorted : TPointArray;
  Bool : Boolean;
  Temp,I,II,LengthTPA : Integer;
begin;
  Temp := Length(TPA);
  if Temp < 1 then Exit;
  SetLength(Middles,Temp);
  SetLength(Lengths,Temp);
  SetLength(TempSorted,Temp);
  Temp := Temp - 1;
  LengthTPA := -1;
  For I:= 0 to Temp do
  begin;
    Bool := True;
    For II := 0 to LengthTPA do
      if Abs(TPA[I].x - TempSorted[II].x) < w then
        if Abs(TPA[I].y - TempSorted[II].y) < h then
        Begin;
          Bool := False;
          Break;
        end;
    if bool then
    begin;
      LengthTPA := LengthTPA + 1;
      TempSorted[LengthTPA] := Tpa[I];
      Lengths[LengthTPA] := 1;
      Inc(Middles[LengthTPA].x,TPA[I].x);
      Inc(Middles[LengthTPA].y,TPA[I].y);
    end else
    begin;
      Lengths[II] := Lengths[II] + 1;

      Inc(Middles[II].x,TPA[I].x);
      Inc(Middles[II].y,TPA[I].y);
    end;
  end;
  SetLength(TempSorted,0);
  SetLength(Middles,LengthTPA + 1);
  SetLength(Lengths,LengthTPA + 1);
  SetLength(Result, LengthTPA + 1);
  For I := 0 to LengthTPA do
  begin;
    Result[I].x := Middles[I].x div Lengths[I];
    Result[I].y := Middles[I].y div Lengths[I];
  end;
end;

Function BoxTPAToATPA(w,h : integer; Points : TPointArray) : T2DPointArray;stdcall;
var
  I,II,L,LL,III : integer;
  TempDist,Temp : Array of TBox;
  SwapTPA : TPointArray;
  Counts : TIntegerArray;
  Bool : Boolean;
begin;
  L := Length(Points);
  SetLength(Temp,L);
  SetLength(TempDist,L);
  SetLength(Counts,L);
  SetLength(Result,0);
  L := L - 1;
  LL := -1;
  if L < 1 then
    exit;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (Points[I].x >= TempDist[II].x1) and (Points[I].x <= TempDist[II].x2) then
        if (Points[I].y >= TempDist[II].y1) and (Points[I].y <= TempDist[II].y2) then
        begin;
          if (Points[I].x < Temp[II].x1) then
          begin;
            Temp[II].x1 := Points[I].x;
            TempDist[II].x1 := Points[I].x - W;
          end;
          if (Points[I].y < Temp[II].y1) then
          begin;
            Temp[II].y1 := Points[I].y;
            TempDist[II].y1 := Points[I].y - H;
          end;
          if (Points[I].x > Temp[II].x2) then
          begin;
            Temp[II].x2 := Points[I].x;
            TempDist[II].x2 := Points[I].x + W;
          end;
          if (Points[I].y > Temp[II].y2) then
          begin;
            Temp[II].y2 := Points[I].y;
            TempDist[II].y2 := Points[I].y + H;
          end;
          Bool := True;
          Counts[II] := Counts[II] + 1;
          Result[II][Counts[II]] := Points[I];
          Break;
        end;
    if not Bool then
    begin;
      LL := LL + 1;
      TempDist[LL] := IntToBox(Points[I].x-W,Points[I].y-H,Points[I].x+W,Points[I].y+H);
      Temp[LL] := IntToBox(Points[I].x,Points[I].y,Points[I].x,Points[I].y);
      SetLength(Result,LL+1);
      SetLength(Result[LL],L - I + 1);
      Result[LL][0] := Points[I];
    end;
  end;
  For I := 0 to LL do
    SetLength(Result[I],Counts[I] + 1);
  Bool := True;
  SetLength(TempDist,1);
  While Bool do
  begin;
    Bool := False;
    For I := 0 to LL do
      For II := 0 to (I-1) do
        if ((Temp[I].x1 >= Temp[II].x1) and (Temp[I].x1 <= Temp[II].x2)) or ((Temp[I].x2 >= Temp[II].x1) and (Temp[I].x2 <= Temp[II].x2)) then
          if ((Temp[I].y1 >= Temp[II].y1) and (Temp[I].y1 <= Temp[II].y2)) or ((Temp[I].y2 >= Temp[II].y1) and (Temp[I].y2 <= Temp[II].y2)) then
          begin;
            Bool := True;
            L := Counts[I] + 1;
            Setlength(Result[I], Counts[II] + L+ 1);
            For III := 0 to Counts[II] do
              Result[I][III + L] := Result[II][III];
            Counts[II] := Counts[LL];
            Result[II] := Result[LL];
            Temp[II]   := Temp[LL];
            LL := LL - 1;
            Break;
          end;
  end;
  SetLength(Result,LL+1);
end;

Function SortTPAToATPA (w,h : integer; TPA : TPointArray) : T2DPointArray;stdcall;
var
  Lengths : TIntegerArray;
  Bool : Boolean;
  Temp,I,II,LengthTPA : Integer;
begin;
  Temp := Length(TPA);
  SetLength(Lengths,Temp);
  Temp := Temp - 1;
  LengthTPA := -1;
  For I:= 0 to Temp do
  begin;
    Bool := True;
    For II := 0 to LengthTPA do
      if Abs(TPA[I].x - Result[II][0].x) < w then
        if Abs(TPA[I].y - Result[II][0].y) < h then
        Begin;
          Bool := False;
          Break;
        end;
    if bool then
    begin;
      LengthTPA := LengthTPA + 1;
      SetLength(Result,LengthTPA+1);
      SetLength(Result[LengthTPA],1);
      Result[LengthTPA][0] := Tpa[I];
      Lengths[LengthTPA] := 1;
    end else
    begin;
      Lengths[II] := Lengths[II] + 1;
      SetLength(Result[II],Lengths[II]);
      Result[II][Lengths[II]-1] := Tpa[I];
    end;
  end;
end;


Function GetHBitmap(var CanvasHandle : LongWord) : LongWord; stdcall;
var
  Bmp : Bitmap;
  TempDC : HDC;
begin;
  TempDC := CreateCompatibleDC(CanvasHandle);
  GetObject(GetCurrentObject(CanvasHandle,Obj_Bitmap),Sizeof(bitmap),@Bmp);
  Result := CreateCompatibleBitmap( CanvasHandle,Bmp.bmwidth,bmp.bmHeight);
  SelectObject(TempDC,Result);
end;

Procedure ChangeSize(Width,Height : integer); stdcall;
begin;
  Bmp.PixelFormat := pf32bit;
  Bmp.Width := Width;
  Bmp.Height := Height;
  ScanLinePointer := Bmp.Scanline[0];
  LineLength := (Longint(Bmp.Scanline[1]) - Longint(ScanLinePointer)) div 4;
end;

Procedure CreateSearchingBitmap(Width,Height : Integer);stdcall;
begin;
  ChangeSize(Width,Height);
end;

function LargestTPAInATPA(ATPA: T2DPointArray): Integer;stdcall;
var
  I, L, W,Len: Integer;
begin
  Result := -1;
  Len := High(ATPA);
  if Len < 0 then exit;
  L:= Length(ATPA[0]);
  W:= 0;
  for I:= 1 to Len do
    if Length(ATPA[I]) > L then
    begin
      L:= Length(ATPA[I]);
      W:= I;
    end;
  Result := W;
end;

Procedure FreeSearchingBitmap;stdcall;
begin;
end;

Procedure SortColorsSaveCounts(var Colors,Counts: TintegerArray);stdcall;
var
  I,II,LenResult,Len : integer;
  TempColors : TIntegerArray;
  Found : Boolean;
begin
  Len := High(Colors);
  SetLength(Counts,Len +1);
  SetLength(TempColors,Len+1);
  LenResult := -1;
  For I:= 0 to Len do
  begin;
    Found := False;
    For II := 0 to LenResult do
      if TempColors[II] = Colors[I] then
      begin;
        Found := True;
        Counts[II] := Counts[II] + 1;
      end;
    if Not found then
    begin;
      LenResult := LenResult + 1;
      TempColors[LenResult] := Colors[I];
    end;
  end;
  SetLength(TempColors,LenResult+1);
  SetLength(Counts,LenResult+1);
  SortColorsCount(TempColors,Counts);
  Colors := TempColors;
end;
Function SortTPABoxes( Boxes : TBoxArray; TPA: TPointArray) : T2DPointArray; stdcall;
Var
  Len, I , II, L : integer;
  Counts : TIntegerArray;
begin;
  Len := High(TPA);
  L := Length(Boxes);
  SetLength(Result, L,Len+1 );
  SetLength(Counts,L);
  Dec(L);
  For I:= 0 to Len do
    For II := 0 to L do
      if (TPA[I].x >= Boxes[II].x1) then
        if (TPA[I].x <= Boxes[II].x2) then
          if (TPA[I].y >= Boxes[II].y1) then
            if (TPA[I].y <= Boxes[II].y2) then
            begin;
              Result[II][Counts[II]] := TPA[I];
              Counts[II] := Counts[II] + 1;
              Break;
            end;
  For I:= 0 to L do
    SetLength(Result[I], Counts[I]);
end;
Function SortTPAToATPADist (Dist : Integer; TPA :TPointArray) : T2DPointArray;stdcall;
var
  Lengths : TIntegerArray;
  Bool : Boolean;
  Temp,I,II,III,LengthTPA : Integer;
begin;
  Temp := Length(TPA);
  SetLength(Lengths,Temp);
  Temp := Temp - 1;
  LengthTPA := -1;
  For I:= 0 to Temp do
  begin;
    Bool := True;
    For II := 0 to LengthTPA do
    begin;
      For III := 0 to Lengths[II]-1 do
        if sqrt((Result[II][III].x - TPA[I].x) * (Result[II][III].x - TPA[I].x) + (Result[II][III].y - TPA[I].y) * (Result[II][III].y - TPA[I].y)) <= Dist then
        Begin;
          Bool := False;
          Break;
        end;
      if not bool then break;
    end;
    if bool then
    begin;
      LengthTPA := LengthTPA + 1;
      SetLength(Result,LengthTPA+1);
      SetLength(Result[LengthTPA],1);
      Result[LengthTPA][0] := Tpa[I];
      Lengths[LengthTPA] := 1;
    end else
    begin;
      Lengths[II] := Lengths[II] + 1;
      SetLength(Result[II],Lengths[II]);
      Result[II][Lengths[II]-1] := Tpa[I];
    end;
  end;
end;
{
20,042957042957  ms   Mine
180,679320679321 ms   WizzyPlugin
}
Function SortTPADistance(x,y : integer; TPA : TPointArray) : TPointArray;stdcall;
var
  Distances : Array of Extended;
  I,Len : Integer;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  SetLength(Result,Len+1);
  SetLength(Distances,Len+1);
  For I:= 0 to Len do
  begin;
    Result[I] := TPA[I];
    Distances[I] := sqrt((x - TPA[I].x) * (x - TPA[I].x) + (y - TPA[I].y) * (y - TPA[I].y));
  end;
  SortTPointArrayE(Distances,Result);
end;

function SortATPADistFirstPoint(x,y : integer ; ATPA : T2DPointArray) : T2DPointArray;stdcall;
var
  Distances : Array of Extended;
  I,Len,K,J : Integer;
  H : extended;
begin;
  Len := High(ATPA);
  if Len < 0 then exit;
  SetLength(Result,Len+2);
  SetLength(Distances,Len+1);
  For I:= 0 to Len do
    if High(ATPA[I]) >= 0 then
    begin;
      Result[I] := ATPA[I];
      Distances[I] := sqrt((x - ATPA[I][0].x) * (x - ATPA[I][0].x) + (y - ATPA[I][0].y) * (y - ATPA[I][0].y));
    end;
  k := Len shr 1;
  if k = 0 then
    K := 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Distances[j] > Distances[j + k]) do
      begin
        h := Distances[j];
        Result[Len+1] := Result[j];
        Distances[j] := Distances[j + k];
        Result[j] := Result[J + K];
        Result[J+K] := Result[Len+1];
        Distances[j + k] := h;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;
    k := k shr 1;
  end;
  SetLength(Result,Len+1);
end;

function CenterBounds(Arr: TpointArray):Tpoint;stdcall;
var
  Len,xmin,xmax,ymin,ymax, I : Integer;
begin;
  Len := High(Arr);
  if Len < 0 then exit;
  xmin := arr[0].x;
  xmax := arr[0].x;
  ymin := arr[0].y;
  ymax := arr[0].y;
  For I := 1 to Len do
  begin;
    if Arr[I].x < xmin then
      xmin := Arr[I].x
    else if  Arr[I].x > xmax then
      xmax := Arr[I].x;
    if Arr[I].y < ymin then
      ymin := Arr[I].y
    else if  Arr[I].y > ymax then
      ymax := Arr[I].y;
  end;
  Result.x := Round((xmin + xmax) / 2);
  Result.y := Round((ymin + ymax) / 2);
end;

function MiddlePT(P1, P2: TPoint): TPoint;stdcall;
begin
  result.x:= (P1.x + P2.x) div 2;
  result.y:= (P1.y + P2.y) div 2;
end;
Procedure CenterTPAEx(var x,y : integer; tpa : TPointArray); stdcall;
var
  Len : integer;
  XCount,YCount : integer;
  I : integer;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  XCount := 0;
  YCount := 0;
  For I:= 0 to Len do
  begin;
    XCount := XCount + TPA[I].x;
    YCount := YCount + TPA[I].y;
  end;
  X := XCount div (Len + 1);
  Y := YCount div (Len + 1);
end;

function CenterATPA(ATPA : T2DPointArray) : TPointArray;stdcall;
var
  XCount,YCount : int64;
  I,II,L,LL : integer;
begin;
  L := High(ATPA);
  SetLength(Result,L+1);
  For I:= 0 to L do
  begin;
    LL := High(ATPA[I]);
    XCount := 0;
    YCount := 0;
    For II := 0 to LL do
    begin;
      XCount := XCount + ATPA[I][II].x;
      YCount := YCount + ATPA[I][II].y;
    end;
    result[I].x:= XCount div (LL+1);
    result[I].y:= YCount div (LL+1);
  end;
end;

function CenterTPA(TPA: TPointArray): TPoint;stdcall;
var
  l, xCount, yCount: Int64;
  i: integer;
begin
  L := High(TPA);
  xCount:= 0;
  yCount:= 0;
  for i:= 0 to L do
  begin
    xCount:= xCount + TPA[I].x;
    yCount:= yCount + TPA[I].y;
  end;
  result.x:= xCount div (L+1);
  result.y:= yCount div (L+1);
end;

Function SortColors( Colors : TIntegerArray): TIntegerArray;stdcall;
var
  I,II,LenResult,Len : integer;
  Counts : TIntegerArray;
  Found : Boolean;
begin
  Len := High(Colors);
  SetLength(counts,Len +1);
  SetLength(result,Len+1);
  LenResult := -1;
  For I:= 0 to Len do
  begin;
    Found := False;
    For II := 0 to LenResult do
      if Result[II] = Colors[I] then
      begin;
        Found := True;
        Counts[II] := Counts[II] + 1;
      end;
    if Not found then
    begin;
          LenResult := LenResult + 1;
      Result[LenResult] := Colors[I];
    end;
  end;
  SetLength(Result,LenResult+1);
  SetLength(Counts,LenResult+1);
  SortColorsCount(Result,Counts);
end;

Procedure XYZToRGBRay(X,Y,Z : Double;var R,G,B: integer);stdcall;
var
  TempR,TempG,TempB,Tempx,tempy,tempz : double;
begin;
  Tempx := X / 100;
  tempy := Y / 100;
  tempz := Z / 100;

  TempR := Tempx *  3.2406 + tempy * -1.5372 + tempz * -0.4986;
  TempG := Tempx * -0.9689 + tempy *  1.8758 + tempz *  0.0415;
  TempB := Tempx *  0.0557 + tempy * -0.2040 + tempz *  1.0570;

  if TempR > 0.0031308  then
    TempR := 1.055 * ( Power(TempR, ( 1 / 2.4 )) ) - 0.055
  else
    TempR := 12.92 * TempR;
  if TempG > 0.0031308 then
    TempG := 1.055 * ( Power(TempG, ( 1 / 2.4 )) ) - 0.055
  else
    TempG := 12.92 * TempG;
  if  TempB > 0.0031308 then
    TempB := 1.055 * ( Power(TempB , ( 1 / 2.4 )) ) - 0.055
  else
    TempB := 12.92 * TempB;

  R := Round(TempR * 255);
  G := Round(TempG * 255);
  B := Round(TempB * 255);
end;

Procedure RGBToXYZRay(R,G,B : integer;var x,y,z : double);stdcall;
var
  Red,Green,Blue : double;
begin;
  Red := R / 255;
  Green := G / 255;
  Blue := B / 255;
  if Red > 0.04045  then
    Red := Power( ( Red + 0.055 ) / 1.055  , 2.4)
  else
    Red := Red / 12.92;
  if Green > 0.04045  then
    Green := Power( ( Green + 0.055 ) / 1.055 , 2.4)
  else
    Green := Green / 12.92;
  if  Blue > 0.04045 then
    Blue := Power(  ( Blue + 0.055 ) / 1.055  , 2.4)
  else
    Blue := Blue / 12.92;

  Red := Red * 100;
  Green := Green * 100;
  Blue := Blue * 100;
  X := Red * 0.4124 + Green * 0.3576 + Blue * 0.1805;
  Y := Red * 0.2126 + Green * 0.7152 + Blue * 0.0722;
  Z := Red * 0.0193 + Green * 0.1192 + Blue * 0.9505;
end;

Procedure RGBToHSLRay(RR,GG,BB : integer;var H,S,L : Double);stdcall;
var
  R,  G,  B,   D,  Cmax, Cmin: Double;

begin
  R := RR / 255;
  G := GG / 255;
  B := BB / 255;
  CMin := R;
  if G < Cmin then Cmin := G;
  if B  < Cmin then Cmin := B;
  CMax := R;
  if G > Cmax then Cmax := G;
  if B  > Cmax then Cmax := B;
  L := 0.5 * (Cmax + Cmin);
  if Cmax = Cmin then
  begin
    H := 0;
    S := 0;
  end else
  begin;
    D := Cmax - Cmin;
    if L < 0.5 then
      S := D / (Cmax + Cmin)
    else
      S := D / (2 - Cmax - Cmin);
    if R = Cmax then
      H := (G - B) / D
    else
      if G = Cmax then
        H  := 2 + (B - R) / D
      else
        H := 4 +  (R - G) / D;
    H := H / 6;
    if H < 0 then
      H := H + 1;
  end;
end;
Procedure RGBToHSLRayInt(RR,GG,BB : integer;var H,S,L : Integer);stdcall;
var
  R,  G,  B,   D,  Cmax, Cmin: Integer;

begin
  R := RR * 10000 div 255;
  G := GG * 10000 div 255;
  B := BB * 10000 div 255;
  CMin := R;
  if G < Cmin then Cmin := G;
  if B  < Cmin then Cmin := B;
  CMax := R;
  if G > Cmax then Cmax := G;
  if B  > Cmax then Cmax := B;
  L := (Cmax + Cmin) div 2;
  if Cmax = Cmin then
  begin
    H := 0;
    S := 0;
  end else
  begin;
    D := Cmax - Cmin;
    if L < 5000 then
      S := D div (Cmax + Cmin)
    else
      S := D div (20000 - Cmax - Cmin);
    if R = Cmax then
      H := (G - B) div D
    else
      if G = Cmax then
        H  := 20000 + (B - R) div D
      else
        H := 40000 +  (R - G) div D;
    H := H div 60000;
    if H < 0 then
      H := H + 10000;
  end;
end;

Procedure RGBToCMYKRay(R,G,B : integer;var C,M,Y,K : Double);stdcall;
begin;
  C := 1 - R / 255;
  M := 1 - G / 255;
  Y := 1 - B / 255;
  K := 1;
  if ( C < 1 ) then  K := C;
  if ( M < K ) then  K := M;
  if ( Y < K ) then  K := Y;
  if K = 1  then
  begin;
     C := 0;
     M := 0;
     Y := 0;
  end else
  begin;
     C:= ( C - K ) / ( 1 - K );
     M:= ( M - K ) / ( 1 - K );
     Y:= ( Y - K ) / ( 1 - K );
  end;
end;

Function FindColorsCMYK(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;CTol,MTol,YTol,KTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  CC,  MC,  YC, KC ,  TmpC,TmpM,TmpY ,TmpK: Double;
begin
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  RGBToCMYKRay((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),CC,MC,YC,KC);
  CTol := CTol / 100;
  MTol := MTol / 100;
  YTol := YTol / 100;
  KTol := KTol / 100;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TmpC := 1 - (ScanLinePointer[x].R / 255);
      TmpM := 1 - (ScanLinePointer[x].G / 255);
      TmpY := 1 - (ScanLinePointer[x].B / 255);
      TmpK := 1;
      if  TmpC < 1     then  TmpK := TmpC;
      if  TmpM < TmpK  then  TmpK := TmpM;
      if  TmpY < TmpK  then  TmpK := TmpY;
      if Abs(KC - TmpK) <= KTol then
      begin;
        if TmpK = 1  then
        begin;
          if (CC <= CTol) then
            if (MC <= MTol) then
              if (YC <= YTol) then
              begin;
                Len := Len + 1;
                Points[Len].x := x-Startnum+xs;
                Points[Len].y := y+ys;
              end;
        end else
        begin;
          if Abs((TmpC - TmpK) / (1 - TmpK) - CC) <= CTol then
            if Abs(( TmpM - TmpK ) / ( 1 - TmpK)  - MC) <= MTol then
              if Abs(( TmpY - TmpK ) / ( 1 -  TmpK) - YC) <= YTol then
              begin;
                Len := Len + 1;
                Points[Len].x := x-Startnum+xs;
                Points[Len].y := y+ys;
              end;
        end;
      end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;
Function FindColorsHSLInt(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  H,  S,  L,TempR,TempG,TempB,  TmpH,TmpS,TmpL , D,  Cmax, Cmin: Integer;
begin
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  RGBToHSLRayInt((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),H,S,L);
{  HTol := HTol * 100;
  STol := STol * 100;
  LTol := LTol * 100;}
  H := H div 100;
  S := S div 100;
  L := L div 100;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TempR := (ScanLinePointer[x].R * 100 div 255);
      TempG := (ScanLinePointer[x].G * 100 div 255);
      TempB := (ScanLinePointer[x].B * 100 div 255);
      CMin := TempR;
      CMax := TempR;
      if TempG  < Cmin then CMin := TempG;
      if TempB  < Cmin then CMin := TempB;
      if TempG  > Cmax then CMax := TempG;
      if TempB  > Cmax then CMax := TempB;
      TmpL := (CMax + CMin) div 2;
      if Abs(L - TmpL) <= LTol then
      begin;
        if Cmax = Cmin then
        begin
          if (H <= HTol) and (S <= STol) then
          begin;
            Len := Len + 1;
            Points[Len].x := x-Startnum+xs;
            Points[Len].y := y+ys;
          end;
        end else
        begin;
          D := Cmax - Cmin;
          if Tmpl < 50 then
            TmpS := D div (Cmax + Cmin)
          else
            TmpS := D div (200 - Cmax - Cmin);
          if Abs(S - TmpS) <= STol then
          begin;
            if TempR = Cmax then
              TmpH := (TempG - TempB) div D
            else
            if TempG = Cmax then
              TmpH  := 200 + (TempB - TempR) div D
            else
              TmpH := 400 +  (TempR - TempG) div D;
            TmpH := TmpH div 600;
            if TmpH < 0 then
              TmpH := TmpH + 100;
            if Abs(H - TmpH) <= HTol then
            begin;
              Len := Len + 1;
              Points[Len].x := x-Startnum+xs;
              Points[Len].y := y+ys;
            end;
          end;
        end;
      end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;
Function FindColorsHSL(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  H,  S,  L,TempR,TempG,TempB,  TmpH,TmpS,TmpL , D,  Cmax, Cmin: Double;
begin
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  RGBToHSLRay((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),H,S,L);
  HTol := HTol / 100;
  STol := STol / 100;
  LTol := LTol / 100;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TempR := (ScanLinePointer[x].R / 255);
      TempG := (ScanLinePointer[x].G / 255);
      TempB := (ScanLinePointer[x].B / 255);
      CMin := TempR;
      CMax := TempR;
      if TempG  < Cmin then CMin := TempG;
      if TempB  < Cmin then CMin := TempB;
      if TempG  > Cmax then CMax := TempG;
      if TempB  > Cmax then CMax := TempB;
      TmpL := 0.5 * (CMax + CMin);
      if Abs(L - TmpL) <= LTol then
      begin;
        if Cmax = Cmin then
        begin
          if (H <= HTol) and (S <= STol) then
          begin;
            Len := Len + 1;
            Points[Len].x := x-Startnum+xs;
            Points[Len].y := y+ys;
          end;
        end else
        begin;
          D := Cmax - Cmin;
          if Tmpl < 0.5 then
            TmpS := D / (Cmax + Cmin)
          else
            TmpS := D / (2 - Cmax - Cmin);
          if Abs(S - TmpS) <= STol then
          begin;
            if TempR = Cmax then
              TmpH := (TempG - TempB) / D
            else
            if TempG = Cmax then
              TmpH  := 2 + (TempB - TempR) / D
            else
              TmpH := 4 +  (TempR - TempG) / D;
            TmpH := TmpH / 6;
            if TmpH < 0 then
              TmpH := TmpH + 1;
            if Abs(H - TmpH) <= HTol then
            begin;
              Len := Len + 1;
              Points[Len].x := x-Startnum+xs;
              Points[Len].y := y+ys;
            end;
          end;
        end;
      end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;

Function FindColorsXYZ(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;XTol,YTol,ZTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  OX,  OY,  OZ,TempR,TempG,TempB : Double;
begin
  RGBToXYZRay((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),OX,OY,OZ);
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TempR := (ScanLinePointer[x].R / 255);
      TempG := (ScanLinePointer[x].G / 255);
      TempB := (ScanLinePointer[x].B / 255);
      if TempR > 0.04045  then
       TempR := Power( ( TempR + 0.055 ) / 1.055  , 2.4)
      else
       TempR := TempR / 12.92;
      if TempG > 0.04045  then
        TempG := Power( ( TempG + 0.055 ) / 1.055 , 2.4)
      else
        TempG := TempG / 12.92;
      if  TempB > 0.04045 then
        TempB := Power(  ( TempB + 0.055 ) / 1.055  , 2.4)
      else
        TempB := TempB / 12.92;
      TempR := TempR * 100;
      TempG := TempG * 100;
      TempB := TempB * 100;
      if Abs((TempR * 0.4124 + TempG * 0.3576 + TempB * 0.1805) - OX) <= XTol then
        if Abs((TempR * 0.2126 + TempG * 0.7152 + TempB * 0.0722) - OY) <= YTol then
          if Abs((TempR * 0.0193 + TempG * 0.1192 + TempB * 0.9505) - OZ) <= ZTol then
          begin;
            Len := Len + 1;
            Points[Len].x := x-startnum+xs;
            Points[Len].y := y+ys;
          end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;

Function FindColorsRGB(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;stdcall;
var
  L,X,Y,W,H,StartNum,EndNum: integer;
  R,G,B : Byte;
begin;
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  L := -1;
  W := Xe - Xs+1;
  H := Ye - Ys+1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, W,H, DC, xs, ys, SRCCOPY);
  R := Color and $ff;
  G := Color shr 8 and $ff;
  B := Color shr 16 and $ff;
  SetLength(Points,(W * H));
  W := W-1;
  H := H-1;
  For Y := 0 to H do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + w;
    For x := StartNum to EndNum do
    begin;
      if Abs(ScanLinePointer[x].R - R) <= RTol then
        if Abs(ScanLinePointer[x].G - G) <= GTol then
          if Abs(ScanLinePointer[x].B - B) <= BTol then
          begin;
            L := L + 1;
            Points[L].x := x-startnum+xs;
            Points[L].y := y+ys;
          end;
    end;
  end;
  SetLength(Points,L+1);
  Result := L + 1;
end;

Function FindColorsRay(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;stdcall;
var
  L,X,Y,W,H,TmpR,TmpG,TmpB ,StartNum,EndNum: integer;
  Tol : Extended;
  R,G,B : Byte;
begin;
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  L := -1;
  W := Xe - Xs+1;
  H := Ye - Ys+1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, W,H, DC, xs, ys, SRCCOPY);
  R := Color and $ff;
  G := Color shr 8 and $ff;
  B := Color shr 16 and $ff;
  Tol := (RTol + GTol + BTol) / 3;
  SetLength(Points,(W * H));
  W := W-1;
  H := H-1;
  For Y := 0 to H do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + w;
    For x := StartNum to EndNum do
    begin;
      TmpR := Abs(ScanLinePointer[x].R - R);
      if TmpR <= RTol then
      begin;
        TmpG := Abs(ScanLinePointer[x].G - G);
        if TmpG <= GTol then
        begin;
          TmpB := Abs(ScanLinePointer[x].B - B);
          if TmpB <= BTol then
            if sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) <= Tol then
            begin;
              L := L + 1;
              Points[L].x := x-Startnum+xs;
              Points[L].y := y+ys;
            end;
        end;
      end;
    end;
  end;
  SetLength(Points,L+1);
  Result := L + 1;
end;
Function CreateMaskFromBMP( BmpDC : HDC) :  TMaskRay;Stdcall;
var
  x,y,L,LL : Integer;
  Bmp : Windows.TBitmap;
  Bitmappie : TBitmap;
  HBmp : Windows.HBitmap;
  LengthLine : LongInt;
  ScanLine : PRGB32Array;
begin;
  HBmp := GetCurrentObject(BmpDC,OBJ_BITMAP);
  GetObject(HBmp,SizeOf(Bmp),@Bmp);
  Bitmappie := TBitmap.Create;
  Bitmappie.PixelFormat := pf32bit;
  Bitmappie.Width := Bmp.bmWidth;
  Bitmappie.Height := Bmp.bmHeight;
  SetLength(Result.WhiteArray,Bmp.bmWidth * Bmp.bmHeight);
  SetLength(Result.BlackArray,Bmp.bmWidth * Bmp.bmHeight);
  BitBlt(Bitmappie.Canvas.Handle, 0, 0, Bmp.bmWidth,Bmp.bmHeight, BmpDC, 0, 0, SRCCOPY);
  ScanLine := Bitmappie.Scanline[0];
  LengthLine := (Longint(Bitmappie.Scanline[1]) - Longint(ScanLine)) div 4;
  L := -1;
  LL := -1;
  Bmp.bmWidth := Bmp.bmWidth - 1;
  Bmp.bmHeight := Bmp.bmHeight - 1;
  Result.Width := Bmp.bmWidth;
  Result.Height := Bmp.bmHeight;
  For y := 0 to Bmp.bmHeight do
    For x := 0 to Bmp.bmWidth do
    begin;
      if Scanline[y * LengthLine + x].r = 255 then
      begin;
        L := L + 1;
        Result.WhiteArray[L].x := x;
        Result.WhiteArray[L].y := y;
      end else
      begin;
        LL := LL + 1;
        Result.BlackArray[LL].x := x;
        Result.BlackArray[LL].y := y;
      end;
  end;
  SetLength(Result.WhiteArray,L + 1);
  SetLength(Result.BlackArray,LL + 1);
  Result.CheckPoint := Result.BlackArray[LL];
  For x := 0 to Bmp.bmWidth do
    For Y := 0 to Bmp.bmHeight do
      if Scanline[y * LengthLine + x].r = 255 then
      begin;
        Result.xOff := x;
        Result.yOff := y;
        Bitmappie.Free;
        Exit;
      end;
end;

Function FindMaskTolRay(xs,ys : integer; const xe,ye,Tol,ContourTol : integer;Const BackgroundAllColors : Boolean; Const Mask : TMaskRay; Const ClientDC : HDC; var mx,my : integer) : Boolean;stdcall;
var
  PrecalcedNumbers : TIntegerArray;
  L,LL,X,Y,W,H,I,II,TmpR,TmpG,TmpB ,StartNum: integer;
  R,G,B,RR,GG,BB : Byte;
  Bmp : TBitmap;
  LengthLine : LongInt;
  ScanLine : PRGB32Array;
  StartPT : TPoint;
Label
  NoMatch;
begin;
  Result := False;
  Bmp := TBitmap.Create;
  Bmp.PixelFormat := pf32bit;
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  L  := High(Mask.WhiteArray);
  LL := High(Mask.BlackArray);
  if L = 0 then exit;
  W := Xe - Xs+1;
  H := Ye - Ys+1;
  Bmp.Width := W;
  Bmp.Height:= H;
  BitBlt(Bmp.Canvas.Handle, 0, 0,W,H, ClientDC, xs, ys, SRCCOPY);
  ScanLine := Bmp.Scanline[0];
  LengthLine := (Longint(Bmp.Scanline[1]) - Longint(ScanLine)) div 4;
  SetLength(PrecalcedNumbers,H);
  For I := 0 to (H - 1) do
    PrecalcedNumbers[I] := I * LengthLine;
  W := W-Mask.Width-1;
  H := H-Mask.Height-1;
  For Y := Mask.yOff to H do
    For x := Mask.xOff to W do
    begin;
      R := ScanLine[PrecalcedNumbers[Y] + x].r;
      G := ScanLine[PrecalcedNumbers[Y] + x].g;
      B := ScanLine[PrecalcedNumbers[Y] + x].b;
      StartPT.x := x - Mask.xOff;
      StartPT.y := y - Mask.yOff;
      StartNum := PrecalcedNumbers[ Mask.CheckPoint.y + StartPT.y] + Mask.CheckPoint.x + StartPT.x;
      if sqrt((ScanLine[StartNum].R - R) * (ScanLine[StartNum].R - R)
             +(ScanLine[StartNum].G - G) * (ScanLine[StartNum].G - G)
             +(ScanLine[StartNum].B - B) * (ScanLine[StartNum].B - B)) <= ContourTol then
               Continue;
      For I := 0 to L do
      begin;
        StartNum := PrecalcedNumbers[Mask.WhiteArray[I].y + StartPT.y] + StartPT.x + Mask.WhiteArray[I].x;
        TmpR := ScanLine[StartNum].R - R;
        TmpG := ScanLine[StartNum].G - G;
        TmpB := ScanLine[StartNum].B - B;
        if (sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) > Tol) then
          Goto NoMatch;
        if BackgroundAllColors then
        begin;
          RR := ScanLine[StartNum].R;
          GG := ScanLine[StartNum].G;
          BB := ScanLine[StartNum].B;
          For II := 0 to LL do
          begin;
            StartNum := PrecalcedNumbers[Mask.BlackArray[II].y + StartPT.y] + StartPT.x + Mask.BlackArray[II].x;
            TmpR := ScanLine[StartNum].R - RR;
            TmpG := ScanLine[StartNum].G - GG;
            TmpB := ScanLine[StartNum].B - BB;
            if (sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) <= ContourTol) then
              goto NoMatch;
          end;
        end;
      end;
      if not BackgroundAllColors then
        For I := 0 to LL do
        begin;
          StartNum := PrecalcedNumbers[Mask.BlackArray[I].y + StartPT.y] + StartPT.x + Mask.BlackArray[I].x;
          TmpR := ScanLine[StartNum].R - R;
          TmpG := ScanLine[StartNum].G - G;
          TmpB := ScanLine[StartNum].B - B;
          if (sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) <= ContourTol) then
            goto NoMatch;
        end;
      Result := True;
      mx :=  x+xs-Mask.xOff;
      my :=  y+ys-Mask.yOff;
      Bmp.Free;
      ScanLine := Nil;
      Exit;
      NoMatch:
  end;
  Bmp.Free;
  Scanline := nil;
end;

Function IsMaskAt(x,y : integer; mask : TMaskRay; Tol,ContourTol : Integer; Bmp : TBitmap) : Boolean;
//var
//  I, II : integer;
begin;
  Result := True;
end;

{Function FindRocks(PointsDist,BoxDist,LastBoxDist : Integer;var Points : TPointArray;Color,RTol,GTol,BTol,xs, ys, xe, ye : Integer; DC : LongWord) : Boolean;stdcall;
var
  I,II,L,LL,X,Y : integer;
  R,G,B : Byte;
  TempDist,Temp : Array of TBox;
  TempPoints,TempPoints2 : TPointArray;
  Counts : TIntegerArray;
  Bool : Boolean;
  Bmp : TBitmap;
  Line : PRGB32Array;
begin;
  Result := False;
  L := -1;
  Bmp := TBitmap.Create;
  Bmp.Width := xe - xs+1;
  Bmp.Height := ye - ys+1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, DC, xs, ys, SRCCOPY);
  Bmp.PixelFormat := pf32bit;
  R := Color and $ff;
  G := Color shr 8 and $ff;
  B := Color shr 16 and $ff;
  SetLength(TempPoints,(Bmp.Width * Bmp.Height));
  I := Bmp.Height-1;
  II := Bmp.Width-1;
  for y := 0 to I do
  begin
    Line := Bmp.ScanLine[y];
    for x := 0 to II do
    begin
      if (Abs(Line[x].R - R) <= RTol) then
        if (Abs(Line[x].G - G) <= GTol) then
          if (Abs(Line[x].B - B) <= Btol) then
          begin
            L := L + 1;
            TempPoints[L].x := x+xs;
            TempPoints[L].y := y+ys;
         end;
    end;
  end;
  L := L + 1;
  SetLength(TempPoints,L);
  Line := nil;
  Bmp.Free;
  if L < 2 then Exit;
  SetLength(Temp,L);
  SetLength(TempDist,L);
  SetLength(Counts,L);
  L := L -1;
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (TempPoints[I].x >= TempDist[II].x1) and (TempPoints[I].x <= TempDist[II].x2) then
        if (TempPoints[I].y >= TempDist[II].y1) and (TempPoints[I].y <= TempDist[II].y2) then
        begin;
          if (TempPoints[I].x < Temp[II].x1) then
          begin;
            Temp[II].x1 := TempPoints[I].x;
            TempDist[II].x1 := TempPoints[I].x - PointsDist;
          end;
          if (TempPoints[I].y < Temp[II].y1) then
          begin;
            Temp[II].y1 := TempPoints[I].y;
            TempDist[II].y1 := TempPoints[I].y - PointsDist;
          end;
          if (TempPoints[I].x > Temp[II].x2) then
          begin;
            Temp[II].x2 := TempPoints[I].x;
            TempDist[II].x2 := TempPoints[I].x + PointsDist;
          end;
          if (TempPoints[I].y > Temp[II].y2) then
          begin;
            Temp[II].y2 := TempPoints[I].y;
            TempDist[II].y2 := TempPoints[I].y + PointsDist;
          end;
          Bool := True;
          Counts[II] := Counts[II] + 1;
          Break;
        end;
    if not Bool then
    begin;
      LL := LL + 1;
      TempDist[LL] := IntToBox(TempPoints[I].x-PointsDist,TempPoints[I].y-PointsDist,TempPoints[I].x+PointsDist,TempPoints[I].y+PointsDist);
      Temp[LL] := TempDist[LL];
    end;
  end;
  if LL < 0 then exit;
  SetLength(TempDist,0);
  SetLength(TempPoints,LL+1);
  SetLength(Counts,LL+1);
  For I:= 0 to LL do
  begin;
    TempPoints[I].x := (Temp[I].x1 + Temp[I].x2) div 2;
    TempPoints[I].y := (Temp[I].y1 + Temp[I].y2) div 2;
  end;
  SetLength(Temp,0);
  SortTPointArray(Counts,TempPoints);
  SetLength(TempPoints2,LL+1);
  L := -1;
  For I:= LL downto 0 do
  begin;
    Bool := False;
    For II := 0 to L do
      if (Abs(TempPoints[I].x - TempPoints2[II].x) <= BoxDist) and (Abs(TempPoints[I].y - TempPoints2[II].y) <= BoxDist) then
      begin;
        TempPoints2[II].x := (TempPoints2[II].x + TempPoints[I].x) div 2;
        TempPoints2[II].y := (TempPoints2[II].y + TempPoints[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      L := L + 1;
      TempPoints2[L] := TempPoints[I];
    end;
  end;
  if L < 0 then exit;
  SetLength(TempPoints2,L+1);
  SetLength(Points,L+1);
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (Abs(TempPoints2[I].x - Points[II].x) <= LastBoxDist) and (Abs(TempPoints2[I].y - Points[II].y) <= LastBoxDist) then
      begin;
        Points[II].x := (TempPoints2[II].x + Points[I].x) div 2;
        Points[II].y := (TempPoints2[II].y + Points[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      LL := LL + 1;
      Points[LL] := TempPoints2[I];
    end;
  end;
  if LL < 0 then
    exit
  else
    Result := True;
  SetLength(Points,LL+1);
end;    }


Procedure RadixSort(Integers : TIntegerArray; Digits : Integer; Negative : Boolean);stdcall;
var
  Dump : Array[0..9] of TIntegerArray; //We store them temporary here
  Counts : Array[0..9] of Integer; //Counts, for the length of the Dump
  Len,Divider,I,II,III,Temporary,Counter : Integer;
  TotalCleaning,TotalDump,TotalBack,TotalInit,Temp,Destroy : integer;
begin
  Divider := 1; //We use this, to sort all the digits time by time ;).
  Len := High(Integers);
  TotalDump := 0;
  TotalCleaning := 0;
  TotalBack := 0;
  TotalInit := 0;
  Temp := GetTickCount;
  For I := 0 to 9 do
    SetLength(Dump[I],Len + 1);
  TotalInit := TotalInit + Integer(GetTickCount) - Temp;
  For I := 1 to Digits do //Digits!
  begin;
    Temp := GetTickCount;
    For II := 0 to 9 do
      Counts[II] := -1; //Reset the counts
    TotalCleaning := TotalCleaning + Integer(GetTickCount) - Temp;
    Temp := Integer(GetTickCount);
    For II := 0 to Len do
    begin;
      Temporary := (Integers[II] div Divider) mod 10; // We get the single digit of the number..
      //Counts[Temporary] := Counts[Temporary] + 1; //Increase the Counts ;)
      Inc(Counts[Temporary]);
      Dump[Temporary][Counts[Temporary]] := Integers[II]; //Store the whole number in in its own digit 'dump', 0 to Radix - 1.. E.G. : Dump[0][0] := Integers[II];
    end;
    TotalDump := TotalDump + Integer(GetTickCount) - Temp;
    Temp := GetTickCount;
    Counter := -1;
    For II := 0 to 9 do
      For III := 0 to  Counts[II] do
      begin;
        Inc(Counter);//Counter := Counter + 1;
        Integers[Counter] := Dump[II][III]; //Place back the orignal var, "Integers"
      end;
    TotalBack := TotalBack + Integer(GetTickCount) - Temp;
    Divider := Divider * 10; //So that we go to the next Digit
  end;
  Writeln(inttostr(TotalCleaning) + ' Cleaning');
  Writeln(inttostr(TotalDump) + ' Dump');
  Writeln(inttostr(TotalBack) + ' Back');
  Writeln(inttostr(TotalInit) + ' Init');
  Destroy := GetTickCount;
  For I := 0 to 9 do
    SetLength(Dump[I],0);
  Writeln(IntToStr(Integer(GetTickCount) - Destroy) + ' DeInit');

end;



procedure QuickSort(var arr: TIntegerArray; s, e: integer); stdcall;
var
  cs, ce: Integer;
  pivot, swap: INteger;
begin
  cs:= s;
  ce:= e;
  pivot:= arr[(s + e) div 2];
  repeat
    while arr[cs] < pivot do cs:= cs + 1;
    while arr[ce] > pivot do ce:= ce - 1;
    if cs <= ce then
    begin
      swap:= arr[cs];
      arr[cs]:= arr[ce];
      arr[ce]:= swap;
      cs:= cs + 1;
      ce:= ce - 1;
    end;
  until cs > ce;
  if ce > s then QuickSort(arr, s, ce);
  if cs < e then QuickSort(arr, cs, e);
end;
Procedure RandomArray(var Ints : TIntegerArray; MinRandom,PlusRandom : Integer; Len : Integer);stdcall;
var
  I : integer;
begin;
  SetLength(Ints,Len+1);
  For I := 0 to len do
    INts[I] := Random(PlusRandom);
  if MinRandom > 0 then
  For I := 0 to len do
    Ints[I] := Ints[I] - Random(MinRandom);
end;
Function FindRocksOld(PointsDist,BoxDist,LastBoxDist : Integer;var Points : TPointArray) : Boolean;stdcall;
var
  I,II,L,LL,X,Y : integer;
  TempDist,Temp : Array of TBox;
  TempPoints,TempPoints2 : TPointArray;
  Counts : TIntegerArray;
  Bool : Boolean;
begin;
  Result := False;
  L := Length(Points);
  if L < 2 then Exit;
  SetLength(Temp,L);
  SetLength(TempDist,L);
  SetLength(Counts,L);
  L := L - 1;
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := LL downto 0 do
      if (Points[I].x >= TempDist[II].x1) and (Points[I].x <= TempDist[II].x2) then
        if (Points[I].y >= TempDist[II].y1) and (Points[I].y <= TempDist[II].y2) then
        begin;
          if (Points[I].x < Temp[II].x1) then
          begin;
            Temp[II].x1 := Points[I].x;
            TempDist[II].x1 := Points[I].x - PointsDist;
          end;
          if (Points[I].y < Temp[II].y1) then
          begin;
            Temp[II].y1 := Points[I].y;
            TempDist[II].y1 := Points[I].y - PointsDist;
          end;
          if (Points[I].x > Temp[II].x2) then
          begin;
            Temp[II].x2 := Points[I].x;
            TempDist[II].x2 := Points[I].x + PointsDist;
          end;
          if (Points[I].y > Temp[II].y2) then
          begin;
            Temp[II].y2 := Points[I].y;
            TempDist[II].y2 := Points[I].y + PointsDist;
          end;
          Bool := True;
          Counts[II] := Counts[II] + 1;
          Break;
        end;
    if not Bool then
    begin;
      LL := LL + 1;
      TempDist[LL] := IntToBox(Points[I].x-PointsDist,Points[I].y-PointsDist,Points[I].x+PointsDist,Points[I].y+PointsDist);
      Temp[LL] := IntToBox(Points[I].x,Points[I].y,Points[I].x,Points[I].y);
    end;
  end;
  if LL < 0 then exit;
  SetLength(TempDist,0);
  SetLength(TempPoints,LL+1);
  SetLength(Counts,LL+1);
  For I:= 0 to LL do
  begin;
    TempPoints[I].x := (Temp[I].x1 + Temp[I].x2) div 2;
    TempPoints[I].y := (Temp[I].y1 + Temp[I].y2) div 2;
  end;
  SetLength(Temp,0);
  SortTPointArray(Counts,TempPoints);
  SetLength(TempPoints2,LL+1);
  L := -1;
  For I:= LL downto 0 do
  begin;
    Bool := False;
    For II := 0 to L do
      if (Abs(TempPoints[I].x - TempPoints2[II].x) <= BoxDist) and (Abs(TempPoints[I].y - TempPoints2[II].y) <= BoxDist) then
      begin;
        TempPoints2[II].x := (TempPoints2[II].x + TempPoints[I].x) div 2;
        TempPoints2[II].y := (TempPoints2[II].y + TempPoints[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      L := L + 1;
      TempPoints2[L] := TempPoints[I];
    end;
  end;
  if L < 0 then exit;
  SetLength(TempPoints2,L+1);
  SetLength(Points,L+1);
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (Abs(TempPoints2[I].x - Points[II].x) <= LastBoxDist) and (Abs(TempPoints2[I].y - Points[II].y) <= LastBoxDist) then
      begin;
        Points[II].x := (TempPoints2[II].x + Points[I].x) div 2;
        Points[II].y := (TempPoints2[II].y + Points[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      LL := LL + 1;
      Points[LL] := TempPoints2[I];
    end;
  end;
  if LL < 0 then
    exit
  else
    Result := True;
  SetLength(Points,LL+1);
end;

function FindTextTPAinTPARay(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; stdcall;
var
  Len, I,II,LenSearch,LenTPA,xOff,yOff,x,y: integer;
  tx,ty,MatchCount : integer;
  Screen : Array of Array of Boolean;
  ScreenBox,SearchBox : TBox;
  InversedTPA : TPointArray;
begin;
  Result := False;
  Len := High(TotalTPA);
  LenSearch := High(SearchTPA);
  if LenSearch < 0 then Exit;
  if Len < LenSearch then Exit;
  MatchCount := 0;
  xOff := -5;
  yOff := 0;
  ScreenBox := GetTPABounds(TotalTPA);
  SearchBox := GetTPABounds(SearchTPA);
  SearchBox.y2 := Height;
  SetLength(Screen, SearchBox.x2 + 1,Searchbox.y2 + 1);
  SetLength(InversedTPA,(SearchBox.x2 + 1) * (Searchbox.y2 + 1));
  for I := 0 to LenSearch do
    Screen[ SearchTPA[I].x][SearchTPA[I].y] := True;
  LenTPA := -1;
  for y := 0 to SearchBox.y2 do
    for x := 0 to SearchBox.x2 do
      if Screen[X][Y] = False then
      begin;
        LenTPA := LenTPA + 1;
        InversedTPA[LenTPA].x := x;
        InversedTPA[LenTPA].y := y;
      end;
  for x := 0 to SearchBox.x2 do
  begin;
    for y := 0 to SearchBox.y2 do
      if Screen[x][y] = True then
      begin;
        xOff := x;
        yOff := y;
        Break;
      end;
    if xOff >= 0 then
      Break;
  end;
  try
    SetLength(Screen,0);
    SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1);
  except
    Exit;
  end;
  for I := 0 to Len do
    Screen[TotalTPA[I].x][TotalTPA[I].y] := True;
  for I := 0 to Len do
  begin;
    tx := TotalTPA[I].x - xOff;
    ty := TotalTPA[I].y - yOff;
    if tx > 0 then
      if ty > 0 then
        if ((SearchBox.x2 + tx) <= ScreenBox.x2) and ((SearchBox.y2 + ty) <= ScreenBox.y2) then
          begin;
            For II := 0 to LenSearch do
              if Screen[tx + SearchTPA[II].x ][ty + SearchTPA[II].y] = False then
                Break;
            if (II > LenSearch) then
            begin;
              For II := 0 to LenTPA do
                if Screen[tx + InversedTPA[II].x ][ty + InversedTPA[II].y] = True then
                  Break;
              if (II > LenTPA) then
              begin;
                MatchCount := MatchCount + 1;
                SetLength(Matches,MatchCount);
                Matches[MatchCount - 1].x := TotalTPA[I].x;
                Matches[MatchCount - 1].y := TotalTPA[I].y;
              end;
            end;
          end;
  end;
  if (MatchCount > 0) then
    Result := True;
end;

function TPAFromBox(var Box : TBox) : TPointArray; stdcall;
var
  x,y : integer;
  l : integer;
begin;
  ShowMessage(Inttostr(Box.x2) + '-' + inttostr(box.x1) + '-' + inttostr(box.y2) + '-' + inttostr(box.y1));
  ShowMessage(inttostr((Box.x2 - Box.x1 + 1) * (Box.y2 - Box.y1 + 1)));
  SetLength(Result, (Box.x2 - Box.x1 + 1) * (Box.y2 - Box.y1 + 1));
  ShowMessage('Jemoeder');
  l := 0;
  For x := box.x1 to Box.x2 do
    for y := box.y1 to box.y2 do
    begin;
      Result[l].x := x;
      Result[l].y := y;
      inc(l);
    end;
end;

Function FindText(var Chars : TCharInfoArray; var TPA : TPointArray) : String;
var
  I,II : integer;
begin;
end;
function GetFunctionCount(): Integer; stdcall; export;
begin
  Result := 52;
end;

function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
  case x of
    0:
       begin;
         ProcAddr := @RemoveTPADistEachother;
         StrPCopy(ProcDef, 'Function RemoveTPADistEachother(Dist : Integer; TPA : TPointArray) : TPointArray;');
       end;
    1:
       begin;
         ProcAddr := @FindRocksOld;
         StrPCopy(ProcDef, 'Function FindRocksOld(PointsDist,BoxDist,LastBoxDist : Integer;var Points : TPointArray) : Boolean;');
       end;
    2:
       begin;
         ProcAddr := @FindColorsRay;
         StrPCopy(ProcDef, 'Function FindColorsRay(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;');
       end;
    3:
       begin;
         ProcAddr := @GetHBitmap;
         StrPCopy(ProcDef, 'Function GetHBitmap(CanvasHandle : LongWord) : LongWord;');
       end;
    4:
       begin;
         ProcAddr := @ChangeSize;
         StrPCopy(ProcDef, 'Procedure ChangeSize(Width,Height : integer);');
       end;
    5:
       begin;
         ProcAddr := @FreeSearchingBitmap;
         StrPCopy(ProcDef, 'Procedure FreeSearchingBitmap;');
       end;
    6:
       begin;
         ProcAddr := @CreateSearchingBitmap;
         StrPCopy(ProcDef, 'Procedure CreateSearchingBitmap(Width,Height : Integer);');
       end;
    7:
       begin;
         ProcAddr := @RGBToHSLRay;
         StrPCopy(ProcDef, ' Procedure RGBToHSLRay(R,G,B : integer;var H,S,L : double);');
       end;
    8:
       begin;
         ProcAddr := @CreateSearchingBitmap;
         StrPCopy(ProcDef, 'Procedure CreateSearchingBitmap(Width,Height : Integer);');
       end;
    9:
       begin;
         ProcAddr := @FindColorsHSL;
         StrPCopy(ProcDef, 'Function FindColorsHSL(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;');
       end;
    10:
       begin;
         ProcAddr := @SortColors;
         StrPCopy(ProcDef, 'Function SortColors( Colors : TIntegerArray): TIntegerArray;');
       end;
    11:
       begin;
         ProcAddr := @SortColorsSaveCounts;
         StrPCopy(ProcDef, 'Procedure SortColorsSaveCounts(var Colors,Counts: TintegerArray);');
       end;
    12:
       begin;
         ProcAddr := @SortTPAMiddles;
         StrPCopy(ProcDef, 'Function SortTPAMiddles ( w,h : integer; TPA : TPointArray) : TPointArray;');
       end;
    13:
       begin;
         ProcAddr := @SortTPAToATPA;
         StrPCopy(ProcDef, 'Function SortTPAToATPA (w,h : integer; TPA : TPointArray) : T2DPointArray;');
       end;
    14:
       begin;
         ProcAddr := @BoxTPAToATPA;
         StrPCopy(ProcDef, 'Function BoxTPAToATPA(w,h : integer; Points : TPointArray) : T2DPointArray;');
       end;
    15:
       begin;
         ProcAddr := @GetTPABounds;
         StrPCopy(ProcDef, 'Function GetTPABounds(TPA: TPointArray): TBox;');
       end;
    16:
       begin;
         ProcAddr := @FloodFillTPA;
         StrPCopy(ProcDef, 'Function FloodFillTPA(TPA : TPointArray) : T2DPointArray;');
       end;
    17:
       begin;
         ProcAddr := @FloodFillTPADistance;
         StrPCopy(ProcDef, 'Function FloodFillTPADistance(Dist : Integer; TPA : TPointArray) : T2DPointArray;');
       end;
    18:
       begin;
         ProcAddr := @FindCommonPoint;
         StrPCopy(ProcDef, 'Function FindCommonPoint(ArrayTPA : T2DPointArray) : TPointArray;');
       end;
    19:
       begin;
         ProcAddr := @FindColorsXYZ;
         StrPCopy(ProcDef, 'Function FindColorsXYZ(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;XTol,YTol,ZTol : Double;const DC : LongWord) : Integer;');
       end;
    20:
       begin;
         ProcAddr := @RGBToXYZRay;
         StrPCopy(ProcDef, 'Procedure RGBToXYZRay(R,G,B : integer;var x,y,z : double);');
       end;
    21:
       begin;
         ProcAddr := @XYZToRGBRay;
         StrPCopy(ProcDef, 'Procedure XYZToRGBRay(X,Y,Z : Double;var R,G,B: integer);');
       end;
    22:
       begin;
         ProcAddr := @LargestTPAInATPA;
         StrPCopy(ProcDef, 'function LargestTPAInATPA(ATPA: T2DPointArray): Integer;');
       end;
    23:
       begin;
         ProcAddr := @RemoveTPASameRange;
         StrPCopy(ProcDef, 'Function RemoveTPASameRange(Dist : Integer; TPA : TPointArray) : TPointArray;');
       end;
    24:
       begin;
         ProcAddr := @FindTPAEdgePoints;
         StrPCopy(ProcDef, 'Function FindTPAEdgePoints ( MaxW,MaxH : integer; TPA : TPointArray): TPointArray;');
       end;
    25:
       begin;
         ProcAddr := @RGBToCMYKRay;
         StrPCopy(ProcDef, 'Procedure RGBToCMYKRay(R,G,B : integer;var C,M,Y,K : Double);');
       end;
    26:
       begin;
         ProcAddr := @FindColorsCMYK;
         StrPCopy(ProcDef, 'Function FindColorsCMYK(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;CTol,MTol,YTol,KTol : Double;const DC : LongWord) : Integer;');
       end;
    27:
       begin;
         ProcAddr := @SortTPABoxes;
         StrPCopy(ProcDef, 'Function SortTPABoxes( Boxes : TBoxArray; TPA: TPointArray) : T2DPointArray;');
       end;
    28:
       begin;
         ProcAddr := @SortTPADistance;
         StrPCopy(ProcDef, 'Function SortTPADistance(x,y : integer; TPA : TPointArray) : TPointArray;');
       end;
    29:
       begin;
         ProcAddr := @FindColorsRGB;
         StrPCopy(ProcDef, 'Function FindColorsRGB(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;');
       end;
    30:
       begin;
         ProcAddr := @CenterTPA;
         StrPCopy(ProcDef, 'function CenterTPA(TPA: TPointArray): TPoint;');
       end;
    31:
       begin;
         ProcAddr := @CenterBounds;
         StrPCopy(ProcDef, 'function CenterBounds(Arr: TpointArray):Tpoint;');
       end;
    32:
       begin;
         ProcAddr := @MiddlePT;
         StrPCopy(ProcDef, 'function MiddlePT(P1, P2: TPoint): TPoint;');
       end;
    33:
       begin;
         ProcAddr := @MergeATPA;
         StrPCopy(ProcDef, 'Function MergeATPA(ATPA : T2DPointArray)  : TPointArray;');
       end;
    34:
       begin;
         ProcAddr := @AbsoluteInt;
         StrPCopy(ProcDef, 'Function AbsoluteInt ( SomeNumber : integer) : integer;');
       end;
    35:
       begin;
         ProcAddr := @ColorToRGBASM;
         StrPCopy(ProcDef, 'Function ColorToRGBASM( Color : integer;var R,G,B : integer):integer;');
       end;
    36:
       begin;
         ProcAddr := @FindColorsHSLInt;
         StrPCopy(ProcDef, 'Function FindColorsHSLInt(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;');
       end;
    37:
       begin;
         ProcAddr := @CleanATPA;
         StrPCopy(ProcDef, 'Procedure CleanATPA(MinLength,MaxLength : Integer; var ATPA : T2DPointArray);');
       end;
    38:
       begin;
         ProcAddr := @SortATPADistFirstPoint;
         StrPCopy(ProcDef, 'function SortATPADistFirstPoint(x,y : integer ; ATPA : T2DPointArray) : T2DPointArray;');
       end;
    39:
       begin;
         ProcAddr := @CenterTPAEx;
         StrPCopy(ProcDef, 'Procedure CenterTPAEx(var x,y : integer; tpa : TPointArray);');
       end;
    40:
       begin;
         ProcAddr := @SortTPAToATPADist;
         StrPCopy(ProcDef, 'Function SortTPAToATPADist(Dist : Integer; TPA :TPointArray) : T2DPointArray;');
       end;
    41:
       begin;
         ProcAddr := @FindTPAinTPA;
         StrPCopy(ProcDef, 'Function FindTPAinTPA(SearchTPA, TotalTPA : TPointArray; var Matches : TPointArray) : Boolean;');
       end;
    42:
       begin;
         ProcAddr := @GayBounds;
         StrPCopy(ProcDef, 'Function GayBounds(Points: TPointArray): TBox; ');
       end;
    43:
       begin;
         ProcAddr := @FindGapsTPA;
         StrPCopy(ProcDef, 'Function FindGapsTPA( TPA : TPointArray; MinPixels : Integer) :T2DPointArray;');
       end;
    44:
       begin;
         ProcAddr := @EditToBounds;
         StrPCopy(ProcDef, 'Procedure EditToBounds( var TPA : TPointArray);');
       end;
    45:
       begin;
         ProcAddr := @FindMaskTolRay;
         StrPCopy(ProcDef, 'Function FindMaskTolRay(xs,ys : integer; const xe,ye,Tol,ContourTol : integer;Const BackgroundAllColors : Boolean; Const Mask : TMaskRay; Const ClientDC : HDC; var mx,my : integer) : Boolean;');
       end;
    46:
       begin;
         ProcAddr := @CreateMaskFromBMP;
         StrPCopy(ProcDef, 'Function CreateMaskFromBMP( BmpDC : HDC) :  TMaskRay;');
       end;
    47:
       begin;
         ProcAddr := @RadixSort;
         StrPCopy(ProcDef, 'Procedure RadixSort(Integers : TIntegerArray; Digits : Integer; Negative : Boolean);');
       end;
    48:
       begin;
         ProcAddr := @QuickSort;
         StrPCopy(ProcDef, 'procedure QuickSort2(var arr: TIntegerArray; s, e: integer);');
       end;
    49:
       begin;
         ProcAddr := @RandomArray;
         StrPCopy(ProcDef, 'Procedure RandomArray(var Ints : TIntegerArray; MinRandom,PlusRandom : Integer; Len : Integer);');
       end;
     50:
       begin;
         ProcAddr := @PNGToBitmap;
         StrPCopy(ProcDef, 'Procedure PNGToBitmap(LoadPath,SavePath : String);');
       end;
    51:
       begin;
         ProcAddr := @TPAFromBox;
         StrPCopy(ProcDef, 'function TPAFromBox242424242(var Box : TBox) : TPointArray;');
       end;
    else
     x := -1;
  end;
  Result := x;
end;

function GetTypeCount(): Integer; stdcall; export;
begin
  Result := 1;
end;

//*******************************
//  Types you want to add

function GetTypeInfo(x: Integer; var sType, sTypeDef: string): Integer; stdcall;
begin
  case x of
    0:
      begin
        sType := 'TMaskRay';
        sTypeDef := 'Record xOff, yOff : Integer;Width,Height:Integer;CheckPoint : TPoint;WhiteArray : TPointArray;BlackArray : TPointArray;end;';
      end;
    1:
      begin
        sType := 'TNumbers';
        sTypeDef := 'record n1, n2: Integer; end;';
      end;
  else
    x := -1;
  end;
  Result := x;
end;


procedure SetFunctions(Funcs: array of TSCARPlugFunc); stdcall;
var
  i: Integer;
begin
  for i := 0 to Length(Funcs) - 1 do
    if Funcs[i].Name = 'Writeln' then
      Writeln := Funcs[i].Ptr;
end;
exports SetFunctions;

exports GetFunctionCount;
exports GetFunctionInfo;
exports GetTypeCount;
exports GetTypeInfo;

procedure DllMain(reason: integer);
begin
   case reason of
     DLL_PROCESS_ATTACH: begin;
                           Bmp := TBitmap.Create;
                           CreateSearchingBitmap(775,525);
                         end;
     DLL_PROCESS_DETACH: begin;
                           Bmp.free;
                           ScanLinePointer := nil;
                         end;
   end;
end;

begin
   DllProc := @DllMain;
   DllProc(DLL_PROCESS_ATTACH) ;
end.

You just posted that…