Delphi [Delphi] DH Auto Clicker 0.6

[Doddy]

Un programa en Delphi para usar un clicker automatico para juegos o lo que sea.

Opciones :

[+] Capturar posicion del mouse para usar en el programa

[+] Timeout para cada click

[+] Teclas de acceso rapido para empezar y terminar el clicker

[+] Clicks en posiciones aleatorias

[+] Los Clicks que permite son izquierda,medio,derecha y doble click

Una imagen :

El codigo :

>
// DH Auto Clicker 0.6
// (C) Doddy Hackman 2016

unit auto_clicker;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
 System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
 Vcl.ComCtrls, Math, Vcl.ImgList, Vcl.Imaging.pngimage;

type
 TFormHome = class(TForm)
   logo: TImage;
   gbMousePosition: TGroupBox;
   lblXPosition: TLabel;
   txt_X_Now: TEdit;
   lblYPosition: TLabel;
   txt_Y_Now: TEdit;
   gbOptions: TGroupBox;
   lblType: TLabel;
   cmbType: TComboBox;
   lblSleep: TLabel;
   txtSleep: TEdit;
   lblXSelect: TLabel;
   txt_X_Select: TEdit;
   lblYSelect: TLabel;
   txt_Y_Select: TEdit;
   lblSeconds: TLabel;
   btnGetPosition: TButton;
   cbUseRandomClicks: TCheckBox;
   btnStart: TButton;
   btnStop: TButton;
   status: TStatusBar;
   tmGetMousePosition: TTimer;
   tmClicker: TTimer;
   notificar: TTrayIcon;
   tmHookKeys: TTimer;
   ilIconos: TImageList;
   procedure tmGetMousePositionTimer(Sender: TObject);
   procedure btnGetPositionClick(Sender: TObject);
   procedure tmClickerTimer(Sender: TObject);
   procedure notificarClick(Sender: TObject);
   procedure tmHookKeysTimer(Sender: TObject);
   procedure btnStartClick(Sender: TObject);
   procedure btnStopClick(Sender: TObject);
 private
   { Private declarations }
 public
   procedure capturar_posicion_mouse();
   procedure iniciar_clicker();
   procedure desactivar_clicker();
 end;

var
 FormHome: TFormHome;

implementation

{$R *.dfm}

function message_box(title, message_text, type_message: string): string;
begin
 if not(title = '') and not(message_text = '') and not(type_message = '') then
 begin
   try
     begin
       if (type_message = 'Information') then
       begin
         MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
           MB_ICONINFORMATION);
       end
       else if (type_message = 'Warning') then
       begin
         MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
           MB_ICONWARNING);
       end
       else if (type_message = 'Question') then
       begin
         MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
           MB_ICONQUESTION);
       end
       else if (type_message = 'Error') then
       begin
         MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
           MB_ICONERROR);
       end
       else
       begin
         MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
           MB_ICONINFORMATION);
       end;
       Result := '[+] MessageBox : OK';
     end;
   except
     begin
       Result := '[-] Error';
     end;
   end;
 end
 else
 begin
   Result := '[-] Error';
 end;
end;

procedure mouse_click(option: string);
// Function based in : [url]http://www.swissdelphicenter.ch/torry/showcode.php?id=360[/url]
// Thanks to Thomas Stutz
begin
 if (option = 'left') then
 begin
   mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
   mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
 end
 else if (option = 'right') then
 begin
   mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0);
   mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0);
 end
 else if (option = 'middle') then
 begin
   mouse_event(MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0);
   mouse_event(MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0);
 end
 else if (option = 'double') then
 begin
   mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
   mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
   GetDoubleClickTime;
   mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
   mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
 end
 else
 begin
   mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
   mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
 end;
end;

procedure TFormHome.iniciar_clicker();
begin
 if (cmbType.ItemIndex <> -1) and not(txt_X_Select.Text = '') and
   not(txt_Y_Select.Text = '') and not(txtSleep.Text = '') then
 begin
   tmClicker.Interval := StrToInt(txtSleep.Text) * 1000;
   tmClicker.Enabled := True;
   status.Panels[0].Text := '[+] Working ...';
   FormHome.Update;
   notificar.BalloonTitle := 'DH Auto Clicker';
   notificar.BalloonHint := 'Clicker Started';
   notificar.ShowBalloonHint;
 end
 else
 begin
   message_box('DH Auto Clicker 0.6', 'Complete the options', 'Warning');
 end;
end;

procedure TFormHome.desactivar_clicker();
begin
 tmClicker.Enabled := False;
 status.Panels[0].Text := '[+] Stopped';
 FormHome.Update;
 notificar.BalloonTitle := 'DH Auto Clicker';
 notificar.BalloonHint := 'Clicker Stopped';
 notificar.ShowBalloonHint;
end;

procedure TFormHome.btnStartClick(Sender: TObject);
begin
 iniciar_clicker();
end;

procedure TFormHome.btnStopClick(Sender: TObject);
begin
 desactivar_clicker();
end;

procedure TFormHome.capturar_posicion_mouse();
begin
 txt_X_Select.Text := txt_X_Now.Text;
 txt_Y_Select.Text := txt_Y_Now.Text;
 status.Panels[0].Text := '[+] Position updated';
 FormHome.Update;
 notificar.BalloonTitle := 'DH Auto Clicker';
 notificar.BalloonHint := 'Position updated';
 notificar.ShowBalloonHint;
end;

procedure TFormHome.notificarClick(Sender: TObject);
begin
 Show();
 WindowState := wsNormal;
 Application.BringToFront();
end;

procedure TFormHome.btnGetPositionClick(Sender: TObject);
begin
 capturar_posicion_mouse();
end;

procedure TFormHome.tmGetMousePositionTimer(Sender: TObject);
var
 ubicacion: tPoint;
begin
 ubicacion := Mouse.CursorPos;
 txt_X_Now.Text := IntToStr(ubicacion.X);
 txt_Y_Now.Text := IntToStr(ubicacion.Y);
end;

procedure TFormHome.tmHookKeysTimer(Sender: TObject);
var
 i: integer;
 re: Longint;
begin
 for i := 119 to 124 do
 begin
   re := GetAsyncKeyState(i);
   If re = -32767 then
   Begin
     if (i = 120) then
     begin
       capturar_posicion_mouse();
     end
     else if (i = 122) then
     begin
       iniciar_clicker();
     end
     else if (i = 123) then
     begin
       desactivar_clicker();
     end
     else
     begin
       // ?
     end;
   End;
 End;
end;

procedure TFormHome.tmClickerTimer(Sender: TObject);
var
 tipo: integer;
 nombre_tipo: string;
 X: integer;
 Y: integer;
 time_sleep: integer;
begin

 tipo := cmbType.ItemIndex;
 nombre_tipo := '';

 if (tipo = 0) then
 begin
   nombre_tipo := 'left';
 end
 else if (tipo = 1) then
 begin
   nombre_tipo := 'middle';
 end
 else if (tipo = 2) then
 begin
   nombre_tipo := 'right';
 end
 else if (tipo = 3) then
 begin
   nombre_tipo := 'double';
 end
 else
 begin
   nombre_tipo := 'left';
 end;

 X := 0;
 Y := 0;

 if (cbUseRandomClicks.Checked) then
 begin
   X := RandomRange(1, 2000);
   Y := RandomRange(1, 1000);
 end
 else
 begin
   X := StrToInt(txt_X_Select.Text);
   Y := StrToInt(txt_Y_Select.Text);
 end;

 time_sleep := StrToInt(txtSleep.Text) * 1000;

 SetCursorPos(X, Y);

 mouse_click(nombre_tipo);

end;

end.

// The End ?

Si quieren bajar el programa y el proyecto con el codigo fuente lo pueden hacer desde aca :

[HIDE-THANKS]

This link is hidden for visitors. Please Log in or register now.

.[/HIDE-THANKS]

Eso seria todo.