FAQ VCL
Клавиатура и мышь\Мышь

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как узнать/изменить позицию курсора мыши?

// Чтобы узнать позицию курсора воспользуйтесь функцией GetCursorPos
// function GetCursorPos( var IpPoint: TPoint ): LongBool;
// Чтобу установить курсор в новую позицию воспользуйтесь функцией SetCursorPos
// function SetCursorPos( X, Y: integer ): LongBool;
// Ниже приведен небольшой пример на использование этих функций.

// Способ первый
const
  speed = 6; // Скорость движения курсора

var
  Form1: TForm1;
  CurPos: TPoint; // Позиция курсора
  Angle: real;    // Угол движения

procedure TForm1.Button1Click(Sender: TObject);
begin
   GetCursorPos( CurPos );
   Randomize;
   Angle := Random( 360 );
   Timer1.Enabled := true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   Timer1.Enabled := false;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   CurPos.X := Round( CurPos.X + cos( Angle ) * speed );
   CurPos.Y := Round( CurPos.Y + sin( Angle ) * speed );
   if ( CurPos.Y <= 0 ) or ( CurPos.Y >= Screen.Height ) then
      Angle := -Angle;
   if ( CurPos.X <= 0 ) or ( CurPos.X >= Screen.Width ) then
      Angle := pi - Angle;
   SetCursorPos( CurPos.X, CurPos.Y );
end;

// Способ второй
procedure TForm1.Timer1Timer(Sender: TObject);
begin
   mouse_event( MOUSEEVENTF_MOVE, Random( 21 ) - 10, Random( 21 ) - 10, 0, 0 );
end;

// Способ третий
// Движение курсора мыши по синусоиде
procedure TForm1.Button1Click(Sender: TObject);
var
  x1, y1: Integer; // Начальные координаты области
  x2, y2: Integer; // Конечные координаты области
  x, y: Integer;   // Промежуточные значения
begin
   x1 := 100;
   y1 := 100;
   x2 := 500;
   y2 := 100;

   for x := x1 to x2-1 do
   begin
       y := y1 + Round( Sin( x * 0.1 ) * 10 ); // по y1 Будет y1-10..y1+10; 0.1 для растяжения по оси x1
       SetCursorPos( x, y );
       Sleep( 10 );
   end;
   y1 := y1 + 20;
end;


Как узнать, что курсор мыши над моей формой?

// Timer1.intervel = 1
procedure TForm1.Timer1Timer(Sender: TObject);
var
  FormPos: TRect;
  CursorPos: TPoint;
begin
   GetCursorPos( CursorPos );
   FormPos := Rect( Form1.Left, Form1.Top,
                    Form1.Left + Form1.Width,
                    Form1.Top + Form1.Height );
   if PtInRect( FormPos, CursorPos ) then
      Form1.Caption := 'Мышка над формой!'
   else
      Form1.Caption := 'Мышка вне формы...';
end;


Как проверить условие: если колесико мыши крутится вниз, то?..

// В Delphi5 и выше можно использовать события
// OnMouseWheelDown и OnMouseWheelUp
// В другом случае попробуй так:

type
  TForm1 = class(TForm)
  private
    { Private declarations }
    procedure WMMouseWheel(var Msg: TWMMouseWheel); message WM_MOUSEWHEEL;
  public
    { Public declarations }
  end;

procedure TForm1.WMMouseWheel(var Msg: TWMMouseWheel);
begin
   if Msg.WheelDelta > 0 then
   begin
      Caption := 'Вверх';
      Windows.Beep( 500, 100 );
   end
   else
   begin
      Caption := 'Вниз';
      Windows.Beep( 1500, 100 );
   end;
end;


Как узнать, присутствует ли мышка?

function MousePresent: boolean;
begin
   if GetSystemMetrics( SM_MOUSEPRESENT ) <> 0 then
      Result := true
   else
      Result := false;
end;


Как поместить курсор мыши в центр контрола, получившего фокус?

procedure MoveMouseOverControl(Sender: TObject);
var
  KonturWidth: integer;   // Ширина 3D-рамки
  CaptionHeight: integer; // Высота заголовка
  x, y: integer;
begin
   KonturWidth := ( Form1.Width - Form1.ClientWidth ) div 2;
   CaptionHeight := Form1.Height - Form1.ClientHeight - 2 * KonturWidth;
   with TControl( Sender ) do
   begin
      x := Form1.Left + ( left + ( width div 2 ) ) + KonturWidth;
      y := Form1.Top + KonturWidth + CaptionHeight +
           ( Top + ( Height div 2) );
      SetCursorPos( x, y );
   end;
end;

procedure TForm1.Button1Enter(Sender: TObject);
begin
   MoveMouseOverControl( Sender );
end;


Как поменять местами функции кнопок мышки?

// Способ первый
// • Поменять местами (перевод мыши в режим "для левши")
//   SwapMouseButton( true );
// • Вернуть обратно (перевод мыши в режим "для правши")
//   SwapMouseButton( false );

function LeftToRight(Swap: Boolean): Boolean;
begin
   Result := LongInt(SwapMouseButton(Swap)) = 0;
   // Если Result = 0, значит состояние кнопок уже изменено
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if not LeftToRight(True) then
   // Если состояние кнопок уже менялось,
   // восстанавливаем состояние по умолчанию
      LeftToRight(False);
end;

// Способ второй
// Поменять местами (перевод мыши в режим "для левши")
SystemParametersInfo(SPI_SETMOUSEBUTTONSWAP, Integer(True), nil, 0{SPIF_UPDATEINIFILE});

// Вернуть обратно (перевод мыши в режим "для правши")
SystemParametersInfo(SPI_SETMOUSEBUTTONSWAP, Integer(False), nil, 0{SPIF_UPDATEINIFILE});


Как недопустить выхода курсора за пределы своей формы?

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    // Для отслеживания перемещения формы
    procedure OnMove( Var Msg : TWMMove ); Message WM_MOVE;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MyHandle: THandle; // Указатель на форму
  MyRect: TRect;     // Размеры формы

// Ограничение области движения курсора
procedure Clip;
begin
   MyHandle := FindWindow( 'TForm1', 'Form1' );
   GetWindowRect( MyHandle, MyRect );
   ClipCursor( @MyRect );
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   Clip;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
   Clip;
end;

procedure TForm1.OnMove(var Msg: TWMMove);
begin
   inherited;
   Clip;
end;

// Снимаем ограничение области перемещения курсора
procedure TForm1.Button1Click(Sender: TObject);
begin
   ClipCursor( nil );
end;


Как использовать анимированный курсор в своем приложении?

procedure TForm1.FormCreate(Sender: TObject);
var
  h: THandle;
begin
   h := LoadImage( 0, 'C:\Animation.ani', IMAGE_CURSOR,
                   0, 0, LR_DEFAULTSIZE or LR_LOADFROMFILE );
   if h = 0 then
      ShowMessage( 'Курсор не загружен' )
   else
   begin
      Screen.Cursors[1] := h;
      Form1.Cursor := 1;
   end;
end;


Как узнать диапазон, прокручиваемый колесиком мышки?

function GetNumScrollLines: integer;
begin
   SystemParametersInfo( SPI_GETWHEELSCROLLLINES, 0, @Result, 0 );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( IntToStr( GetNumScrollLines ) );
end;


Как узнать в каком режиме работает мышь (для левши или для правши)?

procedure TForm1.Button1Click(Sender: TObject);
begin
   if GetSystemMetrics( SM_SWAPBUTTON ) <> 0 then
      ShowMessage( 'Включен режим работы мыши "для левши"' )
   else
      ShowMessage( 'Включен режим работы мыши "для правши"' );
end;

При использовании материала - ссылка на сайт обязательна