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;

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