Advertisement
WarPie90

CTS2 - plugin fast

Mar 15th, 2018
485
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 7.19 KB | None | 0 0
  1. unit Finder;
  2. {=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=]
  3.  Copyright (c) 2018, Jarl K. <Slacky> Holta || http://github.com/WarPie
  4.  All rights reserved.
  5.  For more info see: Copyright.txt
  6. [=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
  7. {$mode objfpc}{$H+}
  8. {$modeswitch advancedrecords}
  9. {$inline on}
  10. interface
  11. uses
  12.   SysUtils, Classes, Header;
  13.  
  14. type
  15.   iColorHSL = record H,S,L: Int32; end;
  16.  
  17.   PFinder = ^TFinder;
  18.   TFinder = packed record
  19.     FData: PRGB32;
  20.     FWidth, FHeight: Int32;
  21.     FHueMod, FSatMod: Double;
  22.   public
  23.     procedure Init(Data: PRGB32; Width, Height: Int32);
  24.     procedure Free;
  25.  
  26.     procedure SetModifiers(HueMod, SatMod: Double);
  27.     procedure GetModifiers(out HueMod, SatMod: Double);
  28.  
  29.     function SimilarColorsHSL(i: iColorHSL; RGB: TRGB32; HueTol, SatTol, LightTol: Int32): Boolean; inline;
  30.     function FindColor(out TPA: TPointArray; Color: TColor; Area: TBox; Tolerance: Double): Boolean;
  31.   end;
  32.  
  33.  
  34. //--------------------------------------------------
  35. implementation
  36.  
  37. uses
  38.   math;
  39.  
  40. function ToHSL_I(R,G,B: Byte): iColorHSL; inline;
  41. var
  42.   cLo, cHi, deltaC: Int32;
  43. begin
  44.   cLo := Min(R, Min(G,B));
  45.   cHi := Max(R, Max(G,B));
  46.   deltaC := cHi - cLo;
  47.  
  48.   Result.L := (100393 * (cHi + cLo)) shr 9;
  49.   if deltaC = 0 then
  50.   begin
  51.     Result.H := 0;
  52.     Result.S := 0;
  53.   end else
  54.   begin
  55.     if Result.L < 50000 then Result.S := (100000 * deltaC) div (cHi + cLo)
  56.     else                     Result.S := (100000 * deltaC) div (510-cHi-cLo);
  57.  
  58.     if      (R = cHi) then Result.H :=          (60000 * (G - B)) div deltaC
  59.     else if (G = cHi) then Result.H := 120000 + (60000 * (B - R)) div deltaC
  60.     else {if(B = cHi) then}Result.H := 240000 + (60000 * (R - G)) div deltaC;
  61.     if(Result.H < 0) then  Result.H += 360000;
  62.   end;
  63. end;
  64.  
  65.  
  66. procedure TFinder.Init(Data: PRGB32; Width, Height: Int32);
  67. begin
  68.   FData   := Data;
  69.   FWidth  := Width;
  70.   FHeight := Height;
  71.   FHueMod := 0.2;
  72.   FSatMod := 0.2;
  73. end;
  74.  
  75. procedure TFinder.Free;
  76. begin
  77.   FData   := nil;
  78.   FWidth  := 0;
  79.   FHeight := 0;
  80.   FHueMod := 0.2;
  81.   FSatMod := 0.2;
  82. end;
  83.  
  84. procedure TFinder.SetModifiers(HueMod, SatMod: Double);
  85. begin
  86.   Self.FHueMod := HueMod;
  87.   Self.FSatMod := SatMod;
  88. end;
  89.  
  90. procedure TFinder.GetModifiers(out HueMod, SatMod: Double);
  91. begin
  92.   HueMod := Self.FHueMod;
  93.   SatMod := Self.FSatMod;
  94. end;
  95.  
  96. function TFinder.SimilarColorsHSL(i: iColorHSL; RGB: TRGB32; HueTol, SatTol, LightTol: Int32): Boolean;
  97. var
  98.   cLo, cHi, deltaC, deltaH: Int32;
  99.   H,S,L: Int32;
  100. begin
  101.   cLo := Min(RGB.R, Min(RGB.G, RGB.B));
  102.   cHi := Max(RGB.R, Max(RGB.G, RGB.B));
  103.   deltaC := cHi - cLo;
  104.  
  105.   L := (100393 * (cHi + cLo)) shr 9;
  106.   if Abs(i.L - L) > LightTol then
  107.     Exit(False);
  108.  
  109.   if deltaC = 0 then
  110.   begin
  111.     if ((i.H <= HueTol) or (360000-i.H <= HueTol)) and (i.S <= SatTol) then
  112.       Exit(True)
  113.     else
  114.       Exit(False);
  115.   end;
  116.  
  117.   if L < 50000 then S := (100000 * deltaC) div (cHi + cLo)
  118.   else              S := (100000 * deltaC) div (510-cHi-cLo);
  119.   if Abs(i.S - S) > SatTol then
  120.     Exit(False);
  121.  
  122.   if      (RGB.R = cHi) then H :=          (60000 * (RGB.G - RGB.B)) div deltaC
  123.   else if (RGB.G = cHi) then H := 120000 + (60000 * (RGB.B - RGB.R)) div deltaC
  124.   else{if (RGB.B = cHi) then}H := 240000 + (60000 * (RGB.R - RGB.G)) div deltaC;
  125.   if(H < 0) then H += 360000;
  126.  
  127.   deltaH := Abs(i.H - H);
  128.   if deltaH < 180000 then Result := deltaH          <= HueTol
  129.   else                    Result := 360000 - deltaH <= HueTol;
  130. end;
  131.  
  132. function  TFinder.FindColor(out TPA:TPointArray; Color:TColor; Area: TBox; Tolerance: Double): Boolean;
  133. var
  134.   x,y,c: Int32;
  135.   SatTol, HueTol, LightTol: Int32;
  136.   HSL: iColorHSL;
  137.   dataPtr: PRGB32;
  138.   (*
  139.   cacheRGB: TRGB32;
  140.   cacheRES: Boolean;
  141.   function IsSimilar(color: TRGB32): Boolean; inline;
  142.   begin
  143.     if (cacheRGB.R = color.R) and (cacheRGB.G = color.G) and (cacheRGB.B = color.B) then
  144.       Result := cacheRES
  145.     else
  146.     begin
  147.       Result := SimilarColorsHSL(HSL, color, HueTol, SatTol, LightTol);
  148.       cacheRGB := color;
  149.       cacheRES := Result;
  150.     end;
  151.   end;
  152.   *)
  153. begin
  154.   LightTol := Round(Tolerance * 1000.0);
  155.   HueTol   := Round(Tolerance * 3600.0 * Self.FHueMod);
  156.   SatTol   := Round(Tolerance * 1000.0 * Self.FSatMod);
  157.  
  158.   HSL := ToHSL_I(color shr 0 and $FF, color shr 8 and $FF, color shr 16 and $FF);
  159.  
  160.   //cacheRGB.R := 0;  cacheRGB.R := 0; cacheRGB.R := 0;
  161.   //cacheRES := SimilarColorsHSL(HSL, cacheRGB, HueTol, SatTol, LightTol);
  162.  
  163.   c := 0;
  164.   dataPtr := Self.FData;
  165.   SetLength(TPA, 1024);
  166.   for y:=Area.Y1 to Area.Y2 do
  167.     for x:=Area.X1 to Area.X2 do
  168.     begin
  169.       //if IsSimilar(dataPtr^) then
  170.       if SimilarColorsHSL(HSL, dataPtr^, HueTol, SatTol, LightTol) then
  171.       begin
  172.         if c = Length(TPA) then
  173.           SetLength(TPA, c+c);
  174.  
  175.         TPA[c].x := x;
  176.         TPA[c].y := y;
  177.         Inc(c);
  178.       end;
  179.       Inc(dataPtr);
  180.     end;
  181.   SetLength(TPA, c);
  182.   Result := c > 0;
  183. end;
  184.  
  185. end.
  186.  
  187.  
  188.  
  189.  
  190.  
  191. //-------- plugin main ---------------------------------------------
  192. library cts2;
  193. {=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=]
  194.  Copyright (c) 2013, Jarl K. <Slacky> Holta || http://github.com/WarPie
  195.  All rights reserved.
  196.  For more info see: Copyright.txt
  197. [=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
  198. {$mode objfpc}{$H+}
  199.  
  200. uses
  201.   SysUtils,
  202.   Classes,
  203.   Math,
  204.   Header,
  205.   Finder;
  206.  
  207. {$I SimbaPlugin.inc}
  208.  
  209. // -----------------------------------------------------------------------------------------
  210. // Finder exports
  211.  
  212. procedure TFinder_Init(var Finder: TFinder; RawData: PRGB32; Width, Height: Int32); cdecl;
  213. begin
  214.   Finder.Init(RawData, Width, Height);
  215. end;
  216.  
  217. procedure TFinder_Free(var Finder: TFinder); cdecl;
  218. begin
  219.   Finder.Free();
  220. end;
  221.  
  222. procedure TFinder_SetMod(var Finder: TFinder; HueMod, SatMod: Double); cdecl;
  223. begin
  224.   Finder.SetModifiers(HueMod, SatMod);
  225. end;
  226.  
  227. procedure TFinder_GetMod(var Finder: TFinder; out HueMod, SatMod: Double); cdecl;
  228. begin
  229.   Finder.GetModifiers(HueMod, SatMod);
  230. end;
  231.  
  232. function TFinder_FindColor(var Finder: TFinder; out TPA: TPointArray; Color: TColor; Area: TBox; Tolerance: Double): LongBool; cdecl;
  233. begin
  234.   Result := Finder.FindColor(TPA, Color, Area, Tolerance);
  235. end;
  236.  
  237.  
  238. // -----------------------------------------------------------------------------------------
  239.  
  240.  
  241. initialization
  242.   ExportType('TMFinder2', 'packed record               ' + #13#10 +
  243.                           '  FData: PRGB32;            ' + #13#10 +
  244.                           '  FWidth, FHeight: PRGB32;  ' + #13#10 +
  245.                           '  FHueMod, FSatMod: Double; ' + #13#10 +
  246.                           'end;');
  247.  
  248.   ExportMethod(@TFinder_Init,      'procedure TMFinder2.Init(RawData: PRGB32; Width, Height: Int32);');
  249.   ExportMethod(@TFinder_Free,      'procedure TMFinder2.Free();');
  250.   ExportMethod(@TFinder_SetMod,    'procedure TMFinder2.SetModifiers(HueMod, SatMod: Double);');
  251.   ExportMethod(@TFinder_GetMod,    'procedure TMFinder2.GetModifiers(out HueMod, SatMod: Double);');
  252.   ExportMethod(@TFinder_FindColor, 'function  TMFinder2.FindColor(out TPA: TPointArray; Color: TColor; Area: TBox; Tolerance: Double): LongBool;');
  253. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement