SRL Archive - General

i made it in delphi, lol obviously, but for some reason i cant get it to work, and ive been looking at it, and it should work, any help would be appreciated

//SCAR Plugin. Created for SCAR 2.0 by Kaitnieks
// currently you can't call SCAR functions from plugin
library brambleplugin;

uses
  SysUtils,
  Graphics,
  windows;

//---------------------------------------
// Functions to be called from SCAR

function ColorRGB(SColor, i: Integer): Extended; stdcall;
var
  Color:TColor;
begin
  Color := ColorToRGB(SColor);
  Result:= 0;
  case i of
    1:result:= GetRValue(Color);
    2:result:= GetGValue(Color);
    3:result:= GetBValue(Color);
  end;
end;

function SimilarColors(Color1, Color2, Tolerance: Integer): Boolean; stdcall;
begin
  Result:=False;
  if(Abs(Round(ColorRGB(Color1, 1))-Round(ColorRGB(Color2, 1)))<=Tolerance)then
  begin
    if(Abs(Round(ColorRGB(Color1, 2))-Round(ColorRGB(Color2, 2)))<=Tolerance)then
    begin
      if(Abs(Round(ColorRGB(Color1, 3))-Round(ColorRGB(Color2, 3)))<=Tolerance)then
        begin
          Result:= True;
        end;
    end;
  end;
end;

Function ControlledColorSearch(x,y,Color,x1,y1,x2,y2,Tol,xc,yc:integer;flip:boolean;Wind:Longint):boolean; stdcall;
var WindH:Hwnd;Windc:HDC;color11:Tcolor;color22:integer;
begin
Windh:=Wind;
Windc:=GetDc(Windh);
if (xc=0) and (yc=0) then
begin
  X:=x1;
  Y:=y1;
end
else
begin
  x:=xc;
  y:=yc;
end;
if (flip = False) then
begin
  if x1>x2 then
    x:=x+1
  else
    x:=x-1;
  repeat
    if not(y=y2) then
    begin
      if x1<=x2 then
        x:=x+1
      else if x1>x2 then
        x:=x-1;
      Color11:=GetPixel(windc,x,y);
      color22:=color11;
      if (SimilarColors(color,color22,Tol) = true) then
      begin
        result:=True;
        exit;
      end;
    end;
    Y:=y1;
    repeat
      if y1<=y2 then
        Y:=y+1
      else if y1>y2 then
        Y:=y-1;
      Color11:=GetPixel(windc,x,y);
      color22:=color11;
      if (SimilarColors(color,color22,Tol) = true) then
      begin
        result:=True;
        exit;
      end;
      until (y=y2) or(result=true);
    if x1<=x2 then
      x:=x+1
    else if x1>x2 then
      x:=x-1;
  until (x=x2) or (result=true);
end;
if (flip = True) then
begin
  if y1>y2 then
    y:=y+1
  else
    y:=y-1;
  repeat
  if not(x=x2) then
  begin
    if y1<=y2 then
      y:=y+1
    else if y1>y2 then
      y:=y-1;
    Color11:=GetPixel(windc,x,y);
    color22:=color11;
    if (SimilarColors(color,color22,Tol) = true) then
    begin
      result:=True;
      exit;
    end;
  end;
  repeat
    if x1<=x2 then
      x:=x+1
    else if x1>x2 then
      x:=x-1;
    Color11:=GetPixel(windc,x,y);
    color22:=color11;
    if (SimilarColors(color,color22,Tol) = true) then
    begin
      result:=True;
      exit;
    end;
  until (x=x2) or(result=true);
  x:=x1;
until (y=y2) or (result=true);
end;
end;

//********************************
//  Change this accordingly to your function count
function GetFunctionCount(): Integer; stdcall; export;
begin
  Result:= 1;
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:= @ControlledColorSearch;
         StrPCopy(ProcDef, 'Function ControlledColorSearch(x,y,Color,x1,y1,x2,y2,Tol,xc,yc:integer;flip:boolean;Wind:Longint):boolean;');
       end;
  else
    x:= -1;
  end;
  Result:= x;
end;

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

and usage in scar that i have been trying

program new;
{.include srl/srl.scar}
var wind:longint;xc,yc:integer;

Function BColorFind(x,y,Color,x1,y1,x2,y2,Tol,xc,yc:integer;Flip:boolean):boolean;
begin
wind:=GetClientWindowHandle;
SetClientWindowHandle(Wind);
if ControlledColorSearch(x,y,Color,x1,y1,x2,y2,Tol,xc,yc,Flip,Wind) then
result:=true;
end;

begin
if BColorFind(x,y,6842735,100,70,150,100,0,xc,yc,False) then
mmouse(x,y,0,0);

end.

If noone can help you, I'd reccomend that you PM it to Freddy and ask him if he has some spare time to help you; I'm not sure how many people here know delphi, but I don't…

Hmm… I have absolutely no idea what you're trying to do… but, for starters:

//SCAR Plugin. Created for SCAR 2.0 by Kaitnieks
// currently you can't call SCAR functions from plugin
library BramblePlugin;

uses
  SysUtils,
  Graphics,
  windows;

//---------------------------------------
// Functions to be called from SCAR

function ColorRGB(SColor, i: Integer): Extended; stdcall;
var
  Color: TColor;
begin
  Color := ColorToRGB(SColor);
  Result := 0;
  case i of
    1: result := GetRValue(Color);
    2: result := GetGValue(Color);
    3: result := GetBValue(Color);
  end;
end;

function SimilarColors(Color1, Color2, Tolerance: Integer): Boolean; stdcall;
begin
  Result := False;
  if (Abs(Round(ColorRGB(Color1, 1)) - Round(ColorRGB(Color2, 1))) <= Tolerance) then
    if (Abs(Round(ColorRGB(Color1, 2)) - Round(ColorRGB(Color2, 2))) <= Tolerance) then
      if (Abs(Round(ColorRGB(Color1, 3)) - Round(ColorRGB(Color2, 3))) <= Tolerance) then
        Result := True;
end;

function ControlledColorSearch(x, y, Color, x1, y1, x2, y2, Tol, xc, yc: Integer; flip: Boolean; Wind: Hwnd): Boolean; stdcall;
var
  WndDC: HDC;
  color11: Tcolor;
begin
  WndDC := GetDC(Wind);
  if (xc = 0) and (yc = 0) then
  begin
    X := x1;
    Y := y1;
  end else begin
    x := xc;
    y := yc;
  end;
  if (flip = False) then
  begin
    if x1 > x2 then
      x := x + 1
    else
      x := x - 1;
    repeat
      if not (y = y2) then
      begin
        if x1 <= x2 then
          x := x + 1
        else if x1 > x2 then
          x := x - 1;
        Color11 := GetPixel(WndDC, x, y);
        if (SimilarColors(color, Color11, Tol) = True) then
        begin
          result := True;
          ReleaseDC(Wind, WndDC);
          exit;
        end;
      end;
      Y := y1;
      repeat
        if y1 <= y2 then
          Y := y + 1
        else if y1 > y2 then
          Y := y - 1;
        Color11 := GetPixel(WndDC, x, y);
        if (SimilarColors(color, color11, Tol) = True) then
        begin
          result := True;
          ReleaseDC(Wind, WndDC);
          exit;
        end;
      until (y = y2) or (result = True);
      if x1 <= x2 then
        x := x + 1
      else if x1 > x2 then
        x := x - 1;
    until (x = x2) or (result = True);
  end;
  if (flip = True) then
  begin
    if y1 > y2 then
      y := y + 1
    else
      y := y - 1;
    repeat
      if not (x = x2) then
      begin
        if y1 <= y2 then
          y := y + 1
        else if y1 > y2 then
          y := y - 1;
        Color11 := GetPixel(WndDC, x, y);
        if (SimilarColors(color, Color11, Tol) = True) then
        begin
          result := True;
          ReleaseDC(Wind, WndDC);
          exit;
        end;
      end;
      repeat
        if x1 <= x2 then
          x := x + 1
        else if x1 > x2 then
          x := x - 1;
        Color11 := GetPixel(WndDC, x, y);
        if (SimilarColors(color, Color11, Tol) = True) then
        begin
          result := True;
          ReleaseDC(Wind, WndDC);
          exit;
        end;
      until (x = x2) or (result = True);
      x := x1;
    until (y = y2) or (result = True);
  end;
  ReleaseDC(Wind, WndDC);
end;

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

function GetFunctionCount(): Integer; stdcall; export;
begin
  Result := 1;
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 := @ControlledColorSearch;
        StrPCopy(ProcDef, 'function ControlledColorSearch(x, y, Color, x1, y1, x2, y2, Tol, xc, yc: Integer; flip: Boolean; Wind: Hwnd): Boolean;');
      end;
  else
    x := -1;
  end;
  Result := x;
end;

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

and

program New;
{.include SRL/SRL.scar}
var
  xc, yc: Integer;

function BColorFind(x, y, Color, x1, y1, x2, y2, Tol, xc, yc: Integer; Flip: Boolean): Boolean;
begin
  Result := ControlledColorSearch(x, y, Color, x1, y1, x2, y2, Tol, xc, yc, Flip, GetClientWindowHandle) then
end;

begin
  if BColorFind(x, y, 6842735, 100, 70, 150, 100, 0, xc, yc, False) then
    MMouse(x, y, 0, 0);
end.

Now, the basic principle of a FindColor function is searching row by row:

for y := y1 to y2 do
  for x := x1 to x2 do
    if Color = GetCurrentColor then
      ...

Well, I'm not 100% sure, but might this be what you wanted to make?

//SCAR Plugin. Created for SCAR 2.0 by Kaitnieks
// currently you can't call SCAR functions from plugin
library BramblePlugin;

uses
  SysUtils,
  Graphics,
  windows;

//---------------------------------------
// Functions to be called from SCAR

function ColorRGB(SColor, i: Integer): Extended; stdcall;
var
  Color: TColor;
begin
  Color := ColorToRGB(SColor);
  Result := 0;
  case i of
    1: result := GetRValue(Color);
    2: result := GetGValue(Color);
    3: result := GetBValue(Color);
  end;
end;

function SimilarColors(Color1, Color2, Tolerance: Integer): Boolean; stdcall;
begin
  Result := False;
  if (Abs(Round(ColorRGB(Color1, 1)) - Round(ColorRGB(Color2, 1))) <= Tolerance) then
    if (Abs(Round(ColorRGB(Color1, 2)) - Round(ColorRGB(Color2, 2))) <= Tolerance) then
      if (Abs(Round(ColorRGB(Color1, 3)) - Round(ColorRGB(Color2, 3))) <= Tolerance) then
        Result := True;
end;

function ControlledColorSearch(x, y, Color, x1, y1, x2, y2, Tol, xc, yc: Integer; Flip: Boolean; Wnd: Hwnd): Boolean; stdcall;
var
  WndDC: HDC;
  xx, yy: Integer;
begin
  WndDC := GetDC(Wnd);
  if not ((xc = 0) and (yc = 0)) then
  begin
    x1 := xc;
    y1 := yc;
  end;
  if not Flip then
  begin
    for xx := x1 to x2 do
      for yy := y1 to y2 do
        if SimilarColors(Color, GetPixel(WndDC, x, y), Tol) then
        begin
          Result := True;
          ReleaseDC(Wnd, WndDC);
          x := xx;
          y := yy;
          exit;
        end;
  end else
    for yy := y1 to y2 do
      for xx := x1 to x2 do
        if SimilarColors(Color, GetPixel(WndDC, x, y), Tol) then
        begin
          Result := True;
          ReleaseDC(Wnd, WndDC);    
          x := xx;
          y := yy;
          exit;
        end;
  Result := False;
  x := -1;
  y := -1;
  ReleaseDC(Wnd, WndDC);
end;

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

function GetFunctionCount(): Integer; stdcall; export;
begin
  Result := 1;
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 := @ControlledColorSearch;
        StrPCopy(ProcDef, 'function ControlledColorSearch(x, y, Color, x1, y1, x2, y2, Tol, xc, yc: Integer; Flip: Boolean; Wnd: Hwnd): Boolean;');
      end;
  else
    x := -1;
  end;
  Result := x;
end;

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