Delphi et le multi-touch

  function RegisterTouchWindow(aWnd :hWnd; aFlags :ulong):BOOL; stdcall; external 'user32.dll' delayed;
  function UnregisterTouchWindow(aWnd :hWnd):BOOL; stdcall; external 'user32.dll' delayed;
  function GetTouchInputInfo(aHandle :THandle; aCount :integer; aInputs :PTouchInput; aSize :integer):BOOL; stdcall; external 'user32.dll' delayed;
  function CloseTouchInputHandle(aHandle :THandle):BOOL; stdcall; external 'user32.dll' delayed;

const
  SM_DIGITIZER           = 94;

  NID_INTEGRATED_TOUCH   = $01;
  NID_EXERNAL_TOUCH      = $02;
  NID_INTEGRATED_PEN     = $04;
  NID_EXERNAL_PEN        = $08;
  NID_MULTI_INPUT        = $40;
  NID_READY              = $80;

const
  TWF_FINETOUCH          = $1;
  TWF_WANTPALM           = $2;

Const
  WM_TOUCH               = $240;

  TOUCHEVENTF_MOVE       = $0001;
  TOUCHEVENTF_DOWN       = $0002;
  TOUCHEVENTF_UP         = $0004;
  TOUCHEVENTF_INRANGE    = $0008;
  TOUCHEVENTF_PRIMARY    = $0010;
  TOUCHEVENTF_NOCOALESCE = $0020;
  TOUCHEVENTF_PALM       = $0080;

type
  TTouchInput = record
    x         :longInt;
    y         :longInt;
    Source    :THandle;
    ID        :dword;
    Flags     :dword;
    Mask      :dword;
    Time      :dword;
    ExtraInfo :PLongInt;
    xContact  :dword;
    yContact  :dword;
  end;

function IsMultiTouch :boolean;
const
  Mask = NID_MULTI_INPUT or NID_READY;

begin
  Result := GetSystemMetrics(SM_DIGITIZER) and Mask = Mask;
end;

Interface

TForm1 = class(TForm)
protected
  procedure WMTouch(var Message :TMessage); message WM_TOUCH;
end;

implementation

procedure TForm1.WMTouch(var Message: TMessage);
var
  Count  :integer;               //Nombre de contacts
  Inputs :array of TTouchInput;  //Tableau de contacts
  Pt     :TPoint;                //Point en coordonnées fiche en pixel
  i      :integer;

begin
  //Récupère le nombre de contacts disponibles
  Count := LoWord(Message.WParam);

  //Fixe la taille du tableau
  SetLength(Inputs, Count);

  //et le remplit
  if GetTouchInputInfo(Message.LParam, Count, @Inputs[0], SizeOf(TTouchInput)) then
  begin

    //Traite chaque contact
    for i := 0 to high(Inputs) do
    begin
      //Le digitizer envoie le point au 1/100 de pixel et en coordonnées écran !
      //Conversion en pixel et coordonnées fiche
      Pt := Point(Inputs[i].x div 100, Inputs[i].y div 100);
      Pt := ScreenToClient(Pt);

      //Presser
      if (Inputs[i].Flags and TOUCHEVENTF_DOWN <> 0) then
      begin
        //Code pour gérer l'appui
      end

      //Déplacer
      else if (Inputs[i].Flags and TOUCHEVENTF_MOVE <> 0) then
      begin
        //Code pour gérer le déplacement 
      end

      //Relâcher
      else if (Inputs[i].Flags and TOUCHEVENTF_UP <> 0) then
      begin
        //Code pour gérer le relâchement
      end;
    end;
  end;

  //Libération de la mémoire associée
  CloseTouchInputHandle(Message.LParam);

  Message.Result := 0;
end.

Interface

TForm1 = class(TForm)
  procedure FormCreate(Sender: TObject);
  procedure FormDestroy(Sender: TObject);
end;

implementation

procedure TForm1.FormCreate(Sender: TObject);
begin
  if IsMultiTouch then
    RegisterMultiTouch(Handle, 0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if IsMultiTouch then
    UnregisterMultiTouch(Handle);
end;

//==============================================================================
// developpez.net                                               Andnotor - 2012
//
//                  TUTORIEL - DELPHI ET LE MULTITOUCH
//
// https://andnotor.developpez.com/tutoriels/delphi/delphi-et-le-multitouch/
//==============================================================================
unit Unit1;

interface

uses
  Windows, Classes, Controls, StdCtrls, Graphics, Messages, Forms,
  Generics.Collections;

//------------------------------------------------------------------------------
// Contrôle de compatibilité
const
  SM_DIGITIZER           = 94;

  NID_INTEGRATED_TOUCH   = $01;
  NID_EXERNAL_TOUCH      = $02;
  NID_INTEGRATED_PEN     = $04;
  NID_EXERNAL_PEN        = $08;
  NID_MULTI_INPUT        = $40;
  NID_READY              = $80;


//------------------------------------------------------------------------------
// Réglage et événements du digitizer
const
  TWF_FINETOUCH          = $1;
  TWF_WANTPALM           = $2;

  WM_TOUCH               = $240;

  TOUCHEVENTF_MOVE       = $0001;
  TOUCHEVENTF_DOWN       = $0002;
  TOUCHEVENTF_UP         = $0004;
  TOUCHEVENTF_INRANGE    = $0008;
  TOUCHEVENTF_PRIMARY    = $0010;
  TOUCHEVENTF_NOCOALESCE = $0020;
  TOUCHEVENTF_PALM       = $0080;

//------------------------------------------------------------------------------
// Détection du digitizer dans les gestionnaires de souris
  MOUSEEVENTF_FROMTOUCH  = $FF515700;


//------------------------------------------------------------------------------
// désactivation de la fonction Press&Hold
const
  TABLET_DISABLE_PRESSANDHOLD = $000000001;


//------------------------------------------------------------------------------
// Structure TPoint en flottant
//Permet d'éviter les erreurs d'arrondi, surtout en rotation !
type
  TPointF = record
  public
    X :extended;
    Y :extended;

    function    Point :TPoint;
    constructor Create(aX, aY :extended); overload;
    constructor Create(aPt :TPoint); overload;
  end;


//------------------------------------------------------------------------------
// La forme sur laquelle nous nous amuserons
type
  TShape = record
  private
    const HandleSize = 20;

  private
    Handles :array[0..3] of TPointF;

  public
    function    PtInHandle(aPt :TPoint) :integer;

    procedure   Translate(X, Y :integer);
    procedure   Rotate(aAngle :extended; aCenter :TPoint);
    procedure   MoveHandle(aHandle :integer; aPt :TPoint);

    procedure   Draw(aCanvas :TCanvas);
    constructor Create(aLeft, aTop, aWidth, aHeight: integer);
  end;


//------------------------------------------------------------------------------
// Structure envoyée par WM_TOUCH
type
  TTouchInput = record
    x         :longInt;
    y         :longInt;
    Source    :THandle;
    ID        :dword;
    Flags     :dword;
    Mask      :dword;
    Time      :dword;
    ExtraInfo :PLongInt;
    xContact  :dword;
    yContact  :dword;
  end;


//------------------------------------------------------------------------------
// Contacts
type

  //Informations sauvegardées par contact
  TContactInfo = record
    Pt      :TPoint;
    Handle  :integer;
    Primary :boolean;
  end;

  //Liste des contacts en cours
  TContact     = TPair<integer, TContactInfo>;
  TContactList = TDictionary<integer, TContactInfo>;

  //Action en fonction du nombre de contacts et de leur positionnement
  TContactAction = (caNone, caTranslate, caRotate, caMove);


//------------------------------------------------------------------------------
// Fiche
type
  TForm1 = class(TForm)
    procedure   FormPaint(Sender: TObject);
    procedure   FormCreate(Sender: TObject);
    procedure   FormDestroy(Sender: TObject);
    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);

  private
    const ShapeSize = 200;

  protected
    Shape       :TShape;
    ContactList :TContactList;

    function    IsMultiTouch :boolean;
    function    IsFromTouch(aExtraInfo:integer) :boolean;
    procedure   DisablePressAndHold;

    function    CheckAction :TContactAction;

    procedure   Translate(X, Y :integer);
    procedure   Rotate(aPrevPt, aPt :TPoint);
    procedure   MoveHandle(aHandle :integer; aPt :TPoint);

    procedure   WMTouch(var Message :TMessage); message WM_TOUCH;

    //Gestion centralisée (digitizer et souris)
    procedure   AddEvent(aID :integer; aPrimary :boolean; aPt :TPoint);
    procedure   MoveEvent(aID :integer; aPt :TPoint);
    procedure   RemoveEvent(aID :integer);

  end;


//------------------------------------------------------------------------------
// Fonctions exportées par User32.dll concernant le multi-touch
  function RegisterTouchWindow(aWnd :hWnd; aFlags :ulong):BOOL; stdcall; external 'user32.dll' delayed;
  function UnregisterTouchWindow(aWnd :hWnd):BOOL; stdcall; external 'user32.dll' delayed;
  function GetTouchInputInfo(aHandle :THandle; aCount :integer; aInputs :PTouchInput; aSize :integer):BOOL; stdcall; external 'user32.dll' delayed;
  function CloseTouchInputHandle(aHandle :THandle):BOOL; stdcall; external 'user32.dll' delayed;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TPointF }

//==============================================================================
constructor TPointF.Create(aX, aY: extended);
begin
  X := aX;
  Y := aY;
end;

constructor TPointF.Create(aPt: TPoint);
begin
  Create(aPt.X, aPt.Y);
end;

function TPointF.Point: TPoint;
begin
  Result.X := Round(X);
  Result.Y := Round(Y);
end;

{ TShape }

//==============================================================================
// Création
constructor TShape.Create(aLeft, aTop, aWidth, aHeight: integer);
begin
  Handles[0] := TPointF.Create(aLeft, aTop);
  Handles[1] := TPointF.Create(aLeft +aWidth, aTop);
  Handles[2] := TPointF.Create(aLeft +aWidth, aTop +aHeight);
  Handles[3] := TPointF.Create(aLeft, aTop +aHeight);
end;

//==============================================================================
// Dessin
procedure TShape.Draw(aCanvas: TCanvas);
var
  Poly :array[0..3] of TPoint;
  R    :TRect;
  i    :integer;

begin
  //Dessin du polygone
  for i := 0 to High(Handles) do
    Poly[i] := Handles[i].Point;

  aCanvas.Brush.Color := clGray;
  aCanvas.Pen.Color   := clBlack;

  aCanvas.Polygon(Poly);

  //Dessin des poignées
  aCanvas.Pen.Color   := clSilver;
  aCanvas.Brush.Style := bsClear;

  for i := 0 to High(Poly) do
  begin
    R := Rect(Poly[i], Poly[i]);
    InflateRect(R, HandleSize, HandleSize);

    aCanvas.Ellipse(R);
  end;
end;

//==============================================================================
// Est sur une poignée ?
function TShape.PtInHandle(aPt: TPoint): integer;
var
  i :integer;
  R :TRect;

begin
  for i := 0 to High(Handles) do
  begin
    R := Rect(Handles[i].Point, Handles[i].Point);
    InflateRect(R, HandleSize, HandleSize);

    if PtInRect(R, aPt) then
    begin
      Result := i;
      Exit;
    end;
  end;

  Result := -1;
end;

//==============================================================================
// Translation
procedure TShape.Translate(X, Y: integer);
var
  i: integer;

begin
  for i := 0 to High(Handles) do
  begin
    Handles[i].X := Handles[i].X +X;
    Handles[i].Y := Handles[i].Y +Y;
  end;
end;

//==============================================================================
// Rotation
procedure TShape.Rotate(aAngle: extended; aCenter: TPoint);
var
  X, Y :extended;
  i    :integer;

begin
  for i := 0 to High(Handles) do
  begin
    X := Handles[i].X;
    Y := Handles[i].Y;
    Handles[i].X := (X -aCenter.X) *COS(aAngle) -(Y -aCenter.Y) *SIN(aAngle) +aCenter.X;
    Handles[i].Y := (X -aCenter.X) *SIN(aAngle) +(Y -aCenter.Y) *COS(aAngle) +aCenter.Y;
  end;
end;

//==============================================================================
// Déplace une poignée
procedure TShape.MoveHandle(aHandle: integer; aPt: TPoint);
begin
  Handles[aHandle] := TPointF.Create(aPt);
end;

{ TForm1 }

//==============================================================================
// Création
procedure TForm1.FormCreate(Sender: TObject);
begin
  //Création de la liste des points de contact
  ContactList := TContactList.Create;

  //La fiche aux dimensions de la zone de travail
  BoundsRect := Screen.Monitors[0].WorkareaRect;

  //Création de la forme centrée
  Shape := TShape.Create((ClientWidth -ShapeSize) div 2, (ClientHeight -ShapeSize) div 2,
                         ShapeSize, ShapeSize);

  //Active le multi-touch si possible
  if IsMultiTouch then
    RegisterTouchWindow(Handle, 0);

  //Désactivation de la fonction Press&Hold
  DisablePressAndHold;
end;

//==============================================================================
// Destruction
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if IsMultiTouch then
    UnregisterTouchWindow(Handle);

  ContactList.Free;
end;

//==============================================================================
// Dessin
procedure TForm1.FormPaint(Sender: TObject);
begin
  Shape.Draw(Canvas);
end;

//==============================================================================
//Désactivation de la fonction Press&Hold
procedure TForm1.DisablePressAndHold;
var
  Atom :TAtom;

const
  TabletAtom = 'MicrosoftTabletPenServiceProperty';

begin
  Atom := GlobalAddAtom(tabletAtom);

  if Atom <> 0 then
  begin
    SetProp(Handle, tabletAtom, TABLET_DISABLE_PRESSANDHOLD);
    GlobalDeleteAtom(Atom);
  end;
end;

//==============================================================================
// Multi-touch possible ?
function TForm1.IsMultiTouch: boolean;
const
  Mask = NID_MULTI_INPUT or NID_READY;

begin
  Result := GetSystemMetrics(SM_DIGITIZER) and Mask = Mask;
end;

//==============================================================================
// Événement généré par le digitizer ?
function TForm1.IsFromTouch(aExtraInfo: integer): boolean;
begin
  Result := IsMultiTouch and (aExtraInfo and MOUSEEVENTF_FROMTOUCH = MOUSEEVENTF_FROMTOUCH);
end;

//==============================================================================
// Nouveau point de contact (digitizer ou souris)
procedure TForm1.AddEvent(aID: integer; aPrimary :boolean; aPt: TPoint);
var
  ContactInfo :TContactInfo;

begin
  ContactInfo.Pt      := aPt;
  ContactInfo.Primary := aPrimary;
  ContactInfo.Handle  := Shape.PtInHandle(aPt);

  ContactList.Add(aID, ContactInfo);
end;

//==============================================================================
// Déplacement (digitizer ou souris)
procedure TForm1.MoveEvent(aID: integer; aPt: TPoint);
var
  ContactInfo :TContactInfo;

begin
  if ContactList.TryGetValue(aID, ContactInfo) then
  begin
    case CheckAction of
      caMove      : MoveHandle(ContactInfo.Handle, aPt);

      caTranslate : Translate(aPt.X -ContactInfo.Pt.X, aPt.Y -ContactInfo.Pt.Y);

      caRotate    : Rotate(ContactInfo.Pt, aPt);
    end;

    ContactInfo.Pt := aPt;
    ContactList.AddOrSetValue(aID, ContactInfo);

    invalidate;
  end;
end;

//==============================================================================
// Suppression du contact (digitizer ou souris)
procedure TForm1.RemoveEvent(aID: integer);
begin
  ContactList.Remove(aID);
end;

//==============================================================================
// Action à effectuer en fonction du nombre de points de contact
// et de leur positionnement
function TForm1.CheckAction: TContactAction;
var
  Contact :TContact;
  Count   :integer;

begin
  Count := 0;

  //Nombre de contacts sur les poignées
  for Contact in ContactList do
    if Contact.Value.Handle > -1 then
      inc(Count);

  //Action à effectuer
  case Count of
    0 :  //Pas d'action
         Result := caNone;

    1 :  //Rotation si 2 points sinon translation
         if ContactList.Count = 2
         then Result := caRotate
         else Result := caTranslate;

    else //Déplace le point
         Result := caMove;
  end;
end;

//==============================================================================
// Bouton souris pressé
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //Uniquement si l'événement est généré par la souris (ignore le digitizer)
  if not IsFromTouch(GetMessageExtraInfo) then
    AddEvent(0, TRUE, Point(X,Y));
end;

//==============================================================================
// Souris déplacée
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  //Uniquement si l'événement est généré par la souris (ignore le digitizer)
  if not IsFromTouch(GetMessageExtraInfo) then
    MoveEvent(0, Point(X,Y));
end;

//==============================================================================
// Bouton souris relâché
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //Uniquement si l'événement est généré par la souris (ignore le digitizer)
  if not IsFromTouch(GetMessageExtraInfo) then
    RemoveEvent(0);
end;

//==============================================================================
// Événement du digitizer
procedure TForm1.WMTouch(var Message: TMessage);
var
  Count  :integer;               //Nombre de contacts
  Inputs :array of TTouchInput;  //Tableau de contacts
  Pt     :TPoint;                //Point en coordonnées fiche en pixel
  i      :integer;

begin
  //Récupère le nombre de contacts disponibles
  Count := LoWord(Message.WParam);

  //Fixe la taille du tableau
  SetLength(Inputs, Count);

  //et le remplit
  if GetTouchInputInfo(Message.LParam, Count, @Inputs[0], SizeOf(TTouchInput)) then
  begin

    //Traite chaque contact
    for i := 0 to high(Inputs) do
    begin
      //Le digitizer envoie le point au 1/100 de pixel et en coordonnées écran !
      //Conversion en pixel et coordonnées fiche
      Pt := Point(Inputs[i].x div 100, Inputs[i].y div 100);
      Pt := ScreenToClient(Pt);

      //Presser
      if (Inputs[i].Flags and TOUCHEVENTF_DOWN <> 0) then
        AddEvent(Inputs[i].ID, Inputs[i].Flags and TOUCHEVENTF_PRIMARY <> 0, Pt)

      //Déplacer
      else if (Inputs[i].Flags and TOUCHEVENTF_MOVE <> 0) then
        MoveEvent(Inputs[i].ID, Pt)

      //Relâcher
      else if (Inputs[i].Flags and TOUCHEVENTF_UP <> 0) then
        RemoveEvent(Inputs[i].ID);
    end;
  end;

  //Libération de la mémoire associée
  CloseTouchInputHandle(Message.LParam);

  Message.Result := 0;
end;

//==============================================================================
// Translation
procedure TForm1.Translate(X, Y :integer);
begin
  Shape.Translate(X, Y);
end;

//==============================================================================
// Rotation
procedure TForm1.Rotate(aPrevPt, aPt: TPoint);
var
  Contact :TContact;
  Angle   :extended;
  Center  :TPoint;
  X1, Y1  :integer;
  X2, Y2  :integer;

begin
  //Le point de rotation est défini par le contact primaire
  for Contact in ContactList do
    if Contact.Value.Primary then
    begin
      Center := Contact.Value.Pt;

      //Vecteur centre-point précédent
      X1 := aPrevPt.X -Center.X;
      Y1 := aPrevPt.Y -Center.Y;

      //Vecteur centre-point courant
      X2 := aPt.X -Center.X;
      Y2 := aPt.Y -Center.Y;

      if (X1*X2 +Y1*Y2) > 0 then
      begin
        Angle := ARCTAN((X1*Y2 -X2*Y1) /(X1*X2 +Y1*Y2));

        Shape.Rotate(Angle, Center);
      end;

      Break;
    end;
end;

//==============================================================================
// Déplace un point
procedure TForm1.MoveHandle(aHandle: integer; aPt: TPoint);
begin
  if aHandle > -1 then
    Shape.MoveHandle(aHandle, aPt);
end;

end.