Programowanie w języku Delphi » Gotowce

Gesty myszy we własnej aplikacji

Gesty myszy (ang. mouse gestures) to bardzo przydatne narzędzie spopularyzowane głównie dzięki przeglądarkom Firefox (Mozilla) oraz Opera, aczkolwiek dostępne również w innych aplikacjach. Kombinacja ruchów kursora myszy umożliwia wykonanie najczęściej stosowanych poleceń danej aplikacji. Przykładowo, w przeglądarce Firefox trzymając wciśnięty prawy klawisz myszy i wykonując ruch w lewo wykonujemy polecenie "Wstecz" (powrót do poprzedniej strony). Jeżeli zastanawiasz się jak zaimplementować taki mechanizm we własnej aplikacji, ten artykuł powinien dać Ci rozwiązanie.

Obsługa gestów myszy polega na odpowiedniej obsługdze komunikatów określających ruch myszy oraz wciśnięcie klawiszy myszy. Na szczęście w Delphi nie musimy tego robić gdyż formularze udostępniają odpowiednie zdarzenia: OnMouseDown, OnMouseMove, OnMouseUp. W naszej aplikacji musimy określić w którą stronę użytkownik przesuwa kursor myszy (prawo, lewo, góra, dół) i na tej podstawie wykonać odpowiednie zdarzenie (w naszym wypadku - odpowiednią procedurę). Nasza przykładowa aplikacja nie będzie wykonywała żadnych specjalistycznych działań, powiedzmy iż w skutek odpowiednich ruchów myszy, wykonane zostaną procedury przedstawione poniżej:

{ Procedura wyświetla przykładowe okienko "O autorze..." }
procedure About;
begin
  Application.MessageBox(
  'Mouse Gestures' + #13 +
  'Copyright (c) 2006 by Adam Boduch' + #13#13 +
  'http://4programmers.net',
  'O programie...');
end;
 
{ Procedura służy do zamykania aplikacji }
procedure ExitApp;
begin
  Application.Terminate;
end;
 
{ Wyświetlanie okienka - nic konkretnego }
procedure Foo;
begin
  Application.MessageBox(
  'Surprise!', ':-)');
end;


W przykładowej aplikacji wkorzystałem także komponent TStatusBar na którym wyświetlane będą ruchy myszy.

Deklaracja nowych typów


Przede wszystkim należy zadeklarować nowy typ który określał będzie przesunięcia kursora myszy. W naszej przykładowej aplikacji, obsługiwać będziemy 4 posunięcia (prawo, lewo, góra, dół):

type
  { typ określający rodzaje gestu }
  TMouseGestures = (mgNone, mgDown, mgUp, mgLeft, mgRight);


Będziemy również potrzebowali tablicy zawierającej zbiór elementów, posunięć myszy stanowiących gest. Przykładowo, za wyświetlanie okienka "O autorze..." może odpowiadać gest: lewo-prawo. Czyli użytkownik musi wykonać dwa ruchy muszą. Te ruchy musimy właśnie zapisać w tablicy - np.:

TMouseGesturesElements = array of TMouseGestures;


Kolejnym etapem jest deklaracja klasy, która odpowiada za obsługę kolejki ruchów:

type
  { klasa służąca do kolejkowania gestów }
  TQueue = class
  private
    { Ilość pozycji w kolejce }
    FCounter : Integer;
    { Gesty }
    FItems : TMouseGesturesElements;
  public
    { Dodawanie ruchu do kolejki }
    procedure Add(Value : TMouseGestures);
    { Czyszczenie kolejki }
    procedure Clear;
    { Wykonywanie procedury gestu }
    function Exec : Boolean;
  end;


Dzięki tej klasie, możemy w prosty sposób dodawać lub czyścić kolejkę oraz mieć dostęp do poszczególnych ruchów (pola FItems).

Obsługa procedur


W tym momencie należy się zastanowić skąd program ma wiedzieć jaką procedurę wykonać oraz jaki gest odpowiada za wykonanie danej procedury. Należy ustawić unikalny kod gestu, aby posunięcie lewa-prawa miało inny kod niż posunięcie góra-dół. W tym celu można zastosować funkcję Ord, która zwraca wartość odpowiadającą konkretnemu gestowi z typu TMouseGestures. Przykładowo:

Ord(mgNone); // zwraca 0
Ord(mgDown); // zwraca 1
Ord(mgUp); // zwraca 2
Ord(mgLeft); // zwraca 3
Ord(mgRight); // zwraca 4


Jeżeli więc połączymy gest lewa-prawa w łańcuch otrzymamy: 34, natomiast posunięcie góra-doł zwróci 21. Mamy kod, więc trzeba ustalić jaka procedura ma być wykonywana w skutek wykonania tego gestu. Można więc zadeklarować następujący rekord:

type
  { rekord określający zadanie do wykonania w danym geście }
  TAssignment = packed record
    Key : String;
    ProcAddr : procedure;
  end;


Pole Key będzie przechowywać kod gestu a ProcAddr - adres procedury do wykonania. Ponieważ gestów będzie wiele, deklarujemy tablicę rekordu TAssignment:

var
  Assignment : array [0..2] of TAssignment;


Oto jak wygląda zdarzenie OnCreate przykładowej aplikacji:

procedure TMainForm.FormCreate(Sender: TObject);
begin
  { domyślny gest }
  FLastGesture := mgNone;
 
  { utworzenie instancji klasy kolejki }
  FQueue := TQueue.Create;
 
  Assignment[0].Key := '34';
  Assignment[0].ProcAddr := @About;
 
  Assignment[1].Key := '21';
  Assignment[1].ProcAddr := @ExitApp;
 
  Assignment[2].Key := '214';
  Assignment[2].ProcAddr := @Foo;
end;


Przypisujemy w niej odpowiednie zdarzenia dla konkretnych gestów.

Pola klasy TMainForm


Aby cała aplikacja działa, potrzebujemy skorzysać ze zdarzeń OnMouseDown, OnMouseMove oraz OnMouseUp. Potrzebujemy też kilku pól. Cała klasa TMainForm może wyglądać następująco:

type
  TMainForm = class(TForm)
    StatusBar: TStatusBar;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Pole przybiera wartość True jeżeli użytkownik wykonuje gest }
    FMouseGesture : Boolean;
    { Współrzędne startowe wykonywania gestu }
    FBasePos : TPoint;
    { Pole przechowuje ostatni wykonany gest }
    FLastGesture : TMouseGestures;
    { Dostęp do klasy TQueue }
    FQueue : TQueue;
    { Metoda ustawia odpowiedni tekst na pasku zadań }
    procedure SetStatusBarText(Value : String);
    { Metoda zapisuje gest do kolejki }
    procedure SetGesture(Gesture : TMouseGestures);
  public
    { Public declarations }
  end;


Opis znaczenia danych pól znajduje się w komentarzach.

Określanie gestu


Chyba najtrudniejszą operacją w całym programie jest określenie jakich ruch wykonał użytkownik. Czy przesunął kursor w doł, czy może w lewo. Musimy w naszej aplikacji określić również margines błędu ponieważ nie chcemy aby najczulszy ruch spowodował wykonanie gestu. Margines błędu ustalamy na poziomie 15 pikseli. O tyle musi przesunąć się kursor myszy aby ruch został rozpoznany. Całą operację wykonujemy w zdarzeniu OnMouseMove:

procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  Gesture : TMouseGestures;
  absDX, absDY, DX, DY : Integer;
begin
  if FMouseGesture then
  begin
    { obliczenie przesunięcia kursora myszy w stosunku do bazowej pozycji }
    DX := X - FBasePos.X;
    DY := Y - FBasePos.Y;
 
    { Obliczenie stosunku przesunięcia do bazowej pozycji }
    absDX := Abs(DX);
    absDY := Abs(DY);
 
    { Wymagana wielkość ruchu to 15 px. }
    if (absDX > 15) or (absDY > 15) then
    begin
      if absDX > 15 then
      begin
        if DX < 0 then
          Gesture := mgLeft
        else
         Gesture := mgRight;
      end;
 
      { up }
      if absDY > 15 then
      begin
        if DY < 0 then
        begin
          Gesture := mgUp;
        end else
          Gesture := mgDown;
      end;
 
      { zapisanie ruchu do kolejki }
      SetGesture(Gesture);
      { ustanowienie nowych współrzędnych początkowych }
      FBasePos := Point(X, Y);
    end;
  end;
end;


Po rozpoznaniu kierunku wykonania ruchu, możemy dodać go do kolejki, a tym zajmuje się metoda SetGesture:

{ Metoda dodaje ruch do kolejki }
procedure TMainForm.SetGesture(Gesture: TMouseGestures);
begin
  if Gesture <> FLastGesture then
  begin
    FLastGesture := Gesture;
 
    { dodanie gestu do kolejki }
    FQueue.Add(Gesture);
 
    { w zależności od ruchu dodajemy odpowiedni tekst na pasku statusu }
    case Gesture of
      mgDown: SetStatusBarText('D');
      mgUp: SetStatusBarText('U');
      mgLeft: SetStatusBarText('L');
      mgRight: SetStatusBarText('R');
    end;
  end;
end;


Ponieważ nie chcemy aby ruch był duplikowany, w pierwszym warunku musimy sprawdzić czy ostatni wykonany ruch nie był identyczny z tym, który chcemy dodać do kolejki. Jeżeli warunek zostanie spełniony, wywoływana jest metoda Add z klasy TQueue:

{ Metoda dodaje gest do kolejki }
procedure TQueue.Add(Value: TMouseGestures);
begin
  { zwiększenie elementów kolejki }
  Inc(FCounter);
  { zwiększenie elementów tablicy }
  SetLength(FItems, FCounter);
 
  { przypisanie gestu do tablicy }
  FItems[Fcounter -1] := Value;
end;


Wykonuje ona prostą operację - zwiększenie rozmiaru tablicy oraz przypisanie ruchu do owej tablicy.
Pełny kod programu (formularza głównego) został przedstawiony na listingu poniżej:

(**************************************************************)
(*                                                            *)
(*                   Mouse Gestures                           *)
(*            Copytight (c) 2006 Adam Boduch                  *)
(*              E-mail: [email protected]                       *)
(*             WWW: http://4programmers.net                   *)
(*                                                            *)
(*
 
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
 
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.
 
Update: 2.03.2006
 
(**************************************************************)
 
unit MainFrm;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;
 
type
  { typ określający rodzaje gestu }
  TMouseGestures = (mgNone, mgDown, mgUp, mgLeft, mgRight);
  { tablica zawierająca spis kolejnych gestów }
  TMouseGesturesElements = array of TMouseGestures;
 
  { rekord określający zadanie do wykonania w danym geście }
  TAssignment = packed record
    Key : String;
    ProcAddr : procedure;
  end;
 
  { klasa służąca do kolejkowania gestów }
  TQueue = class
  private
    { Ilość pozycji w kolejce }
    FCounter : Integer;
    { Gesty }
    FItems : TMouseGesturesElements;
  public
    { Dodawanie ruchu do kolejki }
    procedure Add(Value : TMouseGestures);
    { Czyszczenie kolejki }
    procedure Clear;
    { Wykonywanie procedury gestu }
    function Exec : Boolean;
  end;
 
  TMainForm = class(TForm)
    StatusBar: TStatusBar;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Pole przybiera wartość True jeżeli użytkownik wykonuje gest }
    FMouseGesture : Boolean;
    { Współrzędne startowe wykonywania gestu }
    FBasePos : TPoint;
    { Pole przechowuje ostatni wykonany gest }
    FLastGesture : TMouseGestures;
    { Dostęp do klasy TQueue }
    FQueue : TQueue;
    { Metoda ustawia odpowiedni tekst na pasku zadań }
    procedure SetStatusBarText(Value : String);
    { Metoda zapisuje gest do kolejki }
    procedure SetGesture(Gesture : TMouseGestures);
  public
    { Public declarations }
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
{$R *.dfm}
 
var
  Assignment : array [0..2] of TAssignment;
 
{ Procedura wyświetla przykładowe okienko "O autorze..." }
procedure About;
begin
  Application.MessageBox(
  'Mouse Gestures' + #13 +
  'Copyright (c) 2006 by Adam Boduch' + #13#13 +
  'http://4programmers.net',
  'O programie...');
end;
 
{ Procedura służy do zamykania aplikacji }
procedure ExitApp;
begin
  Application.Terminate;
end;
 
{ Wyświetlanie okienka - nic konkretnego }
procedure Foo;
begin
  Application.MessageBox(
  'Suprise!', ':-)');
end;
 
procedure TMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  { rozpoczynamy całą operację tylko wówczas gdy użytkownik naciśnie prawy klawisz myszy }
  if Button = mbRight then
  begin
    FMouseGesture := True;
    StatusBar.SimpleText := '';
 
    { przypisanie bazowych współrzędnych }
    FBasePos := Point(X, Y);
  end;
end;
 
procedure TMainForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FMouseGesture := False;
 
  FLastGesture:= mgNone;
 
  StatusBar.SimpleText := '';
 
  { sprawdzenie czy danemu gestowi przypisane jest jakieś zdarzenie }
  if not FQueue.Exec then
    StatusBar.SimpleText := 'Gest nieznany...';
 
  { wyczyszczenie kolejki }
  FQueue.Clear;
end;
 
procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  Gesture : TMouseGestures;
  absDX, absDY, DX, DY : Integer;
begin
  if FMouseGesture then
  begin
    { obliczenie przesunięcia kursora myszy w stosunku do bazowej pozycji }
    DX := X - FBasePos.X;
    DY := Y - FBasePos.Y;
 
    { Obliczenie stosunku przesunięcia do bazowej pozycji }
    absDX := Abs(DX);
    absDY := Abs(DY);
 
    { Wymagana wielkość ruchu to 15 px. }
    if (absDX > 15) or (absDY > 15) then
    begin
      if absDX > 15 then
      begin
        if DX < 0 then
          Gesture := mgLeft
        else
         Gesture := mgRight;
      end;
 
      { up }
      if absDY > 15 then
      begin
        if DY < 0 then
        begin
          Gesture := mgUp;
        end else
          Gesture := mgDown;
      end;
 
      { zapisanie ruchu do kolejki }
      SetGesture(Gesture);
      { ustanowienie nowych współrzędnych początkowych }
      FBasePos := Point(X, Y);
    end;
  end;
end;
 
procedure TMainForm.SetStatusBarText(Value: String);
begin
  StatusBar.SimpleText := StatusBar.SimpleText + ' ' + Value;
end;
 
{ Metoda dodaje ruch do kolejki }
procedure TMainForm.SetGesture(Gesture: TMouseGestures);
begin
  if Gesture <> FLastGesture then
  begin
    FLastGesture := Gesture;
 
    { dodanie gestu do kolejki }
    FQueue.Add(Gesture);
 
    { w zależności od ruchu dodajemy odpowiedni tekst na pasku statusu }
    case Gesture of
      mgDown: SetStatusBarText('D');
      mgUp: SetStatusBarText('U');
      mgLeft: SetStatusBarText('L');
      mgRight: SetStatusBarText('R');
    end;
  end;
end;
 
procedure TMainForm.FormCreate(Sender: TObject);
begin
  { domyślny gest }
  FLastGesture := mgNone;
 
  { utworzenie instancji klasy kolejki }
  FQueue := TQueue.Create;
 
  Assignment[0].Key := '34';
  Assignment[0].ProcAddr := @About;
 
  Assignment[1].Key := '21';
  Assignment[1].ProcAddr := @ExitApp;
 
  Assignment[2].Key := '214';
  Assignment[2].ProcAddr := @Foo;
end;
 
{ Metoda dodaje gest do kolejki }
procedure TQueue.Add(Value: TMouseGestures);
begin
  { zwiększenie elementów kolejki }
  Inc(FCounter);
  { zwiększenie elementów tablicy }
  SetLength(FItems, FCounter);
 
  { przypisanie gestu do tablicy }
  FItems[Fcounter -1] := Value;
end;
 
{ Czyszczenie kolejki }
procedure TQueue.Clear;
begin
  FCounter := 0;
 
  FItems := nil;
end;
 
{ Metoda sprawdza czy danemu gestowi przypisano jakieś działanie }
function TQueue.Exec : Boolean;
var
  i : Integer;
  ExecStr : String;
begin
  Result := False;
 
  { pętla po wszystkich ruchach w kolejce }
  for I := 0 to FCounter -1 do
    ExecStr := ExecStr + IntToStr(Ord(FItems[i]));
 
  { pętla po przypisanych zdarzeniach... }
  for I := Low(Assignment) to High(Assignment) do
  begin
    { należy sprawdzić czy kod gestu zgadza się }
    if Assignment[i].Key = ExecStr then
    begin
      Assignment[i].ProcAddr;
 
      Result := True;
      Break;
    end;
  end;
end;
 
end.


Załączniki:

Zobacz też:

4 komentarze

koval_s 2007-02-21 22:06

Może to głupie pytanie, ale jak zrobić żeby szło "machać" po całej formie z różnymi kontrolkami i żeby to działało, oczywiście chodzi o prosty kod, a nie przypisywanie do każdego zdarzenia poszczególnych procedur, tylko to mnie blokuje w zastosowaniu tego "bajeru" w swoich programach, pozdrawiam...

Berus123 2006-04-02 13:28

Coś podobnego w Ekspercie było tylko w C#

miner 2006-03-02 15:43

Fajne!

Można też robić koła np:

  Assignment[3].Key := '31423';
  Assignment[3].ProcAddr := @KoloLewo;
 
  Assignment[4].Key := '41324';
  Assignment[4].ProcAddr := @KoloPrawo;


ale tylko dla kółek zaczynanych od góry i kończonych u góry

PS. Tak jak jest w I-Podach na tym panelu:
Koło w lewo - Zmniejsza głośność muzyki
Koło w prawo - Zwiększa głośność muzyki