⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 An approach to implement the spacemouse to Delphi.
💻 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 + -