Core:Colors.scar[INDENT]
{*******************************************************************************
procedure CaptureCTS(var CTS: integer);
By: lordsaturn
Description: Captures the ColorToleranceSpeed and stores to variable 'CTS'.
*******************************************************************************}
procedure CaptureCTS(var CTS: integer);
begin
CTS := GetColorToleranceSpeed;
end;
{*******************************************************************************
procedure RestoreCTS(CTS: integer);
By: lordsaturn
Description: Restores ColorToleranceSpeed 'CTS' and default ColorSpeed2Modifiers.
*******************************************************************************}
procedure RestoreCTS(CTS: integer);
begin
if GetColorToleranceSpeed = 2 then
SetColorSpeed2Modifiers(0.2, 0.2);
ColorToleranceSpeed(CTS);
end;
{*******************************************************************************
function FindColorsArrayTolerance(var ResultTPA: T2DPointArray; var Colors: TIntegerArray; xs, ys, xe, ye, Tol: integer): Boolean;
By: lordsaturn
Description: Finds all colors of TIntegerArray 'Colors' in the area specified by
xs, ys, xe, ye and returns their coordinates in T2DPA 'ResultTPA'. Will return
True if all colors are found.
*******************************************************************************}
function FindColorsArrayTolerance(var ResultTPA: T2DPointArray; var Colors: TIntegerArray; xs, ys, xe, ye, Tol: integer): Boolean;
var
i, LTIA: integer;
begin
if Length(Colors) = 0 then Exit;
Result := True;
LTIA := Length(Colors) - 1;
for i := 0 to LTIA do
if not FindColorsTolerance(ResultTPA[i], Colors[i], xs, ys, xe, ye, Tol) then
Result := False;
end;
{*******************************************************************************
function FindColorsArraySpiralTolerance(var ResultTPA: T2DPointArray; var Colors: TIntegerArray; xs, ys, xe, ye, Tol: integer): Boolean;
By: lordsaturn
Description: Same as FindColorsArrayTolerance, but uses spiral technique.
*******************************************************************************}
function FindColorsArraySpiralTolerance(var ResultTPA: T2DPointArray; var Colors: TIntegerArray; xs, ys, xe, ye, Tol: integer): Boolean;
var
i, LTIA: integer;
MP: TPoint;
begin
if Length(Colors) = 0 then Exit;
Result := True;
LTIA := Length(Colors) - 1;
MP := MidPoint(xs, ys, xe, ye);
for i := 0 to LTIA do
begin
FindColorsSpiralTolerance(MP.x, MP.y, ResultTPA[i], Colors[i], xs, ys, xe, ye, Tol);
if Length(ResultTPA[i]) = 0 then
Result := False;
end;
end;
[/INDENT]
GameTab.scar[INDENT]
{*******************************************************************************
function CheckQuest(Quest: string): Boolean;
By: lordsaturn
Description: Will return true if the quest 'Quest' is completed, and perform the
action declared in 'Action'.
*******************************************************************************}
function CheckQuest(Quest: string; Action: fnct_ActionOptions): Boolean;
var
arS: TStringArray;
arI: TIntegerArray;
x, y, fx, fy, i, c, fColor, WT, L: Integer;
UltiBool: Boolean;
begin
arS := TrimString(Quest);
L := Length(arS) - 1;
for i := 0 to L do
begin
if arS[i] = 'i' then arS[i] := 'II';
if arS[i] = 'okt' then arS[i] := 'ok';
end;
arI := [65280, 65535, 255];
GameTab(3);
while not UltiBool do
begin
c := c + 1;
if c = 2 then
if GetColor(728, 245) <> 1316634 then
Mouse(728, 250, 4, 4, True);
if c = 3 then
begin
MMouse(728, 446, 5, 5);
GetMousePos(x, y);
HoldMouse(x, y, True);
end;
if GetColor(728, 419) = 1316634 then
begin
Writeln('We could not find the quest name.');
Result := False;
Exit;
end;
for i := 0 to 2 do
begin
UltiBool := FindTextArrayTPAEx(arI[i], 0, 547, 227, 720, 454, fx, fy, arS, StatChars, 140, 13);
if UltiBool then
begin
arI[i] := fColor;
Break;
end;
end;
end;
if UltiBool then
begin
if c > 2 then
begin
WT := 100+Random(700);
Wait(WT); //for randomization
ReleaseMouse(x, y, True);
end;
if fColor = arI[0] then
Result := True;
if Action = Nothing then Exit;
if WT > 0 then fy := fy - (WT/5) - 11;
MMouse(fx, fy, 4, 4);
if not FindTextArrayTPA(16777215, 0, 547, 227, 720, 454, arS, StatChars) then
begin
for i := 0 to 2 do
if FindTextArrayTPAEx(arI[i], 0, 547, 227, 720, 454, fx, fy, arS, StatChars, 140, 13) then
Break;
if i = 3 then Exit;
MMouse(fx, fy, 4, 4);
end;
if Action = Move then Exit;
GetMousePos(fx, fy);
case Action of
ClickLeft: Mouse(fx, fy, 0, 0, True);
ClickRight: begin
Mouse(fx, fy, 0, 0, False);
ChooseOption('ead');
end;
end;
MouseBox(455, 66, 474, 84, 1);
//CloseWindows;
end;
end;
{*******************************************************************************
function GetQP: Integer;
By: lordsaturn
Description: Will return number of quest points.
*******************************************************************************}
function GetQP: Integer;
var
x, y: integer;
s: string;
begin
if GetCurrentTab <> 3 then GameTab(3);
if FindColor(x, y, 2070763, 650, 205, 712, 226) then
begin
s := Trim(GetTextAtEx(x - 2, y - 2, 5, SmallChars, False, False, 0, 1, 2070763, 3, False, tr_AllChars));
try
Result := StrToInt(s);
except
if Pos('g', Lowercase(s)) <> 0 then
begin
s := Uppercase(ReplaceRegex(Lowercase(s), 'g', '6'));
try
Result := StrToInt(s);
except
writeln('GetQP failed and got: '+s);
end;
end;
end;
end;
end;
[/INDENT]
MapWalk.scar[INDENT]
{*******************************************************************************
function GetWalls: TPointArray;
By: lordsaturn
Description: Will return all the white-colored walls on the minimap in a TPA.
Could be used for perfect map aligning projects.
*******************************************************************************}
function GetWalls: TPointArray;
var
CTS, Hi, i, x, y, c, j: integer;
P, Playerses: TPointArray;
begin
if not LoggedIn then Exit;
CTS := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
SetColorspeed2Modifiers(15.75, 5.27); // 15462126
FindColorsSpiralTolerance(MMCX, MMCY, P, 15593449, MMX1, MMY1, MMX2, MMY2, 7);
SetColorspeed2Modifiers(0.2, 0.2);
ColorToleranceSpeed(1);
FindColorsTolerance(Playerses, 16711422, MMX1, MMY1, MMX2, MMY2, 19);
ColorToleranceSpeed(2);
P := RemoveDistTPointArray(MMCX, MMCY, 76, P, True);
P := ClearTPAFromTPA(P, Playerses);
Hi := High(P);
for j := 0 to 2 do
for i := 0 to Hi do
begin
x := P[i].x;
y := P[i].y;
c := GetColor(x-1, y);
if ((GetColor(x-2, y) = c) and (GetColor(x-1, y-1) = c) and
(GetColor(x-2, y-1) = c) and (GetColor(x, y+2) = 65536)) or
((c = 65536) and ((GetColor(x, y+1) = c) or (GetColor(x+2, y) = c))) or
(GetColor(x, y+1) = 12961221) or (GetColor(x, y+1) = 13816530) then
begin
P := RemoveDistTPointArray(x, y, 2, P, False);
Hi := High(P);
end;
end;
Result := P;
end;
[/INDENT]
Math.scar[INDENT]
{*******************************************************************************
function MidPoint(x1, y1, x2, y2: integer): TPoint;
By: lordsaturn
Description: Will return the midpoint of two points as a TPoint.
*******************************************************************************}
function MidPoint(x1, y1, x2, y2: integer): TPoint;
var
mx, my: integer;
mmx, mmy: extended;
P: TPoint;
begin
mx := x1 + x2;
my := y1 + y2;
mmx := mx / 2;
mmy := my / 2;
P := Point(Round(mmx), Round(mmy));
Result := P;
end;
Same as:
MiddleTPA([inttopoint(x1, y1), inttopoint(x2, y2)]);
[/INDENT]
Text.scar[INDENT]
{*******************************************************************************
function FindTextArrayTPAEx(Color, Tol, xs, ys, xe, ye: integer; var x, y :integer; TextArray: TStringArray; Chars, MaxDist: integer; Action: fnct_ActionOptions; var Bools: array of Boolean): Boolean;
By: lordsaturn
Description: Like FindTextTPAEx, but finds an array of text, declared by
'TextArray'. Returns true if all instances of the TextArray are found within box
defined by distance boundaires 'w' and 'h'.
*******************************************************************************}
function FindTextArrayTPAEx(Color, Tol, x1, y1, x2, y2: integer; var x, y :integer; TextArray: TStringArray; Chars, w, h: integer): Boolean;
var
TextTPA, SearchTPA, tmpMatches: TPointArray;
SearchT2D: T2DPointArray;
i, j, Height, LATPA, LTSA: integer;
foundInDist: Boolean;
begin
if not FindColorsTolerance(SearchTPA, Color, x1, y1, x2, y2, Tol) then Exit;
SearchT2D := TPAtoATPAEx(SearchTPA, w, h);
LATPA := High(SearchT2D);
LTSA := Length(TextArray) - 1;
for i := 0 to LATPA do
begin
for j := 0 to LTSA do
begin
TextTPA := LoadTextTPA(TextArray[j], Chars, Height);
foundInDist := FindTextTPAinTPA(Height, TextTPA, SearchT2D[i], tmpMatches);
if not foundInDist then Break;
end;
if foundInDist then Break;
end;
if foundInDist then
begin
Result := True;
MiddleTPAEx(SearchT2D[i], x, y);
end;
end;
{*******************************************************************************
FindTextArrayTPA(Color, Tol, xs, ys, xe, ye: integer; TextArray: TStringArray; Chars: integer): Boolean;
By: lordsaturn
Description: Like FindTextArrayTPAEx, but has no distance restriction, and will
only return a boolean statement.
*******************************************************************************}
function FindTextArrayTPA(Color, Tol, xs, ys, xe, ye: integer; TextArray: TStringArray; Chars: integer): Boolean;
var
cx, cy: integer;
begin
Result := FindTextArrayTPAEx(Color, Tol, xs, ys, xe, ye, cx, cy, TextArray, Chars, xe-xs, ye-ys);
end;
{*******************************************************************************
function TrimString(TString: string): TStringArray;
By: lordsaturn
Description: Trims a string into an array of short 3-character strings.
Used in CheckQuest, ChooseOptionText.
*******************************************************************************}
function TrimString(TString: string): TStringArray;
var
i, P, L: integer;
S, S2: string;
arS: TStringArray;
begin
S := Trim(TString);
S := Lowercase(S);
S := Replace(S, '''', ' ');
S := Replace(S, '-', ' ');
arS := strToStrArray(S);
L := Length(arS) - 1;
for i := 0 to L do
begin
arS[i] := Trim(arS[i]);
if Pos('.', arS[i]) <> 0 then
Delete(arS[i], P, Length(arS[i])-P+1);
arS[i] := Replace(arS[i], '&', '');
if (Length(arS[i]) = 1) then arS[i] := '';
if (not(arS[i] = 'of')) and
(not(arS[i] = 'to')) then
arS[i] := Trim(Copy(arS[i], 2, 3));
if arS[i] <> '' then
S2 := S2+' '+arS[i]; //rebuilding the TSA to remove blank indexes
end;
S2 := Trim(S2);
Result := strToStrArray(S2);
end;
{*******************************************************************************
function ChooseOptionTPA(Option: string): Boolean;
By: lordsaturn
Description: Chooses an option using TPAs. Returns true if found. Use full text
string for best results. Ex: ChooseOptionTPA('Talk-to Sir Vant');
ChooseOptionTPA('Chop down Oak');
*******************************************************************************}
function ChooseOptionTPA(Option: string): Boolean;
var
x, y, i, c: Integer;
TPA: TPointArray;
P: TPoint;
B: TBox;
s: TStringArray;
begin
GetClientDimensions(B.X2, B.Y2);
B.X1 := 0;
B.Y1 := 0;
FindColorsTolerance(TPA, 4674653, B.X1, B.Y1, B.X2, B.Y2, 0);
If Length(TPA) < 10 Then
Exit;
B.X2 := 0;
B.Y2 := 0;
P := TPA[0];
For I := 0 To High(TPA) - 1 Do
If TPA[i].X = TPA[I+1].X - 1 Then
Begin
If C > 5 Then
Begin
B.X1 := P.X;
B.Y1 := P.Y;
Break;
End Else
C := C + 1;
End
Else
Begin
P := TPA[I + 1];
C := 0;
End;
If I = Length(TPA) Then
Begin
WriteLn('Choose Option Menu Getting Failed');
Exit;
End;
InvertTPA(TPA);
C := 0;
P := TPA[0];
For I := 0 To High(TPA) - 1 Do
If TPA[i].X = TPA[I+1].X + 1 Then
Begin
If C > 5 Then
Begin
B.X2 := P.X;
B.Y2 := P.Y;
Break;
End Else
C := C + 1;
End Else
Begin
P := TPA[I + 1];
C := 0;
End;
If I = Length(TPA) Then
Begin
WriteLn('Choose Option Menu Getting Failed');
Exit;
End;
s := TrimString(Option);
Result := FindTextArrayTPAEx(16777215, 255, B.x1, B.y1, B.x2, B.y2, x, y, s, UpChars, B.x2-B.x1, 14);
if Result then
if (x <> 0) and (y <> 0) then
begin
Mouse(x, y, (Length(Option)*5)/2, 3, True);
Exit;
end;
Result := ChooseOptionMulti(s);
end;
Useless, but works:
{*******************************************************************************
function LoadTextArrayTPA(TextArray: TStringArray; chars: integer; var Height: TIntegerArray): T2DPointArray;
By: lordsaturn
Description: Loads TPAs of the TStringArray 'TextArray'. Returns the TPAs in a
T2DPointArray corresponding to the indexes of TextArray. Also returns the
TIntegerArray 'Height' with indexes corresponding to TextArray.
*******************************************************************************}
function LoadTextArrayTPA(TextArray: TStringArray; chars: integer; var Height: TIntegerArray): T2DPointArray;
var
DC: HDC;
CTS, w, h, BMP, i: Integer;
begin;
if Length(TextArray) = 0 then Exit;
DC := GetClientCanvas.Handle;
CaptureCTS(CTS);
ColorToleranceSpeed(0);
for i := 0 to Length(TextArray) - 1 do
begin
BMP := CreateBitmapMaskFromText(TextArray[i], Chars);
GetBitmapSize(BMP, W, H);
SetTargetDc(GetBitmapDc(BMP));
FindColorsTolerance(Result[i], clwhite, 0, 0, w+1, h+1, 0);
Height[i] := h - 1;
FreeBitmap(BMP);
end;
SetTargetDC(DC);
RestoreCTS(CTS);
end;
[/INDENT]