?? main.pas
字號:
{
Written by TutTut
This is an approach to implement the
3d-Spacemouse to Delphi
i am not a so well programmer
therefore it doesn't work really because
there were different problems to me
i don't know where the SpaceMause
unit comes from, i have some samples
from c and that dcu, that dcu
should be the implementation from the
magelln-source
maybe some will find interest
and have a further look on such
}
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
SpaceMouse,
StdCtrls;
type
TSpaceM = class(TThread)
private
Hnd : THandle;
DevHdl : SiHdl;
Res : Integer;
counter : integer;
T1,t2,t3,t4:string;
Identity : String;
Procedure Sync;
protected
procedure Execute; override;
Function SbInit : Integer;
Public
OK : Bool;
constructor Create(Fhnd : THandle;ident : String); virtual;
Destructor Destroy; Override;
end;
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure FormActivate(Sender: TObject);
private
{ Private-Deklarationen}
public
{ Public-Deklarationen}
end;
var
Form1: TForm1;
mloop : TSpaceM;
implementation
{$R *.DFM}
constructor TSpaceM.Create(Fhnd : THandle;ident : String);
begin
OK:=False;
identity:=ident;
Hnd:=Fhnd;
inherited Create(True);
if SBINIT = 1 then OK:=True;
FreeOnTerminate := True;
if ok then execute;
end;
Destructor TSpaceM.destroy;
begin
inherited Destroy;
SiTerminate;
end;
Function TSpaceM.SbInit : Integer;
Var oData : SiOpenData; //* OS Independent data to open ball */
Test : integer;
Begin
if (SiInitialize = 8) then begin
Messagedlg('Cant load 3DMouse',mtInformation,[mbok],0);
Result:=0;
exit;
end;
SiOpenWinInit(@oData, Hnd); //* init Win. platform specific data */
devHdl := SiOpen(Identity, Hnd, SI_NO_MASK,SI_EVENT, @oData);
if devhdl = 0 then begin
SiTerminate; //* called to shut down the SpaceWare input library */
Result:=0;
end else Result:=1;
SiSetUiMode(devHdl, SI_UI_All_CONTROLS); //* Config SoftButton Win Display */
End;
Procedure TSpaceM.Sync;
Begin
form1.Label1.Caption:=t1;
form1.Label2.Caption:=t2;
form1.Label3.Caption:=t3;
form1.label4.caption:=t4;
end;
procedure TSpaceM.Execute;
var VMSG:Tmsg;
EDATA :SiGetEventData;
EVENT :SiSpwEvent;
WinH : THandle;
v1,v2 : integer;
begin
counter:=0;
repeat
inc(counter);
if getMessage(Vmsg,0, 0, 0) then begin
t3:=inttostr(vmsg.pt.x)+' '+inttostr(vmsg.pt.y);
WinH:=WindowFromPoint(vmsg.pt);
counter:=vmsg.message;
if counter<>15 then t4:=inttostr(counter);
SiGetEventWinInit(@EData, VMSG.message, Vmsg.wParam, Vmsg.lParam);
if SiGetEvent(devHdl, 0, @EData, @Event) = 5 then begin // 1-button 2-move
T1:=inttostr(event.eventtype);
end else begin
end;
SendMessage(Form1.Handle , vmsg.message , Vmsg.wParam, Vmsg.lParam);
end;
v1:=sibuttonpressed(@Event);
v2:=event.Eventtype;
t1:=inttostr(v1)+' '+inttostr(v2);
t2:='';
v1:=event.u.SPWDATA.mdata[0];
t2:=t2+' '+inttostr(v1);
v1:=event.u.SPWDATA.mdata[1];
t2:=t2+' '+inttostr(v1);
v1:=event.u.SPWDATA.mdata[2];
t2:=t2+' '+inttostr(v1);
v1:=event.u.SPWDATA.mdata[3];
t2:=t2+' '+inttostr(v1);
v1:=event.u.SPWDATA.mdata[4];
t2:=t2+' '+inttostr(v1);
v1:=event.u.SPWDATA.mdata[5];
t2:=t2+' '+inttostr(v1);
Synchronize(Sync);
until (1=2);
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
mloop:=tSpaceM.Create(Form1.handle,'3DTest1');
if mloop.OK then begin
mloop.Priority:=tplower;
end else begin
Form1.Close;
exit;
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -