Composant tdbpmouser : jouez avec la souris !!

0/5 (1 avis)

Vue 6 413 fois - Téléchargée 470 fois

Description

dbpMouser permet de :
- faire trembler la souris (force et intervalle modifiable)
- bloker la souris a un point precis (x, y)(a améliorer...)
- faire scroller la souris sur l'écran, c'est a dire que la souris n'est plus bloquée par les bords de l'écran
mais passe de droite a gauche, de haut en bas etc
- bloker la souris sur un composant ou sur la fenetre
- faire suivre un composant visuel derriere la souris
- placer directement la souris automatiquement sur un compo. visuel
- faire deplacer la souris (pas a pas) vers un point precis (x, y), ou sur un compo. visuel
- modifier le curseur de la souris (hors ressources)
- simuler des clics ou mouvement de souris, molette (mouvements molette non simulés)
- "ajoute" les evènements : OnMouseEnter et OnMouseLeave pour TOUS les composants ne les possédant pas !!!
ex : TImage; TCheckBox, TButton, TEdit, TListbox, TComboBox etc :)))))

dbpMouser contient le code du composant ClipMouseReg (o. KillGuss : killguss@web.de)
et aussi deux fonctions du compo. JvMousePositionner

Source / Exemple :


{
################################################################################
# DBPMOUSER                                                                    #
################################################################################
#                                                                              #
# VERSION       : 1.5                                                          #
# FICHIERS      : dbpMouser.pas,.dcu,.dcr,.bmp,ReadMe.htm                      #
# AUTEUR        : Julio P. (Diabloporc)                                        #
# CREATION      : 20 jul 2004                                                  #
# MODIFIEE      : 27 jul 2004                                                  #
# SITE WEB      : http://diabloporc.free.fr                                    #
# MAIL          : diabloporc@laposte.net                                       #
# LEGAL         : Free sous Licence GNU/GPL                                    #
# INFOS         : Retrouvez moi sur www.delphifr.com : "JulioDelphi"           #
#                                                                              #
################################################################################ 
}
unit dbpMouser;

interface

uses
  Messages, Windows, SysUtils, Classes, Graphics, StdCtrls, Controls, ComCtrls, ExtCtrls, Forms;

type
  TPositiontype = (mpLeftCenter, mpRightCenter, mpCenter, mpTopCenter, mpBottomCenter,
                   mpLeftTop, mpLeftBottom, mpRightTop, mpRightBottom);
  TAreaType     = (caWindow, caComponent, caComponentPosOnly);

  TdbpInterval  = 1..10000;
  TdbpForce     = 1..100;
  TdbpMouser    = class(TComponent)
  private
    // clipmousereg
    FOnGetFocus,
    FOnLostFocus : TNotifyEvent;
    FPos         : TPositionType;
    FArea        : TAreaType;
    FActive,
    FWasActive   : Boolean;
    //dbpMouser
    FControl:    TControl;
    FAbout:      string;
    FFollow,
    FBloker,
    FScroller,
    FShakeIt:    boolean;
    FForce:      TdbpForce;
    FInterval:   TdbpInterval;
    FTimerFollow,
    FTimerBloker,
    FTimerScroller,
    FTimerShake,
    FTimerScreen,
    FTimerSimulMouse: TTimer;
    blokX, blokY, FWidth, FHeight: Word;
    FCursor: TCursor;
    FForm: TCustomForm;
    FOnScroll, FOnShake, FOnMouseEnter, FOnMouseLeave: TNotifyEvent;

    procedure SetActive(Value: Boolean); //clipmousereg
    procedure SetScroller(value: boolean);
    procedure SetShakeIt(value: boolean);
    procedure SetBloker(value: boolean);
    procedure SetFollow(value: boolean);
    procedure SetForce(value: TdbpForce);
    procedure SetInterval(value: TdbpInterval);
    procedure SetCursor(value: TCursor);

    procedure ActTimerShake(Sender: TObject);
    procedure ActTimerScroller(Sender: TObject);
    procedure ActTimerScreen(Sender: TObject);
    procedure ActTimerBloker(sender: TObject);
    procedure ActTimerFollow(sender: TObject);
    procedure ActTimerSimulMouse(sender: TObject);

    function GetAbout: string;
  protected
    //clipmousereg
    procedure Loaded; override;
    procedure lostFocus(Sender: TObject);
    procedure getFocus(Sender: TObject);
    //dbpmouser
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent);                      override;
    destructor  Destroy;                                         override;
    //dbpmouser
    procedure ShakeMe(Force: TdbpForce = 1; Interval: TdbpInterval = 10);  overload;
    procedure StopShakeMe;
    procedure GoToComponent(Steps: Integer = 100; Delay: Integer = 5);
    procedure GoToPoint(Dest: TPoint; Steps: Integer = 100; Delay: Integer = 5); overload;
    procedure GoToPoint(DestX, DestY: Integer; Steps: Integer = 100; Delay: Integer = 5); overload;
    procedure Simuler_ClicGauche;
    procedure Simuler_ClicDroit;
    procedure Simuler_ClicMilieu;
    procedure Simuler_MouvementSouris;
    procedure Simuler_MouvementMolette;
//    procedure Simuler_MoletteHaut;
//    procedure Simuler_MoletteBas;
  published
    property About:         String       read GetAbout    write FAbout;
    //clipmousereg
    property ClipActif:     Boolean       read FActive      write SetActive;
    property ClipPosition:  TPositionType read FPos         write FPos;
    property ClipControlArea:TAreaType    read FArea        write FArea;
    property OnLostFocus:   TNotifyEvent  read FOnLostFocus write FOnLostFocus;
    property OnGetFocus:    TNotifyEvent  read FOnGetFocus  write FOnGetFocus;
    //dbpmouser
    property Control:       TControl     read FControl     write FControl;
    property ClipFollow:    Boolean      read FFollow      write SetFollow;
    property Cursor:        TCursor      read FCursor      write SetCursor;
    property ShakeIt:       Boolean      read FShakeIt     write SetShakeIt;
    property ShakeForce:    TdbpForce    read FForce       write SetForce;
    property ShakeInterval: TdbpInterval read FInterval    write SetInterval;
    property Scroller:      Boolean      read FScroller    write SetScroller;
    property Bloquer:       Boolean      read FBloker      write SetBloker;
    property OnMouseEnter:  TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave:  TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property OnScroll:      TNotiFyEvent read FOnScroll    write FOnScroll;
    property OnShake:       TNotiFyEvent read FOnShake     write FOnShake;
  end;

procedure Register;

{**********************}  implementation {**********************}

procedure TdbpMouser.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FControl) then
    FControl := nil;
end;

function TdbpMouser.GetAbout: string;
begin
 Result := 'v1.5 par Julio P. (Diabloporc)';
end;

constructor TdbpMouser.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 //dbpmouser
 FCursor   := crDefault;
 FForce    := 1;
 FShakeIt  := False;
 FBloker   := False;
 FInterval := 10;
 FWidth    := GetSystemMetrics(SM_CXSCREEN);
 FHeight   := GetSystemMetrics(SM_CYSCREEN);
 FForm     := GetParentForm(TControl(AOwner));

 FTimerShake          := TTimer.Create(self);
 FTimerShake.Interval := FInterval;
 FTimerShake.Enabled  := FShakeIt;
 FTimerShake.OnTimer  := ActTimerShake;

 FTimerScroller          := TTimer.Create(self);
 FTimerScroller.Interval := 1;
 FTimerScroller.Enabled  := false;
 FTimerScroller.OnTimer  := ActTimerScroller;

 FTimerScreen          := TTimer.Create(self);
 FTimerScreen.Interval := 1000;
 FTimerScreen.Enabled  := false;
 FTimerScreen.OnTimer  := ActTimerScreen;

 FTimerBloker          := TTimer.Create(self);
 FTimerBloker.Interval := 1;
 FTimerBloker.Enabled  := false;
 FTimerBloker.OnTimer  := ActTimerBloker;

 FTimerFollow          := TTimer.Create(self);
 FTimerFollow.Interval := 1;
 FTimerFollow.Enabled  := false;
 FTimerFollow.OnTimer  := ActTimerFollow;

 FTimerSimulMouse          := TTimer.Create(self);
 FTimerSimulMouse.Interval := 1;
 FTimerSimulMouse.Enabled  := true;
 FTimerSimulMouse.OnTimer  := ActTimerSimulMouse;

 //clipmousereg
  ClipActif                := False;
  Control                  := nil;
  ClipPosition             := mpCenter;
  FWasActive               := false;
  Application.OnDeactivate := lostFocus;
  Application.OnActivate   := getFocus;
end;

destructor TdbpMouser.destroy;
var
 P: TRect;
begin
  //dbpmouser
  FTimerShake    := nil;
  FTimerScroller := nil;
  FTimerScreen   := nil;
  FTimerBloker   := nil;
  FTimerFollow   := nil;
  //clipmousereg
  SetActive(False);
  P := Rect(0, 0, Screen.Width, Screen.Height);
  ClipCursor(@P);

  inherited Destroy;
end;

procedure TdbpMouser.SetBloker(value: boolean);
begin
 FBloker := Value;
 FTimerBloker.Enabled := value;
 if Value then
  begin
   blokX := mouse.CursorPos.X;
   blokY := mouse.CursorPos.Y;
  end;
end;

procedure TdbpMouser.GoToPoint(Dest: TPoint; Steps, Delay: Integer);
var
  Src, Tmp: TPoint;
  DiffX, DiffY: Real;
begin
  while Steps > 0 do
  begin
    GetCursorPos(Src);
    DiffX := (Dest.X - Src.X) / Steps;
    DiffY := (Dest.Y - Src.Y) / Steps;
    if (Round(DiffX) <> 0) or (Round(DiffY) <> 0) then
    begin
      Tmp.X := Round(Src.X + DiffX);
      Tmp.Y := Round(Src.Y + DiffY);
      SetCursorPos(Tmp.X, Tmp.Y);
      Sleep(Delay);
    end;
    Dec(Steps);
  end;
end;

procedure TdbpMouser.GoToPoint(DestX, DestY: Integer; Steps, Delay: Integer);
var
  Src, Tmp, Dest: TPoint;
  DiffX, DiffY: Real;
begin
  while Steps > 0 do
  begin
   Dest := Point(DestX,DestY);
    GetCursorPos(Src);
    DiffX := (Dest.X - Src.X) / Steps;
    DiffY := (Dest.Y - Src.Y) / Steps;
    if (Round(DiffX) <> 0) or (Round(DiffY) <> 0) then
    begin
      Tmp.X := Round(Src.X + DiffX);
      Tmp.Y := Round(Src.Y + DiffY);
      SetCursorPos(Tmp.X, Tmp.Y);
      Sleep(Delay);
    end;
    Dec(Steps);
  end;
end;

procedure TdbpMouser.GoToComponent(Steps: Integer; Delay: Integer);
var
  Src, Dest, Tmp: TPoint;
  DiffX, DiffY: Real;
begin
  if Assigned(FControl) then
  begin
    while Steps > 0 do
    begin
      GetCursorPos(Src);
      Dest.X := FControl.ClientRect.Left + FControl.ClientWidth div 2;
      Dest.Y := FControl.ClientRect.Top + FControl.ClientHeight div 2;
      Dest := FControl.ClientToScreen(Dest);
      DiffX := (Dest.X - Src.X) / Steps;
      DiffY := (Dest.Y - Src.Y) / Steps;
      Tmp.X := Round(Src.X + DiffX);
      Tmp.Y := Round(Src.Y + DiffY);
      SetCursorPos(Tmp.X, Tmp.Y);
      Sleep(Delay);
      Dec(Steps);
    end;
  end;
end;

procedure TdbpMouser.Simuler_ClicGauche;
begin
 mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
 mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
end;

procedure TdbpMouser.Simuler_ClicDroit;
begin
 mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0);
 mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0);
end;

procedure TdbpMouser.Simuler_ClicMilieu;
begin
 mouse_event(MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0);
 mouse_event(MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0);
end;

procedure TdbpMouser.Simuler_MouvementSouris;
begin
 mouse_event(MOUSEEVENTF_MOVE, 0, 0, 0, 0);
end;

procedure TdbpMouser.Simuler_MouvementMolette;
begin
 mouse_event(MOUSEEVENTF_WHEEL, 0, 0, 0, 0);
end;
{
procedure TdbpMouser.Simuler_MoletteHaut;
begin
 mouse_event(MOUSEEVENTF_WHEELUP, 0, 0, 0, 0);
end;

procedure TdbpMouser.Simuler_MoletteBas;
begin
 mouse_event(MOUSEEVENTF_WHEELDOWN, 0, 0, 0, 0);
end;
}
procedure TdbpMouser.SetShakeIt(value: boolean);
begin
 FShakeIt := value;
 if not (csDesigning in ComponentState) then
  FTimerShake.Enabled := value;
end;

procedure TdbpMouser.SetFollow(value: boolean);
begin
 FFollow := value;
 if not (csDesigning in ComponentState) then
  FTimerFollow.Enabled := value;
end;

procedure TdbpMouser.SetScroller(value: boolean);
begin
 FScroller := value;
 if not (csDesigning in ComponentState) then
  begin
   FTimerScroller.Enabled := value;
   FTimerScreen.Enabled   := value;
  end;
end;

procedure TdbpMouser.SetForce(value: TdbpForce);
begin
 FForce := value;
end;

procedure TdbpMouser.SetInterval(value: TdbpInterval);
begin
 FInterval := value;
 FTimerShake.Interval := value;
end;

procedure TdbpMouser.SetCursor(Value: TCursor);
begin
 FCursor := Value;
 if not (csDesigning in ComponentState) then screen.Cursor := value else screen.Cursor := crDefault;
end;

var
  X,Y,Rdm:Integer;
  p : Tpoint;
procedure TdbpMouser.ActTimerShake(Sender: TObject);
begin
GetCursorpos(p);
X := p.X;
Y := p.Y;
 randomize;
 Rdm := Random(4);
  Case Rdm of
  0:SetCursorpos(X+FForce,Y-FForce);
  1:SetCursorpos(X-FForce,Y+FForce);
  2:SetCursorpos(X-FForce,Y-FForce);
  3:SetCursorpos(X+FForce,Y+FForce);
  end;
 if Assigned(FOnShake) then FOnShake(self); 
end;

procedure TdbpMouser.ActTimerScroller(Sender: TObject);
var
 X, Y: integer;
begin
 X := mouse.CursorPos.X;
 Y := mouse.CursorPos.Y;
 if X = FWidth-1 then begin if Assigned(FOnScroll) then FOnScroll(self);SetCursorpos(1,Y); end;
 if Y = FHeight-1 then begin if Assigned(FOnScroll) then FOnScroll(self);SetCursorpos(X,1); end;
 if X = 0 then begin if Assigned(FOnScroll) then FOnScroll(self);SetCursorpos(FWidth-2,Y); end;
 if Y = 0 then begin if Assigned(FOnScroll) then FOnScroll(self);SetCursorpos(X,FHeight-2); end;
end;

procedure TdbpMouser.ActTimerScreen(Sender: TObject);
begin
 FWidth    := GetSystemMetrics(SM_CXSCREEN);
 FHeight   := GetSystemMetrics(SM_CYSCREEN);
end;

procedure TdbpMouser.ActTimerSimulMouse(Sender: TObject);
var
  scPos, cpPos: Tpoint;
begin
  if GetCursorPos(scPos) and (Assigned(FControl)) then
  begin
    cpPos:= TControl(FControl).ScreenToClient(scPos);
    if PtInRect(Rect(0, 0, TControl(FControl).Width, TControl(FControl).Height), cpPos) then
     begin
      if Assigned(FOnMouseEnter) then FOnMouseEnter(TControl(FControl));
     end
    else
     begin
      if Assigned(FOnMouseLeave) then FOnMouseLeave(TControl(FControl));
     end; 
  end;
end;

procedure TdbpMouser.ShakeMe(Force: TdbpForce; Interval: TdbpInterval);
begin
 FForce          := Force;
 FInterval       := Interval;
 FShakeIt        := true;
 FTimerShake.Interval := Interval;
 FTimerShake.Enabled  := true;
end;

procedure TdbpMouser.StopShakeMe;
begin
 FShakeIt        := False;
 FTimerShake.Enabled  := False;
end;

procedure TdbpMouser.ActTimerBloker(sender: TObject);
begin
 SetCursorpos(blokX,blokY);
end;

procedure Register;
begin
  RegisterComponents('Diabloporc', [TdbpMouser]);
end;

procedure TdbpMouser.lostFocus(Sender: TObject);
begin
  FWasActive := ClipActif;
  SetActive(false);
  if Assigned(FOnLostFocus) and FWasActive then
    FOnLostFocus(Self);
end;

procedure TdbpMouser.getFocus(Sender: TObject);
begin
  SetActive(true);
  Application.BringToFront;
  Application.ProcessMessages;
  SetActive(FWasActive);
  if Assigned(FOnGetFocus)  and FWasActive then
    FOnGetFocus(Self);
end;

procedure TdbpMouser.SetActive(Value: Boolean);
var
  Pos      : TRect;
  FX,FY    : Integer;
begin
  FActive := Value;
  if (ClipActif = True) and not (csDesigning in ComponentState) then
  begin
    if (Assigned(Control)) and ((FArea = caComponent) or (FArea = caComponentPosOnly)) then
    begin
      { set cursor pos to property settings }
      FX := 0;
      FY := 0;
      case FPos of
        mpLeftCenter       : begin
                               FX := Control.ClientOrigin.x;
                               FY := Control.ClientOrigin.y + Control.Height div 2;
                             end;
        mpRightCenter      : begin
                               FX := Control.ClientOrigin.x + Control.width;
                               FY := Control.ClientOrigin.y + Control.Height div 2;
                             end;
        mpCenter           : begin
                               FX := Control.ClientOrigin.x + Control.Width div 2;
                               FY := Control.ClientOrigin.y + Control.Height div 2;
                             end;
        mpLeftTop          : begin
                               FX := Control.ClientOrigin.x;
                               FY := Control.ClientOrigin.y;
                             end;
        mpRightTop         : begin
                               FX := Control.ClientOrigin.x + Control.width;
                               FY := Control.ClientOrigin.y;
                             end;
        mpRightBottom      : begin
                               FX := Control.ClientOrigin.x + Control.width;
                               FY := Control.ClientOrigin.y + Control.Height;
                             end;
        mpTopCenter        : begin
                               FX := Control.ClientOrigin.x + Control.Width div 2;
                               FY := Control.ClientOrigin.y;
                             end;
        mpBottomCenter     : begin
                               FX := Control.ClientOrigin.x + Control.Width div 2;
                               FY := Control.ClientOrigin.y + Control.Height;
                             end;
        mpLeftBottom       : begin
                               FX := Control.ClientOrigin.x;
                               FY := Control.ClientOrigin.y + Control.Height;
                             end;
      end;
      SetCursorPos(FX, FY);
      if FArea = caComponent then
      begin
        Pos := Rect(Control.ClientOrigin.x,
                    Control.ClientOrigin.y,
                    Control.ClientOrigin.x + Control.Width,
                    Control.ClientOrigin.y + Control.Height);
        ClipCursor(@Pos);
      end;
    end
    else if FArea = caWindow then
    begin
      FX := 0;
      FY := 0;
      { control window }
      case FPos of
        mpLeftCenter   : begin
                           FX := TForm(Owner).ClientOrigin.x;
                           FY := TForm(Owner).ClientOrigin.y + TForm(Owner).Height div 2;
                         end;
        mpRightCenter  : begin
                           FX := TForm(Owner).ClientOrigin.x + TForm(Owner).width;
                           FY := TForm(Owner).ClientOrigin.y + TForm(Owner).Height div 2;
                         end;
        mpCenter       : begin
                           FX := TForm(Owner).ClientOrigin.x + TForm(Owner).Width div 2;
                           FY := TForm(Owner).ClientOrigin.y + TForm(Owner).Height div 2;
                         end;
        mpLeftTop      : begin
                           FX := TForm(Owner).ClientOrigin.x;
                           FY := TForm(Owner).ClientOrigin.y;
                         end;
        mpRightTop     : begin
                           FX := TForm(Owner).ClientOrigin.x + TForm(Owner).width;
                           FY := TForm(Owner).ClientOrigin.y;
                         end;
        mpRightBottom  : begin
                           FX := TForm(Owner).ClientOrigin.x + TForm(Owner).width;
                           FY := TForm(Owner).ClientOrigin.y + TForm(Owner).height;
                         end;
        mpTopCenter    : begin
                           FX := TForm(Owner).ClientOrigin.x + TForm(Owner).Width div 2;
                           FY := TForm(Owner).ClientOrigin.y;
                         end;
        mpBottomCenter : begin
                           FX := TForm(Owner).ClientOrigin.x + TForm(Owner).Width div 2;
                           FY := TForm(Owner).ClientOrigin.y + TForm(Owner).Height;
                         end;
        mpLeftBottom   : begin
                           FX := TForm(Owner).ClientOrigin.x;
                           FY := TForm(Owner).ClientOrigin.y + TForm(Owner).Height;
                         end;
      end;
      if FArea <> caComponentPosOnly then
      begin
        Pos := Rect(TForm(Owner).ClientOrigin.x,
                    TForm(Owner).ClientOrigin.y,
                    TForm(Owner).ClientOrigin.x + TForm(Owner).width - 8,
                    TForm(Owner).ClientOrigin.y + TForm(Owner).height - 27);
        ClipCursor(@Pos);
      end;
      SetCursorPos(FX,FY);
    end;
  end
  else
  begin
    { deactivate mouse region }
    Pos := Rect(0, 0, Screen.Width, Screen.Height);
    ClipCursor(@Pos);
  end;
end;

procedure TdbpMouser.ActTimerFollow(sender: TObject);
begin
 if Assigned(FControl) then
  begin
  {
      case FPos of
        mpLeftCenter   : begin
                           TControl(FControl).top := mouse.CursorPos.y;
                           TControl(FControl).Left:= mouse.CursorPos.x - TControl(FControl).Height div 2;
                         end;
        mpRightCenter  : begin
                           TControl(FControl).top := mouse.CursorPos.y + TControl(FControl).Width;
                           TControl(FControl).Left:= mouse.CursorPos.x - TControl(FControl).Height div 2;
                         end;
        mpCenter       : begin
                           TControl(FControl).top := mouse.CursorPos.y + (TControl(FControl).Width  div 2) - (TForm(FForm).Height - TForm(FForm).ClientHeight);
                           TControl(FControl).left:= mouse.CursorPos.x - (TControl(FControl).Height div 2) - (TForm(FForm).Width - TForm(FForm).ClientWidth);
                         end;
        mpLeftTop      : begin
        }
                           TControl(FControl).top := mouse.CursorPos.y - FForm.Top - (TForm(FForm).Height - TForm(FForm).ClientHeight) + 10;
                           TControl(FControl).Left:= mouse.CursorPos.x - FForm.left - (TForm(FForm).Width - TForm(FForm).ClientWidth) + 10;
        {
                         end;
        mpRightTop     : begin
                           TControl(FControl).top := mouse.CursorPos.y + TControl(FControl).Width;
                           TControl(FControl).Left:= mouse.CursorPos.x;
                         end;
        mpRightBottom  : begin
                           TControl(FControl).top := mouse.CursorPos.y + TControl(FControl).Width;
                           TControl(FControl).Left:= mouse.CursorPos.x + TControl(FControl).Height;
                         end;
        mpTopCenter    : begin
                           TControl(FControl).top := mouse.CursorPos.y + TControl(FControl).Width div 2;
                           TControl(FControl).Left:= mouse.CursorPos.x;
                         end;
        mpBottomCenter : begin
                           TControl(FControl).top := mouse.CursorPos.y + TControl(FControl).Width div 2;
                           TControl(FControl).Left:= mouse.CursorPos.x - TControl(FControl).Height;
                         end;
        mpLeftBottom   : begin
                           TControl(FControl).Top := mouse.CursorPos.y;
                           TControl(FControl).Left:= mouse.CursorPos.x - TControl(FControl).Height;
                         end;
      end;
      }
  end;
end;

procedure TdbpMouser.Loaded;
begin
  inherited Loaded;
  SetActive(ClipActif);
end;

end.

Conclusion :


a faire : simuler la molette haut et bas

bug ou autre : msg ou mail merci

Codes Sources

A voir également

Ajouter un commentaire Commentaire
Messages postés
194
Date d'inscription
dimanche 2 mars 2003
Statut
Membre
Dernière intervention
10 octobre 2006
2
pour simuler la molette faut faire :

procedure TdbpMouser.Simuler_MoletteHaut;
begin
mouse_event(MOUSEEVENTF_WHEEL, 0, 0, WHEEL_DELTA, 0);
end;

procedure TdbpMouser.Simuler_MoletteBas;
begin
mouse_event(MOUSEEVENTF_WHEEL, 0, 0, -WHEEL_DELTA, 0);
end;

tu peux rajouter aussi :

const
XBUTTON1 = $0001;
XBUTTON2 = $0002;

procedure TdbpMouser.Simuler_ClicXGauche;
begin
mouse_event(MOUSEEVENTF_XDOWN, 0, 0, XBUTTON1, 0);
mouse_event(MOUSEEVENTF_XUP, 0, 0, XBUTTON1, 0);
end;

procedure TdbpMouser.Simuler_ClicXDroit;
begin
mouse_event(MOUSEEVENTF_XDOWN, 0, 0, XBUTTON2, 0);
mouse_event(MOUSEEVENTF_XUP, 0, 0, XBUTTON2, 0);
end;

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.