SRL Archive - SRL Archives

Hello

FindRange Doesnt seem to work for me :( Neither N1kes does, (i am near lumby cook)

So i figured i will make my own. This is a part of the script i am going to apply with btw.

Function FindRangex(var x, y: Integer): Boolean;
var Trys : Integer;
begin
  FindColorSpiral(x,y,1319578,MSX1,MSY1,MSX2,MSY2);
  Mouse(x,y,1,1,False);
  If (ChooseOption('ange')) then
   begin
      Writeln('Range Found at: '+InttoStr(x)+','+IntToStr(y));
      x := x
      y := y
   end else
    begin
        MakeCompass('N');
        Trys := 0;
    Repeat
        Case Trys of
        5: MakeCompass('S');
        10: MakeCompass('E');
        15: MakeCompass('W');
        20: TerminateScript;
        end;
        Inc(Trys)
        Wait(500);
        FindColorSpiral(x,y,1319578,MSX1,MSY1,MSX2,MSY2);
        Mouse(x,y,2,2,False);
    Until(ChooseOption('ange'));
  Writeln('Range Found at: '+InttoStr(x)+','+IntToStr(y));
  x := x
  y := y
  end;
end;

I am sure it can be done better, but thats my bet for now

EDIT: Found out its not working very well, some problem with the color (The red color on the range changes)

Instead of:

  x := x
  y := y

Just do GetMousePos(x, y) :)

I made it a bit shorter + more usfull'er'

Function FindRangex(var x, y: Integer): Boolean;
var Trys : Integer;
begin
  If FindColorSpiral(x,y,1319578,MSX1,MSY1,MSX2,MSY2) Then
    MMouse(x,y,1,1);
  Result := (ChooseOption('ange'));
   Writeln('Range Found at: '+InttoStr(x)+','+IntToStr(y));
   If Result Then
   GetMousePos(x, y)
  else
    MakeCompass('N');
  If Result Then Exit Else
    Trys := 0;

    Repeat
        Case Trys of
          5: MakeCompass('S');
          10: MakeCompass('E');
          15: MakeCompass('W');
          20: MakeCompass(Random(360));
        end;
        Inc(Trys)
        Wait(500 + Random(200));
        If FindColorSpiral(x,y,1319578,MSX1,MSY1,MSX2,MSY2) Then
          Mouse(x,y,2,2,False);
    Until(ChooseOption('ange')) xor (Trys >= 21);
  Writeln('Range Found at: '+InttoStr(x)+','+IntToStr(y));
end;

1) You never use your Result variable?
2) Use an if statement - saves it clicking on 0
3)Added a try's variable on your loop (Otherwise was a potential neverending loop)

Thx for reply, but if found out its not working because the range changes. i made a new one should be working much better than this, will use "result" better also :)

Will be posting in less than 1 hour (its 97% complete), need to go someplace :)

EDIT: Well, before going i will post the whole program, will make it to a function when i return :O

.:****** Test Please ******:.

program New;
//Credits to Blumblebee for DDTM tut And Nielsie95 For DDTM Editor
{.include SRL/SRL.scar}
var DDTMTol, theDDTM,x,y, endelig : Integer;
tpa: TPointArray;

function RangeDDTM: Integer;
var
  dtmMainPoint: TDTMPointDef;
  dtmSubPoints: Array [0..3] of TDTMPointDef;
  TempTDTM: TDTM;
begin
  dtmMainPoint.x := 430;
  dtmMainPoint.y := 335;
  dtmMainPoint.AreaSize := 0;
  dtmMainPoint.AreaShape := 0;
  dtmMainPoint.Color := 1319837;
  dtmMainPoint.Tolerance := DDTMTol;

  dtmSubPoints[0].x := 430;
  dtmSubPoints[0].y := 335;
  dtmSubPoints[0].AreaSize := 0;
  dtmSubPoints[0].AreaShape := 0;
  dtmSubPoints[0].Color := 1319837;
  dtmSubPoints[0].Tolerance := DDTMTol;

  dtmSubPoints[1].x := 428;
  dtmSubPoints[1].y := 337;
  dtmSubPoints[1].AreaSize := 0;
  dtmSubPoints[1].AreaShape := 0;
  dtmSubPoints[1].Color := 1319837;
  dtmSubPoints[1].Tolerance := DDTMTol;

  dtmSubPoints[2].x := 429;
  dtmSubPoints[2].y := 337;
  dtmSubPoints[2].AreaSize := 0;
  dtmSubPoints[2].AreaShape := 0;
  dtmSubPoints[2].Color := 1319837;
  dtmSubPoints[2].Tolerance := DDTMTol;

  dtmSubPoints[3].x := 426;
  dtmSubPoints[3].y := 335;
  dtmSubPoints[3].AreaSize := 0;
  dtmSubPoints[3].AreaShape := 0;
  dtmSubPoints[3].Color := 1319837;
  dtmSubPoints[3].Tolerance := DDTMTol;

  TempTDTM.MainPoint := dtmMainPoint;
  TempTDTM.SubPoints := dtmSubPoints;
  Result := AddDTM(TempTDTM);
end;

Function FindDDTMonMS: Boolean;
begin
  DDTMTol := 5;
  theddtm := SetDDTM;
  repeat
    if not DtmRotated(theddtm, X, Y, MSX1, MSY1, MSX2, MSY2) then
    begin
      IncEx(DDTMTol, 5)
      FreeDTM(theddtm);
      theddtm := SetDDTM;
    end else
    begin
      Result := True;
      Break;
    end;
  until (DDTMTol >= 100);
  DDTMTol := 5;
  FreeDtm(theddtm);
end;

begin

SetupSRL;
if (FindDDTMonMS) then
begin
Writeln('Range Found');
end;

end.

Okay, I made one aswell :).

Function FindRange(Var X, Y : Integer) : Boolean;
Var TPA : Array Of TPoint;
    ATPA : T2DPointArray;
    I : Byte;
Begin
  FindColorsTolerance(TPA, 1385376, MSX1, MSY1, MSX2, MSY2, 10);
  ATPA := TPAtoATPAEx(TPA, 22, 8);
  SortATPAFrom(ATPA, Point(MSCX, MSCY));

  If Length(TPA) > 0 Then
  For I := 0 To High(ATPA) Do
  Begin
    RAaSTPA(ATPA[I], 15);
    
    If MiddleTPAEx(ATPA[I], x, y) Then
      MMouse(x, y, 0, 0);
    Wait(120 + Random(20));
    Result := IsUpText('Cooking range');
    If Result Then
    Begin
      GetMousePos(x, y);
      Exit;
    End Else
      Continue;
  End;
End;

^Looks nice :)

I think the new Cooking.scar should look:

Its working perfect :) (Until now)

*Going to other ranges to test…*

//-----------------------------------------------------------------//
//--               Scar Standard Resource Library                --//
//--                      Cooking routines                       --//
//-----------------------------------------------------------------//
// * Function FindRange: Boolean; //By XabdullahX
// *

{*******************************************************************************
function FindRange: Boolean;
By: XabdullahX. Credits to Blumblebee for DDTM tut And Nielsie95 For DDTM Editor
Description: Will find a range, returns x and y
*******************************************************************************}

var DDTMTol, theDDTM,x,y : Integer;

function RangeDDTM: Integer;
var
  dtmMainPoint: TDTMPointDef;
  dtmSubPoints: Array [0..3] of TDTMPointDef;
  TempTDTM: TDTM;
begin
  dtmMainPoint.x := 430;
  dtmMainPoint.y := 335;
  dtmMainPoint.AreaSize := 0;
  dtmMainPoint.AreaShape := 0;
  dtmMainPoint.Color := 1319837;
  dtmMainPoint.Tolerance := DDTMTol;

  dtmSubPoints[0].x := 430;
  dtmSubPoints[0].y := 335;
  dtmSubPoints[0].AreaSize := 0;
  dtmSubPoints[0].AreaShape := 0;
  dtmSubPoints[0].Color := 1319837;
  dtmSubPoints[0].Tolerance := DDTMTol;

  dtmSubPoints[1].x := 428;
  dtmSubPoints[1].y := 337;
  dtmSubPoints[1].AreaSize := 0;
  dtmSubPoints[1].AreaShape := 0;
  dtmSubPoints[1].Color := 1319837;
  dtmSubPoints[1].Tolerance := DDTMTol;

  dtmSubPoints[2].x := 429;
  dtmSubPoints[2].y := 337;
  dtmSubPoints[2].AreaSize := 0;
  dtmSubPoints[2].AreaShape := 0;
  dtmSubPoints[2].Color := 1319837;
  dtmSubPoints[2].Tolerance := DDTMTol;

  dtmSubPoints[3].x := 426;
  dtmSubPoints[3].y := 335;
  dtmSubPoints[3].AreaSize := 0;
  dtmSubPoints[3].AreaShape := 0;
  dtmSubPoints[3].Color := 1319837;
  dtmSubPoints[3].Tolerance := DDTMTol;

  TempTDTM.MainPoint := dtmMainPoint;
  TempTDTM.SubPoints := dtmSubPoints;
  Result := AddDTM(TempTDTM);
end;

Function FindRange: Boolean;

begin
  DDTMTol := 5;
  theddtm := RangeDDTM;
  repeat
    if not DtmRotated(theddtm, X, Y, MSX1, MSY1, MSX2, MSY2) then
    begin
      IncEx(DDTMTol, 5)
      FreeDTM(theddtm);
      theddtm := RangeDDTM;
    end else
    begin
      Result := True;
      Break;
    end;
  until (DDTMTol >= 100);
  DDTMTol := 5;
  FreeDtm(theddtm);
end;




{*******************************************************************************
procedure SetupCooking;
By: SRL
Description: Declares Global Bitmaps.
*******************************************************************************}

procedure SetupCooking;
begin
  srl_LoadBitmapRange(76, 95);
end;

Testing result: Tried at 3 ranges, one at edgeville, 2 in lumby, working perfect on all of them
Pictures of the ranges :P:

From: NaumanAkhlaQ
Okay, I made one aswell :).

Function FindRange(Var X, Y : Integer) : Boolean;
Var TPA : Array Of TPoint;
    ATPA : T2DPointArray;
    I : Byte;
Begin
  FindColorsTolerance(TPA, 1385376, MSX1, MSY1, MSX2, MSY2, 10);
  ATPA := TPAtoATPAEx(TPA, 22, 8);
  SortATPAFrom(ATPA, Point(MSCX, MSCY));

  If Length(TPA) > 0 Then
  For I := 0 To High(ATPA) Do
  Begin
    RAaSTPA(ATPA[I], 15);
    
    If MiddleTPAEx(ATPA[I], x, y) Then
      MMouse(x, y, 0, 0);
    Wait(120 + Random(20));
    Result := IsUpText('Cooking range');
    If Result Then
    Begin
      GetMousePos(x, y);
      Exit;
    End Else
      Continue;
  End;
End;

efficiencypolice says: no need for GetMousePos(x, y) because MiddleTPAEx(ATPA, x, y) here u store alrdy to x, y. you are wasting precious nanoseconds.