3Dconnexion commercialise une souris 3D
.
Comme j'ai eu l'occasion de l'utiliser dans un projet Delphi, je vous livre ici son interface Delphi :)
Le principe de cette unité est d'avoir un objet TMouse3D global et unique qui reçois les événements de la souris 3D.
Pour chaque contrôle qui doit réagir à la souris, il suffit de lui associer un
TMouse3DEvent
qui recevra automatiquement l'événement s'il possède le focus.type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); private FMouse3D : TMouse3DEvent; procedure Mouse3DChange(Sender: TObject); procedure Mouse3DKeyDown(Sender: TObject; Key: Integer); end; // ... procedure TForm1.FormCreate(Sender: TObject); begin FMouse3D := TMouse3DEvent.Create(Self); FMouse3D.OnChange := Mouse3DChange; FMouse3D.OnKeyDown := Mouse3DKeyDown; end;
unit Mouse3D; { (c)2009 by Paul TOTH, http://lookinside.free.fr { This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. } interface uses Windows, Classes, Controls, Forms, ActiveX, ComObj; const CLASS_Device: TGUID = '{82C5AB54-C92C-4D52-AAC5-27E25E22604C}'; DIID__ISensorEvents: TGUID = '{E6929A4A-6F41-46C6-9252-A8CC53472CB1}'; DIID__IKeyboardEvents: TGUID = '{6B6BB0A8-4491-40CF-B1A9-C15A801FE151}'; type IKeyboard = interface(IDispatch) ['{D6F968E7-2993-48D7-AF24-8B602D925B2C}'] function Get_Keys: Integer; safecall; function Get_ProgrammableKeys: Integer; safecall; function GetKeyLabel(key: Integer): WideString; safecall; function GetKeyName(key: Integer): WideString; safecall; function Get_Device: IDispatch; safecall; function IsKeyDown(key: Integer): WordBool; safecall; function IsKeyUp(key: Integer): WordBool; safecall; property Keys: Integer read Get_Keys; property ProgrammableKeys: Integer read Get_ProgrammableKeys; property Device: IDispatch read Get_Device; end; IAngleAxis = interface(IDispatch) ['{1EF2BAFF-54E9-4706-9F61-078F7134FD35}'] function Get_X: Double; safecall; procedure Set_X(pVal: Double); safecall; function Get_Y: Double; safecall; procedure Set_Y(pVal: Double); safecall; function Get_Z: Double; safecall; procedure Set_Z(pVal: Double); safecall; function Get_Angle: Double; safecall; procedure Set_Angle(pVal: Double); safecall; property X: Double read Get_X write Set_X; property Y: Double read Get_Y write Set_Y; property Z: Double read Get_Z write Set_Z; property Angle: Double read Get_Angle write Set_Angle; end; IVector3D = interface(IDispatch) ['{8C2AA71D-2B23-43F5-A6ED-4DF57E9CD8D5}'] function Get_X: Double; safecall; procedure Set_X(pVal: Double); safecall; function Get_Y: Double; safecall; procedure Set_Y(pVal: Double); safecall; function Get_Z: Double; safecall; procedure Set_Z(pVal: Double); safecall; function Get_Length: Double; safecall; procedure Set_Length(pVal: Double); safecall; property X: Double read Get_X write Set_X; property Y: Double read Get_Y write Set_Y; property Z: Double read Get_Z write Set_Z; property Length: Double read Get_Length write Set_Length; end; ISensor = interface(IDispatch) ['{F3A6775E-6FA1-4829-BF32-5B045C29078F}'] function Get_Translation: IVector3D; safecall; function Get_Rotation: IAngleAxis; safecall; function Get_Device: IDispatch; safecall; function Get_Period: Double; safecall; property Translation: IVector3D read Get_Translation; property Rotation: IAngleAxis read Get_Rotation; property Device: IDispatch read Get_Device; property Period: Double read Get_Period; end; ISimpleDevice = interface(IDispatch) ['{CB3BF65E-0816-482A-BB11-64AF1E837812}'] procedure Connect; safecall; procedure Disconnect; safecall; function Get_Sensor: ISensor; safecall; function Get_Keyboard: IKeyboard; safecall; function Get_Type: Integer; safecall; function Get_IsConnected: WordBool; safecall; procedure LoadPreferences(const PreferencesName: WideString); safecall; property Sensor: ISensor read Get_Sensor; property Keyboard: IKeyboard read Get_Keyboard; property Type_: Integer read Get_Type; property IsConnected: WordBool read Get_IsConnected; end; TMouseKeyEvent = procedure(Sender: TObject; Key : Integer) of object; TMouse3DEvent = class private FEnabled : Boolean; FOwner : TControl; FForm : TCustomForm; FOnChange : TNotifyEvent; FOnKeyDown: TMouseKeyEvent; FOnKeyUp : TMouseKeyEvent; protected function Focused : Boolean; virtual; procedure DoChange; virtual; procedure DoKeyDown(Key : Integer); virtual; procedure DoKeyUp(Key: Integer); virtual; public constructor Create(AOwner: TControl); destructor Destroy; override; property Enabled: Boolean read FEnabled write FEnabled; property OnChange : TNotifyEvent read FOnChange write FOnChange; property OnKeyDown: TMouseKeyEvent read FOnKeyDown write FOnKeyDown; property OnKeyUp : TMouseKeyEvent read FOnKeyUp write FOnKeyUp; end; TCustomEvents = class(TObject, IUnknown) private FRefCount : Integer; FConnection : Integer; FEventsIID : TGUID; protected { IUnknown } function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; { IDispatch } function GetTypeInfoCount(out Count: Integer): HResult; stdcall; function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall; function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall; end; TSensorEvents = class(TCustomEvents, IDispatch) private FSensor : ISensor; protected { IDispatch } function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall; public constructor Create(ASensor: ISensor); destructor Destroy; override; end; TKeyboardEvents = class(TCustomEvents, IDispatch) private FKeyboard : IKeyboard; protected { IDispatch } function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall; public constructor Create(AKeyboard: IKeyboard); destructor Destroy; override; end; TVector4D = record X, Y, Z, W : Double; end; TMouse3D = class private FEvents : TList; FDevice : ISimpleDevice; FSensorEvents : TSensorEvents; FKeyboardEvents : TKeyboardEvents; FTranslation : TVector4D; FRotation : TVector4D; procedure OnChange; procedure GetValues; procedure DoKeyDown(Key : Integer); procedure DoKeyUp(Key: Integer); public constructor Create; destructor Destroy; override; property Translation : TVector4D read FTranslation; property Rotation : TVector4D read FRotation; end; var gMouse3D : TMouse3D; implementation { TMouse3D } constructor TMouse3D.Create; var cClass : IUnknown; cErr : Integer; begin FEvents := TList.Create; cErr := CoCreateInstance(CLASS_Device, nil, CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, IUnknown, cClass); if cErr <> S_OK then Exit; FDevice := cClass as ISimpleDevice; FSensorEvents := TSensorEvents.Create(FDevice.Sensor); FKeyboardEvents := TKeyboardEvents.Create(FDevice.Keyboard); FDevice.Connect; end; destructor TMouse3D.Destroy; begin if Assigned(FDevice) then FDevice.Disconnect; FSensorEvents.Free; FKeyboardEvents.Free; FEvents.Free; inherited; end; procedure TMouse3D.DoKeyDown(Key: Integer); var i : Integer; begin for i := 0 to Pred(FEvents.Count) do with TMouse3DEvent(FEvents[i]) do if Focused then begin DoKeyDown(Key); Exit; end; end; procedure TMouse3D.DoKeyUp(Key: Integer); var i : Integer; begin for i := 0 to Pred(FEvents.Count) do with TMouse3DEvent(FEvents[i]) do if Focused then begin DoKeyUp(Key); Exit; end; end; procedure TMouse3D.GetValues; var T : IVector3D; R : IAngleAxis; begin T := FDevice.Sensor.Translation; FTranslation.X := T.X; FTranslation.Y := T.Y; FTranslation.Z := T.Z; FTranslation.W := T.Length; R := FDevice.Sensor.Rotation; FRotation.X := R.X; FRotation.Y := R.Y; FRotation.Z := R.Z; FRotation.W := R.Angle; end; procedure TMouse3D.OnChange; var i : Integer; begin GetValues; for i := 0 to Pred(FEvents.Count) do with TMouse3DEvent(FEvents[i]) do if Focused then begin DoChange; Exit; end; end; { TMouse3DEvent } constructor TMouse3DEvent.Create(AOwner: TControl); begin inherited Create; FOwner := AOwner; FForm := GetParentForm(FOwner); FEnabled := True; gMouse3D.FEvents.Add(Self); end; destructor TMouse3DEvent.Destroy; begin gMouse3D.FEvents.Remove(Self); inherited; end; procedure TMouse3DEvent.DoChange; begin if Assigned(FOnChange) then FOnChange(Self); end; procedure TMouse3DEvent.DoKeyDown(Key: Integer); begin if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key); end; procedure TMouse3DEvent.DoKeyUp(Key: Integer); begin if Assigned(FOnKeyUp) then FOnKeyUp(Self, Key); end; function TMouse3DEvent.Focused: Boolean; begin if FForm = nil then FForm := GetParentForm(FOwner); Result := (FEnabled) and Assigned(FOnChange) and ((FOwner = Screen.ActiveControl) or (FForm = Screen.ActiveForm)); end; { TCustomEvents } function TCustomEvents._AddRef: Integer; begin inc(FRefCount); Result := FRefCount; end; function TCustomEvents._Release: Integer; begin dec(FRefCount); Result := FRefCount; end; function TCustomEvents.QueryInterface(const IID: TGUID; out Obj): HResult; begin if GetInterface(IID, Obj) then begin Result := S_OK; Exit; end; if IsEqualIID(IID, FEventsIID) then begin GetInterface(IDispatch, Obj); Result := S_OK; Exit; end; Result := E_NOINTERFACE; end; function TCustomEvents.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; begin Result := E_NOTIMPL; end; function TCustomEvents.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; begin Pointer(TypeInfo) := nil; Result := E_NOTIMPL; end; function TCustomEvents.GetTypeInfoCount(out Count: Integer): HResult; begin Count := 0; Result:= S_OK; end; { TSensorEvents } function TSensorEvents.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; begin gMouse3D.OnChange; Result := S_OK; end; constructor TSensorEvents.Create(ASensor: ISensor); begin inherited Create; FSensor := ASensor; FEventsIID := DIID__ISensorEvents; InterfaceConnect(FSensor, FEventsIID, Self, FConnection); end; destructor TSensorEvents.Destroy; begin InterfaceDisconnect(FSensor, FEventsIID, FConnection); inherited; end; { TKeyboardEvents } constructor TKeyboardEvents.Create(AKeyboard: IKeyboard); begin inherited Create; FKeyboard := AKeyboard; FEventsIID := DIID__IKeyboardEvents; InterfaceConnect(FKeyboard, FEventsIID, Self, FConnection); end; destructor TKeyboardEvents.Destroy; begin InterfaceDisconnect(FKeyboard, FEventsIID, FConnection); inherited; end; function TKeyboardEvents.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; begin if DispID = 1 then gMouse3D.DoKeyDown(OleVariant(TDispParams(Params).rgvarg^[0])) else gMouse3D.DoKeyUp(OleVariant(TDispParams(Params).rgvarg^[0])); Result := S_OK; end; initialization gMouse3D := TMouse3D.Create; finalization gMouse3D.Free; end.
Date de dernière modification : 22/01/2009