unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, pngimage, XPMan, xmldom, XMLIntf, msxmldom,
XMLDoc,shellapi;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
Image1: TImage;
Label2: TLabel;
Label3: TLabel;
XPManifest1: TXPManifest;
Label4: TLabel;
Edit1: TEdit;
Label6: TLabel;
Label7: TLabel;
Image2: TImage;
Image3: TImage;
Button4: TButton;
Button5: TButton;
CheckBox1: TCheckBox;
Label8: TLabel;
XMLDocument1: TXMLDocument;
procedure Button1Click(Sender: TObject);
procedure Image1EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure Button1MouseEnter(Sender: TObject);
procedure Button2MouseEnter(Sender: TObject);
procedure Button4MouseEnter(Sender: TObject);
procedure Button5MouseEnter(Sender: TObject);
procedure Image2MouseEnter(Sender: TObject);
procedure Image2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button5Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure Image1Click(Sender: TObject);
procedure Image3Click(Sender: TObject);
procedure Label1Click(Sender: TObject);
procedure Label2Click(Sender: TObject);
procedure Label3Click(Sender: TObject);
procedure Label6Click(Sender: TObject);
procedure Label7Click(Sender: TObject);
procedure Label8Click(Sender: TObject);
private
{ Private declarations }
public
procedure clik(xm,ym:integer);
Procedure workbot;
procedure minimap_click;
Function minimap_fly:boolean;
function GetColorXY(Graphic: TGraphic; var X, Y: Integer): Boolean;
procedure region_search;
var minimap,zoneregion:trect;
end;

var
Form1: TForm1;
Hwnd_window:THandle;
stop:boolean;
HwndRect:Trect;
startpoint:tpoint;
minimap_dc:hdc;
M_Canvas:TCanvas;
region_bmp:tbitmap;
sl:integer;
colorsrgb_res:array of cardinal;





implementation

uses Unit2, Unit3;

{$R *.dfm}

function TForm1.GetColorXY(Graphic: TGraphic; var X, Y: Integer): Boolean;
var
Bmp: TBitmap;
i, j: Integer;
Pixel: Cardinal;
Scan: Pointer;
R, G, B: Byte;
ic:integer;
x1,x2,x3,x4,y1,y2,y3,y4:integer;
l1,l2,l3,l4,l:integer;
cx,cy:integer;
begin
Result:=false;
Bmp:=TBitmap.Create;
x1:=-1; y1:=-1;
x2:=-1; y2:=-1;
x3:=-1; y3:=-1;
x4:=-1; y4:=-1;
try
Bmp.Assign(Graphic);
Bmp.PixelFormat:=pf24bit;
cx:=bmp.Width div 2;
cy:=bmp.Height div 2;

for ic := low(colorsrgb_res) to high(colorsrgb_res) do begin
if result then break;

for i:=cy downto 0 do begin
Scan:=Bmp.ScanLine[i];

for j:=cx downto 0 do begin
Pixel:=PCardinal(Integer(Scan) + j*3)^;
R:=GetBValue(Pixel);
G:=GetGValue(Pixel);
B:=GetRValue(Pixel);
if RGB(R, G, B) = colorsrgb_res[ic] then begin
X1:=j + 1;
Y1:=i + 1;
break;
end;
end;

for j:=cx+1 to Bmp.Width - 1 do begin
Pixel:=PCardinal(Integer(Scan) + j*3)^;
R:=GetBValue(Pixel);
G:=GetGValue(Pixel);
B:=GetRValue(Pixel);
if RGB(R, G, B) = colorsrgb_res[ic] then begin
X2:=j + 1;
Y2:=i + 1;
break;
end;
end;

end;


for i:=cy+1 to Bmp.Height - 1 do begin
Scan:=Bmp.ScanLine[i];
for j:=cx downto 0 do begin
Pixel:=PCardinal(Integer(Scan) + j*3)^;
R:=GetBValue(Pixel);
G:=GetGValue(Pixel);
B:=GetRValue(Pixel);
if RGB(R, G, B) = colorsrgb_res[ic] then begin
X3:=j + 1;
Y3:=i + 1;
break;
end;
end;

for j:=cx+1 to Bmp.Width - 1 do begin
Pixel:=PCardinal(Integer(Scan) + j*3)^;
R:=GetBValue(Pixel);
G:=GetGValue(Pixel);
B:=GetRValue(Pixel);
if RGB(R, G, B) = colorsrgb_res[ic] then begin
X4:=j + 1;
Y4:=i + 1;
break;
end;
end;
end;


l1:=-1;l2:=-1;l3:=-1;l4:=-1;

if x1>=0 then l1:=cx-x1+cy-y1;
if x2>=0 then l2:=x2-cx+cy-y2;
if x3>=0 then l3:=cx-x3+y3-cy;
if x4>=0 then l4:=x4-cx+y4-cy;

if not result then begin
if l1>=0 then begin
l:=1;
if (l1>l2) and (l2>=0) and (l=1) then l:=2;
if (l1>l3) and (l3>=0) and (l=1) then l:=3;
if (l1>l4) and (l4>=0) and (l=1) then l:=4;
if l=1 then begin
result:=true;
X:=x1;
Y:=y1;
end;
end;
end;

if not result then begin
if l2>=0 then begin
l:=2;
if (l2>l1) and (l1>=0) and (l=2) then l:=1;
if (l2>l3) and (l3>=0) and (l=2) then l:=3;
if (l2>l4) and (l4>=0) and (l=2) then l:=4;
if l=2 then begin
result:=true;
X:=x2;
Y:=y2;
end;
end;
end;

if not result then begin
if l3>=0 then begin
l:=3;
if (l3>l1) and (l1>=0) and (l=3) then l:=1;
if (l3>l2) and (l2>=0) and (l=3) then l:=2;
if (l3>l4) and (l4>=0) and (l=3) then l:=4;
if l=3 then begin
result:=true;
X:=x3;
Y:=y3;
end;
end;
end;

if not result then begin
if l4>=0 then begin
l:=4;
if (l4>l1) and (l1>=0) and (l=4) then l:=1;
if (l4>l2) and (l2>=0) and (l=4) then l:=2;
if (l4>l3) and (l3>=0) and (l=4) then l:=3;
if l=4 then begin
result:=true;
X:=x4;
Y:=y4;
end;
end;
end;

end;
finally
Bmp.Free;
end;
end;

procedure TForm1.clik(xm,ym:integer);
var
Lparams: Lparam;
begin
LPARAMs:=makelparam(xm,ym);
postmessage(Hwnd_window,WM_LBUTTONDOWN,MK_LBUTTON,LPARAMs);
sleep(10);
postmessage(Hwnd_window,WM_LBUTTONUP,0,LPARAMs);
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in ['0'..'9',#8]) then key:=#0;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
M_Canvas.Free;
region_bmp.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
fn:string;
begin
region_bmp:=TBitmap.Create;
M_Canvas:=TCanvas.Create;
fn:=extractFilePath(application.ExeName)+'color_db.xml';
if not fileexists(fn) then begin
messagedlg('Файл color_db.xml не найден!',MtError,[MbOk],0);
Application.Terminate;
end else begin
XMLDocument1.XML.LoadFromFile(fn);
XMLDocument1.Active:=true;
i:=XMLDocument1.DocumentElement.ChildNodes['resources'].ChildNodes.Count-1;
setlength(colorsrgb_res,i+1);
for i := low(colorsrgb_res) to high(colorsrgb_res) do
colorsrgb_res[i]:=colortorgb(XMLDocument1.DocumentElement.ChildNodes['resources'].ChildNodes[i].NodeValue);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
borderzone:integer;
begin
Form2.ClientHeight:=150;
Form2.ClientWidth:=250;
Form2.Left:=100;
form2.Top:=100;
form2.showmodal;
borderzone:=(form2.Width - form2.ClientWidth-4) div 2;
minimap.Left:=form2.Left+borderzone-hwndrect.Left;
minimap.Top:=form2.Top+form2.Height-borderzone-form2.ClientHeight-hwndrect.top;
minimap.Right:=minimap.Left+form2.ClientWidth;
minimap.Bottom:=minimap.Top+form2.ClientHeight;
M_Canvas.Handle:=minimap_DC;
Zoneregion.Left:=0;
Zoneregion.Top:=0;
Zoneregion.Right:=hwndrect.Right-hwndrect.Left;
Zoneregion.bottom:=hwndrect.bottom-hwndrect.top;
region_Bmp.Width:=Zoneregion.Right-Zoneregion.Left;
region_Bmp.Height:=Zoneregion.bottom-Zoneregion.top;
Button3.Enabled:=true
end;

procedure TForm1.Button1MouseEnter(Sender: TObject);
begin
label6.Caption:='Подсказка: определение положения окна миникарты.'+#10+
'Не делайте окно полностью по периметру миникарты,'+#10+
'что бы не было случаев залетания корабля в зону р.а.';

end;

procedure TForm1.Button2Click(Sender: TObject);
var
borderzone:integer;
begin
Form2.ClientHeight:=480;
Form2.ClientWidth:=640;
Form2.Left:=100;
form2.Top:=100;
Form2.ShowModal;
borderzone:=(form2.Width - form2.ClientWidth-4) div 2;
Zoneregion.Left:=form2.Left+borderzone-hwndrect.Left;
Zoneregion.Top:=form2.Top+form2.Height-borderzone-form2.ClientHeight-hwndrect.top;
Zoneregion.Right:=Zoneregion.Left+form2.ClientWidth;
Zoneregion.Bottom:=Zoneregion.Top+form2.ClientHeight;
region_Bmp.Width:=Zoneregion.Right-Zoneregion.Left;
region_Bmp.Height:=Zoneregion.bottom-Zoneregion.top;
end;

procedure TForm1.Button2MouseEnter(Sender: TObject);
begin
label6.Caption:='Подсказка: Если не указывать, то будет использо-'+#10+
'ваться вся область игрового экрана.';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if tag=0 then begin
tag:=1;
Button3.Caption:='Остановить сбор';
Stop:=false;
startpoint.X:=-10;
startpoint.Y:=10;
sl:=strtoint(edit1.text);
workbot;
end else begin
tag:=0;
Button3.Caption:='Запуск сборщика';
Stop:=true;
end;
end;

procedure TForm1.Button4MouseEnter(Sender: TObject);
begin

label6.Caption:='Подсказка: Указать зону безопасности на миникарте.'+#10+
'Область для убегания от мобов.';
end;

procedure TForm1.Button5MouseEnter(Sender: TObject);
begin
label6.Caption:='Подсказка: при недостаточном уровне энергии,'+#10+
'будет убегать в зону безопасности. Обязательно шкала.';
end;

procedure TForm1.Image1EndDrag(Sender, Target: TObject; X, Y: Integer);
var
hWnd: THandle;
begin
hWnd := WindowFromPoint(Point(x,y));
Hwnd_window:=hWnd;
Label3.Caption :=IntToStr(hWnd);
GetWindowRect(hwnd,HwndRect);
minimap_dc:=GetDC(Hwnd_window);
Button1.Enabled:=true;
Button2.Enabled:=true;
Button4.Enabled:=true;
Button5.Enabled:=true;
end;

procedure TForm1.Image2Click(Sender: TObject);
var
fn:string;
begin
fn:=extractfilepath(application.ExeName)+'color_db_editor.exe';
if fileexists(fn) then ShellExecute(Handle, nil, PChar(fn), nil, nil, SW_SHOW) else
messagedlg('Редактор не найден в директории программы!',mterror,[mbOk],0);


end;

procedure TForm1.Image2MouseEnter(Sender: TObject);
begin
label6.Caption:='Подсказка: Запуск редактора цветовой базы,'+#10+
'для настройки обьектов сбора и врагов.';
end;

procedure TForm1.minimap_click;
var
a:integer;
begin
a:=startpoint.X;
startpoint.X:=random(minimap.Right-minimap.Left-2);
startpoint.Y:=random(minimap.bottom-minimap.top);
clik(startpoint.X+minimap.Left,startpoint.Y+minimap.top);
if a>=0 then sleep(1500);
end;

function TForm1.minimap_fly: boolean;
var
col:tcolor;
begin
result:=false;
if startpoint.X<0 then result:=true else begin
col:=getpixel(minimap_dc,startpoint.X+2+minimap.Left,startpoint.Y+minimap.top);
if (col<>0) then result:=true;
end;
end;

procedure TForm1.region_search;
var
xc,yc:integer;
begin
region_Bmp.Canvas.Copyrect(Rect(0,0, region_Bmp.Width,region_Bmp.Height),
m_Canvas, Zoneregion);
if GetColorXY(region_Bmp,xc,yc) then begin
clik(xc+Zoneregion.Left,yc+Zoneregion.Top);
startpoint.X:=-10;
sleep(sl);
end else begin
if minimap_fly then minimap_click;
end;
end;

procedure TForm1.workbot;
begin
randomize;
//form3.show;
repeat
application.ProcessMessages;
sleep(100);
region_search;
until stop;
//form3.close;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin

end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin

end;

procedure TForm1.Edit1Change(Sender: TObject);
begin

end;

procedure TForm1.Image1Click(Sender: TObject);
begin

end;

procedure TForm1.Image3Click(Sender: TObject);
begin

end;

procedure TForm1.Label1Click(Sender: TObject);
begin

end;

procedure TForm1.Label2Click(Sender: TObject);
begin

end;

procedure TForm1.Label3Click(Sender: TObject);
begin

end;

procedure TForm1.Label6Click(Sender: TObject);
begin

end;

procedure TForm1.Label7Click(Sender: TObject);
begin

end;

procedure TForm1.Label8Click(Sender: TObject);
begin

end;

end.