All pastes #372358 Raw Edit

Mine

public text v1 · immutable
#372358 ·published 2007-02-26 00:11 UTC
rendered paste body
//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
    repeat
      if x1>x2 then
        x:=x1+1
      else
        x:=x1-1;
      if x1<=x2 then
        x:=x+1
      else if y1>y2 then
        x:=x-1;
      Color11:=GetPixel(windc,x,y);
      color22:=color11;
      if (SimilarColors(color,color22,Tol) = true) then
      begin
        result:=True;
        exit;
      end
      else begin
        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)
      end;
      Y:=y1;
      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
    repeat
      if y1>y2 then
        y:=y1+1
      else
        y:=y1-1;
      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
      else
      begin
        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)
      end;
      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.