SRL Archive - SRL Archives

There you go Sumilion..

NOTE: It is designed for Falador's Gate.. if it works anywere else, you are probably lucky.. :)

program New;

Var
   RColor: Integer;

Function ClearTPointArray(a: TPointArray): TPointArray;

Var
   I, C: Integer;

Begin
  For I := 0 To GetArrayLength(a) - 1 Do
  Begin
    If rs_OnMiniMap(a[i].x, a[i].y) Then
    Begin
      C := C + 1;
      SetArrayLength(Result, C + 1);
      Result[C] := a[i];
    End;
  End;
End;

Function NumberDoesntExist(Ar2: Array Of Integer; Number: Integer): Boolean;

Var
   I: Integer;
Begin
  Result := False;
  For I := 0 To GetArrayLength(Ar2) - 1 Do
  Begin
    If Ar2[I] = Number Then
      Exit;
  End;
  Result := True;
End;

Function ShrinkArray(YourArray: Array Of Integer): Array Of Integer;

Var
   I: Integer;

Begin
  SetArrayLength(Result, 0);
  For I := 0 To GetArrayLength(YourArray) - 1 Do
  Begin
    If NumberDoesntExist(Result, YourArray[I]) Then
    Begin
      SetArrayLength(Result, GetArrayLength(Result) + 1);
      Result[GetArrayLength(Result) - 1] := YourArray[I];
    End;
  End;
End;

Function GetRoadColor(New: Boolean): Integer;

Var
   Points: TPointArray;
   Colors, Colors2, Colors3, Amount, Amount2: Array Of Integer;
   I, iZ: Integer;
   myZ: Extended;
   X, Y, Z: Array Of Extended;


Begin
  ColorToleranceSpeed(0);
  FindColorsTolerance(Points, RColor, MMX1, MMY1, MMX2, MMY2, 50);
  Points := ClearTPointArray(Points);
  Colors := ShrinkArray(GetColors(Points));
  SetArrayLength(Amount, GetArrayLength(Colors));

  For I := 0 To GetArrayLength(Colors) - 1 Do
  Begin
    Amount[i] := CountColor(Colors[I], MMX1, MMY1, MMX2, MMY2);
   // If Amount[I] > 50 Then WriteLn('Color ' + IntToStr(Colors[I]) + ': '+IntToStr(Amount[I]));
  End;

  For I := 0 To GetArrayLength(Colors) - 1 Do
  Begin
    If Amount[I] > 200 Then // You might want to tweak the 200.
    Begin
      SetArrayLength(Amount2, GetArrayLength(Amount2) + 1);
      SetArrayLength(Colors2, GetArrayLength(Colors2) + 1);
      Amount2[GetArrayLength(Amount2) - 1] := Amount[I];
      Colors2[GetArrayLength(Colors2) - 1] := Colors[I];
    End;
  End;
  SetArrayLength(X, GetArrayLength(Colors2));
  SetArrayLength(Y, GetArrayLength(Colors2));
  SetArrayLength(Z, GetArrayLength(Colors2));

  For I := 0 To GetArrayLength(Colors2) - 1 Do
  Begin
    ColorToXYZ(Colors2[I], X[I], Y[I], Z[I]);
    If (X[I] > 10) And (X[I] < 30) And (Y[I] > 10) And (Y[I] < 30)
    And (Z[I] > 10) And (Z[I] < 30) Then
    Begin
      SetArrayLength(Colors3, GetArrayLength(Colors3) + 1);
      Colors3[GetArrayLength(Colors3) - 1] := Colors2[I];
      AddToReport('Color['+IntToStr(I)+']: ' + IntToStr(Colors3[GetArrayLength(Colors3) - 1]));
    End;
  End;
  If New Then
  Begin
    MyZ := 0;
    For I := 0 To GetArrayLength(Colors3) - 1 Do
    Begin
      If MaxE(Z[I], MyZ) <> MyZ Then
      Begin
        iZ := I;
        MyZ := MaxE(Z[I], MyZ);
      End;
    End;
  End
  Else
  Begin
    myZ := 100000;
    For I := 0 To GetArrayLength(Colors3) - 1 Do
    Begin
      If Y[I] > X[I] Then
      If MinE(Z[I], MyZ) <> MyZ Then
      Begin
        iZ := I;
        MyZ := MinE(Z[I], MyZ);
      End;
    End
  End;
  If iZ < GetArrayLength(Colors3) Then Result := Colors3[iZ];
  WriteLn('The Color is: '+IntToStr(Result));
End;

Function GetRoadColorIn(x1, y1, x2, y2: Integer; New: Boolean): Integer;
  // Should be quite a large area.
  // Use this in lumbridge, otherwise it finds the other colors.

Var
   Points: TPointArray;
   Colors, Colors2, Colors3, Amount, Amount2: Array Of Integer;
   I, iZ: Integer;
   myZ: Extended;
   X, Y, Z: Array Of Extended;


Begin
  ColorToleranceSpeed(0);
  FindColorsTolerance(Points, RColor, x1, y1, x2, y2, 50);
  Points := ClearTPointArray(Points);
  Colors := ShrinkArray(GetColors(Points));
  SetArrayLength(Amount, GetArrayLength(Colors));

  For I := 0 To GetArrayLength(Colors) - 1 Do
  Begin
    Amount[i] := CountColor(Colors[I], MMX1, MMY1, MMX2, MMY2);
   // If Amount[I] > 50 Then WriteLn('Color ' + IntToStr(Colors[I]) + ': '+IntToStr(Amount[I]));
  End;

  For I := 0 To GetArrayLength(Colors) - 1 Do
  Begin
    If Amount[I] > 200 Then // You might want to tweak the 200.
    Begin
      SetArrayLength(Amount2, GetArrayLength(Amount2) + 1);
      SetArrayLength(Colors2, GetArrayLength(Colors2) + 1);
      Amount2[GetArrayLength(Amount2) - 1] := Amount[I];
      Colors2[GetArrayLength(Colors2) - 1] := Colors[I];
    End;
  End;
  SetArrayLength(X, GetArrayLength(Colors2));
  SetArrayLength(Y, GetArrayLength(Colors2));
  SetArrayLength(Z, GetArrayLength(Colors2));

  For I := 0 To GetArrayLength(Colors2) - 1 Do
  Begin
    ColorToXYZ(Colors2[I], X[I], Y[I], Z[I]);
    If (X[I] > 10) And (X[I] < 30) And (Y[I] > 10) And (Y[I] < 30)
    And (Z[I] > 10) And (Z[I] < 30) Then
    Begin
      SetArrayLength(Colors3, GetArrayLength(Colors3) + 1);
      Colors3[GetArrayLength(Colors3) - 1] := Colors2[I];
      AddToReport('Color['+IntToStr(I)+']: ' + IntToStr(Colors3[GetArrayLength(Colors3) - 1]));
    End;
  End;
  If New Then
  Begin
    MyZ := 0;
    For I := 0 To GetArrayLength(Colors3) - 1 Do
    Begin
      If MaxE(Z[I], MyZ) <> MyZ Then
      Begin
        iZ := I;
        MyZ := MaxE(Z[I], MyZ);
      End;
    End;
  End
  Else
  Begin
    myZ := 100000;
    For I := 0 To GetArrayLength(Colors3) - 1 Do
    Begin
      If MinE(Z[I], MyZ) <> MyZ Then
      Begin
        iZ := I;
        MyZ := MinE(Z[I], MyZ);
      End;
    End
  End;
  If iZ < GetArrayLength(Colors3) Then Result := Colors3[iZ];
  WriteLn('The Color is: '+IntToStr(Result));
End;

Var
   I1, I2: LongInt;

begin
  ClearDebug;
  RColor := 6453371;
  Repeat
    I1 := GetSystemTime;
    GetRoadColor(False);
    I2 := GetSystemTime;
    Wait(1000);
    ClearReport;
  Until False;
end.

EDIT: I will post one which makes it able to assign a x1, y1, x2, y2.. I got no bugs, but sumilion reported that it would very rarely (but still would!!!!) get the wrong road color (the other no, no non-road).
Now, I upped new code, (I tried it out too, in a repeat look, just keps rotating screen and moving, no errors.)

There was some array error.. solved too in the new code….
Sum, I really got no errors… Try this code..

EDIT2: Boreas pointed out an error, it would find the wrong color in lumbridge, so I added GetRoadColorIn(x1, y1, x2, y2: Integer; New: Boolean): Integer;

thanks for posting :)

I read through that and thought it was Boreas for a second with all those arrays.


Good work Wizzup!

<3 wizzup :)

What's wrong with the old FindRoadColor?

Also, could you make a fix to FindDirtRoadColor please? It's screwing up a LOT.

They dont always work :)

So far i like the road color finder wizzup… well.. except for one thing, it doesnt always pick the New road when i select it to do so and when both roads are visible… (so for me its useless atm)

Erm… "New" road?

"Fala" ;)

Ohh Falador's roads? ;)

Yeah, I need to work on FindDirtRoadColor some more. The others work pretty much 100% of the time for me.

From: Sumilion
They dont always work :)

So far i like the road color finder wizzup… well.. except for one thing, it doesnt always pick the New road when i select it to do so and when both roads are visible… (so for me its useless atm)

It Doesn't?

Weird… the new road's Z is always higher than the old Road's Z…

Oh, alright.

Well anyway, I changed one line, but you will have to make sure the road is visible. (200 pixels.. sounds like alot, trust me, it isn't…)

    If Amount[I] > 200 Then // You might want to tweak the 200.

 If (X[I] > 10) And (X[I] < 30) And (Y[I] > 10) And (Y[I] < 30)
    And (Z[I] > 10) And (Z[I] < 30) Then

You might want to increase the 30 to 35… should help..
Anyway, copy the code again, I tweaked a small part.