Multitouch Anwendung unter Delphi 7

[ich2]

Hallo zusammen...

da ich mir ein Multitouch fähiges Tablet gekönnt habe, will ich natürlich auch gerne diese schöne Eigenschaft ausnutzen. Und das natürlich gerne unter Delphi 7!

Diese ganze Geschichte ist ja in Delphi 2010 bereits fest initialisiert, aber wir schauen einfach nach den nötigen Funktionen und Definitionen und holen sie uns nach Delphi 7. Eine kleine Einführung gibt bereits diese Seite:
http://wiki.helpmvp.com/home/notes/touch

Ich wollte aber noch zusätzlich die Anzahl der Finger und die Positionen der Finger haben, also mußte das Ganze noch mit dem WM_TOUCH -Event erweitert werden...

erstmal ein paar Definitionen:

Delphi-Quellcode:

const
  WM_GESTURENOTIFY    = $011A;
  WM_GESTURE          = $0119;
  WM_TOUCH            = $0240;

  WM_TABLET_DEFBASE   = $02C0;
  WM_TABLET_FLICK = WM_TABLET_DEFBASE + 11;

type
  TGestureNotifyStruct = record
    cbSize: UINT;                    // size, in bytes, of this structure
    dwFlags: DWORD;                  // unused
    hwndTarget: HWND;                // handle to window targeted by the gesture
    ptsLocation: TSmallPoint;        // starting location
    dwInstanceID: DWORD;             // internally used
  end;
  PGestureNotifyStruct = ^TGestureNotifyStruct;

  TWMGestureNotify = packed record
    Msg: Cardinal;
    Unused: WPARAM;
    NotifyStruct: PGestureNotifyStruct;
    Result: Integer;
  end;

  HTOUCHINPUT = THandle;

type
  PTOUCHINPUT = ^TOUCHINPUT;
  TOUCHINPUT = record
    x: Integer;
    y: Integer;
    hSource: THandle;
    dwID: DWORD;
    dwFlags: DWORD;
    dwMask: DWORD;
    dwTime: DWORD;
    dwExtraInfo: LongInt;
    cxContact: DWORD;
    cyContact: DWORD;
  end;
  TTouchInput = TOUCHINPUT;

...

  TForm1 = class(TForm)
  protected
    procedure WMTOUCH(var Msg: TMessage); message WM_TOUCH;
    procedure WMGestureNotify(var Msg: TWMGestureNotify); message WM_GESTURENOTIFY;
    procedure WMGesture(var Msg: TMessage); message WM_GESTURE;
    procedure WMTabletFlick(var Msg: TMessage); message WM_TABLET_FLICK;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

...dann holen wir uns noch die nötigen Funktionen aus der User32.dll (ACHTUNG: das funktioniert nur unter Windows 7 !!)...

Delphi-Quellcode:

  function CloseTouchInputHandle(hTouchInput: HTOUCHINPUT): BOOL; stdcall;
  function CloseTouchInputHandle; external user32 name 'CloseTouchInputHandle';

  function PhysicalToLogicalPoint(hWnd: HWND; var lpPoint: TPoint): BOOL; stdcall;
  function PhysicalToLogicalPoint; external user32 name 'PhysicalToLogicalPoint';

  function GetTouchInputInfo(hTouchInput: HTOUCHINPUT; cInputs: UINT; pInputs: PTOUCHINPUT; cbSize: Integer): BOOL; stdcall;
  function GetTouchInputInfo; external user32 name 'GetTouchInputInfo';

  function RegisterTouchWindow(hwnd: HWND; ulFlags: Cardinal): BOOL; stdcall;
  function RegisterTouchWindow; external user32 name 'RegisterTouchWindow';

  function UnregisterTouchWindow(hwnd: HWND): BOOL; stdcall;
  function UnregisterTouchWindow; external user32 name 'UnregisterTouchWindow';

...und schon kann man die Eingaben abholen...

Delphi-Quellcode:

procedure TForm1.WMGestureNotify(var Msg: TWMGestureNotify);
begin
  Msg.Result := DefWindowProc(Form1.Handle, Msg.Msg, Msg.Unused, Longint(Msg.NotifyStruct));
end;

procedure TForm1.WMGesture(var Msg: TMessage);
begin
  Msg.Result := DefWindowProc(Form1.Handle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

procedure TForm1.WMTabletFlick(var Msg: TMessage);
begin
  Msg.Result := DefWindowProc(Form1.Handle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

procedure TForm1.WMTOUCH(var Msg: TMessage);
  function TouchPointToPoint(const TouchPoint: TTouchInput): TPoint;
  begin
    Result := Point(TouchPoint.X div 100, TouchPoint.Y div 100);
    PhysicalToLogicalPoint(Form1.Handle, Result);
  end;

var
  TouchInputs: array of TTouchInput;
  counter: Integer;
  Handled: Boolean;
  Point: TPoint;
begin
  Handled := False;
  SetLength(TouchInputs, Msg.WParam);
  GetTouchInputInfo(Msg.LParam, Msg.WParam, @TouchInputs[0], SizeOf(TTouchInput));

  try
    for counter := 1 to Length (TouchInputs) do begin
      Point := TouchPointToPoint(TouchInputs [counter-1]);
      // ...
    end;

    Handled := True;
  finally
    if Handled then
      CloseTouchInputHandle(Msg.LParam)
    else
      inherited;
  end;
end;

...mit dem obigen Code bekommen wir noch keine Fingereingaben...wir müssen noch das Fenster-Handle registrieren...

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
  RegisterTouchWindow ( Form1.Handle, 0 );
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  UnRegisterTouchWindow ( Form1.Handle );
end;

...und schon funktioniert es...

viel Spaß beim Spielen

[sx2008]

Schön, aber du hast noch einen heftigen Bug in deinem Code:

Delphi-Quellcode:

procedure TForm1.WMGestureNotify(var Msg: TWMGestureNotify);
begin
  Msg.Result := DefWindowProc(Form1.Handle, Msg.Msg, Msg.Unused, Longint(Msg.NotifyStruct));
end;

Was würde wohl passieren, wenn von der Formular-Klasse TForm1 mehrere Objekte (also Formulare) erzeugt werden?

[rollstuhlfahrer]

Ums kurz zu machen: Da muss Self.Handle rein.

Bernhard

PS: Grund: Wenn du mehr als 1 Form hast, dann wird bei allen außer der ersten das falsche Handle genommen, nämlich das der ersten. Wenn du jetzt allerdings alle Forms auf die Variable Form1 erzeugst, dann hast du für alle außer der neusten Form den Fehler.

[himitsu]

Hab mal ein bissl am Exceptionhandling rumgespielt.
TouchPointToPoint wird in den Private-Abschnitt der TForm1 verschoben.
Und die angesprochenen Form1 entfernt.

Delphi-Quellcode:

procedure TForm1.WMGestureNotify(var Msg: TWMGestureNotify);
begin
  Msg.Result := DefWindowProc(Handle, Msg.Msg, Msg.Unused, Longint(Msg.NotifyStruct));
end;

procedure TForm1.WMGesture(var Msg: TMessage);
begin
  Msg.Result := DefWindowProc(Handle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

procedure TForm1.WMTabletFlick(var Msg: TMessage);
begin
  Msg.Result := DefWindowProc(Handle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

function TForm1.TouchPointToPoint(const TouchPoint: TTouchInput): TPoint;
begin
  Result := Point(TouchPoint.X div 100, TouchPoint.Y div 100);
  PhysicalToLogicalPoint(Handle, Result);
end;

procedure TForm1.WMTouch(var Msg: TMessage);
var
  TouchInputs: array of TTouchInput;
  counter: Integer;
  Point: TPoint;
begin
  SetLength(TouchInputs, Msg.WParam);
  GetTouchInputInfo(Msg.LParam, Msg.WParam, @TouchInputs[0], SizeOf(TTouchInput));
  try
    for counter := 0 to High(TouchInputs) do begin
      Point := TouchPointToPoint(TouchInputs[counter]);

      // ...

    end;
  finally
    CloseTouchInputHandle(Msg.LParam);
  end;
  inherited;
end;

Tipp: Verschiebe einfach mal diese globale Variable aus deiner Unit in die DPR.
Bzw. lösch diese aus deinen Unit und erstelle eine Dummy: TForm; in deiner DPR und benenne alle Form-Variablen in diese um.

Wenn danach dein Programm noch funktioniert, dann hast du es richtig gemacht.


Diese Globale ist einfach nur was Schreckliches und gehört abgeschafft.

[ich2]

Danke für die schnelle Antworten und die Tips...

werde sie in meinen Projekten berücksichtigen...

[himitsu]

oder eventuell auch so

Delphi-Quellcode:

procedure TForm1.WMTOUCH(var Msg: TMessage);
var
  TouchInputs: array of TTouchInput;
  TouchPoints: array of TPoint;
  counter: Integer;
begin
  SetLength(TouchInputs, Msg.WParam);
  SetLength(TouchPoints, Msg.WParam);
  GetTouchInputInfo(Msg.LParam, Msg.WParam, @TouchInputs[0], SizeOf(TTouchInput));
  CloseTouchInputHandle(Msg.LParam);
  for counter := 0 to High(TouchInputs) do
  begin
    TouchPoints[counter] := Point(TouchInputs[counter].X div 100, TouchInputs[counter].Y div 100);
    PhysicalToLogicalPoint(Handle, TouchPoints[counter]);
  end;


  // ...
  for counter := 0 to High(TouchPoints) do begin
    // TouchPoints[counter]

  end;
  // ...

  inherited;
end;

und alles zusammen, aber dennoch getrennt

Delphi-Quellcode:

type
  TForm1 = class(TForm)
  protected
    procedure WndProc(var Message: TMessage); override;
  private
    { Private declarations }
  public
    { Public declarations }
    procedure OnTouchPoints(const TouchPoints: TTouchPoints); 
  end; 

procedure TForm1.WndProc(var Message: TMessage); 
var
  TouchInputs: array of TTouchInput;
  TouchPoints: array of TPoint;
  counter: Integer;
begin
  if Message.msg = WM_GESTURENOTIFY then
    Msg.Result := DefWindowProc(Handle, Msg.Msg, Msg.Unused, Longint(Msg.NotifyStruct))
  else
  if Message.msg = WM_GESTURE then
    Msg.Result := DefWindowProc(Handle, Msg.Msg, Msg.WParam, Msg.LParam)
  else
  if Message.msg = WM_TABLET_FLICK then
    Msg.Result := DefWindowProc(Form1.Handle, Msg.Msg, Msg.WParam, Msg.LParam)
  else
  if Message.msg = WM_TOUCH then
  begin
    SetLength(TouchInputs, Msg.WParam);
    SetLength(TouchPoints, Msg.WParam);
    GetTouchInputInfo(Msg.LParam, Msg.WParam, @TouchInputs[0], SizeOf(TTouchInput));
    CloseTouchInputHandle(Msg.LParam);
    for counter := 0 to High(TouchInputs) do
    begin
      TouchPoints[counter] := Point(TouchInputs[counter].X div 100, TouchInputs[counter].Y div 100);
      PhysicalToLogicalPoint(Handle, TouchPoints[counter]);
    end;
    OnTouchPoints(TouchPoints);
    inherited;
  end else
    inherited;
end;

procedure TForm1.OnTouchPoints(const TouchPoints: TTouchPoints); 
begin
  // ...
end;

[greenmile]

Hallo,

ich denke da fehlt noch etwas ganz wichtiges. Nachdem Windows "WMGestureNotify" gesendet hat, muss man mittels "SetGestureConfig" definieren, welche Gesturen man gerne bekommen möchte (im Zweifelsfall GC_ALLGESTURES):

TGestureStruct = packed record
dwID: DWord; // gesture ID
dwWant: Dword; // settings related to gesture ID that are to be turned on
dwBlock: DWord; // settings related to gesture ID that are to be turned off
End;
PGestureStruct = ^TGestureStruct;


procedure TForm1.WMGestureNotify(var Msg: TWMGestureNotify);
var GCGestureStruct;
begin
GC.dwID := Msg.NotifyStruct.dwInstanceID;
GC.dwWant := 1; // GC_ALLGESTURES;
SetGestureConfig(Msg.NotifyStruct.hwndTarget, 0, 3, @gc, SizeOf(TGestureStruct));

Msg.Result := DefWindowProc(Handle, Msg.Msg, Msg.Unused, Longint(Msg.NotifyStruct));
end;

Anschließend sollte WMGesture ankommen. Klappt bei mir allerdings nicht, ich denke ich habe nen Fehler im Struct.