Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit Finder;
- {=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=]
- Copyright (c) 2018, Jarl K. <Slacky> Holta || http://github.com/WarPie
- All rights reserved.
- For more info see: Copyright.txt
- [=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
- {$mode objfpc}{$H+}
- {$modeswitch advancedrecords}
- {$inline on}
- interface
- uses
- SysUtils, Classes, Header;
- type
- iColorHSL = record H,S,L: Int32; end;
- PFinder = ^TFinder;
- TFinder = packed record
- FData: PRGB32;
- FWidth, FHeight: Int32;
- FHueMod, FSatMod: Double;
- public
- procedure Init(Data: PRGB32; Width, Height: Int32);
- procedure Free;
- procedure SetModifiers(HueMod, SatMod: Double);
- procedure GetModifiers(out HueMod, SatMod: Double);
- function SimilarColorsHSL(i: iColorHSL; RGB: TRGB32; HueTol, SatTol, LightTol: Int32): Boolean; inline;
- function FindColor(out TPA: TPointArray; Color: TColor; Area: TBox; Tolerance: Double): Boolean;
- end;
- //--------------------------------------------------
- implementation
- uses
- math;
- function ToHSL_I(R,G,B: Byte): iColorHSL; inline;
- var
- cLo, cHi, deltaC: Int32;
- begin
- cLo := Min(R, Min(G,B));
- cHi := Max(R, Max(G,B));
- deltaC := cHi - cLo;
- Result.L := (100393 * (cHi + cLo)) shr 9;
- if deltaC = 0 then
- begin
- Result.H := 0;
- Result.S := 0;
- end else
- begin
- if Result.L < 50000 then Result.S := (100000 * deltaC) div (cHi + cLo)
- else Result.S := (100000 * deltaC) div (510-cHi-cLo);
- if (R = cHi) then Result.H := (60000 * (G - B)) div deltaC
- else if (G = cHi) then Result.H := 120000 + (60000 * (B - R)) div deltaC
- else {if(B = cHi) then}Result.H := 240000 + (60000 * (R - G)) div deltaC;
- if(Result.H < 0) then Result.H += 360000;
- end;
- end;
- procedure TFinder.Init(Data: PRGB32; Width, Height: Int32);
- begin
- FData := Data;
- FWidth := Width;
- FHeight := Height;
- FHueMod := 0.2;
- FSatMod := 0.2;
- end;
- procedure TFinder.Free;
- begin
- FData := nil;
- FWidth := 0;
- FHeight := 0;
- FHueMod := 0.2;
- FSatMod := 0.2;
- end;
- procedure TFinder.SetModifiers(HueMod, SatMod: Double);
- begin
- Self.FHueMod := HueMod;
- Self.FSatMod := SatMod;
- end;
- procedure TFinder.GetModifiers(out HueMod, SatMod: Double);
- begin
- HueMod := Self.FHueMod;
- SatMod := Self.FSatMod;
- end;
- function TFinder.SimilarColorsHSL(i: iColorHSL; RGB: TRGB32; HueTol, SatTol, LightTol: Int32): Boolean;
- var
- cLo, cHi, deltaC, deltaH: Int32;
- H,S,L: Int32;
- begin
- cLo := Min(RGB.R, Min(RGB.G, RGB.B));
- cHi := Max(RGB.R, Max(RGB.G, RGB.B));
- deltaC := cHi - cLo;
- L := (100393 * (cHi + cLo)) shr 9;
- if Abs(i.L - L) > LightTol then
- Exit(False);
- if deltaC = 0 then
- begin
- if ((i.H <= HueTol) or (360000-i.H <= HueTol)) and (i.S <= SatTol) then
- Exit(True)
- else
- Exit(False);
- end;
- if L < 50000 then S := (100000 * deltaC) div (cHi + cLo)
- else S := (100000 * deltaC) div (510-cHi-cLo);
- if Abs(i.S - S) > SatTol then
- Exit(False);
- if (RGB.R = cHi) then H := (60000 * (RGB.G - RGB.B)) div deltaC
- else if (RGB.G = cHi) then H := 120000 + (60000 * (RGB.B - RGB.R)) div deltaC
- else{if (RGB.B = cHi) then}H := 240000 + (60000 * (RGB.R - RGB.G)) div deltaC;
- if(H < 0) then H += 360000;
- deltaH := Abs(i.H - H);
- if deltaH < 180000 then Result := deltaH <= HueTol
- else Result := 360000 - deltaH <= HueTol;
- end;
- function TFinder.FindColor(out TPA:TPointArray; Color:TColor; Area: TBox; Tolerance: Double): Boolean;
- var
- x,y,c: Int32;
- SatTol, HueTol, LightTol: Int32;
- HSL: iColorHSL;
- dataPtr: PRGB32;
- (*
- cacheRGB: TRGB32;
- cacheRES: Boolean;
- function IsSimilar(color: TRGB32): Boolean; inline;
- begin
- if (cacheRGB.R = color.R) and (cacheRGB.G = color.G) and (cacheRGB.B = color.B) then
- Result := cacheRES
- else
- begin
- Result := SimilarColorsHSL(HSL, color, HueTol, SatTol, LightTol);
- cacheRGB := color;
- cacheRES := Result;
- end;
- end;
- *)
- begin
- LightTol := Round(Tolerance * 1000.0);
- HueTol := Round(Tolerance * 3600.0 * Self.FHueMod);
- SatTol := Round(Tolerance * 1000.0 * Self.FSatMod);
- HSL := ToHSL_I(color shr 0 and $FF, color shr 8 and $FF, color shr 16 and $FF);
- //cacheRGB.R := 0; cacheRGB.R := 0; cacheRGB.R := 0;
- //cacheRES := SimilarColorsHSL(HSL, cacheRGB, HueTol, SatTol, LightTol);
- c := 0;
- dataPtr := Self.FData;
- SetLength(TPA, 1024);
- for y:=Area.Y1 to Area.Y2 do
- for x:=Area.X1 to Area.X2 do
- begin
- //if IsSimilar(dataPtr^) then
- if SimilarColorsHSL(HSL, dataPtr^, HueTol, SatTol, LightTol) then
- begin
- if c = Length(TPA) then
- SetLength(TPA, c+c);
- TPA[c].x := x;
- TPA[c].y := y;
- Inc(c);
- end;
- Inc(dataPtr);
- end;
- SetLength(TPA, c);
- Result := c > 0;
- end;
- end.
- //-------- plugin main ---------------------------------------------
- library cts2;
- {=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=]
- Copyright (c) 2013, Jarl K. <Slacky> Holta || http://github.com/WarPie
- All rights reserved.
- For more info see: Copyright.txt
- [=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
- {$mode objfpc}{$H+}
- uses
- SysUtils,
- Classes,
- Math,
- Header,
- Finder;
- {$I SimbaPlugin.inc}
- // -----------------------------------------------------------------------------------------
- // Finder exports
- procedure TFinder_Init(var Finder: TFinder; RawData: PRGB32; Width, Height: Int32); cdecl;
- begin
- Finder.Init(RawData, Width, Height);
- end;
- procedure TFinder_Free(var Finder: TFinder); cdecl;
- begin
- Finder.Free();
- end;
- procedure TFinder_SetMod(var Finder: TFinder; HueMod, SatMod: Double); cdecl;
- begin
- Finder.SetModifiers(HueMod, SatMod);
- end;
- procedure TFinder_GetMod(var Finder: TFinder; out HueMod, SatMod: Double); cdecl;
- begin
- Finder.GetModifiers(HueMod, SatMod);
- end;
- function TFinder_FindColor(var Finder: TFinder; out TPA: TPointArray; Color: TColor; Area: TBox; Tolerance: Double): LongBool; cdecl;
- begin
- Result := Finder.FindColor(TPA, Color, Area, Tolerance);
- end;
- // -----------------------------------------------------------------------------------------
- initialization
- ExportType('TMFinder2', 'packed record ' + #13#10 +
- ' FData: PRGB32; ' + #13#10 +
- ' FWidth, FHeight: PRGB32; ' + #13#10 +
- ' FHueMod, FSatMod: Double; ' + #13#10 +
- 'end;');
- ExportMethod(@TFinder_Init, 'procedure TMFinder2.Init(RawData: PRGB32; Width, Height: Int32);');
- ExportMethod(@TFinder_Free, 'procedure TMFinder2.Free();');
- ExportMethod(@TFinder_SetMod, 'procedure TMFinder2.SetModifiers(HueMod, SatMod: Double);');
- ExportMethod(@TFinder_GetMod, 'procedure TMFinder2.GetModifiers(out HueMod, SatMod: Double);');
- ExportMethod(@TFinder_FindColor, 'function TMFinder2.FindColor(out TPA: TPointArray; Color: TColor; Area: TBox; Tolerance: Double): LongBool;');
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement