Le Jingle
04-17-2013, 01:23 AM
I've reworked a function (still called in the same way, only UTH - under the hood - code changed).
I noted the changes, as well as the ideal improvements I seek at the end of this post.
OLD / Current Code:
(*
GetAmountBox
~~~~~~~~~~~~
.. code-block:: pascal
function GetAmountBox(box: TBox): integer;
Returns the amount of an item at in the box 'box'. Returns approximate values
for 'K' and 'M'.
.. note::
Author: Zeph, N1ke & Narcle
Last Modified: Unknown
Example:
.. code-block:: pascal
var
i: Integer;
begin
i := GetAmountBox(InvBox(1)); // Gets the amount in inventory slot 1
Writeln('Amount = '+toStr(i));
end;
*)
function GetAmountBox(box: TBox): integer;
var
Col: TIntegerArray;
X, Y, I: Integer;
B: TBox;
TPA: TPointArray;
S: String;
begin
Result := 0;
If Not FindColor(X, Y, srl_outline_black, box.x1, box.y1, box.x2, box.y2) then
Exit;
Inc(Result);
Col := [65535, 65278, 16777215, 8453888];
For I := 0 to High(Col) do
If FindColor(X, Y, Col[I], box.x1, box.y1, box.x2, box.y2)then
begin
FindColors(TPA, Col[i], box.x1, box.y1, box.x2, box.y2);
B := GetTPABounds(TPA);
//SMART_DrawBoxEx(False, b, clYellow);
B := IntToBox(b.x1-2, b.y1-2, b.x2+2, b.y2+2);
S := GetTextAtExWrap(b.x1, b.y1, b.x2, b.y2, 0, 1, 1, Col[i], 0, StatChars);
Result := StrToIntDef(GetNumbers(S), 1);
Case I of
2: Result := Result * 1000;
3: Result := Result * 1000000;
end;
Exit;
end;
end;
New / Proposed Code
(GetAmountBoxEx)
function GetAmountBoxEx(box: TBox; color: Integer): Integer;
var
m, x, y: Integer;
s: string;
b: TBox;
TPA: TPointArray;
begin
Result := 0; // say there's nothing there by default.
if not FindColor(x, y, SRL_OUTLINE_BLACK, box.X1, box.Y1, box.X2, box.Y2) then
Exit; // let's leave if there's really nothing there.
Result := 1;
if not FindColor(x, y, color, box.X1, box.Y1, box.X2, box.Y2) then
Exit; // if there's an item, but no text, let's leave it at 1 and Exit.
FindColors(TPA, color, box.X1, box.Y1, box.X2, box.Y2);
if (not Length(TPA) > 10) then
Exit; // The lowest pixel count for any single number character is 11.
b := GetTPABounds(TPA); // get the bounds/box
SetArrayLength(TPA, 0);
// I don't know why this is here, but I left it just in case.
b := IntToBox(b.X1 - 2, b.Y1 - 2, b.X2 + 2, b.Y2 + 2);
s := GetTextAtExWrap(b.X1, b.Y1, b.X2, b.Y2, 0, 1, 1, color, 0, StatChars07);
m := 1; // default value to multiply by
// if there's a stack of thousands or millions, we'll store it in m.
if (Pos('K', s) > 0) or (Pos('k', s) > 0) then
m := 1000
else if (Pos('M', s) > 0) or (Pos('m', s) > 0) then
m := 1000000;
s := ReplaceRegExpr('[oO]', s, '0', True); // replace mis-read text
s := ReplaceRegExpr('[^0-9]', s, '', True); // delete non-numbers
Result := (StrToIntDef(GetNumbers(s), 1) * m);
end;
(getAmountBox)
function GetAmountBox(box: TBox): Integer;
var
i: Integer;
colors: TIntegerArray;
begin
Result := 0;
colors := [65535, 65278, 16777215, 8453888];
for i := 0 to high(colors) do
begin
Result := GetAmountBoxEx(box, colors[i]);
if (Result > 0) then
Break;
end;
SetArrayLength(colors, 0);
end;
Ideally, I think that this changes are beneficial because:
There is a potential elimination of a loop needed to find text (hence the GetAmountBoxEx) - probably more added in that I didn't account for though :p
The reworked functions now trim's mis-read alphabetical characters o or O with 0's - assumptive and the most concern I shed goes here.
added more fail safe checks to the code
So please let me know what you think, I didn't think to commit this just yet and may not depending on the responses here.
The main goal of this code is just to add some fail safe and counter the text being mis-read.
Initiated after reading errors with the current function, via this thread:
http://villavu.com/forum/showthread.php?t=101443
I noted the changes, as well as the ideal improvements I seek at the end of this post.
OLD / Current Code:
(*
GetAmountBox
~~~~~~~~~~~~
.. code-block:: pascal
function GetAmountBox(box: TBox): integer;
Returns the amount of an item at in the box 'box'. Returns approximate values
for 'K' and 'M'.
.. note::
Author: Zeph, N1ke & Narcle
Last Modified: Unknown
Example:
.. code-block:: pascal
var
i: Integer;
begin
i := GetAmountBox(InvBox(1)); // Gets the amount in inventory slot 1
Writeln('Amount = '+toStr(i));
end;
*)
function GetAmountBox(box: TBox): integer;
var
Col: TIntegerArray;
X, Y, I: Integer;
B: TBox;
TPA: TPointArray;
S: String;
begin
Result := 0;
If Not FindColor(X, Y, srl_outline_black, box.x1, box.y1, box.x2, box.y2) then
Exit;
Inc(Result);
Col := [65535, 65278, 16777215, 8453888];
For I := 0 to High(Col) do
If FindColor(X, Y, Col[I], box.x1, box.y1, box.x2, box.y2)then
begin
FindColors(TPA, Col[i], box.x1, box.y1, box.x2, box.y2);
B := GetTPABounds(TPA);
//SMART_DrawBoxEx(False, b, clYellow);
B := IntToBox(b.x1-2, b.y1-2, b.x2+2, b.y2+2);
S := GetTextAtExWrap(b.x1, b.y1, b.x2, b.y2, 0, 1, 1, Col[i], 0, StatChars);
Result := StrToIntDef(GetNumbers(S), 1);
Case I of
2: Result := Result * 1000;
3: Result := Result * 1000000;
end;
Exit;
end;
end;
New / Proposed Code
(GetAmountBoxEx)
function GetAmountBoxEx(box: TBox; color: Integer): Integer;
var
m, x, y: Integer;
s: string;
b: TBox;
TPA: TPointArray;
begin
Result := 0; // say there's nothing there by default.
if not FindColor(x, y, SRL_OUTLINE_BLACK, box.X1, box.Y1, box.X2, box.Y2) then
Exit; // let's leave if there's really nothing there.
Result := 1;
if not FindColor(x, y, color, box.X1, box.Y1, box.X2, box.Y2) then
Exit; // if there's an item, but no text, let's leave it at 1 and Exit.
FindColors(TPA, color, box.X1, box.Y1, box.X2, box.Y2);
if (not Length(TPA) > 10) then
Exit; // The lowest pixel count for any single number character is 11.
b := GetTPABounds(TPA); // get the bounds/box
SetArrayLength(TPA, 0);
// I don't know why this is here, but I left it just in case.
b := IntToBox(b.X1 - 2, b.Y1 - 2, b.X2 + 2, b.Y2 + 2);
s := GetTextAtExWrap(b.X1, b.Y1, b.X2, b.Y2, 0, 1, 1, color, 0, StatChars07);
m := 1; // default value to multiply by
// if there's a stack of thousands or millions, we'll store it in m.
if (Pos('K', s) > 0) or (Pos('k', s) > 0) then
m := 1000
else if (Pos('M', s) > 0) or (Pos('m', s) > 0) then
m := 1000000;
s := ReplaceRegExpr('[oO]', s, '0', True); // replace mis-read text
s := ReplaceRegExpr('[^0-9]', s, '', True); // delete non-numbers
Result := (StrToIntDef(GetNumbers(s), 1) * m);
end;
(getAmountBox)
function GetAmountBox(box: TBox): Integer;
var
i: Integer;
colors: TIntegerArray;
begin
Result := 0;
colors := [65535, 65278, 16777215, 8453888];
for i := 0 to high(colors) do
begin
Result := GetAmountBoxEx(box, colors[i]);
if (Result > 0) then
Break;
end;
SetArrayLength(colors, 0);
end;
Ideally, I think that this changes are beneficial because:
There is a potential elimination of a loop needed to find text (hence the GetAmountBoxEx) - probably more added in that I didn't account for though :p
The reworked functions now trim's mis-read alphabetical characters o or O with 0's - assumptive and the most concern I shed goes here.
added more fail safe checks to the code
So please let me know what you think, I didn't think to commit this just yet and may not depending on the responses here.
The main goal of this code is just to add some fail safe and counter the text being mis-read.
Initiated after reading errors with the current function, via this thread:
http://villavu.com/forum/showthread.php?t=101443