SCAR Code:
library MimePlugin;
uses
FastShareMem,
SysUtils,
Classes,
Windows,
Math,
Graphics;
{$R *.res}
type
TSCARPlugFunc = record
Name: string;
Ptr: Pointer;
end;
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;
var
GetClientWindowHandle: TSCARWindowHandle;
c: array of array of Integer;
b: array of array of Boolean;
w, h: Integer;
{
Mime solver
By: ManFromCzech + NaumanAkhlaQ
}
function Mime_AnalyzeAnimation(ClientHDC: HDC): string; stdcall;
var
BMP: TBitmap;
Line: PRGB32Array;
Sx1, Sy1, Sx2, Sy2, ObjectArea, x, y, CoMax, CoMin,
BlackArea, BMaxArea, BMinArea, sx, sy, a1, a2, b1, b2, BArea: integer;
Start, Stop, Freq: int64;
Time: double;
Obj: string;
Lum: extended;
begin
a1 := 0; b1 := 0; a2 := 0; b2 := 0;
CoMax := 0; CoMin := 20000; BMinArea := 0; BMaxArea := 20000;
Sx1 := 300; Sx2 := 410; Sy1 := 100; Sy2 := 200;
QueryPerformanceFrequency(Freq);
QueryPerformanceCounter(Start);
repeat
w := 430; h := 210;
Bmp := TBitmap.Create;
Bmp.Width := w;
Bmp.Height:= h;
Bmp.PixelFormat := pf32bit;
SetLength(c, w + 1, h + 1);
SetLength(b, w + 1, h + 1);
BitBlt(Bmp.Canvas.Handle, 0, 0, w, h, ClientHDC, 0, 0, SRCCOPY);
BlackArea := 0;
for y := Sy1 to Sy2 do
begin
Line := bmp.ScanLine[y];
for x := Sx1 to Sx2 do
begin
c[x][y] := RGB(Line[x].R, Line[x].G, Line[x].B);
if (Line[x].R <> 0) then
begin
if (Line[x].R < 190) and (Line[x].G < 180) and (Line[x].B < 170) then
begin
c[x][y] := 0;
b[x][y] := True;
inc(BlackArea);
end;
end else
begin
c[x][y] := 0;
b[x][y] := True;
inc(BlackArea);
end;
end;
end;
ObjectArea := (11211 - BlackArea);
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
for sx := Sx2 - 1 downto Sx1 + 1 do
for sy := Sy1 + 1 to Sy2 - 1 do
begin
if (c[sx][sy] <> 0) then
begin
a2 := sx;
break;
end;
end;
for sx := Sx1 + 1 to Sx2 - 1 do
for sy := Sy1 + 1 to Sy2 - 1 do
begin
if (c[sx][sy] <> 0) then
begin
a1 := sx;
break;
end;
end;
for sy := Sy2 - 1 downto Sy1 + 1 do
for sx := Sx1 + 1 to Sx2 - 1 do
begin
if (c[sx][sy] <> 0) then
begin
b2 := sy;
break;
end;
end;
for sy := Sy1 + 1 to Sy2 - 1 do
for sx := Sx1 + 1 to Sx2 - 1 do
begin
if (c[sx][sy] <> 0) then
begin
b1 := sy;
break;
end;
end;
BArea := (a2 - a1)*(b2 - b1);
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
if (ObjectArea > CoMax) then
begin
CoMax := ObjectArea;
BMaxArea := BArea;
end;
if (ObjectArea < CoMin) then
begin
CoMin := ObjectArea;
BMinArea := BArea;
end;
Bmp.Free;
QueryPerformanceCounter(Stop);
Time := (1E3 * (Stop - Start) / Freq);
Until (Time >= 2500);
Lum := 0;
if (CoMax <> 0) then Lum := (BMaxArea/CoMax);
Obj := 'unknow';
if (Obj = 'unknow') then
if InRange(Lum, 1.8, 2.6) and InRange(BMaxArea, 220, 350) and InRange(BMinArea, 50, 250) and InRange(CoMax, 50, 170) and InRange(CoMin , 0, 60) then Obj := 'Laugh';
if (Obj = 'unknow') then
if InRange(Lum, 1.9, 3.2) and InRange(BMaxArea, 190, 350) and InRange(BMinArea, 150, 550) and InRange(CoMax, 70, 150) and InRange(CoMin , 30, 100) then Obj := 'Think';
if (Obj = 'unknow') then
if InRange(Lum, 2.5, 4.9) and InRange(BMaxArea, 250, 350) and InRange(BMinArea, 20, 100) and InRange(CoMax, 50, 110) and InRange(CoMin , 0, 40) then Obj := 'Cry';
if (Obj = 'unknow') then
if InRange(Lum, 3.0, 6.7) and InRange(BMaxArea, 250, 550) and InRange(BMinArea, 300, 510) and InRange(CoMax, 60, 110) and InRange(CoMin , 40, 90) then Obj := 'Lean on air';
if (Obj = 'unknow') then
if InRange(Lum, 5.2, 7.9) and InRange(BMaxArea, 500, 870) and (InRange(BMinArea, 90, 330) or InRange(BMinArea, 400, 750)) and InRange(CoMax, 100, 150) and InRange(CoMin , 20, 100) then Obj := 'Glass Box';
if ((Obj = 'unknow') or (Obj = 'Glass Box')) then
if InRange(Lum, 3.2, 5.7) and InRange(BMaxArea, 550, 800) and InRange(BMinArea, 40, 350) and InRange(CoMax, 50, 250) and InRange(CoMin , 0, 100) then Obj := 'Dance';
if (Obj = 'unknow') then
if InRange(Lum, 2.5, 4.5) and InRange(BMaxArea, 250, 350) and InRange(BMinArea, 80, 250) and InRange(CoMax, 60, 130) and InRange(CoMin , 30, 70) then Obj := 'Climb Rope';
if (Obj = 'unknow') then Obj := 'Glass Wall';
Result := Obj;
// {if (Result = 'unknow') then } Result := (Obj + ' Lum ' + FloatToStr(Lum) + ' BMax: '+ IntToStr(BMaxArea) + ' BMin: ' + IntToStr(BMinArea) + ' ColoredMax: '+ IntToStr(CoMax) + ' ColoredMin: '+ IntToStr(CoMin));
end;
function GetFunctionCount(): Integer; stdcall; export;
begin
Result := 1;
end;
function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
case x of
0:
begin
ProcAddr := @Mime_AnalyzeAnimation;
StrPCopy(ProcDef, 'function Mime_AnalyzeAnimation(ClientHDC: HDC): string;');
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 = 'GetClientWindowHandle' then
GetClientWindowHandle := Funcs[i].Ptr;
end;
end;
exports GetFunctionCount;
exports GetFunctionInfo;
exports SetFunctions;
end.