SRL Archive - SRL Archives

As we all know, ChooseOptionMultiEx is currently horribly slow and doesn't even find all capital letters (don't know why)

I solved the problem by making this function use Bitmap masks instead of Text TPA.

Pros
+ Very fast
+ All letters work (at least Withdraw-X was found immediately)
Cons
- Didn't make it search for any specific colour. In the old function you could only search cyan text etc, in this one the whole text has to be the same color.
Example: You can't use ['Attack Goblin'] Because Attack and Goblin and in different colours.

The searching priority is a bit different than current. This one first searches through all the options for Text[0], and then it searches through all the options for Text[1] etc etc, while the current one first checks if we have any of the texts[0..?] in the very first option, then it goes to the 2nd optionslot etc etc.

This wouldn't even break that many scripts because I think everyone just uses WaitOption and WaitOptionMulti.

function ChooseOptionMultiEx2(Texts: TStringArray; Action: fnct_ActionOptions): Boolean;
var
   B: TBox;
   TPA: TPointArray;
   aTPA: T2DPointArray;
   I, H, TextMask, X, Y: Integer;
begin
  Result := False;
  GetClientDimensions(B.X2, B.Y2);
  B.X1 := 0;
  B.Y1 := 0;

  FindColorsTolerance(TPA, 4016722, B.X1, B.Y1, B.X2, B.Y2, 0);
  If Length(TPA) < 10 Then
    Exit;
  B.X2 := 0;
  B.Y2 := 0;
  aTPA := SplitTPAEx(TPA, 20, 20);
  SortATPASize(aTPA, True);
  B := GetTPABounds(aTPA[0]);

  H := High(Texts);
  for I := 0 to H do
  begin
    TextMask := CreateBitmapMaskFromText(Texts[I], UpChars);
    Result := FindBitmapMaskTolerance(TextMask, X, Y, B.X1, B.Y1, B.X2, B.Y2, 0, 0);
    FreeBitmap(TextMask);
    if Result then
    begin
      case Action of
        ClickLeft: MouseBox(B.X1 + 5, Y + 3, B.X2 - 5, Y + 8, 1);
        Move: MouseBox(B.X1 + 5, Y + 3, B.X2 - 5, Y + 8, 3);
      end;
      Exit;
    end;
  end;
end;

EDIT: Espect a new version of this with colors support :)
EDIT2: So, here comes the monster, obey:

function ChooseOptionMultiEx2(Texts: TStringArray; TextType: String; Action: fnct_ActionOptions): Boolean;
var
   B: TBox;
   TPA: TPointArray;
   aTPA: T2DPointArray;
   Colors, GoodColors: TIntegerArray;
   I, H, II, HH, III, J, TextMask, X, Y, XX, YY, CorrectWords: Integer;
   TSA: TStringArray;
   SmallBoxes: TBoxArray;
begin
  Result := False;
  GetClientDimensions(B.X2, B.Y2);
  B.X1 := 0;
  B.Y1 := 0;

  FindColorsTolerance(TPA, 4016722, B.X1, B.Y1, B.X2, B.Y2, 0);
  If Length(TPA) < 10 Then
    Exit;
  B.X2 := 0;
  B.Y2 := 0;
  aTPA := SplitTPAEx(TPA, 20, 20);
  SortATPASize(aTPA, True);
  B := GetTPABounds(aTPA[0]);
  
  TPA := [];
  Colors := [13034990, 4231423, 2070783, 65535, 16776960, 9812166];
  TextType := LowerCase(TextType);
  
  case TextType of
    'action',
    'player': GoodColors := [Colors[0], Colors[5]];
    'item'  : GoodColors := [Colors[1], Colors[2]];
    'npc'   : GoodColors := [Colors[3]];
    'object': GoodColors := [Colors[4]];
    else
      GoodColors := Colors;
  end;
  
  SetLength(SmallBoxes, (B.Y2 - B.Y1)/15);
  for I := 0 to High(SmallBoxes) do
  begin
    SmallBoxes[I].X1 := B.X1;
    SmallBoxes[I].Y1 := B.Y1 + I * 16 - 3;
    SmallBoxes[I].X2 := B.X2;
    SmallBoxes[I].Y2 := B.Y1 + (I + 1) * 16 + 3;
  end;

  H := High(Texts);
  HH := High(SmallBoxes);
  
  for I := 0 to H do
  begin
    TSA := SRL_Explode(Texts[I], ' ');
    for II := 0 to HH do
    begin
      //DrawBox(SmallBoxes[II]);
      CorrectWords := 0;
      for J := 0 to High(TSA) do
      begin
        TextMask := CreateBitmapMaskFromText(TSA[J], UpChars);
        if FindBitmapMaskTolerance(TextMask, X, Y, SmallBoxes[II].X1, SmallBoxes[II].Y1, SmallBoxes[II].X2, SmallBoxes[II].Y2, 0, 0) then
        begin
          for III := 0 to High(GoodColors) do
          begin
            Result := FindColorTolerance(XX, YY, GoodColors[III], SmallBoxes[II].X1, SmallBoxes[II].Y1, SmallBoxes[II].X2, SmallBoxes[II].Y2, 3);
            if Result then
            begin
              Inc(CorrectWords);
              Break;
            end;
          end;
        end else
          Break;
      end;
      FreeBitmap(TextMask);

      if (CorrectWords < Length(TSA)) then
        Continue;
        
      case Action of
        ClickLeft: MouseBox(SmallBoxes[II].X1 + 5, SmallBoxes[II].Y1 + 3, SmallBoxes[II].X2 - 5, SmallBoxes[II].Y2 - 3, 1);
        Move: MouseBox(SmallBoxes[II].X1, SmallBoxes[II].Y1, SmallBoxes[II].X2, SmallBoxes[II].Y2, 3);
      end;
      Exit;
    end;
  end;
end;

Works like a dream to me

I like it. TPAs cause an overload on my computer…
I'm just wondering, but why do you have to set b.x2 b.y2 to zero. You set them to the tpa bounds two lines later.

From: mormonman
I like it. TPAs cause an overload on my computer…
I'm just wondering, but why do you have to set b.x2 b.y2 to zero. You set them to the tpa bounds two lines later.

Lawl I don't know, I didn't make the Optionbox finding :p
It's straight from the old function.

Made a new one that works just like the old one, with same parameters n' stuff.

Do a speed test…

From: mormonman
Do a speed test…

Already did, it finds 'Examine Iron armour set' from 20 options in 200 ms :)

No, I mean comparing the two. :P

From: mormonman
No, I mean comparing the two. :P

I don't need tests to say that the current ChooseOption lags horribly when there are 5< options available…

function ChooseOptionMultiEx2(Texts: TStringArray; TextType: Integer;
                              Action: fnct_ActionOptions): Boolean;
var
   B: TBox;
   TPA: TPointArray;
   aTPA: T2DPointArray;
   Colors, GoodColors: TIntegerArray;
   I, H, II, HH, III, J, L, LL: Integer;
   X, Y, CorrectWords, maskW, maskH: Integer;
   TextMasks: TIntegerArray;
   TSA: TStringArray;
   SmallBoxes: TBoxArray;
begin
  Result := False;
  GetClientDimensions(B.X2, B.Y2);
  B.X1 := 0;
  B.Y1 := 0;

  { Check if the ChooseOption Menu is present }
  FindColorsTolerance(TPA, 4016722, B.X1, B.Y1, B.X2, B.Y2, 0);
  If High(TPA) < 9 Then
    Exit;
  { Get the Search area for the Text Options }
  B.X2 := 0;
  B.Y2 := 0;
  aTPA := SplitTPAEx(TPA, 20, 20);
  SortATPASize(aTPA, True);
  B := GetTPABounds(aTPA[0]);

  { Select which colours to use based on the inputted const. All is default }
  Colors := [13034990, 4231423, 2070783, 65535, 16776960, 9812166];

  case TextType of
    srl_Option_Player,
    srl_Option_Action: GoodColors := [Colors[0], Colors[5]];
    srl_Option_Item  : GoodColors := [Colors[1], Colors[2]];
    srl_Option_NPC   : GoodColors := [Colors[3]];
    srl_Option_Object: GoodColors := [Colors[4]];
    else
      GoodColors := Colors;
  end;

  { Setup Search Boxes }
  SetLength(SmallBoxes, (B.Y2 - B.Y1)/15);
  H := High(SmallBoxes);
  for I := 0 to H do
  begin
    SmallBoxes[I].X1 := B.X1;
    SmallBoxes[I].Y1 := B.Y1 + I * 16 - 3;
    SmallBoxes[I].X2 := B.X2;
    SmallBoxes[I].Y2 := B.Y1 + (I + 1) * 16 + 3;
  end;

  H := High(Texts);
  HH := High(SmallBoxes);
  LL := High(GoodColors);

  for I := 0 to H do
  begin
    { Create a TStringArray of each individual word for Searching }
    TSA := SRL_Explode(Texts[I], ' ');
    L := High(TSA);
    SetLength(TextMasks, L + 1);
    { Loop through all the different boxes }
    for II := 0 to HH do
    begin
      CorrectWords := 0;
      { Loop through individual words }
      for J := 0 to L do
        with SmallBoxes[II] do
        begin
          {
            Create mask of the word, if its found then check if the right
            colour is there, if the word is not found, move to next search area
          }
          TextMasks[J] := CreateBitmapMaskFromText(TSA[J], UpChars);
          if FindBitmapMaskTolerance(TextMasks[J], X, Y, X1, Y1, X2, Y2, 0, 0) then
          begin
            {
              Get the Mask dimensions, check in the area the bitmap was found
              for one of the good colours, if its found, break out and try to
              find more words.
            }
            GetBitmapSize(TextMasks[J],maskW, maskH);
            for III := 0 to LL do
              if FindColorTolerance(X, Y, GoodColors[III], X, Y, X + maskW, Y + maskH, 3) then
              begin
                Inc(CorrectWords);
                Break;
              end;
          end else
            Break;
        end;
      { Free all the loaded Bitmaps }
      for J := 0 to L do
      try
        FreeBitmap(TextMasks[J]);
      except Break; end;

      { If there isn't enough correct words found, we messed up! Try again. }
      if (CorrectWords < (L + 1)) then
        Continue;

      { Click etc. }
      with SmallBoxes[II] do
        case Action of
          ClickLeft: MouseBox(X1 + 5, Y1 + 3, X2 - 5, Y2 - 3, 1);
          Move     : MouseBox(X1, Y1, X2, Y2, 3);
          Nothing  : ;
          else
            SRL_Warn('ChooseOptionMultiEx', 'Invalid Mouse Type Passed.', Warn_AllVersions);
        end;
      Result := True;
      Exit;
    end;
  end;
end;         

There, cleaned it up.. significantly also made it more accurate and faster.

By the way, meant to say great job, this was an innovative way to look at it :) (Sorry, multitasking :p)

Good job marpis. :)

N1ke noticed that it sometimes clicks the wrong option, either the one above or the one below. This can be fixed by changing the click box to
MouseBox(X1 + 5, Y1 + 5, X2 - 5, Y2 - 5, 1);

Also, the 'Move' option should also move the cursor to the same box
(currently it's just x1, y1, x2, y2 which often hovers wrong option)

And there should also be a const srl_Option_All :)

{*******************************************************************************
function ChooseOptionMultiEx(Texts: TStringArray; TextType: Integer;
                              Action: fnct_ActionOptions): Boolean;
By: Wizzup?, Nava2, and marpis
Description: Finds Popup menu, then clicks on it.
             Will look for the first string first and so on.
             It will search for the Text Type you input valid arguments are
             srl_Option_Action, srl_Option_Player: The white text
             srl_Option_NPC: The yellow text
             srl_Option_Object: The cyan text
             srl_Option_All: Removes colour check, allows for player colours.
             Will default to srl_Option_All.
Date: Nov. 8, 2009
*******************************************************************************}
function ChooseOptionMultiEx(Texts: TStringArray; TextType: Integer;
                              Action: fnct_ActionOptions): Boolean;
var
   B: TBox;
   TPA: TPointArray;
   Colors, GoodColors: TIntegerArray;
   I, H, II, HH, III, J, L, LL: Integer;
   X, Y, CorrectWords, maskW, maskH: Integer;
   TextMasks: TIntegerArray;
   TSA: TStringArray;
   SmallBoxes: TBoxArray;
begin
  Result := False;
  GetClientDimensions(B.X2, B.Y2);
  B.X1 := 0;
  B.Y1 := 0;

  { Check if the ChooseOption Menu is present }
  FindColorsTolerance(TPA, 4016722, B.X1, B.Y1, B.X2, B.Y2, 0);
  If High(TPA) < 9 Then
    Exit;
  { Get the Search area for the Text Options }
  B.X2 := 0;
  B.Y2 := 0;
  B := GetTPABounds(TPA);

  { Select which colours to use based on the inputted const. All is default }
  Colors := [13034990, 4231423, 2070783, 65535, 16776960, 9812166];

  case TextType of
    srl_Option_Player,
    srl_Option_Action: GoodColors := [Colors[0], Colors[5]];
    srl_Option_Item  : GoodColors := [Colors[1], Colors[2]];
    srl_Option_NPC   : GoodColors := [Colors[3]];
    srl_Option_Object: GoodColors := [Colors[4]];
    srl_Option_All   : ;
    else
      SRL_Warn('ChooseOption', 'Invalid Text Type specified', Warn_AllVersions);
  end;

  { Setup Search Boxes }
  SetLength(SmallBoxes, (B.Y2 - B.Y1)/15);
  H := High(SmallBoxes);
  for I := 0 to H do
  begin
    SmallBoxes[I].X1 := B.X1;
    SmallBoxes[I].Y1 := B.Y1 + I * 16 - 3;
    SmallBoxes[I].X2 := B.X2;
    SmallBoxes[I].Y2 := B.Y1 + (I + 1) * 16 + 3;
  end;

  H := High(Texts);
  HH := High(SmallBoxes);
  LL := High(GoodColors);

  for I := 0 to H do
  begin
    { Create a TStringArray of each individual word for Searching }
    TSA := SRL_Explode(Texts[I], ' ');
    L := High(TSA);
    SetLength(TextMasks, L + 1);
    { Loop through all the different boxes }
    for II := 0 to HH do
    begin
      CorrectWords := 0;
      { Loop through individual words }
      for J := 0 to L do
        with SmallBoxes[II] do
        begin
          {
            Create mask of the word, if its found then check if the right
            colour is there, if the word is not found, move to next search area
          }
          TextMasks[J] := CreateBitmapMaskFromText(TSA[J], UpChars);
          if FindBitmapMaskTolerance(TextMasks[J], X, Y, X1, Y1, X2, Y2, 0, 0) then
          begin
            {
              Get the Mask dimensions, check in the area the bitmap was found
              for one of the good colours, if its found, break out and try to
              find more words.
            }
            if (TextType = srl_Option_All) then
            begin
              Inc(CorrectWords);
              Continue;
            end;
            GetBitmapSize(TextMasks[J],maskW, maskH);
            for III := 0 to LL do
              if FindColorTolerance(X, Y, GoodColors[III], X, Y, X + maskW, Y + maskH, 3) then
              begin
                Inc(CorrectWords);
                Break;
              end;
          end else
            Break;
        end;
      { Free all the loaded Bitmaps }
      for J := 0 to L do
      try
        FreeBitmap(TextMasks[J]);
        TextMasks[J] := 0;
      except Break; end;

      { If there isn't enough correct words found, we messed up! Try again. }
      if (CorrectWords < (L + 1)) then
        Continue;

      { Click etc. }
      with SmallBoxes[II] do
        case Action of
          ClickLeft: MouseBox(X1 + 5, Y1 + 5, X2 - 5, Y2 - 5, 1);
          Move     : MouseBox(X1 + 5, Y1 + 5, X2 - 5, Y2 - 5, 3);
          Nothing  : ;
          else
            SRL_Warn('ChooseOptionMultiEx', 'Invalid Mouse Type Passed.', Warn_AllVersions);
        end;
      Result := True;
      Exit;
    end;
  end;
end;