From: Pyro
Can someone post just the scar bit here? :( My girlfriends laptop doesnt have a rar unpacker. And my laptop crapped itself.
I want to take a look. I tried working on this random but i have a short attention span. Most definitely the animals were insanely hard to tell apart. I solved this random manually a few times and i could barely tell them apart myself.
Nice work guys :)
library PetePlugin;
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);
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: array of array of Integer;
b: array of array of Boolean;
area, bitsize, bgcolor, fillcolor,
w, h, x1, y1, x2, y2, xx, yy: Integer;
animx1, animy1, animx2, animy2: integer;
FillInfo: Boolean;
procedure ScanFill(x, y: Integer); stdcall;
var
i: integer;
begin
if (c[x][y] <> bgcolor) then exit;
c[x][y] := fillcolor;
b[x][y] := True;
area := area + 1;
xx := 0;
yy := 0;
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;
// if (animx1 < xx) then animx1 := xx;
end;
if (xx - x > 1) then ScanFill(xx, y);
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;
// if (animx1 > xx) then animx1 := xx;
end;
if (x - xx > 1) then ScanFill(xx, y);
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;
// if (animy1 < yy) then animy1 := yy;
end;
if (yy - y > 1) then ScanFill(x, yy);
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;
// if (animy2 > yy) then animy2 := yy;
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;
procedure FFillBg(x, y: Integer); stdcall;
var
i: integer;
begin
c[x][y] := fillcolor;
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 (c[x + ax[i]][y + ay[i]] = bgcolor) then
begin
FFillBg(x + ax[i], y + ay[i]);
end
end;
{
Prison-Pete solver
By: ManFromCzech
}
var
a: array [1..9] of record
x1, y1, x2, y2, Parts,
Area, Parm, mx, my, Holes,
MinDist:Integer;
end;
function Pete_AnalyzeAnimal( var AnimalName: 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, lum1, lum2: Extended;
Line: PRGB32Array;
label Lab1;
begin
Result := False;
AnimalName := 'unknow';
w := 460; h := 330;
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
BitBlt(Bmp2.Canvas.Handle, 0, 0, w, h, ClientHDC, 60, 20, SRCCOPY);
fillchar(HG, sizeof(HG), 0);
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;
if (Line[x].G <> 0) then
begin
Lum1 := (Line[x].G * 3);
Lum2 := (Line[x].R + Line[x].B);
end else c[x][y] := 0;
if ((lum2 / lum1) < 1.2) then c[x][y] := 0;
with Line[x] do
inc(HG[round(Sqrt(R*R + G*G + B*B))]);
end;
end;
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;
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 - 5;
if (y < y1) then y1 := y;
if (x > x2) then x2 := x + 5;
if (y > y2) then y2 := y;
end;
if ((x2 - x1) >= 50) and ((y2 - y1) >= 30) then Done := True;
Sleep(100);
until (((Now - st) * 86400000) > 15000) or (Done);
if (not(done)) then goto lab1;
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
MaxArea := Area;
fx := x;
fy := y;
end;
end;
Area := 0;
bgcolor := clblue;
fillcolor := clred;
FFillBg(fx, fy);
Pixels := Area;
if (Pixels < 4000) 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];
Holes := 0;
BgColor := 0;
FillColor := clpurple;
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);
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;
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;
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 (Pixels > 22500) then AnimalName := 'goat';
if ((Pixels > 16000) and (Pixels < 22000)) then AnimalName := 'cat';
if ((Pixels > 15000) and (Pixels < 22000)) and (MinDist > 35) then AnimalName := 'sheep';
if ((Pixels > 12500) and (Pixels <= 16000)) and (MinDist > 10) then AnimalName := 'dog';
if (not(AnimalName = 'unknow')) then
begin
Result := True;
goto Lab1;
end;
Lab1:
bmp2.free;
end;
function Pete_FindAnimal(var px, py: Integer; AnimalName: String; ClientHDC: HDC): Boolean; stdcall;
var
BMP: TBitmap;
Line: PRGB32Array;
x, y, BRPixels, BPixels, RPixels, minKol, maxKol, minArea, maxArea, kol, Xa, Ya, AB, BRRPP: Integer;
Lum1, Lum2: extended;
Found, FoundAnim, FoundAnimal: Boolean;
procedure CountBRPixels(var x1, y1, x2, y2: integer);
var
a, b: integer;
begin
BRPixels := 0;
RPixels := 0;
BPixels := 0;
for b := (y1 + 1) to (y2 - 1) do
begin
for a := (x1 + 1) to (x2 - 1) do
begin
if (c[a][b] = clred) then inc(RPixels);
if (c[a][b] = clred) and (c[a + 1][b] = 0) then inc(BRPixels);
if (c[a][b] = clred) and (c[a - 1][b] = 0) then inc(BRPixels);
if (c[a][b] = clred) and (c[a][b + 1] = 0) then inc(BRPixels);
if (c[a][b] = clred) and (c[a][b - 1] = 0) then inc(BRPixels);
end;
end;
end;
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
//Finding cat
procedure FindCat(var x1, y1, x2, y2: integer);
var
x, y, z, v, how, value, rownr, lastrowvalue, tvalue, countvalue, testvalue, ones, twoes: integer;
IsLongTail: boolean;
begin
x := x1; y := y1; z := x2; v := y2;
if ((z - x) >= ((v - y) + 15)) then how := 1 else if (((z - x) + 15) <= (v - y)) then how := 2 else how := 3;
IsLongTail := False;
if (how = 1)then
begin
rownr := 0;
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
FoundAnimal := False;
for x := x1 to z do
begin
value := 0;
for y := y1 to v do
begin
if (c[x][y] = clred) then inc(value);
b[x][y] := True;
end;
inc(rownr);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 20) then tvalue := 2;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
// WriteLn(inttostr(lastrowvalue) + ' [' + inttostr(countvalue) + ']');
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 1) and (countvalue > 11) then IsLongTail := True;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
testvalue := 0;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones < 3) and (ones > 0) and (twoes = 2)) or ((ones = 3) and (twoes = 2)) or ((ones = 3) and (twoes = 3)) or ((ones = 2) and (twoes = 3)) or ((ones = 1) and (twoes = 4))) and (IsLongTail) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
end;
end;
if (how = 2) then
begin
rownr := 0;
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
FoundAnimal := False;
for y := y1 to v do
begin
value := 0;
for x := x1 to z do
begin
if (c[x][y] = clred) then inc(value);
b[x][y] := True;
end;
inc(rownr);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 20) then tvalue := 2;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
// WriteLn(inttostr(lastrowvalue) + ' [' + inttostr(countvalue) + ']');
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 1) and (countvalue > 11) then IsLongTail := True;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
testvalue := 0;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones < 3) and (ones > 0) and (twoes = 2)) or ((ones = 3) and (twoes = 2)) or ((ones = 3) and (twoes = 3)) or ((ones = 2) and (twoes = 3)) or ((ones = 1) and (twoes = 4))) and (IsLongTail) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
end;
end;
if (how = 3) then
for y := y1 to v do
for x := x1 to z do b[x][y] := True;
// WriteLn('how: ' + inttostr(how));
end;
////////////////////////////////////////////////////////////////////////////////
//Finding dog
procedure FindDog(var x1, y1, x2, y2: integer);
var
x, y, z, v, how, value, rownr, lastrowvalue, tvalue, countvalue, testvalue, ones, twoes: integer;
animal: array of integer;
IsDog1, IsDog2: boolean;
begin
x := x1; y := y1; z := x2; v := y2;
if ((z - x) >= ((v - y) + 15)) then how := 1 else if (((z - x) + 15) <= (v - y)) then how := 2 else how := 3;
IsDog1 := False;
IsDog2 := False;
if (how = 1)then
begin
rownr := 0;
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
FoundAnimal := False;
for x := x1 to z do
begin
value := 0;
for y := y1 to v do
begin
if (c[x][y] = clred) then inc(value);
b[x][y] := True;
end;
inc(rownr);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 20) then tvalue := 2;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
// WriteLn(inttostr(lastrowvalue) + ' [' + inttostr(countvalue) + ']');
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 1) and (countvalue > 10) then IsDog1 := True;
if (lastrowvalue = 2) and (countvalue > 8) then IsDog2 := True;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
testvalue := 0;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones = 4) and (twoes = 3)) or ((ones = 3) and (twoes = 3)) or ((ones = 3) and (twoes = 2)) or ((ones = 2) and (twoes = 3))) and (not(IsDog1)) and (not(Isdog2)) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
end;
end;
if (how = 2) then
begin
rownr := 0;
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
FoundAnimal := False;
for y := y1 to v do
begin
value := 0;
for x := x1 to z do
begin
if (c[x][y] = clred) then inc(value);
b[x][y] := True;
end;
inc(rownr);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 20) then tvalue := 2;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
// WriteLn(inttostr(lastrowvalue) + ' [' + inttostr(countvalue) + ']');
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 1) and (countvalue > 10) then IsDog1 := True;
if (lastrowvalue = 2) and (countvalue > 8) then IsDog2 := True;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
testvalue := 0;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones = 4) and (twoes = 3)) or ((ones = 3) and (twoes = 3)) or ((ones = 3) and (twoes = 2)) or ((ones = 2) and (twoes = 3))) and (not(IsDog1)) and (not(Isdog2)) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
end;
end;
end;
////////////////////////////////////////////////////////////////////////////////
//Finding goat
procedure FindGoat(var x1, y1, x2, y2: integer);
begin
Area := 0;
ScanFill(x, y);
if (Area > 200) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
end;
end;
////////////////////////////////////////////////////////////////////////////////
//Finding sheep
procedure FindSheep(var x1, y1, x2, y2: integer);
var
x, y, z, v, how, value, rownr, lastrowvalue, tvalue, countvalue, testvalue,
ones, twoes, xxis, yyis: integer;
IsBigBody, IsHorn: boolean;
begin
x := x1; y := y1; z := x2; v := y2;
if ((z - x) >= ((v - y) + 13)) then how := 1 else if (((z - x) + 13) <= (v - y)) then how := 2 else how := 3;
IsBigBody := False;
IsHorn := False;
xxis := z - x;
yyis := v - y;
if (how = 1)then
begin
rownr := 0;
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
FoundAnimal := False;
for x := x1 to z do
begin
value := 0;
for y := y1 to v do
begin
if (c[x][y] = clred) then inc(value);
b[x][y] := True;
end;
inc(rownr);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 15) then tvalue := 2;
if (value > 15) and (value < 45) then tvalue := 3;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) or not(tvalue <> 3) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
// WriteLn(inttostr(lastrowvalue) + ' [' + inttostr(countvalue) + ']');
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 2) and (countvalue > 11) then IsBigBody := True;
if (lastrowvalue = 2) and (countvalue > 27) then IsBigBody := False;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
testvalue := 0;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones < 4) and (ones > 0)) and ((twoes > 0) and(twoes < 3))) and (IsBigBody) and (yyis < 27) then
// if (((ones = 2) and (twoes = 1)) or ((ones = 0) and (twoes = 1)) or ((ones = 2) and (twoes = 2)) or ((ones = 3) and (twoes = 2)) or ((ones = 1) and (twoes = 2)) or ((ones = 0) and (twoes = 2)) or ((ones = 1) and (twoes = 1))) and (IsBigBody) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
end;
end;
if (how = 2) then
begin
rownr := 0;
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
FoundAnimal := False;
for y := y1 to v do
begin
value := 0;
for x := x1 to z do
begin
if (c[x][y] = clred) then inc(value);
b[x][y] := True;
end;
inc(rownr);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 15) then tvalue := 2;
if (value > 15) and (value < 45) then tvalue := 3;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) or not(tvalue <> 3) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
// WriteLn(inttostr(lastrowvalue) + ' [' + inttostr(countvalue) + ']');
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 2) and (countvalue > 11) then IsBigBody := True;
if (lastrowvalue = 2) and (countvalue > 27) then IsBigBody := False;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
testvalue := 0;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones < 4) and (ones > 0)) and ((twoes > 0) and(twoes < 3))) and (IsBigBody) and (xxis < 27)then
// if (((ones = 2) and (twoes = 1)) or ((ones = 0) and (twoes = 1)) or ((ones = 2) and (twoes = 2)) or ((ones = 3) and (twoes = 2)) or ((ones = 1) and (twoes = 2)) or ((ones = 0) and (twoes = 2)) or ((ones = 1) and (twoes = 1))) and (IsBigBody) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
end;
end;
end;
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
Procedure AnimalCorners(var x, y: integer);
var
sx, sy: Integer;
Found: Boolean;
begin
//animy1
animy1 := y - 5;
//animx1
Found := False;
for sx := x - 25 to x do
for sy := y + 35 downto y do
if (x - 25 > 0) then
if (y + 35 < w) then
begin
if (c[sx][sy] = clred) and not (Found) then
begin
animx1 := sx - 5;
Found := True;
end;
end;// else AnimalCoords(x, y);
//animy2
Found := False;
for sy := y + 35 downto y do
for sx := x + 25 downto animx1 do
if (x + 25 < h) then
if (y + 25 < w) then
begin
if (c[sx][sy] = clred) and not (Found) then
begin
animy2 := sy + 5;
Found := True;
end;
end;// else AnimalCoords(x, y);
//animx2
Found := False;
for sx := x + 25 downto x do
for sy := animy1 to animy2 do
if(x + 25 < h) then
begin
if (c[sx][sy] = clred) and not (Found) then
begin
animx2 := sx + 5;
Found := True;
end;
end;// else AnimalCoords(x, y);
end;
begin
w := 530; h := 350;
Bmp := TBitmap.Create;
Bmp.Width := w;
Bmp.Height:= h;
Bmp.PixelFormat := pf32bit;
SetLength(c, w + 1, h + 1);
SetLength(b, w + 1, h + 1);
bitsize := 7;
BitBlt(Bmp.Canvas.Handle, 0, 0, w, h, ClientHDC, 1, 1, SRCCOPY);
Result := False;
// for y := 0 to h do c[0][y] := 0;
// for y := 0 to w do c[x][0] := 0;
// for y := 0 to h do c[530][y] := 0;
//finding background and coloring 0
for y := 20 to h - 10 do
begin
Line := bmp.ScanLine[y];
for x := 20 to w - 10 do
begin
c[x][y] := RGB(Line[x].R, Line[x].G, Line[x].B);
if (Line[x].G <> 0) then
begin
Lum1 := (Line[x].G * 3);
Lum2 := (Line[x].R + Line[x].B);
end else c[x][y] := 0;
if ((lum2 / lum1) < 1.2) then c[x][y] := 0;
end;
end;
// finding animals and coloring red
for y := 20 to h - 20 do
for x := 20 to w - 20 do
if (c[x][y] <> 0) then
begin
c[x][y] := clred;
b[x][y] := False;
end;
FoundAnim := False;
for y := 20 to h - 10 do
for x := 20 to w - 10 do
if (c[x][y] = clred) and not(b[x][y]) and not(FoundAnim)then
begin
BgColor := c[x][y];
FillColor := c[x][y];
b[x][y] := True;
Area := 0;
ScanFill(x, y);
if (Area > 20) then
begin
AnimalCorners(x, y);
CountBRPixels(animx1, animy1, animx2, animy2);
// WriteLN(Inttostr(animx1 + Round((animx2 - animx1)/2)) + ' ' + IntToStr(animy1 + Round((animy2 - animy1)/2)));
if (AnimalName = 'cat') then FindCat(animx1, animy1, animx2, animy2); //working!!
if (AnimalName = 'dog') then FindDog(animx1, animy1, animx2, animy2); //working!!
if (AnimalName = 'goat') then
begin
if (RPixels > 210) and (RPixels < 1000) then
begin
px := (animx1 + round((animx2 - animx1) / 2));
py := (animy1 + round((animy2 - animy1) / 2));
end;
end;
if (AnimalName = 'sheep') and (RPixels < 180) then FindSheep(animx1, animy1, animx2, animy2); // working??
end;
end;
Bmp.Free;
end;
function GetFunctionCount(): Integer; stdcall; export;
begin
Result := 2;
end;
function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
case x of
0:
begin
ProcAddr := @Pete_AnalyzeAnimal;
StrPCopy(ProcDef, 'function Pete_AnalyzeAnimal( var AnimalName: string; ClientHDC: HDC): Boolean;');
end;
1:
begin
ProcAddr := @Pete_FindAnimal;
StrPCopy(ProcDef, 'function Pete_FindAnimal(var px, py: Integer; AnimalName: String; ClientHDC: HDC): Boolean;');
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
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;
exports GetFunctionCount;
exports GetFunctionInfo;
exports SetFunctions;
end.
There you go.