├── Freetrack ├── Head.rc ├── SimConnect.rc ├── head.res ├── Icons.res ├── FPCuser.Pas ├── FreeTrack.res ├── TIRServer.dcu ├── TIRTypes.dcu ├── TrayIcon.pas ├── FPCuserImpl.INC ├── FPCuserIntf.INC ├── trackirexe.res ├── FreeTrack.dklang ├── Freetrack_fm.ddp ├── Freetrack_fm.pas ├── UsrFilesList.pas ├── DInputMap.dfm ├── SimConnect_dm.dfm ├── Programs.ini ├── Optitrack_dm.dfm ├── Wiimote_dm.dfm ├── SimConnect.Pas.embed.manifest ├── Freetrack.ini ├── ReadMe.txt ├── VideoDevice_dm.dfm ├── FreeTrack.dpr ├── ForceCamProp_fm.dfm ├── SimConnect_dm.pas ├── FreeTrack.dof ├── Average.pas ├── FreeTrackTray.pas ├── Constants.txt ├── changelog.txt ├── ProfilesMngr_fm.dfm ├── ForceCamProp_fm.pas └── gpl.txt ├── TIRfake ├── TrackIRexe.rc ├── TIRfake_fm.pas ├── trackirexe.res ├── TIRfake.dpr ├── TIRfake_fm.dfm └── TIRfake.dof ├── Bpl ├── SideBar.dcr ├── MkRangeSlider.dcr ├── Demo.dpr ├── Demo.cfg ├── Freetrack.cfg ├── Freetrack_Reg.cfg ├── Freetrack.dpk ├── Freetrack_Reg.dpk ├── UrlLink.pas ├── SideBarReg.pas ├── Demo_fm.pas ├── Demo_fm.dfm ├── Freetrack_Reg.dof ├── Demo.dof └── SideBar.pas ├── DShowFilter ├── FreetrackFilter.inc ├── cpuid.pas ├── Seuillage_inc.pas ├── FreeTrackFilter.dsk ├── FreeTrackFilter.res ├── SeuillageProcessor_CbCr.pas ├── SeuillageProcessor_I420.pas ├── SeuillageProcessor_RGB24.pas ├── SeuillageProcessor_RGB32.pas ├── FreeTrackFilter.dpr ├── SeuilProp_fm.dfm ├── FreeTrackFilter.dof ├── SeuilProp_fm.pas ├── SeuillageProcessor_YUV.pas ├── Seuillage.pas ├── SeuillageProcessor_YUYV.pas ├── SeuillageProcessor_UYVY.pas └── SeuillageProcessor.pas └── FreetrackClient ├── FreeTrackTest.dpr ├── FreeTrackClient.dpr ├── FTTypes.pas ├── FreeTrackClient.dof ├── FTClient.pas ├── FTTest.pas ├── FTServer.pas └── FTTest.dfm /Freetrack/Head.rc: -------------------------------------------------------------------------------- 1 | HEAD RCDATA Head.x 2 | -------------------------------------------------------------------------------- /TIRfake/TrackIRexe.rc: -------------------------------------------------------------------------------- 1 | TRACKIR EXE TIRfake.exe -------------------------------------------------------------------------------- /Freetrack/SimConnect.rc: -------------------------------------------------------------------------------- 1 | 1 24 "SimConnect.Pas.embed.manifest" 2 | -------------------------------------------------------------------------------- /Bpl/SideBar.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Bpl/SideBar.dcr -------------------------------------------------------------------------------- /Freetrack/head.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Freetrack/head.res -------------------------------------------------------------------------------- /DShowFilter/FreetrackFilter.inc: -------------------------------------------------------------------------------- 1 | {$define sse2} //undef to compile MMX compatible code 2 | -------------------------------------------------------------------------------- /Freetrack/Icons.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Freetrack/Icons.res -------------------------------------------------------------------------------- /Bpl/MkRangeSlider.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Bpl/MkRangeSlider.dcr -------------------------------------------------------------------------------- /DShowFilter/cpuid.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/DShowFilter/cpuid.pas -------------------------------------------------------------------------------- /Freetrack/FPCuser.Pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Freetrack/FPCuser.Pas -------------------------------------------------------------------------------- /Freetrack/FreeTrack.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Freetrack/FreeTrack.res -------------------------------------------------------------------------------- /Freetrack/TIRServer.dcu: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Freetrack/TIRServer.dcu -------------------------------------------------------------------------------- /Freetrack/TIRTypes.dcu: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Freetrack/TIRTypes.dcu -------------------------------------------------------------------------------- /Freetrack/TrayIcon.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Freetrack/TrayIcon.pas -------------------------------------------------------------------------------- /TIRfake/TIRfake_fm.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/TIRfake/TIRfake_fm.pas -------------------------------------------------------------------------------- /TIRfake/trackirexe.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/TIRfake/trackirexe.res -------------------------------------------------------------------------------- /Freetrack/FPCuserImpl.INC: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Freetrack/FPCuserImpl.INC -------------------------------------------------------------------------------- /Freetrack/FPCuserIntf.INC: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Freetrack/FPCuserIntf.INC -------------------------------------------------------------------------------- /Freetrack/trackirexe.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Freetrack/trackirexe.res -------------------------------------------------------------------------------- /Freetrack/FreeTrack.dklang: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Freetrack/FreeTrack.dklang -------------------------------------------------------------------------------- /Freetrack/Freetrack_fm.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Freetrack/Freetrack_fm.ddp -------------------------------------------------------------------------------- /Freetrack/Freetrack_fm.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Freetrack/Freetrack_fm.pas -------------------------------------------------------------------------------- /Freetrack/UsrFilesList.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/Freetrack/UsrFilesList.pas -------------------------------------------------------------------------------- /DShowFilter/Seuillage_inc.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/DShowFilter/Seuillage_inc.pas -------------------------------------------------------------------------------- /DShowFilter/FreeTrackFilter.dsk: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/DShowFilter/FreeTrackFilter.dsk -------------------------------------------------------------------------------- /DShowFilter/FreeTrackFilter.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/DShowFilter/FreeTrackFilter.res -------------------------------------------------------------------------------- /DShowFilter/SeuillageProcessor_CbCr.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/DShowFilter/SeuillageProcessor_CbCr.pas -------------------------------------------------------------------------------- /DShowFilter/SeuillageProcessor_I420.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/DShowFilter/SeuillageProcessor_I420.pas -------------------------------------------------------------------------------- /DShowFilter/SeuillageProcessor_RGB24.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/DShowFilter/SeuillageProcessor_RGB24.pas -------------------------------------------------------------------------------- /DShowFilter/SeuillageProcessor_RGB32.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PeterN/freetrack/HEAD/DShowFilter/SeuillageProcessor_RGB32.pas -------------------------------------------------------------------------------- /Bpl/Demo.dpr: -------------------------------------------------------------------------------- 1 | program Demo; 2 | 3 | uses 4 | Forms, 5 | Demo_fm in 'Demo_fm.pas' {fmDemo}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.CreateForm(TfmDemo, fmDemo); 12 | Application.Run; 13 | end. 14 | -------------------------------------------------------------------------------- /Freetrack/DInputMap.dfm: -------------------------------------------------------------------------------- 1 | object DInput: TDInput 2 | OldCreateOrder = False 3 | Left = 219 4 | Top = 112 5 | Height = 150 6 | Width = 215 7 | object timerPoll: TTimer 8 | Enabled = False 9 | Interval = 20 10 | Left = 80 11 | Top = 32 12 | end 13 | end 14 | -------------------------------------------------------------------------------- /TIRfake/TIRfake.dpr: -------------------------------------------------------------------------------- 1 | program TIRfake; 2 | 3 | uses 4 | Forms, 5 | TIRfake_fm in 'TIRfake_fm.pas' {Form1}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.Title := 'TrackIR'; 12 | Application.CreateForm(TForm1, Form1); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Freetrack/SimConnect_dm.dfm: -------------------------------------------------------------------------------- 1 | object dmSimConnect: TdmSimConnect 2 | OldCreateOrder = False 3 | OnDestroy = DataModuleDestroy 4 | Left = 1065 5 | Top = 421 6 | Height = 150 7 | Width = 215 8 | object TimerCnx: TTimer 9 | Enabled = False 10 | OnTimer = TimerCnxTimer 11 | Left = 72 12 | Top = 32 13 | end 14 | end 15 | -------------------------------------------------------------------------------- /FreetrackClient/FreeTrackTest.dpr: -------------------------------------------------------------------------------- 1 | program FreetrackTest; 2 | 3 | uses 4 | Forms, 5 | FTTest in 'FTTest.pas' {Form1}, 6 | FTTypes in 'FTTypes.pas'; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.Title := 'FreeTrack Interface Test'; 13 | Application.CreateForm(TForm1, Form1); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /TIRfake/TIRfake_fm.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 307 3 | Top = 221 4 | Width = 870 5 | Height = 600 6 | Caption = 'Form1' 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | end 18 | -------------------------------------------------------------------------------- /Freetrack/Programs.ini: -------------------------------------------------------------------------------- 1 | [Games] 2 | 48091=Falcon4 AF 3 | 5118=Falcon4 OF&RV 4 | 62451=Aces High II 5 | 50146=Live for speed 6 | 29678=Condor soaring 7 | 13309=First Eagles WWI 8 | 22490=Janes FA18 9 | 16849=Orbiter 10 | 6096=Armed Assault 11 | 38885=rFactor 12 | 19441=EECH 13 | 21450=Future Pinball 14 | 21475=GPL 15 | 32505=Lock On 16 | 38138=netKar Pro 17 | 65479=Descent D2X-XL 18 | 16886=Race 07 official WTCC 19 | 12269=Virtual Sailor 20 | -------------------------------------------------------------------------------- /Bpl/Demo.cfg: -------------------------------------------------------------------------------- 1 | -$A8 2 | -$B- 3 | -$C+ 4 | -$D+ 5 | -$E- 6 | -$F- 7 | -$G+ 8 | -$H+ 9 | -$I+ 10 | -$J- 11 | -$K- 12 | -$L+ 13 | -$M- 14 | -$N+ 15 | -$O+ 16 | -$P+ 17 | -$Q- 18 | -$R- 19 | -$S- 20 | -$T- 21 | -$U- 22 | -$V+ 23 | -$W- 24 | -$X+ 25 | -$YD 26 | -$Z1 27 | -cg 28 | -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 29 | -H+ 30 | -W+ 31 | -M 32 | -$M16384,1048576 33 | -K$00400000 34 | -LE"c:\program files\borland\delphi7\Projects\Bpl" 35 | -LN"c:\program files\borland\delphi7\Projects\Bpl" 36 | -w-UNSAFE_TYPE 37 | -w-UNSAFE_CODE 38 | -w-UNSAFE_CAST 39 | -------------------------------------------------------------------------------- /Freetrack/Optitrack_dm.dfm: -------------------------------------------------------------------------------- 1 | object dmOptitrack: TdmOptitrack 2 | OldCreateOrder = False 3 | Left = 382 4 | Top = 82 5 | Height = 335 6 | Width = 565 7 | object NPCameraCollection1: TNPCameraCollection 8 | AutoConnect = False 9 | ConnectKind = ckRunningOrNew 10 | OnDeviceRemoval = NPCameraCollection1DeviceRemoval 11 | OnDeviceArrival = NPCameraCollection1DeviceArrival 12 | Left = 64 13 | Top = 64 14 | end 15 | object NPCamera1: TNPCamera 16 | AutoConnect = False 17 | ConnectKind = ckRunningOrNew 18 | Left = 152 19 | Top = 64 20 | end 21 | end 22 | -------------------------------------------------------------------------------- /Freetrack/Wiimote_dm.dfm: -------------------------------------------------------------------------------- 1 | object dmwiimote: Tdmwiimote 2 | OldCreateOrder = False 3 | Left = 205 4 | Top = 220 5 | Height = 255 6 | Width = 264 7 | object HIDCtrl: TJvHidDeviceController 8 | OnDeviceChange = HIDCtrlDeviceChange 9 | OnRemoval = HIDCtrlRemoval 10 | Left = 64 11 | Top = 32 12 | end 13 | object StatusTimer: TTimer 14 | Enabled = False 15 | OnTimer = StatusTimerTimer 16 | Left = 128 17 | Top = 32 18 | end 19 | object SpeakerTimer: TTimer 20 | Enabled = False 21 | Interval = 9 22 | OnTimer = SpeakerTimerTimer 23 | Left = 128 24 | Top = 96 25 | end 26 | end 27 | -------------------------------------------------------------------------------- /Freetrack/SimConnect.Pas.embed.manifest: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /Bpl/Freetrack.cfg: -------------------------------------------------------------------------------- 1 | -$A8 2 | -$B- 3 | -$C+ 4 | -$D+ 5 | -$E- 6 | -$F- 7 | -$G+ 8 | -$H+ 9 | -$I+ 10 | -$J- 11 | -$K- 12 | -$L+ 13 | -$M- 14 | -$N+ 15 | -$O+ 16 | -$P+ 17 | -$Q- 18 | -$R- 19 | -$S- 20 | -$T- 21 | -$U- 22 | -$V+ 23 | -$W- 24 | -$X+ 25 | -$YD 26 | -$Z1 27 | -cg 28 | -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 29 | -H+ 30 | -W+ 31 | -M 32 | -$M16384,1048576 33 | -K$00400000 34 | -LE"c:\program files\borland\delphi7\Projects\Bpl" 35 | -LN"c:\program files\borland\delphi7\Projects\Bpl" 36 | -U"c:\program files\borland\delphi7\Source\ToolsAPI" 37 | -O"c:\program files\borland\delphi7\Source\ToolsAPI" 38 | -I"c:\program files\borland\delphi7\Source\ToolsAPI" 39 | -R"c:\program files\borland\delphi7\Source\ToolsAPI" 40 | -w-UNSAFE_TYPE 41 | -w-UNSAFE_CODE 42 | -w-UNSAFE_CAST 43 | -------------------------------------------------------------------------------- /Bpl/Freetrack_Reg.cfg: -------------------------------------------------------------------------------- 1 | -$A8 2 | -$B- 3 | -$C+ 4 | -$D+ 5 | -$E- 6 | -$F- 7 | -$G+ 8 | -$H+ 9 | -$I+ 10 | -$J- 11 | -$K- 12 | -$L+ 13 | -$M- 14 | -$N+ 15 | -$O+ 16 | -$P+ 17 | -$Q- 18 | -$R- 19 | -$S- 20 | -$T- 21 | -$U- 22 | -$V+ 23 | -$W- 24 | -$X+ 25 | -$YD 26 | -$Z1 27 | -cg 28 | -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 29 | -H+ 30 | -W+ 31 | -M 32 | -$M16384,1048576 33 | -K$00400000 34 | -LE"c:\program files\borland\delphi7\Projects\Bpl" 35 | -LN"c:\program files\borland\delphi7\Projects\Bpl" 36 | -U"c:\program files\borland\delphi7\Source\ToolsAPI" 37 | -O"c:\program files\borland\delphi7\Source\ToolsAPI" 38 | -I"c:\program files\borland\delphi7\Source\ToolsAPI" 39 | -R"c:\program files\borland\delphi7\Source\ToolsAPI" 40 | -w-UNSAFE_TYPE 41 | -w-UNSAFE_CODE 42 | -w-UNSAFE_CAST 43 | -------------------------------------------------------------------------------- /Freetrack/Freetrack.ini: -------------------------------------------------------------------------------- 1 | [Defaults] 2 | HiRes=1 3 | Tracking_Method=0 4 | Threshold=90 5 | Average=6 6 | Profile=C:\Headtrack\FreetrackSources\FreetrackSVN\Freetrack\Game2.fgp 7 | 8 | [Center] 9 | Yaw=0 10 | Pitch=0 11 | Roll=0 12 | X=0 13 | Y=0 14 | Z=0 15 | 16 | [Camera] 17 | Fps=30 18 | Name=Logitech QuickCam Express/Go 19 | Compressor={E436EB7D-524F-11CE-9F53-0020AF0BA770} 20 | 21 | [Mapping] 22 | Init_0=67 23 | Init_1=0 24 | Init_2=1 25 | Init_3=0 26 | ToggleActive_0=67 27 | ToggleActive_1=1 28 | ToggleActive_2=1 29 | ToggleActive_3=0 30 | 31 | [Offset3Pts] 32 | X=89 33 | Y=60 34 | Z=2 35 | Distance=14 36 | dist=217 37 | 38 | [Offset4Pts] 39 | Distance=14 40 | 41 | [Threepoint_leds] 42 | x1=80 43 | y1=80 44 | x2=50 45 | y2=50 46 | 47 | [Fourpoint_leds] 48 | x1=60 49 | y1=95 50 | z1=70 51 | y2=80 52 | z2=90 53 | -------------------------------------------------------------------------------- /Bpl/Freetrack.dpk: -------------------------------------------------------------------------------- 1 | package Freetrack; 2 | 3 | {$R *.res} 4 | {$R 'SideBar.dcr'} 5 | {$R 'MkRangeSlider.dcr'} 6 | {$ALIGN 8} 7 | {$ASSERTIONS ON} 8 | {$BOOLEVAL OFF} 9 | {$DEBUGINFO ON} 10 | {$EXTENDEDSYNTAX ON} 11 | {$IMPORTEDDATA ON} 12 | {$IOCHECKS ON} 13 | {$LOCALSYMBOLS ON} 14 | {$LONGSTRINGS ON} 15 | {$OPENSTRINGS ON} 16 | {$OPTIMIZATION ON} 17 | {$OVERFLOWCHECKS OFF} 18 | {$RANGECHECKS OFF} 19 | {$REFERENCEINFO ON} 20 | {$SAFEDIVIDE OFF} 21 | {$STACKFRAMES OFF} 22 | {$TYPEDADDRESS OFF} 23 | {$VARSTRINGCHECKS ON} 24 | {$WRITEABLECONST OFF} 25 | {$MINENUMSIZE 1} 26 | {$IMAGEBASE $400000} 27 | {$RUNONLY} 28 | {$IMPLICITBUILD ON} 29 | 30 | requires 31 | rtl, 32 | vcl, 33 | Designide; 34 | 35 | contains 36 | SideBar in 'SideBar.pas', 37 | MkRangeSlider in 'MkRangeSlider.pas', 38 | UrlLink in 'UrlLink.pas'; 39 | 40 | end. 41 | -------------------------------------------------------------------------------- /Bpl/Freetrack_Reg.dpk: -------------------------------------------------------------------------------- 1 | package Freetrack_Reg; 2 | 3 | {$R *.res} 4 | {$R 'SideBar.dcr'} 5 | {$R 'MkRangeSlider.dcr'} 6 | {$ALIGN 8} 7 | {$ASSERTIONS ON} 8 | {$BOOLEVAL OFF} 9 | {$DEBUGINFO ON} 10 | {$EXTENDEDSYNTAX ON} 11 | {$IMPORTEDDATA ON} 12 | {$IOCHECKS ON} 13 | {$LOCALSYMBOLS ON} 14 | {$LONGSTRINGS ON} 15 | {$OPENSTRINGS ON} 16 | {$OPTIMIZATION ON} 17 | {$OVERFLOWCHECKS OFF} 18 | {$RANGECHECKS OFF} 19 | {$REFERENCEINFO ON} 20 | {$SAFEDIVIDE OFF} 21 | {$STACKFRAMES OFF} 22 | {$TYPEDADDRESS OFF} 23 | {$VARSTRINGCHECKS ON} 24 | {$WRITEABLECONST OFF} 25 | {$MINENUMSIZE 1} 26 | {$IMAGEBASE $400000} 27 | {$DESIGNONLY} 28 | {$IMPLICITBUILD ON} 29 | 30 | requires 31 | rtl, 32 | vcl, 33 | designide; 34 | 35 | contains 36 | SideBarReg in 'SideBarReg.pas', 37 | SideBar in 'SideBar.pas', 38 | MkRangeSlider in 'MkRangeSlider.pas', 39 | Response in 'Response.pas', 40 | UrlLink in 'UrlLink.pas'; 41 | 42 | end. 43 | -------------------------------------------------------------------------------- /Freetrack/ReadMe.txt: -------------------------------------------------------------------------------- 1 | Delphi DirectX 9.0 headers : Clootie_DirectX92_01.31 can be found here http://sourceforge.net/project/showfiles.php?group_id=116990 2 | 3 | 4 | DSPack 2.3.4 can be found here 5 | http://www.progdigy.com/modules.php?name=DSPack 6 | 7 | 8 | indy 10.0.52 (required for Lomac DLL) can be found here 9 | http://www.indyproject.org/download/index.iwp 10 | 11 | 12 | PNGComponents 13 | www.thany.org/pngcomponents/ 14 | Ensure DSPack is after PNGComponents in 'uses' list because they both have a TFilter. 15 | 16 | 17 | DKLang localization 18 | http://www.dk-soft.org/products/dklang/ 19 | Requires Tnt Delphi UNICODE Controls 20 | http://mh-nexus.de/tntunicodecontrols.htm 21 | Use DKLang Translation Editor to create translation files *.lang from *.dklang source 22 | Resourcestrings must be defined in: Project -> Edit Project Constants (easier to load from constants.txt file) 23 | and accessed use DKLangConstW('constant'); 24 | *.dklang source language files should never be edited directly. 25 | 26 | 27 | JvHidControllerClass 28 | For HID access to Wii Remote 29 | 30 | 31 | Optitrack SDK 32 | 33 | 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /Bpl/UrlLink.pas: -------------------------------------------------------------------------------- 1 | unit UrlLink; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, Classes, Controls, StdCtrls, Graphics, ShellApi; 7 | 8 | type 9 | TUrlLink = Class(TLabel) 10 | procedure CMMouseEnter(var Msg: TMessage); message CM_MouseEnter; 11 | procedure CMMouseLeave(var Msg: TMessage); message CM_MouseLeave; 12 | procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override; 13 | end; 14 | 15 | procedure Register; 16 | 17 | 18 | implementation 19 | 20 | 21 | { TUrlLink } 22 | 23 | procedure TUrlLink.CMMouseEnter(var Msg: TMessage); 24 | begin 25 | if not (csDesigning in ComponentState) then begin 26 | Font.Style := Font.Style + [fsUnderline]; 27 | Cursor := crHandPoint; 28 | end; 29 | end; 30 | 31 | procedure TUrlLink.CMMouseLeave(var Msg: TMessage); 32 | begin 33 | if not (csDesigning in ComponentState) then begin 34 | Font.Style := Font.Style - [fsUnderline]; 35 | Cursor := crDefault; 36 | end; 37 | end; 38 | 39 | procedure Register; 40 | begin 41 | RegisterComponents('Freetrack', [TUrlLink]); 42 | end; 43 | 44 | procedure TUrlLink.MouseUp(Button: TMouseButton; Shift: TShiftState; X, 45 | Y: Integer); 46 | begin 47 | inherited; 48 | ShellExecute(0, 'open', PChar(caption),nil,nil, SW_SHOWNORMAL); 49 | end; 50 | 51 | end. 52 | -------------------------------------------------------------------------------- /FreetrackClient/FreeTrackClient.dpr: -------------------------------------------------------------------------------- 1 | library FreetrackClient; 2 | 3 | { Important note about DLL memory management: ShareMem must be the 4 | first unit in your library's USES clause AND your project's (select 5 | Project-View Source) USES clause if your DLL exports any procedures or 6 | functions that pass strings as parameters or function results. This 7 | applies to all strings passed to and from your DLL--even those that 8 | are nested in records and classes. ShareMem is the interface unit to 9 | the BORLNDMM.DLL shared memory manager, which must be deployed along 10 | with your DLL. To avoid using BORLNDMM.DLL, pass string information 11 | using PChar or ShortString parameters. } 12 | 13 | uses 14 | FTTypes in 'FTTypes.pas', 15 | FTClient in 'FTClient.pas'; // Client must come after types for correct exports 16 | 17 | {$R *.res} 18 | 19 | const 20 | DLL_PROCESS_ATTACH = 1; 21 | DLL_PROCESS_DETACH = 0; 22 | 23 | exports 24 | FTGetData, 25 | FTReportName, 26 | FTGetDllVersion, 27 | FTProvider; 28 | 29 | 30 | procedure dllMain(reason : Integer); 31 | begin 32 | case reason of 33 | DLL_PROCESS_ATTACH : OpenMapping; 34 | DLL_PROCESS_DETACH : DestroyMapping; 35 | end; 36 | end; 37 | 38 | 39 | begin 40 | DllProc := @dllMain; 41 | DllProc(DLL_PROCESS_ATTACH); 42 | end. 43 | -------------------------------------------------------------------------------- /DShowFilter/FreeTrackFilter.dpr: -------------------------------------------------------------------------------- 1 | { Under GNU License 2 | check http://www.opensource.org/ 3 | project by 4 | Nicolas Camil 5 | http://n.camil.chez.tiscali.fr 6 | ------------------------------ 7 | 8 | This library is free software; you can redistribute it and/or 9 | modify it under the terms of the GNU Library General Public 10 | License as published by the Free Software Foundation. 11 | 12 | This library is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | Library General Public License for more details.} 16 | 17 | library FreeTrackFilter; 18 | {$i 'FreetrackFilter.inc'} 19 | {$ifdef SSE2} 20 | {$LIBSUFFIX 'SSE2'} 21 | 22 | {$else} 23 | {$LIBSUFFIX 'MMX'} 24 | {$endif} 25 | 26 | 27 | 28 | {%File 'FreetrackFilter.inc'} 29 | 30 | uses 31 | Windows, 32 | SysUtils, 33 | BaseClass, 34 | Seuillage in 'Seuillage.pas', 35 | Seuillage_inc in 'Seuillage_inc.pas', 36 | SeuilProp_fm in 'SeuilProp_fm.pas' {fmSettings}, 37 | cpuid in 'cpuid.pas', 38 | SeuillageProcessor in 'SeuillageProcessor.pas', 39 | SeuillageProcessor_RGB24 in 'SeuillageProcessor_RGB24.pas', 40 | SeuillageProcessor_RGB32 in 'SeuillageProcessor_RGB32.pas', 41 | SeuillageProcessor_CbCr in 'SeuillageProcessor_CbCr.pas', 42 | SeuillageProcessor_YUV in 'SeuillageProcessor_YUV.pas', 43 | SeuillageProcessor_YUYV in 'SeuillageProcessor_YUYV.pas', 44 | SeuillageProcessor_UYVY in 'SeuillageProcessor_UYVY.pas'; 45 | 46 | {$E ax} 47 | 48 | {$R *.res} 49 | 50 | exports 51 | DllGetClassObject, 52 | DllCanUnloadNow, 53 | DllRegisterServer, 54 | DllUnregisterServer; 55 | begin 56 | end. 57 | 58 | -------------------------------------------------------------------------------- /Bpl/SideBarReg.pas: -------------------------------------------------------------------------------- 1 | unit SideBarReg; 2 | 3 | interface 4 | uses 5 | Classes, SideBar, DesignIntf, DesignEditors, TypInfo, ComCtrls, SysUtils, 6 | Dialogs, MkRangeSlider; 7 | 8 | type 9 | TSideBarEditor = class(TComponentEditor) 10 | function GetVerb(Index: Integer): string; override; 11 | function GetVerbCount: Integer; override; 12 | procedure ExecuteVerb(Index: Integer); override; 13 | end; 14 | 15 | procedure Register; 16 | 17 | implementation 18 | 19 | 20 | procedure Register; 21 | begin 22 | RegisterComponents('FreeTrack', [TSideBar]); 23 | RegisterComponentEditor(TSideBar, TSideBarEditor); 24 | RegisterComponents('FreeTrack', [TmkRangeSlider]); 25 | end; 26 | 27 | { TSideBarEditor } 28 | 29 | procedure TSideBarEditor.ExecuteVerb(Index: Integer); 30 | var 31 | ts : TTabSheet; 32 | begin 33 | case index of 34 | 0 : begin 35 | ts := TTabSheet.Create(Component); 36 | ts.PageControl := (Component as TSideBar).PageCtrl; 37 | ts.Name := Component.Name + '_Tabsheet' + intToStr(ts.PageControl.PageCount); 38 | ts.Caption := 'Tabsheet' + intToStr(ts.PageControl.PageCount); 39 | end; 40 | 41 | 1 : 42 | (Component as TSideBar).PageCtrl.SelectNextPage(True, False); 43 | 44 | 2 : 45 | (Component as TSideBar).PageCtrl.SelectNextPage(False, False); 46 | 47 | 3 : 48 | if Assigned( (Component as TSideBar).PageCtrl.ActivePage) then 49 | (Component as TSideBar).PageCtrl.ActivePage.Free; 50 | end; 51 | end; 52 | 53 | function TSideBarEditor.GetVerb(Index: Integer): string; 54 | begin 55 | case index of 56 | 0 : Result := 'Ne&w page'; 57 | 1 : Result := 'Ne&xt page'; 58 | 2 : Result := '&Previous page'; 59 | 3 : Result := '&Delete page'; 60 | end; 61 | end; 62 | 63 | function TSideBarEditor.GetVerbCount: Integer; 64 | begin 65 | Result := 4; 66 | end; 67 | 68 | 69 | 70 | end. 71 | -------------------------------------------------------------------------------- /Bpl/Demo_fm.pas: -------------------------------------------------------------------------------- 1 | unit Demo_fm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, ExtCtrls, SideBar, ComCtrls, StdCtrls, MkRangeSlider; 8 | 9 | type 10 | TfmDemo = class(TForm) 11 | SideBar1: TSideBar; 12 | TabSheet2: TTabSheet; 13 | TabSheet3: TTabSheet; 14 | Memo1: TMemo; 15 | Button2: TButton; 16 | Button3: TButton; 17 | RadioGroup1: TRadioGroup; 18 | Panel1: TPanel; 19 | HorizRS: TmkRangeSlider; 20 | RadioGroup2: TRadioGroup; 21 | Panel2: TPanel; 22 | ComboBox1: TComboBox; 23 | procedure RadioGroup2Click(Sender: TObject); 24 | procedure HorizRSGetRullerLength(Sender: TObject; var Value: Integer); 25 | private 26 | { Private declarations } 27 | public 28 | { Public declarations } 29 | end; 30 | 31 | var 32 | fmDemo: TfmDemo; 33 | 34 | 35 | const 36 | ColorDlClick = $00A66EA; 37 | ColorClick = $0080FFFF; 38 | ColorIdle = clGray; 39 | 40 | implementation 41 | 42 | 43 | 44 | {$R *.dfm} 45 | 46 | procedure TfmDemo.RadioGroup2Click(Sender: TObject); 47 | begin 48 | case RadioGroup2.ItemIndex of 49 | 0 : begin //forward 50 | HorizRS.ColorLow := ColorIdle; 51 | HorizRS.ColorMid := ColorClick; 52 | HorizRS.ColorHi := ColorDlClick; 53 | end; 54 | 55 | 1 : begin //central 56 | HorizRS.ColorLow := ColorClick; 57 | HorizRS.ColorMid := ColorIdle; 58 | HorizRS.ColorHi := ColorDlClick; 59 | end; 60 | 61 | { 2 : begin //backward 62 | HorizRS.ColorLow := ColorDlClick; 63 | HorizRS.ColorMid := ColorClick; 64 | HorizRS.ColorHi := ColorIdle; 65 | end; } 66 | end; 67 | HorizRS.Invalidate; 68 | end; 69 | 70 | procedure TfmDemo.HorizRSGetRullerLength(Sender: TObject; 71 | var Value: Integer); 72 | begin 73 | Value := 300; 74 | end; 75 | 76 | end. 77 | -------------------------------------------------------------------------------- /Freetrack/VideoDevice_dm.dfm: -------------------------------------------------------------------------------- 1 | object dmVideoDevice: TdmVideoDevice 2 | OldCreateOrder = False 3 | Left = 304 4 | Top = 173 5 | Height = 378 6 | Width = 459 7 | object Graph: TFilterGraph 8 | Mode = gmCapture 9 | GraphEdit = True 10 | LinearVolume = True 11 | OnDSEvent = GraphDSEvent 12 | Left = 24 13 | Top = 32 14 | end 15 | object GraphDemo: TFilterGraph 16 | GraphEdit = True 17 | LinearVolume = True 18 | OnDSEvent = GraphDSEvent 19 | Left = 80 20 | Top = 32 21 | end 22 | object Camera: TFilter 23 | BaseFilter.data = { 24 | 1A01000037D415438C5BD011BD3B00A0C911CE86060100004000640065007600 25 | 6900630065003A0070006E0070003A005C005C003F005C007500730062002300 26 | 7600690064005F00300034003600640026007000690064005F00300039003200 27 | 6600230035002600310039006200660063006200360063002600300026003200 28 | 23007B00360035006500380037003700330064002D0038006600350036002D00 29 | 31003100640030002D0061003300620039002D00300030006100300063003900 30 | 3200320033003100390036007D005C007B003900620033003600350038003900 31 | 30002D0031003600350066002D0031003100640030002D006100310039003500 32 | 2D003000300032003000610066006400310035003600650034007D000000} 33 | FilterGraph = Graph 34 | Left = 144 35 | Top = 32 36 | end 37 | object Seuillage: TFilter 38 | BaseFilter.data = { 39 | C600000037D415438C5BD011BD3B00A0C911CE86B20000004000640065007600 40 | 6900630065003A00730077003A007B0030003800330038003600330046003100 41 | 2D0037003000440045002D0031003100440030002D0042004400340030002D00 42 | 3000300041003000430039003100310043004500380036007D005C007B003000 43 | 41003900390046003200430041002D0037003900430039002D00340033003100 44 | 32002D0042003700380045002D00450044003600430042003300380032003900 45 | 3200370035007D000000} 46 | FilterGraph = Graph 47 | Left = 200 48 | Top = 32 49 | end 50 | end 51 | -------------------------------------------------------------------------------- /Freetrack/FreeTrack.dpr: -------------------------------------------------------------------------------- 1 | { Under GNU License 2 | check http://www.opensource.org/ 3 | project by 4 | Nicolas Camil 5 | http://n.camil.chez.tiscali.fr 6 | ------------------------------ 7 | 8 | This library is free software; you can redistribute it and/or 9 | modify it under the terms of the GNU Library General Public 10 | License as published by the Free Software Foundation. 11 | 12 | This library is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | Library General Public License for more details.} 16 | 17 | program FreeTrack; 18 | 19 | {$R 'SimConnect.res' 'SimConnect.rc'} 20 | {$R *.res} 21 | {$R *.dkl_const.res} 22 | {$R trackirexe.res} 23 | 24 | 25 | uses 26 | Forms, 27 | Freetrack_fm in 'Freetrack_fm.pas' {fmFreetrack}, 28 | Average in 'Average.pas', 29 | HeadDisplay in 'HeadDisplay.pas', 30 | FreeTrackTray in 'FreeTrackTray.pas', 31 | Parameters in 'Parameters.pas', 32 | ProfilesMngr_fm in 'ProfilesMngr_fm.pas' {ProfilesMngr}, 33 | Pose in 'Pose.pas', 34 | ForceCamProp_fm in 'ForceCamProp_fm.pas' {ForceCamProp}, 35 | SimConnect_dm in 'SimConnect_dm.pas' {dmSimConnect: TDataModule}, 36 | SimConnect in 'SimConnect.pas', 37 | DInputMap in 'DInputMap.pas' {DInput: TDataModule}, 38 | Response in '..\Bpl\Response.pas', 39 | UrlLink in '..\Bpl\UrlLink.pas', 40 | Wiimote_dm in 'Wiimote_dm.pas' {dmwiimote: TDataModule}, 41 | Optitrack_dm in 'Optitrack_dm.pas' {dmOptitrack: TDataModule}, 42 | PoseDataOutput_fm in 'PoseDataOutput_fm.pas' {PoseDataOutput : TPoseDataOutput}, 43 | CamManager_fm in 'CamManager_fm.pas' {CamManager}, 44 | VideoDevice_dm in 'VideoDevice_dm.pas' {dmVideoDevice: TDataModule}; 45 | 46 | begin 47 | Application.Initialize; 48 | Application.Title := 'FreeTrack'; 49 | Application.CreateForm(TdmSimConnect, dmSimConnect); 50 | Application.CreateForm(TDInput, DInput); 51 | Application.CreateForm(TfmFreetrack, fmFreetrack); 52 | Application.Run; 53 | end. 54 | -------------------------------------------------------------------------------- /DShowFilter/SeuilProp_fm.dfm: -------------------------------------------------------------------------------- 1 | object fmSettings: TfmSettings 2 | Left = 425 3 | Top = 207 4 | Width = 323 5 | Height = 184 6 | Caption = 'Seuil' 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Label1: TLabel 17 | Left = 16 18 | Top = 96 19 | Width = 6 20 | Height = 13 21 | Caption = '0' 22 | end 23 | object Label2: TLabel 24 | Left = 232 25 | Top = 96 26 | Width = 18 27 | Height = 13 28 | Caption = '255' 29 | end 30 | object TrackBar: TTrackBar 31 | Left = 16 32 | Top = 112 33 | Width = 249 34 | Height = 45 35 | Max = 255 36 | Frequency = 10 37 | Position = 125 38 | TabOrder = 0 39 | OnChange = TrackBarChange 40 | end 41 | object cbActive: TCheckBox 42 | Left = 16 43 | Top = 40 44 | Width = 81 45 | Height = 17 46 | Caption = 'Active' 47 | TabOrder = 1 48 | OnClick = cbActiveClick 49 | end 50 | object GroupBox1: TGroupBox 51 | Left = 112 52 | Top = 8 53 | Width = 121 54 | Height = 73 55 | Caption = 'Point size' 56 | TabOrder = 2 57 | object Label3: TLabel 58 | Left = 8 59 | Top = 21 60 | Width = 41 61 | Height = 13 62 | Caption = 'Minimal :' 63 | end 64 | object Label4: TLabel 65 | Left = 8 66 | Top = 45 67 | Width = 44 68 | Height = 13 69 | Caption = 'Maximal :' 70 | end 71 | object spMinSize: TSpinEdit 72 | Left = 56 73 | Top = 16 74 | Width = 49 75 | Height = 22 76 | MaxValue = 120 77 | MinValue = 1 78 | TabOrder = 0 79 | Value = 1 80 | OnChange = spMinSizeChange 81 | end 82 | object spMaxSize: TSpinEdit 83 | Left = 56 84 | Top = 40 85 | Width = 49 86 | Height = 22 87 | MaxValue = 150 88 | MinValue = 1 89 | TabOrder = 1 90 | Value = 120 91 | OnChange = spMaxSizeChange 92 | end 93 | end 94 | end 95 | -------------------------------------------------------------------------------- /Freetrack/ForceCamProp_fm.dfm: -------------------------------------------------------------------------------- 1 | object ForceCamProp: TForceCamProp 2 | Left = 439 3 | Top = 160 4 | BorderStyle = bsDialog 5 | Caption = 'Camera Properties' 6 | ClientHeight = 179 7 | ClientWidth = 276 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'MS Sans Serif' 13 | Font.Style = [] 14 | FormStyle = fsStayOnTop 15 | OldCreateOrder = False 16 | OnClose = FormClose 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object Panel1: TPanel 20 | Left = 0 21 | Top = 146 22 | Width = 276 23 | Height = 33 24 | Align = alBottom 25 | BevelOuter = bvNone 26 | TabOrder = 1 27 | object Panel2: TPanel 28 | Left = 24 29 | Top = 0 30 | Width = 252 31 | Height = 33 32 | Align = alRight 33 | BevelOuter = bvNone 34 | TabOrder = 0 35 | object butApply: TButton 36 | Left = 168 37 | Top = 0 38 | Width = 75 39 | Height = 25 40 | Caption = 'Apply' 41 | Enabled = False 42 | TabOrder = 0 43 | OnClick = butApplyClick 44 | end 45 | object butCancel: TButton 46 | Left = 88 47 | Top = 0 48 | Width = 75 49 | Height = 25 50 | Caption = 'Cancel' 51 | TabOrder = 1 52 | OnClick = butCancelClick 53 | end 54 | object butOK: TButton 55 | Left = 8 56 | Top = 0 57 | Width = 75 58 | Height = 25 59 | Caption = 'OK' 60 | TabOrder = 2 61 | OnClick = butOKClick 62 | end 63 | end 64 | end 65 | object pcPropPages: TPageControl 66 | Left = 5 67 | Top = 5 68 | Width = 268 69 | Height = 137 70 | TabOrder = 0 71 | end 72 | object DKLanguageController1: TDKLanguageController 73 | Left = 32 74 | Top = 32 75 | LangData = { 76 | 0C00466F72636543616D50726F70010100000001000000070043617074696F6E 77 | 01070000000B00706350726F7050616765730000060050616E656C3100000600 78 | 50616E656C32000008006275744170706C790101000000060000000700436170 79 | 74696F6E00090062757443616E63656C01010000000700000007004361707469 80 | 6F6E0005006275744F4B010100000008000000070043617074696F6E000A0063 81 | 6C69636B54696D65720000} 82 | end 83 | object clickTimer: TTimer 84 | Enabled = False 85 | Interval = 10 86 | OnTimer = clickTimerTimer 87 | Left = 72 88 | Top = 32 89 | end 90 | end 91 | -------------------------------------------------------------------------------- /FreetrackClient/FTTypes.pas: -------------------------------------------------------------------------------- 1 | unit FTTypes; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Registry; 7 | 8 | const 9 | FT_CLIENT_LOCATION = 'Software\Freetrack\FreetrackClient'; 10 | FT_CLIENT_FILENAME = 'FreeTrackClient.Dll'; 11 | FT_MM_DATA = 'FT_SharedMem'; 12 | FREETRACK = 'Freetrack'; 13 | FREETRACK_MUTEX = 'FT_Mutext'; 14 | 15 | type 16 | TFreeTrackData = packed record 17 | DataID : Cardinal; 18 | CamWidth : Integer; 19 | CamHeight : Integer; 20 | // virtual pose 21 | Yaw : Single; // positive yaw to the left 22 | Pitch : Single; // positive pitch up 23 | Roll : Single; // positive roll to the left 24 | X : Single; 25 | Y : Single; 26 | Z : Single; 27 | // raw pose with no smoothing, sensitivity, response curve etc. 28 | RawYaw : Single; 29 | RawPitch : Single; 30 | RawRoll : Single; 31 | RawX : Single; 32 | RawY : Single; 33 | RawZ : Single; 34 | // raw points, sorted by Y, origin top left corner 35 | X1 : Single; 36 | Y1 : Single; 37 | X2 : Single; 38 | Y2 : Single; 39 | X3 : Single; 40 | Y3 : Single; 41 | X4 : Single; 42 | Y4 : Single; 43 | end; 44 | PFreetrackData = ^TFreetrackData; 45 | 46 | var 47 | FTGetData : function (data : PFreeTrackData) : Boolean; stdcall; 48 | FTGetDllVersion : function : PChar; stdcall; 49 | // program name used to auto-load profile 50 | FTReportName : procedure (name : PAnsiChar); stdcall; 51 | FTProvider : function : PChar; stdcall; 52 | 53 | function FTLoadDll : Boolean; 54 | procedure FTCloseDll; 55 | 56 | 57 | implementation 58 | 59 | var 60 | hdll : THandle; 61 | 62 | function FTLoadDll : Boolean; 63 | var 64 | aKey : TRegistry; 65 | begin 66 | Result := False; 67 | aKey := TRegistry.Create(KEY_READ); 68 | try 69 | aKey.RootKey := HKEY_CURRENT_USER; 70 | if aKey.OpenKey(FT_CLIENT_LOCATION, False) then begin 71 | hdll := LoadLibrary(PChar(aKey.ReadString('Path') + FT_CLIENT_FILENAME)); 72 | if hdll <> 0 then begin 73 | @FTGetData := GetProcAddress(hdll, 'FTGetData'); 74 | @FTGetDllVersion := GetProcAddress(hdll, 'FTGetDllVersion'); 75 | @FTReportName := GetProcAddress(hdll, 'FTReportName'); 76 | @FTProvider := GetProcAddress(hdll, 'FTProvider'); 77 | Result := True; 78 | end; 79 | end; 80 | finally 81 | aKey.Free; 82 | end; 83 | end; 84 | 85 | 86 | procedure FTCloseDll; 87 | begin 88 | FreeLibrary(hdll); 89 | end; 90 | 91 | 92 | 93 | 94 | end. 95 | -------------------------------------------------------------------------------- /DShowFilter/FreeTrackFilter.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=0 80 | UnsafeCode=0 81 | UnsafeCast=0 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir=$(OutFolder) 94 | UnitOutputDir= 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath=$(biblio)\DKLang;$(biblio)\DSPack\src\DSPack;$(biblio)\DSPack\src\DirectX9;$(Biblio)\ClootieDX\Borland_D6-7 98 | Packages=vclx;vcl;rtl;dsnapcon;dsnap;dbrtl;vcldb;VclSmp;adortl;bdertl;vcldbx;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;PNG_D7;PngComponentsD7;Svn4Delphi;HidController;TntUnicodeVcl_R70;GLCg7 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams= 104 | HostApplication=C:\Headtrack\Freetrack\Output\FreeTrack.exe 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Language] 109 | ActiveLang= 110 | ProjectLang= 111 | RootDir= 112 | [Version Info] 113 | IncludeVerInfo=1 114 | AutoIncBuild=0 115 | MajorVer=1 116 | MinorVer=5 117 | Release=3 118 | Build=0 119 | Debug=0 120 | PreRelease=0 121 | Special=0 122 | Private=0 123 | DLL=0 124 | Locale=3081 125 | CodePage=1252 126 | [Version Info Keys] 127 | CompanyName= 128 | FileDescription= 129 | FileVersion=1.5.3.0 130 | InternalName= 131 | LegalCopyright= 132 | LegalTrademarks= 133 | OriginalFilename= 134 | ProductName= 135 | ProductVersion=1.0.0.0 136 | Comments= 137 | [HistoryLists\hlUnitAliases] 138 | Count=1 139 | Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 140 | [HistoryLists\hlSearchPath] 141 | Count=1 142 | Item0=$(biblio)\DKLang 143 | [HistoryLists\hlOutputDirectorry] 144 | Count=1 145 | Item0=$(OutFolder) 146 | -------------------------------------------------------------------------------- /FreetrackClient/FreeTrackClient.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=0 80 | UnsafeCode=0 81 | UnsafeCast=0 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir=$(OutFolder) 94 | UnitOutputDir= 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath=$(biblio)\DKLang 98 | Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;bdertl;vcldbx;webdsnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP;DSPack_D7;DirectX9_D7;ResponseCfg;PNG_D7;PngComponentsD7;inetdb;websnap;FilteringBase;dklang7 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams= 104 | HostApplication=C:\Headtrack\Freetrack\Output\SDK\Delphi7\Test\FreeTrackTest.exe 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Language] 109 | ActiveLang= 110 | ProjectLang= 111 | RootDir= 112 | [Version Info] 113 | IncludeVerInfo=1 114 | AutoIncBuild=0 115 | MajorVer=1 116 | MinorVer=0 117 | Release=0 118 | Build=266 119 | Debug=0 120 | PreRelease=0 121 | Special=0 122 | Private=0 123 | DLL=0 124 | Locale=3081 125 | CodePage=1252 126 | [Version Info Keys] 127 | CompanyName= 128 | FileDescription= 129 | FileVersion=1.0.0.266 130 | InternalName= 131 | LegalCopyright= 132 | LegalTrademarks= 133 | OriginalFilename= 134 | ProductName= 135 | ProductVersion=1.0.0.0 136 | Comments= 137 | [HistoryLists\hlUnitAliases] 138 | Count=1 139 | Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 140 | [HistoryLists\hlSearchPath] 141 | Count=1 142 | Item0=$(biblio)\DKLang 143 | [HistoryLists\hlOutputDirectorry] 144 | Count=1 145 | Item0=$(OutFolder) 146 | -------------------------------------------------------------------------------- /TIRfake/TIRfake.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=0 80 | UnsafeCode=0 81 | UnsafeCast=0 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir= 94 | UnitOutputDir= 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath= 98 | Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;webdsnap;websnap;adortl;bdertl;vcldbx;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP;HidController;PNG_D7;PngComponentsD7;dklang7;DSPack_D7;DirectX9_D7;OptiTrack 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams= 104 | HostApplication= 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Language] 109 | ActiveLang= 110 | ProjectLang= 111 | RootDir= 112 | [Version Info] 113 | IncludeVerInfo=1 114 | AutoIncBuild=0 115 | MajorVer=1 116 | MinorVer=0 117 | Release=0 118 | Build=0 119 | Debug=0 120 | PreRelease=0 121 | Special=0 122 | Private=0 123 | DLL=0 124 | Locale=3081 125 | CodePage=1252 126 | [Version Info Keys] 127 | CompanyName= 128 | FileDescription=Dummy TrackIR Executable 129 | FileVersion=1.0.0.0 130 | InternalName= 131 | LegalCopyright= 132 | LegalTrademarks= 133 | OriginalFilename= 134 | ProductName= 135 | ProductVersion=1.0.0.0 136 | Comments= 137 | [Excluded Packages] 138 | d:\program files\borland\delphi7\Bin\DBWEBXPRT.BPL=Borland Web Wizard Package 139 | [HistoryLists\hlUnitAliases] 140 | Count=1 141 | Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 142 | [HistoryLists\hlSearchPath] 143 | Count=1 144 | Item0=$(biblio)\DSpack\src\DSPack;$(biblio)\DSpack\src\DirectX9;$(biblio)\dklang\ 145 | [HistoryLists\hlOutputDirectorry] 146 | Count=1 147 | Item0=$(OutFolder) 148 | -------------------------------------------------------------------------------- /Freetrack/SimConnect_dm.pas: -------------------------------------------------------------------------------- 1 | unit SimConnect_dm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, SysUtils, Classes, SimConnect, ExtCtrls, Dialogs, Math; 7 | 8 | type 9 | Tfs = (fs9, fsX); 10 | 11 | TdmSimConnect = class(TDataModule) 12 | TimerCnx: TTimer; 13 | procedure TimerCnxTimer(Sender: TObject); 14 | procedure DataModuleDestroy(Sender: TObject); 15 | private 16 | fFs : Tfs; 17 | hSimConnect: THandle; 18 | FOnSimConnectFail : TNotifyEvent; 19 | FAvailable : Boolean; 20 | public 21 | procedure Connect( aFS : Tfs); 22 | procedure Disconnect; 23 | Procedure UpdateData(Yaw, Pitch, Roll, PanX, PanY, PanZ : single); 24 | function SimConnectAvail : Boolean; 25 | property OnSimConnectFail : TNotifyEvent read FOnSimConnectFail write FOnSimConnectFail; 26 | property Available : Boolean read FAvailable; 27 | procedure UpdateZoom(panz : single); 28 | end; 29 | 30 | var 31 | dmSimConnect: TdmSimConnect; 32 | 33 | implementation 34 | 35 | const 36 | KEY_ID_MIN = $00010000; 37 | KEY_ZOOM_IN = KEY_ID_MIN + 119; 38 | KEY_ZOOM_OUT = KEY_ID_MIN + 120; 39 | KEY_ZOOM_MINUS = KEY_ID_MIN + 182; 40 | KEY_ZOOM_PLUS = KEY_ID_MIN + 183; 41 | KEY_ZOOM_IN_FINE = KEY_ID_MIN + 218; 42 | KEY_ZOOM_OUT_FINE = KEY_ID_MIN + 219; 43 | 44 | SIMCONNECT_GROUP_PRIORITY_HIGHEST = 1; 45 | SIMCONNECT_EVENT_FLAG_GROUPID_IS_PRIORITY = 3; 46 | 47 | 48 | {$R *.dfm} 49 | 50 | { TdmSimConnect } 51 | 52 | procedure TdmSimConnect.Connect(aFS: Tfs); 53 | begin 54 | fFs := aFS; 55 | case fFs of 56 | fs9 : ; 57 | 58 | fsX : begin 59 | if not InitSimConnect then begin 60 | if Assigned(FOnSimConnectFail) then 61 | FOnSimConnectFail(Self); 62 | end else 63 | TimerCnx.Enabled := True; 64 | end; 65 | 66 | end; 67 | end; 68 | 69 | 70 | 71 | procedure TdmSimConnect.Disconnect; 72 | begin 73 | TimerCnx.Enabled := False; 74 | CloseSimConnect; 75 | end; 76 | 77 | 78 | 79 | procedure TdmSimConnect.TimerCnxTimer(Sender: TObject); 80 | begin 81 | if SUCCEEDED(SimConnect_Open(hSimConnect, 'Set Data', 0, 0, 0, 0)) then 82 | TimerCnx.Enabled := False; 83 | end; 84 | 85 | 86 | procedure TdmSimConnect.UpdateData(Yaw, Pitch, Roll, PanX, PanY, PanZ : single); 87 | begin 88 | if IsSimConnectInitialized then begin 89 | Yaw := -RadToDeg(Yaw); 90 | Pitch := RadToDeg(Pitch); 91 | Roll := RadToDeg(Roll); 92 | PanX := -PanX; 93 | PanY := PanY; 94 | PanZ := -PanZ; 95 | SimConnect_CameraSetRelative6DOF(hSimConnect, PanX, PanY, PanZ, 96 | Pitch, Roll, Yaw); 97 | 98 | end; 99 | end; 100 | 101 | 102 | procedure TdmSimConnect.UpdateZoom(panz : single); 103 | begin 104 | if panz > 0 then 105 | SimConnect_TransmitClientEvent(hSimConnect, 0, KEY_ZOOM_IN_FINE, 0, SIMCONNECT_GROUP_PRIORITY_HIGHEST, SIMCONNECT_EVENT_FLAG_GROUPID_IS_PRIORITY) 106 | else 107 | SimConnect_TransmitClientEvent(hSimConnect, 0, KEY_ZOOM_OUT_FINE, 0, SIMCONNECT_GROUP_PRIORITY_HIGHEST, SIMCONNECT_EVENT_FLAG_GROUPID_IS_PRIORITY); 108 | end; 109 | 110 | 111 | procedure TdmSimConnect.DataModuleDestroy(Sender: TObject); 112 | begin 113 | CloseSimConnect; 114 | end; 115 | 116 | 117 | function TdmSimConnect.SimConnectAvail: Boolean; 118 | begin 119 | Result := InitSimConnect; 120 | FAvailable := Result; 121 | end; 122 | 123 | end. 124 | -------------------------------------------------------------------------------- /DShowFilter/SeuilProp_fm.pas: -------------------------------------------------------------------------------- 1 | { Under GNU License 2 | check http://www.opensource.org/ 3 | project by 4 | Nicolas Camil 5 | http://n.camil.chez.tiscali.fr 6 | ------------------------------ 7 | 8 | This library is free software; you can redistribute it and/or 9 | modify it under the terms of the GNU Library General Public 10 | License as published by the Free Software Foundation. 11 | 12 | This library is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | Library General Public License for more details.} 16 | 17 | unit SeuilProp_fm; 18 | 19 | interface 20 | 21 | uses 22 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 23 | BaseClass, Dialogs, ComCtrls, Seuillage_inc, StdCtrls, Spin; 24 | 25 | 26 | const 27 | CLSID_SeuilPageSettings : TGUID = '{F12C6F73-C49C-4599-925C-1A528EEE500C}'; 28 | 29 | type 30 | TfmSettings = class(TFormPropertyPage) 31 | TrackBar: TTrackBar; 32 | Label1: TLabel; 33 | Label2: TLabel; 34 | cbActive: TCheckBox; 35 | GroupBox1: TGroupBox; 36 | Label3: TLabel; 37 | spMinSize: TSpinEdit; 38 | spMaxSize: TSpinEdit; 39 | Label4: TLabel; 40 | procedure TrackBarChange(Sender: TObject); 41 | procedure cbActiveClick(Sender: TObject); 42 | procedure spMinSizeChange(Sender: TObject); 43 | procedure spMaxSizeChange(Sender: TObject); 44 | private 45 | Seuil : ISeuil; 46 | public 47 | function OnConnect(Unknown: IUnknown): HRESULT; override; 48 | function OnDisconnect: HRESULT; override; 49 | function OnApplyChanges: HRESULT; override; 50 | end; 51 | 52 | var 53 | fmSettings: TfmSettings; 54 | 55 | implementation 56 | 57 | {$R *.dfm} 58 | 59 | { TfmSettings } 60 | 61 | function TfmSettings.OnApplyChanges: HRESULT; 62 | begin 63 | result := NOERROR; 64 | end; 65 | 66 | function TfmSettings.OnConnect(Unknown: IInterface): HRESULT; 67 | var 68 | i : byte; 69 | b : boolean; 70 | begin 71 | Unknown.QueryInterface(IID_ISeuil, Seuil); 72 | Seuil.GetSeuil(@i); 73 | TrackBar.Position := i; 74 | 75 | Seuil.GetActive(@b); 76 | cbActive.Checked := b; 77 | 78 | Seuil.GetMinPointSize(@i); 79 | spMinSize.Value := i; 80 | 81 | Seuil.GetMaxPointSize(@i); 82 | spMaxSize.Value := i; 83 | 84 | result := NOERROR; 85 | {$ifdef DEBUG} 86 | DbgLog('TfmSettings.OnConnect'); 87 | {$endif} 88 | end; 89 | 90 | 91 | 92 | function TfmSettings.OnDisconnect: HRESULT; 93 | begin 94 | result := NOERROR; 95 | {$ifdef DEBUG} 96 | DbgLog('TfmSettings.OnDisconnect'); 97 | {$endif} 98 | end; 99 | 100 | 101 | 102 | procedure TfmSettings.TrackBarChange(Sender: TObject); 103 | begin 104 | Seuil.SetSeuil(TrackBar.Position); 105 | end; 106 | 107 | 108 | 109 | procedure TfmSettings.cbActiveClick(Sender: TObject); 110 | begin 111 | Seuil.SetActive(cbActive.Checked); 112 | end; 113 | 114 | 115 | 116 | procedure TfmSettings.spMinSizeChange(Sender: TObject); 117 | begin 118 | Seuil.SetMinPointSize(spMinSize.Value); 119 | spMaxSize.MinValue := spMinSize.Value; 120 | end; 121 | 122 | 123 | 124 | procedure TfmSettings.spMaxSizeChange(Sender: TObject); 125 | begin 126 | Seuil.SetMaxPointSize(spMaxSize.Value); 127 | spMinSize.MaxValue := spMaxSize.Value; 128 | end; 129 | 130 | initialization 131 | TBCClassFactory.CreatePropertyPage(TfmSettings, CLSID_SeuilPageSettings); 132 | 133 | end. 134 | -------------------------------------------------------------------------------- /FreetrackClient/FTClient.pas: -------------------------------------------------------------------------------- 1 | unit FTClient; 2 | 3 | interface 4 | 5 | uses 6 | Windows, SysUtils, FTTypes; 7 | 8 | function FTGetData(data : PFreetrackData) : Boolean; stdcall; 9 | procedure FTReportName(name : PAnsiChar); stdcall; 10 | function FTGetDllVersion : PChar; stdcall; 11 | function FTProvider : PChar; stdcall; 12 | 13 | 14 | function OpenMapping : Boolean; 15 | procedure DestroyMapping; 16 | 17 | 18 | implementation 19 | 20 | const 21 | FT_PROGRAMID = 'FT_ProgramID'; 22 | 23 | var 24 | hFTMemMap : THandle; 25 | FTData : PFreetrackData; 26 | lastDataID : Cardinal; 27 | FTHandle : PHandle; 28 | FTProgramName : PAnsiChar; 29 | FTMutex: THandle; 30 | 31 | 32 | function FTGetData(data : PFreetrackData) : Boolean; 33 | begin 34 | Result := False; 35 | if Assigned(FTData) then begin 36 | if FTData^.DataID <> lastDataID then begin 37 | Move(FTData^, data^, SizeOf(TFreetrackData)); 38 | lastDataID := FTData^.DataID; 39 | Result := True; 40 | end; 41 | end else 42 | OpenMapping; 43 | end; 44 | 45 | 46 | procedure FTReportName(name : PAnsiChar); 47 | var 48 | MsgResult : Cardinal; 49 | begin 50 | if OpenMapping and (WaitForSingleObject(FTMutex, 100) = WAIT_OBJECT_0) then begin 51 | Move(name^, FTProgramName^, 100); 52 | SendMessageTimeout(FTHandle^, RegisterWindowMessage(FT_PROGRAMID), 0, 0, 0, 2000, MsgResult); 53 | ReleaseMutex(FTMutex); 54 | end; 55 | end; 56 | 57 | 58 | function FTGetDllVersion : PChar; 59 | var 60 | VerInfoSize: DWORD; 61 | VerInfo: Pointer; 62 | VerValueSize: DWORD; 63 | VerValue: PVSFixedFileInfo; 64 | Dummy: DWORD; 65 | verString : String; 66 | dllName : array[0..99] of PChar; 67 | begin 68 | Result := ''; 69 | GetModuleFilename(HInstance, @dllName, 100); 70 | VerInfoSize := GetFileVersionInfoSize(@dllName, Dummy); 71 | if not (VerInfoSize = 0) then begin 72 | GetMem(VerInfo, VerInfoSize); 73 | GetFileVersionInfo(@dllName, 0, VerInfoSize, VerInfo); 74 | VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize); 75 | with VerValue^ do 76 | begin 77 | verString := IntToStr(dwFileVersionMS shr 16); 78 | verString := verString + '.' + IntToStr(dwFileVersionMS and $FFFF); 79 | verString := verString + '.' + IntToStr(dwFileVersionLS shr 16); 80 | verString := verString + '.' + IntToStr(dwFileVersionLS and $FFFF); 81 | Result := PChar(verString); 82 | end; 83 | FreeMem(VerInfo, VerInfoSize); 84 | end; 85 | end; 86 | 87 | 88 | function FTProvider : PChar; 89 | begin 90 | Result := FREETRACK 91 | end; 92 | 93 | 94 | 95 | 96 | 97 | function OpenMapping : Boolean; 98 | begin 99 | if hFTMemMap <> 0 then 100 | Result := True 101 | else begin 102 | hFTMemMap := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, FT_MM_DATA); 103 | if (hFTMemMap <> 0) then begin 104 | FTData := MapViewOfFile(hFTMemMap, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TFreeTrackData) + SizeOf(THandle) + 100); 105 | FTHandle := Pointer(DWord(FTData) + SizeOf(TFreeTrackData)); 106 | FTProgramName := Pointer(DWord(FTHandle) + SizeOf(THandle)); 107 | FTMutex := OpenMutex(MUTEX_ALL_ACCESS, False, FREETRACK_MUTEX); 108 | end; 109 | Result := Assigned(FTData); 110 | end; 111 | end; 112 | 113 | 114 | procedure DestroyMapping; 115 | begin 116 | if FTData <> nil then begin 117 | UnMapViewofFile(FTData); 118 | FTData := nil; 119 | end; 120 | 121 | CloseHandle(FTMutex); 122 | CloseHandle(hFTMemMap); 123 | hFTMemMap := 0; 124 | end; 125 | 126 | 127 | end. 128 | -------------------------------------------------------------------------------- /Freetrack/FreeTrack.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=0 80 | UnsafeCode=0 81 | UnsafeCast=0 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir=$(OutFolder) 94 | UnitOutputDir= 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath=$(root)\bpl;$(biblio)\DSpack\src\DSPack;$(root)\DShowFilter;$(root)\NPClient;$(root)\FreeTrackClient;$(biblio)\dklang;$(biblio)\TntUniCtrls\Source;$(biblio)\HIDKomp;$(biblio)\ClootieDX\Borland_D6-7;$(biblio)\DSpack\src\DirectX9;$(Biblio)\PngComponents\Source;$(biblio)\HidComposant 98 | Packages=vclx;vcl;rtl;dsnapcon;dsnap;dbrtl;vcldb;VclSmp;adortl;bdertl;vcldbx;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;ResponseCfg;PNG_D7;PngComponentsD7;DSPack_D7;DirectX9_D7 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams= 104 | HostApplication= 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Language] 109 | ActiveLang= 110 | ProjectLang= 111 | RootDir= 112 | [Version Info] 113 | IncludeVerInfo=1 114 | AutoIncBuild=0 115 | MajorVer=2 116 | MinorVer=2 117 | Release=0 118 | Build=267 119 | Debug=0 120 | PreRelease=0 121 | Special=0 122 | Private=0 123 | DLL=0 124 | Locale=1036 125 | CodePage=1252 126 | [Version Info Keys] 127 | CompanyName= 128 | FileDescription= 129 | FileVersion=2.2.0.267 130 | InternalName= 131 | LegalCopyright= 132 | LegalTrademarks= 133 | OriginalFilename= 134 | ProductName= 135 | ProductVersion=1.0.0.0 136 | Comments= 137 | [HistoryLists\hlUnitAliases] 138 | Count=1 139 | Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 140 | [HistoryLists\hlSearchPath] 141 | Count=2 142 | Item0=$(root)\bpl;$(biblio)\DSpack\src\DSPack;$(root)\DShowFilter;$(root)\NPClient;$(root)\FreeTrackClient;$(biblio)\dklang;$(biblio)\TntUniCtrls\Source;$(biblio)\HIDKomp;$(biblio)\ClootieDX\Borland_D6-7;$(biblio)\DSpack\src\DirectX9;$(Biblio)\PngComponents\Source;$(biblio)\HidComposant 143 | Item1=$(biblio)\DKLang 144 | [HistoryLists\hlOutputDirectorry] 145 | Count=1 146 | Item0=$(OutFolder) 147 | -------------------------------------------------------------------------------- /FreetrackClient/FTTest.pas: -------------------------------------------------------------------------------- 1 | unit FTTest; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Controls, Forms, 7 | StdCtrls, FTTypes, ExtCtrls; 8 | 9 | type 10 | TForm1 = class(TForm) 11 | timerData: TTimer; 12 | Label1: TLabel; 13 | Label2: TLabel; 14 | Label3: TLabel; 15 | Label4: TLabel; 16 | Label5: TLabel; 17 | laYaw: TLabel; 18 | laPitch: TLabel; 19 | laRoll: TLabel; 20 | laPanX: TLabel; 21 | laPanY: TLabel; 22 | laPanZ: TLabel; 23 | Label6: TLabel; 24 | laVersion: TLabel; 25 | Label9: TLabel; 26 | laDllLoaded: TLabel; 27 | laDataID: TLabel; 28 | Label7: TLabel; 29 | Label12: TLabel; 30 | Label13: TLabel; 31 | Label14: TLabel; 32 | Label15: TLabel; 33 | Label16: TLabel; 34 | laRawYaw: TLabel; 35 | laRawPitch: TLabel; 36 | laRawRoll: TLabel; 37 | laRawX: TLabel; 38 | laRawY: TLabel; 39 | laRawZ: TLabel; 40 | Label23: TLabel; 41 | Label24: TLabel; 42 | Label25: TLabel; 43 | Label11: TLabel; 44 | Label26: TLabel; 45 | laPoint1: TLabel; 46 | laPoint2: TLabel; 47 | laPoint3: TLabel; 48 | laPoint4: TLabel; 49 | Label18: TLabel; 50 | laCamResolution: TLabel; 51 | Label19: TLabel; 52 | laProgramName: TLabel; 53 | Label17: TLabel; 54 | Label22: TLabel; 55 | Label27: TLabel; 56 | Label28: TLabel; 57 | Label29: TLabel; 58 | Label8: TLabel; 59 | Label10: TLabel; 60 | Label30: TLabel; 61 | Label31: TLabel; 62 | Label32: TLabel; 63 | Label20: TLabel; 64 | Label21: TLabel; 65 | Label33: TLabel; 66 | Label34: TLabel; 67 | procedure timerDataTimer(Sender: TObject); 68 | procedure FormCreate(Sender: TObject); 69 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 70 | private 71 | FTData : TFreetrackData; 72 | 73 | public 74 | { Public declarations } 75 | end; 76 | 77 | var 78 | Form1: TForm1; 79 | 80 | implementation 81 | 82 | {$R *.dfm} 83 | 84 | const 85 | PROGRAM_NAME = 'FreeTrack Test'; 86 | PROGRAM_ID = 1337; 87 | 88 | procedure TForm1.timerDataTimer(Sender: TObject); 89 | begin 90 | if FTGetData(@FTData) then begin 91 | laDataID.Caption := InttoStr(FTData.DataID); 92 | laYaw.Caption := Format('%.3f', [FTData.Yaw]); 93 | laPitch.Caption := Format('%.3f', [FTData.Pitch]); 94 | laRoll.Caption := Format('%.3f', [FTData.Roll]); 95 | laPanX.Caption := Format('%.3f', [FTData.X]); 96 | laPanY.Caption := Format('%.3f', [FTData.Y]); 97 | laPanZ.Caption := Format('%.3f', [FTData.Z]); 98 | 99 | laRawYaw.Caption := Format('%.3f', [FTData.RawYaw]); 100 | laRawPitch.Caption := Format('%.3f', [FTData.RawPitch]); 101 | laRawRoll.Caption := Format('%.3f', [FTData.RawRoll]); 102 | laRawX.Caption := Format('%.3f', [FTData.RawX]); 103 | laRawY.Caption := Format('%.3f', [FTData.RawY]); 104 | laRawZ.Caption := Format('%.3f', [FTData.RawZ]); 105 | 106 | laCamResolution.Caption := Format('%d x %d', [FTData.CamWidth, FTData.CamHeight]); 107 | 108 | laPoint1.Caption := Format('(%.1f, %.1f)', [FTData.X1, FTData.Y1]); 109 | laPoint2.Caption := Format('(%.1f, %.1f)', [FTData.X2, FTData.Y2]); 110 | laPoint3.Caption := Format('(%.1f, %.1f)', [FTData.X3, FTData.Y3]); 111 | laPoint4.Caption := Format('(%.1f, %.1f)', [FTData.X4, FTData.Y4]); 112 | 113 | end; 114 | end; 115 | 116 | 117 | procedure TForm1.FormCreate(Sender: TObject); 118 | begin 119 | if FTLoadDll then begin 120 | timerData.Enabled := True; 121 | laDllLoaded.Caption := 'True'; 122 | laProgramName.Caption := PROGRAM_NAME; 123 | FTReportName(PAnsiChar(PROGRAM_NAME)); 124 | laVersion.Caption := FTGetDllVersion; 125 | end; 126 | end; 127 | 128 | 129 | procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); 130 | begin 131 | FTCloseDll; 132 | end; 133 | 134 | end. 135 | -------------------------------------------------------------------------------- /Bpl/Demo_fm.dfm: -------------------------------------------------------------------------------- 1 | object fmDemo: TfmDemo 2 | Left = 484 3 | Top = 162 4 | Width = 436 5 | Height = 503 6 | Caption = 'fmDemo' 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object SideBar1: TSideBar 17 | Left = 8 18 | Top = 8 19 | Width = 345 20 | Height = 321 21 | PageCtrl.Left = 0 22 | PageCtrl.Top = 75 23 | PageCtrl.Width = 345 24 | PageCtrl.Height = 246 25 | PageCtrl.ActivePage = TabSheet3 26 | PageCtrl.Align = alCustom 27 | PageCtrl.Style = tsFlatButtons 28 | PageCtrl.TabHeight = 1 29 | PageCtrl.TabOrder = 0 30 | ButtonHeight = 25 31 | TabVisible = False 32 | object PageControl: TPageControl 33 | Left = 0 34 | Top = 75 35 | Width = 345 36 | Height = 246 37 | ActivePage = TabSheet3 38 | Align = alCustom 39 | Style = tsFlatButtons 40 | TabHeight = 1 41 | TabOrder = 0 42 | object Tabsheet1: TTabSheet 43 | Caption = 'Tabsheet1' 44 | TabVisible = False 45 | object Button2: TButton 46 | Left = 32 47 | Top = 48 48 | Width = 75 49 | Height = 25 50 | Caption = 'Button2' 51 | TabOrder = 0 52 | end 53 | object Button3: TButton 54 | Left = 32 55 | Top = 96 56 | Width = 75 57 | Height = 25 58 | Caption = 'Button3' 59 | TabOrder = 1 60 | end 61 | end 62 | object TabSheet2: TTabSheet 63 | Caption = 'TabSheet2' 64 | ImageIndex = 1 65 | TabVisible = False 66 | object Memo1: TMemo 67 | Left = 48 68 | Top = 40 69 | Width = 185 70 | Height = 89 71 | Lines.Strings = ( 72 | 'Memo1') 73 | TabOrder = 0 74 | end 75 | end 76 | object TabSheet3: TTabSheet 77 | Caption = 'TabSheet3' 78 | ImageIndex = 2 79 | TabVisible = False 80 | object RadioGroup1: TRadioGroup 81 | Left = 72 82 | Top = 40 83 | Width = 201 84 | Height = 129 85 | Caption = 'RadioGroup1' 86 | Items.Strings = ( 87 | 'A' 88 | 'B' 89 | 'C') 90 | TabOrder = 0 91 | end 92 | end 93 | end 94 | end 95 | object Panel1: TPanel 96 | Left = 8 97 | Top = 336 98 | Width = 409 99 | Height = 89 100 | TabOrder = 1 101 | object HorizRS: TmkRangeSlider 102 | Left = 6 103 | Top = 16 104 | Width = 323 105 | Height = 36 106 | Min = 0 107 | Max = 300 108 | MinPosition = 60 109 | MaxPosition = 100 110 | Value = 0 111 | ThumbStyle = rsRectangle 112 | ColorLow = clGray 113 | ColorMid = 8454143 114 | ColorHi = 681706 115 | OnGetRullerLength = HorizRSGetRullerLength 116 | Constraints.MinHeight = 10 117 | Constraints.MinWidth = 50 118 | TabOrder = 0 119 | TabStop = True 120 | end 121 | object RadioGroup2: TRadioGroup 122 | Left = 18 123 | Top = 48 124 | Width = 191 125 | Height = 33 126 | Caption = 'Neutral zone' 127 | Columns = 2 128 | Items.Strings = ( 129 | 'Forward' 130 | 'Central') 131 | TabOrder = 1 132 | OnClick = RadioGroup2Click 133 | end 134 | object Panel2: TPanel 135 | Left = 16 136 | Top = 8 137 | Width = 217 138 | Height = 5 139 | BevelOuter = bvNone 140 | Color = clRed 141 | TabOrder = 2 142 | end 143 | object ComboBox1: TComboBox 144 | Left = 240 145 | Top = 56 146 | Width = 65 147 | Height = 21 148 | ItemHeight = 13 149 | TabOrder = 3 150 | Text = 'ComboBox1' 151 | end 152 | end 153 | end 154 | -------------------------------------------------------------------------------- /Bpl/Freetrack_Reg.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=0 80 | UnsafeCode=0 81 | UnsafeCast=0 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir= 94 | UnitOutputDir= 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath=$(Delphi)\Source\ToolsAPI 98 | Packages=vcl;rtl;vclx;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;adortl;ibxpress;teeui;teedb;tee;vclactnband;vclshlctrls;Svn4Delphi;A406_R70;UpdateComments;Airmail;IndyProtocols70;LogbookComponents;PngComponentsD7 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams= 104 | HostApplication= 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Language] 109 | ActiveLang= 110 | ProjectLang= 111 | RootDir=C:\Program Files\Borland\Delphi7\Bin\ 112 | [Version Info] 113 | IncludeVerInfo=1 114 | AutoIncBuild=0 115 | MajorVer=1 116 | MinorVer=0 117 | Release=0 118 | Build=0 119 | Debug=0 120 | PreRelease=0 121 | Special=0 122 | Private=0 123 | DLL=0 124 | Locale=2057 125 | CodePage=1252 126 | [Version Info Keys] 127 | CompanyName= 128 | FileDescription= 129 | FileVersion=1.0.0.0 130 | InternalName= 131 | LegalCopyright= 132 | LegalTrademarks= 133 | OriginalFilename= 134 | ProductName= 135 | ProductVersion=1.0.0.0 136 | Comments= 137 | [Excluded Packages] 138 | c:\program files\borland\delphi7\Projects\Bpl\Freetrack_Reg.bpl=(untitled) 139 | [HistoryLists\hlUnitAliases] 140 | Count=1 141 | Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 142 | [HistoryLists\hlSearchPath] 143 | Count=5 144 | Item0=$(biblio)\DSpack\src\DSPack;$(biblio)\DSpack\src\DirectX9;$(biblio)\PngComponents\Source;$(Biblio)\dkLang;$(Biblio)\TntUniCtrl\Source;$(biblio)\FreetrackSVN\DShowFilter;$(biblio)\FreetrackSVN\NPClient;..\DShowFilter;..\NPClient;..\Bpl;..\FreetrackClient 145 | Item1=$(biblio)\DSpack\src\DSPack;$(biblio)\DSpack\src\DirectX9;$(biblio)\FreetrackSVN\DShowFilter;$(biblio)\FreetrackSVN\NPClient;..\DShowFilter;..\NPClient;..\Bpl;$(biblio)\PngComponents\Source;$(Biblio)\dkLang;$(Biblio)\TntUniCtrl\Source 146 | Item2=$(biblio)\DSpack\src\DSPack;$(biblio)\DSpack\src\DirectX9;$(biblio)\FreetrackSVN\DShowFilter;$(biblio)\FreetrackSVN\NPClient;..\DShowFilter;..\NPClient;..\Bpl;$(biblio)\PngComponents\Source;$(Biblio)\dkLang 147 | Item3=$(biblio)\DSpack\src\DSPack;$(biblio)\DSpack\src\DirectX9;$(biblio)\FreetrackSVN\DShowFilter;$(biblio)\FreetrackSVN\NPClient;..\DShowFilter;..\NPClient;..\Bpl;$(biblio)\PngComponents\Source 148 | Item4=$(biblio)\DSpack\src\DSPack;$(biblio)\DSpack\src\DirectX9;$(biblio)\FreetrackSVN\DShowFilter;$(biblio)\FreetrackSVN\NPClient;..\DShowFilter;..\NPClient;..\Bpl 149 | [HistoryLists\hlOutputDirectorry] 150 | Count=1 151 | Item0=$(OutFolder) 152 | -------------------------------------------------------------------------------- /Bpl/Demo.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=0 80 | UnsafeCode=0 81 | UnsafeCast=0 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir= 94 | UnitOutputDir= 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath= 98 | Packages=vcl;rtl;vclx;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;adortl;ibxpress;teeui;teedb;tee;vclactnband;vclshlctrls;Svn4Delphi;A406_R70;UpdateComments;Airmail;IndyProtocols70;LogbookComponents;PngComponentsD7 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams= 104 | HostApplication= 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Language] 109 | ActiveLang= 110 | ProjectLang= 111 | RootDir=C:\Program Files\Borland\Delphi7\Bin\ 112 | [Version Info] 113 | IncludeVerInfo=0 114 | AutoIncBuild=0 115 | MajorVer=1 116 | MinorVer=0 117 | Release=0 118 | Build=0 119 | Debug=0 120 | PreRelease=0 121 | Special=0 122 | Private=0 123 | DLL=0 124 | Locale=2057 125 | CodePage=1252 126 | [Version Info Keys] 127 | CompanyName= 128 | FileDescription= 129 | FileVersion=1.0.0.0 130 | InternalName= 131 | LegalCopyright= 132 | LegalTrademarks= 133 | OriginalFilename= 134 | ProductName= 135 | ProductVersion=1.0.0.0 136 | Comments= 137 | [Excluded Packages] 138 | c:\program files\borland\delphi7\Projects\Bpl\IdeDbg.bpl=(untitled) 139 | c:\program files\borland\delphi7\Projects\Bpl\dclIndyCore70.bpl=Indy 10.0.20-B Core Design Time 140 | [HistoryLists\hlUnitAliases] 141 | Count=1 142 | Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 143 | [HistoryLists\hlSearchPath] 144 | Count=5 145 | Item0=$(biblio)\DSpack\src\DSPack;$(biblio)\DSpack\src\DirectX9;$(biblio)\PngComponents\Source;$(Biblio)\dkLang;$(Biblio)\TntUniCtrl\Source;$(biblio)\FreetrackSVN\DShowFilter;$(biblio)\FreetrackSVN\NPClient;..\DShowFilter;..\NPClient;..\Bpl;..\FreetrackClient 146 | Item1=$(biblio)\DSpack\src\DSPack;$(biblio)\DSpack\src\DirectX9;$(biblio)\FreetrackSVN\DShowFilter;$(biblio)\FreetrackSVN\NPClient;..\DShowFilter;..\NPClient;..\Bpl;$(biblio)\PngComponents\Source;$(Biblio)\dkLang;$(Biblio)\TntUniCtrl\Source 147 | Item2=$(biblio)\DSpack\src\DSPack;$(biblio)\DSpack\src\DirectX9;$(biblio)\FreetrackSVN\DShowFilter;$(biblio)\FreetrackSVN\NPClient;..\DShowFilter;..\NPClient;..\Bpl;$(biblio)\PngComponents\Source;$(Biblio)\dkLang 148 | Item3=$(biblio)\DSpack\src\DSPack;$(biblio)\DSpack\src\DirectX9;$(biblio)\FreetrackSVN\DShowFilter;$(biblio)\FreetrackSVN\NPClient;..\DShowFilter;..\NPClient;..\Bpl;$(biblio)\PngComponents\Source 149 | Item4=$(biblio)\DSpack\src\DSPack;$(biblio)\DSpack\src\DirectX9;$(biblio)\FreetrackSVN\DShowFilter;$(biblio)\FreetrackSVN\NPClient;..\DShowFilter;..\NPClient;..\Bpl 150 | [HistoryLists\hlOutputDirectorry] 151 | Count=1 152 | Item0=$(OutFolder) 153 | -------------------------------------------------------------------------------- /Freetrack/Average.pas: -------------------------------------------------------------------------------- 1 | { Under GNU License 2 | check http://www.opensource.org/ 3 | project by 4 | Nicolas Camil 5 | http://n.camil.chez.tiscali.fr 6 | ------------------------------ 7 | 8 | This library is free software; you can redistribute it and/or 9 | modify it under the terms of the GNU Library General Public 10 | License as published by the Free Software Foundation. 11 | 12 | This library is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | Library General Public License for more details.} 16 | 17 | unit Average; 18 | 19 | interface 20 | 21 | uses 22 | Classes, Types, Parameters; 23 | 24 | type 25 | TAverage = class (TObject) 26 | private 27 | FloatTotal: RPoint2D32f; 28 | FNbSamples: Integer; 29 | FPoint: TPoint; 30 | FPoint2D32f: RPoint2D32f; 31 | FVal: Single; 32 | IdxPoint: Integer; 33 | IdxPoint2D32f: Integer; 34 | IdxSingle: Integer; 35 | IntPts: array of TPoint; 36 | IntTotal: TPoint; 37 | Point2D32fs: TArrayOfPoint2D32f; 38 | Singles: array of single; 39 | SinglesTotal: Single; 40 | procedure SetNbSamples(const Value: Integer); 41 | procedure SetPoint(const Value: TPoint); 42 | procedure SetPoint2D32f(const Value: RPoint2D32f); 43 | procedure SetSingle(const Value: Single); 44 | public 45 | constructor Create; 46 | property NbSamples: Integer read FNbSamples write SetNbSamples; 47 | property Point: TPoint read FPoint write SetPoint; 48 | property Point2D32f: RPoint2D32f read FPoint2D32f write SetPoint2D32f; 49 | property Single: Single read FVal write SetSingle; 50 | end; 51 | 52 | 53 | 54 | implementation 55 | 56 | { 57 | ************************************************************* TAverage ************************************************************* 58 | } 59 | {- 60 | 61 | 62 | } 63 | constructor TAverage.Create; 64 | begin 65 | FNbSamples := 5; 66 | end; 67 | 68 | {- 69 | 70 | 71 | } 72 | procedure TAverage.SetNbSamples(const Value: Integer); 73 | begin 74 | if Value > 0 then 75 | FNbSamples := Value 76 | else 77 | FNbSamples := 1; 78 | end; 79 | 80 | {- 81 | 82 | 83 | } 84 | procedure TAverage.SetPoint(const Value: TPoint); 85 | begin 86 | if High(IntPts)+1 < FNbSamples then begin 87 | IdxPoint := High(IntPts) + 1; 88 | SetLength(IntPts, IdxPoint+1); 89 | IntPts[IdxPoint] := Value; 90 | end else begin 91 | IdxPoint := Succ(IdxPoint) mod (High(IntPts) + 1); 92 | Dec(IntTotal.X, IntPts[IdxPoint].X); 93 | Dec(IntTotal.Y, IntPts[IdxPoint].Y); 94 | IntPts[IdxPoint] := Value; 95 | end; 96 | 97 | Inc(IntTotal.X, Value.X); 98 | Inc(IntTotal.Y, Value.Y); 99 | 100 | FPoint := Types.Point( Round(IntTotal.X / (High(IntPts)+1)), Round(IntTotal.Y / (High(IntPts)+1))); 101 | end; 102 | 103 | {- 104 | 105 | 106 | } 107 | procedure TAverage.SetPoint2D32f(const Value: RPoint2D32f); 108 | var 109 | i, IdxPoint2D32f_remove : Integer; 110 | 111 | begin 112 | if High(Point2D32fs)+1 < FNbSamples then begin 113 | IdxPoint2D32f := High(Point2D32fs) + 1; 114 | SetLength(Point2D32fs, IdxPoint2D32f+1); 115 | Point2D32fs[IdxPoint2D32f] := Value; 116 | end else if High(Point2D32fs)+1 > FNbSamples then begin 117 | IdxPoint2D32f := (Succ(IdxPoint2D32f) mod (High(Point2D32fs) + 1)); 118 | IdxPoint2D32f_remove := (Succ(IdxPoint2D32f) mod (High(Point2D32fs) + 1)); 119 | FloatTotal.x := FloatTotal.x - Point2D32fs[IdxPoint2D32f].X 120 | - Point2D32fs[IdxPoint2D32f_remove].X; 121 | FloatTotal.y := FloatTotal.y - Point2D32fs[IdxPoint2D32f].Y 122 | - Point2D32fs[IdxPoint2D32f_remove].Y; 123 | if IdxPoint2D32f_remove < High(Point2D32fs) then begin 124 | for i := IdxPoint2D32f_remove to (High(Point2D32fs) - 1) do 125 | Point2D32fs[i] := Point2D32fs[i + 1]; 126 | end; 127 | if IdxPoint2D32f = High(Point2D32fs) then begin 128 | SetLength(Point2D32fs, High(Point2D32fs)); 129 | Point2D32fs[IdxPoint2D32f - 1] := Value; 130 | end else begin 131 | SetLength(Point2D32fs, High(Point2D32fs)); 132 | Point2D32fs[IdxPoint2D32f] := Value; 133 | end; 134 | end else begin 135 | IdxPoint2D32f := Succ(IdxPoint2D32f) mod (High(Point2D32fs) + 1); 136 | FloatTotal.x := FloatTotal.x - Point2D32fs[IdxPoint2D32f].X; 137 | FloatTotal.y := FloatTotal.y - Point2D32fs[IdxPoint2D32f].Y; 138 | Point2D32fs[IdxPoint2D32f] := Value; 139 | end; 140 | 141 | FloatTotal.X := FloatTotal.X + Value.X; 142 | FloatTotal.Y := FloatTotal.Y + Value.Y; 143 | 144 | FPoint2D32f.x := FloatTotal.X / (High(Point2D32fs)+1); 145 | FPoint2D32f.y := FloatTotal.Y / (High(Point2D32fs)+1); 146 | end; 147 | 148 | {- 149 | 150 | 151 | } 152 | procedure TAverage.SetSingle(const Value: Single); 153 | begin 154 | if High(Singles)+1 < FNbSamples then begin 155 | IdxSingle := High(Singles) + 1; 156 | SetLength(Singles, IdxSingle+1); 157 | Singles[IdxSingle] := Value; 158 | end else begin 159 | IdxSingle := Succ(IdxSingle) mod (High(Singles) + 1); 160 | SinglesTotal := SinglesTotal - Singles[IdxSingle]; 161 | Singles[IdxSingle] := Value; 162 | end; 163 | 164 | SinglesTotal := SinglesTotal + Value; 165 | 166 | FVal := SinglesTotal / (High(Singles)+1); 167 | end; 168 | 169 | 170 | end. 171 | -------------------------------------------------------------------------------- /FreetrackClient/FTServer.pas: -------------------------------------------------------------------------------- 1 | unit FTServer; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Forms, SysUtils, Classes, Registry, Dialogs, Controls, DKLang, FTTypes; 7 | 8 | type 9 | TClientDllState = (csRegCheck, csLoadDll, csSelectDll, csDoneOK); 10 | 11 | procedure FTUpdateData(dataid : Cardinal; camwidth, camheight : Integer; 12 | yaw, pitch, roll, panx, pany, panz : Single; 13 | rawYaw, rawPitch, rawRoll, rawPanx, rawPany, rawPanz : Single; 14 | x1, y1, x2, y2, x3, y3, x4, y4 : Single); 15 | function FTCreateMapping(handle : THandle) : Boolean; 16 | procedure FTDestroyMapping; 17 | function FTCheckClientDLL : TFileName; 18 | function FTGetProgramName : String; 19 | 20 | implementation 21 | 22 | var 23 | hFTMemMap : THandle; 24 | FTData : PFreeTrackData; 25 | FTHandle : PHandle; 26 | FTProgramName : PAnsiChar; 27 | FTMutex : THandle; 28 | 29 | function FTCreateMapping(handle : THandle) : Boolean; 30 | begin 31 | hFTMemMap := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, Sizeof(TFreetrackData) + SizeOf(FTHandle) + SizeOf(FTProgramName), FT_MM_DATA); 32 | if (hFTMemMap <> 0) and (GetLastError = ERROR_ALREADY_EXISTS) then begin 33 | CloseHandle(hFTMemMap); 34 | hFTMemMap := 0; 35 | end; 36 | 37 | hFTMemMap := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, FT_MM_DATA); 38 | if (hFTMemMap <> 0) then begin 39 | FTData := MapViewOfFile(hFTMemMap, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TFreeTrackData) + SizeOf(THandle) + 100); 40 | FTHandle := Pointer(DWord(FTData) + SizeOf(TFreeTrackData)); 41 | FTHandle^ := handle; 42 | FTProgramName := Pointer(DWord(FTHandle) + SizeOf(THandle)); 43 | FTMutex := CreateMutex(nil, False, FREETRACK_MUTEX); 44 | end; 45 | 46 | Result := Assigned(FTData); 47 | end; 48 | 49 | 50 | procedure FTDestroyMapping; 51 | begin 52 | if FTData <> nil then begin 53 | UnMapViewofFile(FTData); 54 | FTData := nil; 55 | end; 56 | 57 | CloseHandle(hFTMemMap); 58 | hFTMemMap := 0; 59 | end; 60 | 61 | 62 | procedure FTUpdateData(dataid : Cardinal; camwidth, camheight : Integer; 63 | yaw, pitch, roll, panx, pany, panz : Single; 64 | rawYaw, rawPitch, rawRoll, rawPanx, rawPany, rawPanz : Single; 65 | x1, y1, x2, y2, x3, y3, x4, y4 : Single); 66 | begin 67 | if (FTData <> nil) and (WaitForSingleObject(FTMutex, 100) = WAIT_OBJECT_0) then begin 68 | try 69 | FTData^.DataID := dataid; 70 | FTData^.CamWidth := camwidth; 71 | FTData^.CamHeight := camheight; 72 | FTData^.Yaw := yaw; 73 | FTData^.Pitch := pitch; 74 | FTData^.Roll := roll; 75 | FTData^.X := panx; 76 | FTData^.Y := pany; 77 | FTData^.Z := panz; 78 | FTData^.RawYaw := rawyaw; 79 | FTData^.RawPitch := rawpitch; 80 | FTData^.RawRoll := rawroll; 81 | FTData^.RawX := rawpanx; 82 | FTData^.RawY := rawpany; 83 | FTData^.RawZ := rawpanz; 84 | FTData^.x1 := x1; 85 | FTData^.y1 := y1; 86 | FTData^.x2 := x2; 87 | FTData^.y2 := y2; 88 | FTData^.x3 := x3; 89 | FTData^.y3 := y3; 90 | FTData^.x4 := x4; 91 | FTData^.y4 := y4; 92 | except 93 | end; 94 | ReleaseMutex(FTMutex); 95 | end; 96 | end; 97 | 98 | 99 | function FTGetProgramName : String; 100 | begin 101 | Result := FTProgramName; 102 | end; 103 | 104 | 105 | function FTCheckClientDLL : TFileName; 106 | var 107 | aLocation : string; 108 | aKey : TRegistry; 109 | aDLLHandle : THandle; 110 | ClientState: TClientDllState; 111 | LocalDllTested : Boolean; 112 | begin 113 | LocalDllTested := False; 114 | aDLLHandle := INVALID_HANDLE_VALUE; 115 | aKey := TRegistry.Create(KEY_READ or KEY_WRITE); 116 | try 117 | ClientState := csRegCheck; 118 | 119 | while true do 120 | case ClientState of 121 | csRegCheck : begin 122 | ClientState := csSelectDll; 123 | aKey.RootKey := HKEY_CURRENT_USER; 124 | if aKey.OpenKey(FT_CLIENT_LOCATION, True) then begin 125 | aLocation := aKey.ReadString('Path'); 126 | aLocation := IncludeTrailingPathDelimiter(aLocation) + FT_CLIENT_FILENAME; 127 | if FileExists(aLocation) then 128 | ClientState := csLoadDll; 129 | end; 130 | end; 131 | 132 | csLoadDll : begin 133 | aDLLHandle := LoadLibrary(PChar(aLocation)); 134 | FTProvider := GetProcAddress(aDLLHandle, 'FTProvider'); 135 | if Assigned(FTProvider) and (FTProvider = FREETRACK) then 136 | ClientState := csDoneOK 137 | else if not LocalDllTested then 138 | ClientState := csSelectDll 139 | else begin 140 | aLocation := ''; 141 | Break; 142 | end; 143 | end; 144 | 145 | csSelectDll: begin 146 | if aDLLHandle <> INVALID_HANDLE_VALUE then 147 | FreeLibrary(aDLLHandle); 148 | 149 | aLocation := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + FT_CLIENT_FILENAME; 150 | LocalDllTested := True; 151 | ClientState := csLoadDll; 152 | end; 153 | 154 | csDoneOK : begin 155 | if aKey.ReadString('Path') <> ExtractFilePath(aLocation) then 156 | aKey.WriteString('Path', ExtractFilePath(aLocation)); 157 | 158 | Result := aLocation; 159 | Break; 160 | end; 161 | end; 162 | 163 | if aDLLHandle <> INVALID_HANDLE_VALUE then 164 | FreeLibrary(aDLLHandle); 165 | 166 | finally 167 | aKey.Free; 168 | end; 169 | end; 170 | 171 | 172 | 173 | 174 | 175 | end. 176 | -------------------------------------------------------------------------------- /Freetrack/FreeTrackTray.pas: -------------------------------------------------------------------------------- 1 | unit FreeTrackTray; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Classes, Menus, Graphics, Forms, messages, 7 | TrayIcon, PngImageList, PngSpeedButton, extctrls, DKLang; 8 | 9 | type 10 | TTypeState = (tsOff, tsON_Ok, tsOn_HS); 11 | TIconArray = array[TTypeState] of TIcon; 12 | TTrayMenuCaption = (S_START, S_STOP, S_RESUME); 13 | 14 | TOnStateChanged = procedure (Sender : TObject; state : TTypeState) of Object; 15 | TOnHostAppRunning = procedure (Sender : TObject; value : Boolean) of Object; 16 | 17 | TFreeTrackTray = class(TTRayIcon) 18 | private 19 | aIcons : array[TTypeState] of TIcon; 20 | FState: TTypeState; 21 | FOnStateChanged: TOnStateChanged; 22 | FOnRestore: TNotifyEvent; 23 | FOnMinimize: TNotifyEvent; 24 | FHostAppRunning: Boolean; 25 | FOnHostAppRunning: TOnHostAppRunning; 26 | fOwner : TForm; 27 | FMenuState: TTrayMenuCaption; 28 | 29 | procedure GestMnuRestore(Sender: TObject); 30 | procedure GestMnuQuit(Sender: TObject); 31 | procedure GestDblClick(Sender: TObject); 32 | procedure GestMnuStart(Sender: TObject); 33 | procedure SetState(const Value: TTypeState); 34 | procedure SetHostAppRunning(value : Boolean); 35 | function GetIcon(Index : TTypeState): TIcon; 36 | procedure SetMenuCaption(const Value: TTrayMenuCaption); 37 | public 38 | aPopupMenu : TPopupMenu; 39 | Constructor Create(AOwner: TComponent); override; 40 | procedure Restore;override; 41 | procedure Minimize;override; 42 | property MenuCaption : TTrayMenuCaption read FMenuState write SetMenuCaption; 43 | property State : TTypeState read FState write SetState; 44 | property Icons[Index : TTypeState] : TIcon read GetIcon; 45 | property OnStateChanged : TOnStateChanged read FOnStateChanged write FOnStateChanged; 46 | property OnRestore : TNotifyEvent read FOnRestore write FOnRestore; 47 | property OnMinimize : TNotifyEvent read FOnMinimize write FOnMinimize; 48 | property HostAppRunning : Boolean read FHostAppRunning write SetHostAppRunning; 49 | property OnHostAppRunning : TOnHostAppRunning read FOnHostAppRunning write FOnHostAppRunning; 50 | end; 51 | 52 | var 53 | aFreeTrackTray : TFreeTrackTray; 54 | 55 | implementation 56 | 57 | {$R icons.res} 58 | 59 | 60 | { TFreeTrackTray } 61 | 62 | constructor TFreeTrackTray.Create(AOwner: TComponent); 63 | var 64 | aState : TTypeState; 65 | begin 66 | inherited; 67 | aPopupMenu := TPopupMenu.Create(Self); 68 | 69 | aPopupMenu.Items.Add(TMenuItem.Create(aPopupMenu)); 70 | aPopupMenu.Items[0].OnClick := GestMnuStart; 71 | 72 | aPopupMenu.Items.Add(TMenuItem.Create(aPopupMenu)); 73 | aPopupMenu.Items[1].OnClick := GestMnuRestore; 74 | 75 | aPopupMenu.Items.Add(TMenuItem.Create(aPopupMenu)); 76 | aPopupMenu.Items[2].OnClick := GestMnuQuit; 77 | 78 | SetMenuCaption(S_START); 79 | 80 | PopupMenu := aPopupMenu; 81 | OnDblClick := GestDblClick; 82 | Visible := False; 83 | 84 | for aState := low(TTypeState) to high(TTypeState) do 85 | aIcons[aState] := TIcon.Create; 86 | 87 | fOwner := AOwner as TForm; 88 | 89 | aIcons[tsOff] := (fOwner.FindComponent('imTrayIcon1') as TImage).Picture.Icon; 90 | aIcons[tsOn_HS] := (fOwner.FindComponent('imTrayIcon2') as TImage).Picture.Icon; 91 | aIcons[tsOn_OK] := (fOwner.FindComponent('imTrayIcon3') as TImage).Picture.Icon; 92 | 93 | State := tsOff; 94 | Icon := aIcons[tsOff]; 95 | end; 96 | 97 | 98 | 99 | procedure TFreeTrackTray.GestDblClick(Sender: TObject); 100 | begin 101 | Application.Restore; 102 | Application.BringToFront; 103 | end; 104 | 105 | 106 | 107 | procedure TFreeTrackTray.GestMnuQuit(Sender: TObject); 108 | begin 109 | PostMessage( Application.MainForm.Handle, WM_Close, 0, 0); 110 | end; 111 | 112 | 113 | 114 | procedure TFreeTrackTray.GestMnuRestore(Sender: TObject); 115 | begin 116 | GestDblClick(nil); 117 | end; 118 | 119 | 120 | procedure TFreeTrackTray.GestMnuStart(Sender: TObject); 121 | begin 122 | (fOwner.FindComponent('butStart') as TPngSpeedButton).Click; 123 | end; 124 | 125 | 126 | 127 | function TFreeTrackTray.GetIcon(Index : TTypeState): TIcon; 128 | begin 129 | Result := aIcons[Index]; 130 | end; 131 | 132 | 133 | 134 | 135 | procedure TFreeTrackTray.Minimize; 136 | begin 137 | inherited; 138 | Application.ShowMainForm := False; 139 | Visible := True; 140 | if Assigned(FOnMinimize) then 141 | FOnMinimize(Self); 142 | end; 143 | 144 | 145 | 146 | procedure TFreeTrackTray.Restore; 147 | begin 148 | inherited; 149 | Visible := False; 150 | Application.ShowMainForm := True; 151 | Application.MainForm.Visible := True; 152 | if Assigned(FOnRestore) then 153 | FOnRestore(Self); 154 | end; 155 | 156 | 157 | 158 | procedure TFreeTrackTray.SetState(const Value: TTypeState); 159 | begin 160 | if FState = Value then 161 | Exit; 162 | 163 | FState := Value; 164 | Icon := aIcons[Value]; 165 | 166 | if Assigned(FOnStateChanged) then 167 | FOnStateChanged(Self, Value); 168 | end; 169 | 170 | 171 | procedure TFreeTrackTray.SetHostAppRunning(value : Boolean); 172 | begin 173 | FHostAppRunning := value; 174 | if Assigned(FOnHostAppRunning) then 175 | FOnHostAppRunning(Self, value); 176 | end; 177 | 178 | procedure TFreeTrackTray.SetMenuCaption(const Value: TTrayMenuCaption); 179 | begin 180 | FMenuState := Value; 181 | 182 | case FMenuState of 183 | S_START : aPopupMenu.Items[0].Caption := DKLangConstW('S_START'); 184 | S_STOP : aPopupMenu.Items[0].Caption := DKLangConstW('S_STOP'); 185 | S_RESUME: aPopupMenu.Items[0].Caption := DKLangConstW('S_RESUME'); 186 | end; 187 | 188 | aPopupMenu.Items[1].Caption := DKLangConstW('S_RESTORE'); 189 | aPopupMenu.Items[2].Caption := DKLangConstW('S_QUIT'); 190 | 191 | end; 192 | 193 | end. 194 | -------------------------------------------------------------------------------- /Freetrack/Constants.txt: -------------------------------------------------------------------------------- 1 | S_ERROR_SELECT_CLIENTDLL = %s is not compatible with FreeTrack or is missing.\nDo you want to select the proper dll? 2 | S_ERROR_CLIENTDLL_LOADING = Error loading %s. 3 | S_ERROR_ALREADY_RUNNING = FreeTrack is already running. 4 | S_ERROR_PPJOY_DEVICE_DELETED = PPJoy device deleted. Exiting read loop. 5 | S_ERROR_PPJOY = Error sending PPJoy data. Error number: 6 | S_ERROR_PPJOY_NOTFOUND = PPJoy virtual joystick not found. 7 | S_ERROR_SIMCONNECT = SimConnect failed. 8 | S_ERROR_MODEL_ZERO = Model dimensions must be greater than zero. 9 | S_ERROR_FILEMOVE = Error moving file. 10 | S_ERROR_3DSCENE_INI = ERROR: 3D scene failed to initialize. 11 | S_ERROR_3DSCENE_CREATION = ERROR: 3D scene could not be created. 12 | S_ERROR_3DSCENE_DISPLAYMODE = ERROR: Failed to get display mode. 13 | S_ERROR_VM_MISSINGDEMO = Missing demo.avi file. 14 | S_ERROR_VM_THRESHOLD = Failed to set threshold. 15 | S_ERROR_AX_REG_FAILED = Failed to register %s \nVideo sources cannot be used.\nVista users: right click on executable and select "Run As Administrator." 16 | S_ERROR_DELETING_FILE = Error deleting file. 17 | S_ERROR_MOVING_FILE = Error moving file. 18 | S_ERROR_RENAMING_FILE = Error renaming file. 19 | S_ERROR_PROFILE_ALREADY_EXISTS = Profile already exists, please choose another name 20 | S_ERROR_DUMMYPROCESS = Error creating dummy process 21 | S_ERROR_PROGRAM_NAME_TOO_SMALL = Program name must be at least three characters long. 22 | S_ERROR_NP_SOFTWARE_RUNNING = Please shutdown all TrackIR or SmartNav software before starting FreeTrack. 23 | S_ERROR_SSE2_UNAVAILABLE = SSE2 support required and not available\nUse the MMX filter instead 24 | S_ERROR_SSE2_AVAILABLE = SSE2 support is available\nUse the SSE2 filter instead for better performance 25 | S_WARNING_UNSUPPORTED_MEDIATYPE = Video format does not appear to be supported.\n\nGUID: %s \n\nFreeTrack supports: \nYVU9, IF09, YV12, IYUV, I420, NV12, IMC1, IMC2, IMC3, IMC4, Y800, Y8, GREY, RGB8 \nYUYV, YUY2, YVYU \nUYVY, Y422 \nRGB24, RGB32, ARGB32\n 26 | S_WARNING_MODEL_3P_PITCH = Tracking is unreliable when the point plane is close to being parallel with camera plane (when pitching down).\nAvoid by ensuring middle point is deeper than it is high. 27 | S_WARNING_MODEL_3P_YAW = Tracking is unreliable when a forward point moves behind the middle point (when yawing).\nAvoid by keeping depth greater than width. 28 | S_FREETRACK = FreeTrack 29 | S_QUERY_CONFIRM_CLOSE = Are you sure you want to close FreeTrack? 30 | S_QUERY_SAVE_CHANGES = Would you like to save changes to the %s profile? 31 | S_QUERY_CONFIG_DEFAULTS = Are you sure you want to reset the main configuration file to default settings? 32 | S_QUERY_DELETEPROFILE = Are you sure you want to delete the profile file %s ? 33 | S_HINT_THRESHOLD = Adjust this and camera exposure to completely isolate the tracking points.\nWide angle infrared LEDs and visible light filter recommended.\nFor best results remove webcam infrared filter. 34 | S_HINT_AVERAGE = Point locations averaged across this many camera frames.\nIncreases stability at the expense of responsiveness. 35 | S_HINT_SENSITIVITY = Multiplies real measurements. Equals real head measurements when set to one and response curve axis limit set to maximum. 36 | S_HINT_SMOOTHING = Increases stability and smoothness with some loss of low to mid-speed responsiveness.\nHigh speed responsiveness not affected as much. Additional smoothing applied by games\nneeds to be taken into consideration. 37 | S_HINT_SMOOTHINGZOOMING = Increases smoothing to stabilize view when moving head forward.\nEspecially useful for games that use Z-axis zooming or require a steady view.\nWorks in both 2DOF and 6DOF games. 38 | S_HINT_DYNAMICSMOOTHING = Reduce smoothing during motion to improve responsiveness while maintaining stability.\nTracking generally less smooth but depends on amount of in-game smoothing. 39 | S_HINT_AUTOLOADPROFILE = When TrackIR or FreeTrack enabled program is launched, its associated profile is loaded.\nAny profile changes are discarded unless option to auto-save profile is checked. 40 | S_HINT_AUTOMINIMIZE = Minimize after not having focus for more than 20 seconds or when a FreeTrack or TrackIR program is started. 41 | S_HINT_KEYCONTROL_TOGGLE = Double tap key to switch between momentary and toggle mode. 42 | S_HINT_FILTER = Filter optimized for CPU with %s 43 | S_HINT_VIEW_RELATIVE_TRANS_ROT = Translate relative to this axis 44 | S_HINT_VIEW_RELATIVE_TRANS_TRANS = Axis affected by view relative translation 45 | S_HINT_MODEL_DIMENSIONS = Dimensions in millimetres 46 | S_HINT_FTSERVER = SDK Available. 47 | S_HINT_TRACKIR = Standard TrackIR interface.\nNumber of degrees of freedom program dependent. 48 | S_HINT_TIRVIEWS = Alternative interface for some games, requires TIRViews.dll.\nFS2004\nFSX (SimConnect)\nWings of War\nNASCAR Racing Season 2003\nColin McRae Rally 4\nRace Driver 2\nCombat Flight Simulator 3\nRichard Burns Rally\nF1 Challenge 49 | S_HINT_FPS = Webcam frames per second 50 | S_HINT_JITTER = Number of frames more than +/-40% of average 51 | S_HINT_NO_FTCLIENT_DLL = FTClient.dll not found 52 | S_HINT_NO_NPCLIENT_DLL = NPClient.dll not found 53 | S_HINT_NO_TIRVIEWS_DLL = TIRViews.dll not found 54 | S_HINT_MAINTAIN_PAUSED_DATA = Prevents host applications from reseting the view when tracking is paused.\nMay prevent view from being changed by other means. 55 | S_RENAME_PROFILE = Rename Profile 56 | S_NEW_PROFILE_NAME = New profile name 57 | S_TRACKIR_NEW_PROGRAM = New TrackIR program 58 | S_TRACKIR_NEW_PROGRAM_CAPTION = A new TrackIR enabled program has been detected. Enter the program's name below to add it to the program list. 59 | S_PROGRAMID = ProgramID 60 | S_DIALOG_PROFILE_FILTER = FreeTrack Game Profile (*.fgp) | *.fgp 61 | S_DIALOG_PROFILE_TITLE = Add FreeTrack Game Profile 62 | S_CTRL_NONAME = No name 63 | S_NEW_PROFILE = New profile 64 | S_SAVEAS = Save as 65 | S_FILENAME = File name 66 | S_MODIFIED = (modified) 67 | S_PRESS_CONTROL = Press control 68 | S_PRESS_KEY = Press key 69 | S_START = Start 70 | S_STOP = Stop 71 | S_RESUME = Resume 72 | S_RESTORE = Restore 73 | S_QUIT = Quit 74 | S_RESP_LABEL_IN = In 75 | S_RESP_LABEL_OUT = Out 76 | S_YAW = Yaw 77 | S_PITCH = Pitch 78 | S_ROLL = Roll 79 | S_PANX = X 80 | S_PANY = Y 81 | S_PANZ = Z 82 | 83 | 84 | 85 | 86 | 87 | 88 | -------------------------------------------------------------------------------- /Freetrack/changelog.txt: -------------------------------------------------------------------------------- 1 | 2 | FreeTrack Version History 3 | ========================= 4 | 5 | * 2.2.0.0 6 | ---------- 7 | .: RGB filter resolution and sensitivity improved. 8 | .: Force Exposure integrated into camera properties, all slider and checkbox states are automatically remembered. 9 | .: Smoothing and averaging made indepedent of frame rate. 10 | .: Maintaining paused data is optional so that view can be changed by other means. 11 | .: Tracked points are highlighted for better visibility. 12 | .: Comprehensive software documentation. 13 | .: Dialog displayed when new TrackIR program detected for name entry. 14 | .: TrackIR, SmartNav and OptiTrack cameras supported. Need to install OptiTrack SDK. 15 | .: Center of rotation calibration improved, simplified and extended to all 6dof tracking modes. 16 | .: Camera calibration available for calibrating all distances to millimeters. 17 | .: Profile extension changed from *.fgp (FreeTrack Game Profile) changed to *.ftp (FreeTrack Profile). 18 | .: Controls now have default mapping. 19 | .: Axis mapping, primarily for allowing head mounted cameras (x and y swapped with yaw and pitch). 20 | .: Camera orientation can be accounted for so that translation directions are correct. 21 | .: 3D preview options (in right click menu) for displaying render frame rate and pose data frame rate. 22 | .: Fixed: TrackIR enabled games freezing on launch for some people (even when FreeTrack is not running). 23 | .: Four point cap sensitivities increased to match three point cap and clip. 24 | .: Open source FreeTrack interface available for 3rd party apps. See SDK directory. 25 | .: Point size max/min diameter control. 26 | .: Jitter changed to measure number of frames that deviate by more than 40 percent instead of 15 percent. 27 | .: Fixed: Point tracking not covering entire video for resolutions 640x480 and higher. 28 | .: Fixed: NAN axis-lock. A 3 point cap model that produced NAN errors is still degenerate though. 29 | .: Fixed: 4 point cap custom model dimensions initialization. 30 | .: Option to ignore backward Z movement, mainly to avoid virtual head passing through vehicle seat. 31 | .: Video codec support should now include; YVU9, IF09, YV12, YV16, IYUV, I420, NV12, IMC1, IMC2, IMC3, IMC4, Y800, RGB8, Y8, GREY, YUYV, YUY2, YVYU, UYVY, Y422, RGB24, ARGB32 and RGB32. 32 | .: USB Video Class (UVC) standard now supported (YUYV) (eg driverless webcam). 33 | .: Wii remote camera auto-orientation using accelerometer data. 34 | .: Added support for Wii remote camera, practically no cpu usage and more than triple normal webcam frame rate, tested with BlueSoleil. 35 | .: Greyed disabled options in Camera Properties can be enabled just by clicking on them (auto-exposure workaround). 36 | .: Extra game support if TIRViews.dll is available (comes with TrackIR software). Notably full 6DOF in FS2004. 37 | .: Translation can be made with respect to current view, using optional yaw, pitch and roll and affecting optional x, y and z axes. 38 | .: Fixed: RGB mode crashing with too much light. 39 | .: 3D preview fps no longer limited to webcam fps, uses interpolated data, better representation of tracking quality. 40 | .: Custom center; define your own default center location and orientation. 41 | .: Grand Prix Legends TIR detection work-around. 42 | .: Significant improvement to tracking responsiveness and accuracy by using weighted mean to find point centers instead of bounding box. Less smoothing required. 43 | .: Control input now possible via mouse and joystick buttons and extended keyboard keys recognised. 44 | .: Auto-select correct language on first run if translation available. 45 | .: Multi-language support using DKLang. New translations must be made using DKLang Translation Editor, see Language directory for details. 46 | .: Fixed: ArmA rapid view shaking due to short data timeout. 47 | 48 | * 2.1.0.0 49 | ---------- 50 | .: FS2004/2002 4dof support (requires FSUIPC.dll 3.xx in Modules directory) 51 | .: Video demonstration mode. 52 | .: Keyboard output. 53 | .: Absolute mouse control, better accuracy for desktop use. 54 | .: Pixel doubling 55 | .: Improved responsiveness 56 | .: Filter can be manually changed via ini file (auto, mmx, sse2). 57 | .: 3D scene destroyed on minimization to improve compatibility. 58 | .: Preset response curves available through right-click popup and ability to copy curves to other axes. 59 | .: Response curves no longer cause centering lag. 60 | .: Enlarged response curves from 160 to 180 degrees. 61 | .: Output page added to GUI, mouse options for axis source, mousewheel and autopan, PPJoy controller number can now be selected. 62 | .: Dynamic smoothing control, reduces when head moves, and increases when head is stationary. 63 | .: Center hotkey works while paused. 64 | .: Middle mouse center option. 65 | .: Double-tap to change hotkey toggle mode. 66 | .: Hotkey page added to GUI, stored in profile, axis and output have on/off hotkeys, smoothing can be modified via hotkey. 67 | .: FSX support through SimConnect. 68 | .: Launch at startup, start minimized, confirm close and auto-minimize options. 69 | .: Video resolution remembered. 70 | .: Force camera exposure control dialog, ensures new video streams have desired exposure. 71 | .: Auto select correct filter for user's cpu if .ax file is missing. 72 | .: RGB24 3 point tracking fixed. 73 | .: 3 point cap tracking mode. 74 | .: New interpolation timer with control of the number of additional frames. 75 | .: Auto-load profile on detection of specified 6dof capable game, optional. 76 | .: New profile manager, drag and drop games to associate them with a profile for autoloading. 77 | .: Better synchronization of interpolation with webcam. 78 | .: 'Floating deadzone' renamed to 'smoothing' to reduce ambiguity. 79 | 80 | * 2.0.0.0 81 | ----------- 82 | .: 3 Points Clip and 4 points Cap optimizations. 83 | .: Average is included in profile tab 84 | .: CJPG Not implemented 85 | 86 | * 1.2.0.1 Beta test version (never released) 87 | ----------- 88 | .: include Single Point, 3 Points Clip, 4 Points Cap 89 | .: New GUI with icons 90 | .: News Functions 91 | .: CJPG Not implemented 92 | 93 | * 1.1.0.0 94 | ----------- 95 | .: Less CPU Usage 96 | .: 4 Points Cap only 97 | .: Filter Optimisation RGB 24 Bits, I420, RGB 555 (16 Bits) 98 | .: CJPG Not implemented 99 | .: About Tab 100 | .: invert Tab 101 | 102 | * 1.0.0.0 103 | ----------- 104 | .: First no beta release 105 | .: 4 Points Cap only -------------------------------------------------------------------------------- /DShowFilter/SeuillageProcessor_YUV.pas: -------------------------------------------------------------------------------- 1 | unit SeuillageProcessor_YUV; 2 | 3 | interface 4 | 5 | uses 6 | BaseClass, DirectShow9, DSUtil, ActiveX, Windows, Math, Types, 7 | Seuillage_inc, SeuillageProcessor_CbCr, SeuillageProcessor; 8 | 9 | type 10 | TSeuillageProcessor_YUV = class (TSeuillageProcessor_CbCr) 11 | protected 12 | procedure DrawCenterCross; override; 13 | procedure DrawCross(aPoint : TPoint); override; 14 | procedure Find(pPixel : Pointer); override; 15 | function PointCenterWeightedMean: TPoint; override; 16 | function TestPixel(pPixel: Pointer): Boolean; override; 17 | public 18 | function SetSeuil(bSeuil: Byte): HResult; override; 19 | end; 20 | 21 | {$i FreetrackFilter.inc} 22 | 23 | implementation 24 | 25 | 26 | { 27 | *************************** TSeuillageProcessor_YUV **************************** 28 | } 29 | procedure TSeuillageProcessor_YUV.DrawCenterCross; 30 | var 31 | pPixelVert, pPixelHor: pByte; 32 | i: Integer; 33 | begin 34 | pPixelHor := pByte(FAddrStart + (SampleHeight * SampleWidth) shr 1); 35 | pPixelVert := pByte(FAddrStart + SampleWidth shr 1); 36 | 37 | for i := 0 to SampleWidth do begin 38 | if (Longint(pPixelHor) >= FAddrStart) and (Longint(pPixelHor) <= YEnd) then 39 | pPixelHor^ := X_CENTER_COL; 40 | if (Longint(pPixelVert) >= FAddrStart) and (Longint(pPixelVert) <= YEnd) then 41 | pPixelVert^ := X_CENTER_COL; 42 | 43 | inc(pPixelHor); 44 | inc(pPixelVert, SampleWidth); 45 | end; 46 | end; 47 | 48 | 49 | 50 | procedure TSeuillageProcessor_YUV.DrawCross(aPoint : TPoint); 51 | var 52 | pPixelLeft, pPixelRight, pPixelUp, pPixelDown: pByte; 53 | i: Integer; 54 | begin 55 | pPixelLeft := pByte(AddrStart + (aPoint.X + aPoint.Y * SampleWidth)); 56 | pPixelRight := pPixelLeft; 57 | pPixelUp := pPixelLeft; 58 | pPixelDown := pPixelLeft; 59 | 60 | for i := 0 to X_POINT_SIZE do begin 61 | if (aPoint.Y - i) > 0 then 62 | pPixelUp^ := X_POINT_COL; 63 | if (aPoint.X - i) > 0 then 64 | pPixelLeft^ := X_POINT_COL; 65 | 66 | if (aPoint.Y + i) < SampleHeight then 67 | pPixelDown^ := X_POINT_COL; 68 | if (aPoint.X + i) < SampleWidth then 69 | pPixelRight^ := X_POINT_COL; 70 | 71 | inc(pPixelRight); 72 | dec(pPixelLeft); 73 | inc(pPixelDown, SampleWidth); 74 | dec(pPixelUp, SampleWidth); 75 | end; 76 | end; 77 | 78 | 79 | 80 | procedure TSeuillageProcessor_YUV.Find(pPixel : Pointer); 81 | var 82 | x, y: Integer; 83 | aPixAddr: Integer; 84 | _AddrStart: Integer; 85 | begin 86 | inherited; 87 | if ((aLed.Bottom - aLed.Top) > POINT_MAX_DIM) or 88 | ((aLed.Right - aLed.Left) > POINT_MAX_DIM) then 89 | Exit; 90 | _AddrStart := FAddrStart; 91 | 92 | try 93 | if (pByte(pPixel)^ = PIX_LIGHT) then begin 94 | pByte(pPixel)^ := PIX_USED; // set the pixel as used 95 | 96 | asm 97 | mov esi, Self 98 | 99 | //x := ((Longint(pPixel) - AddrStart)div iPixelSize) mod SampleWidth; 100 | mov eax, Longint(pPixel) 101 | sub eax, _AddrStart 102 | xor edx, edx 103 | div [esi].TSeuillageProcessor.SampleWidth 104 | 105 | mov x, edx 106 | mov y, eax 107 | //y := ((Longint(pPixel) - AddrStart)div iPixelSize) div SampleWidth; 108 | end; 109 | 110 | aLed := Rect(Min(aLed.Left, x), Min(aLed.Top, y), Max(aLed.Right, x), Max(aLed.Bottom, y)); 111 | 112 | aPixAddr := Longint(pPixel) - SampleWidth - iPixelSize; 113 | if inside(aPixAddr) then Find(pByte(aPixAddr)); //x-1,y+1 114 | inc(aPixAddr); 115 | if inside(aPixAddr) then Find(pByte(aPixAddr)); //x,y-1 116 | inc(aPixAddr); 117 | if inside(aPixAddr) then Find(pByte(aPixAddr)); //x+1,y-1 118 | 119 | inc(aPixAddr, SampleWidth - iPixelSize shl 1); 120 | if inside(aPixAddr) then Find(pByte(aPixAddr)); //x-1,y 121 | inc(aPixAddr, iPixelSize shl 1); 122 | if inside(aPixAddr) then Find(pByte(aPixAddr)); //x+1,y 123 | 124 | inc(aPixAddr, SampleWidth - iPixelSize shl 1); 125 | if inside(aPixAddr) then Find(pByte(aPixAddr)); //x-1,y-1 126 | inc(aPixAddr); 127 | if inside(aPixAddr) then Find(pByte(aPixAddr)); //x,y+1 128 | inc(aPixAddr); 129 | if inside(aPixAddr) then Find(pByte(aPixAddr)); //x+1,y+1 130 | end 131 | 132 | except 133 | {On E : EAbort do 134 | Raise; 135 | else 136 | Raise Exception.Create('Error in TfmGrabber.Find');} 137 | end; 138 | end; 139 | 140 | 141 | 142 | function TSeuillageProcessor_YUV.PointCenterWeightedMean: TPoint; 143 | var 144 | jPixel: Integer; 145 | xPixel, yPixel, pixelCount, average_x, average_y: Integer; 146 | ledXWeight, ledYWeight: array[0..200] of Integer; 147 | aPixel: pByte; 148 | startPixel: LongInt; 149 | begin 150 | 151 | pixelCount := 0; 152 | average_x := 0; 153 | average_y := 0; 154 | for jPixel := 0 to High(ledXWeight) do begin 155 | ledXWeight[jPixel] := 0; 156 | ledYWeight[jPixel] := 0; 157 | end; 158 | 159 | // range limits used to avoid integer overflow 160 | startPixel := AddrStart + aLed.Left + aLed.Top * SampleWidth; 161 | for xPixel := 0 to Min(aLed.Right - aLed.Left, MaxPointSize) do 162 | for yPixel := 0 to Min(aLed.Bottom - aLed.Top, MaxPointSize) do begin 163 | aPixel := pByte(startPixel + xPixel + yPixel * SampleWidth); 164 | if aPixel^ = PIX_USED then begin 165 | aPixel^ := PIX_TRACKED; 166 | Inc(ledXWeight[xPixel]); 167 | Inc(ledYWeight[yPixel]); 168 | Inc(pixelCount); 169 | end; 170 | end; 171 | 172 | for jPixel := 0 to Min(Max(aLed.Right - aLed.Left, aLed.Bottom - aLed.Top), MaxPointSize) do begin 173 | average_x := average_x + ledXWeight[jPixel] * (jPixel + 1); 174 | average_y := average_y + ledYWeight[jPixel] * (jPixel + 1); 175 | end; 176 | 177 | average_x := round((aLed.Left + (average_x / pixelCount) - 1) * LISTPOINT_SCALER); 178 | average_y := round((aLed.Top + (average_y / pixelCount) - 1) * LISTPOINT_SCALER); 179 | 180 | Result := Point(average_x, average_y); 181 | end; 182 | 183 | 184 | 185 | function TSeuillageProcessor_YUV.SetSeuil(bSeuil: Byte): HResult; 186 | begin 187 | FillChar(Mask1, SizeOF(TMaskSeuil), bSeuil - $80); 188 | FillChar(UVMask, SizeOF(TMaskSeuil), 0); 189 | FillChar(GreyMask, SizeOF(TMaskSeuil), PIX_LIGHT); 190 | Result := S_OK; 191 | end; 192 | 193 | 194 | 195 | function TSeuillageProcessor_YUV.TestPixel(pPixel: Pointer): Boolean; 196 | begin 197 | Result := Byte(pPixel^) = PIX_LIGHT; 198 | end; 199 | 200 | end. 201 | -------------------------------------------------------------------------------- /DShowFilter/Seuillage.pas: -------------------------------------------------------------------------------- 1 | { Under GNU License 2 | check http://www.opensource.org/ 3 | project by 4 | Nicolas Camil 5 | http://n.camil.chez.tiscali.fr 6 | ------------------------------ 7 | 8 | This library is free software; you can redistribute it and/or 9 | modify it under the terms of the GNU Library General Public 10 | License as published by the Free Software Foundation. 11 | 12 | This library is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | Library General Public License for more details.} 16 | 17 | unit Seuillage; 18 | 19 | interface 20 | 21 | {$i FreetrackFilter.inc} 22 | 23 | {.$define DEBUG} 24 | 25 | uses 26 | BaseClass, DirectShow9, DSUtil, ActiveX, Windows, Math, Types, Seuillage_inc, 27 | Dialogs, cpuid, SeuillageProcessor 28 | {$ifdef DEBUG} 29 | ,Classes, SysUtils 30 | {$endif} 31 | ; 32 | 33 | const 34 | {$ifdef SSE2} 35 | MM_SIZE = 16; 36 | {$else} 37 | MM_SIZE = 8; 38 | {$endif} 39 | 40 | type 41 | TMaskSeuil = array[0..MM_SIZE-1] of byte; 42 | 43 | TSeuillage = class(TBCTransInPlaceFilter, IPersist, ISpecifyPropertyPages, ISeuil) 44 | private 45 | fSeuil : byte; 46 | fIsActive : Boolean; 47 | MinPointSize, MaxPointSize : Integer; 48 | fOnLedDetected : TOnLedDetectedCB; 49 | 50 | fSeuillageProcessor : TSeuillageProcessor; 51 | function CanPerformTransform(const pMediaType : PAMMediaType) : boolean; 52 | public 53 | constructor CreateFromFactory(Factory: TBCClassFactory; const Controller: IInterface);override; 54 | Destructor Destroy;override; 55 | 56 | function CheckInputType(mtIn: PAMMediaType): HRESULT;override; 57 | function Transform(Sample: IMediaSample): HRESULT;override; 58 | 59 | (*** ISpecifyPropertyPages methods ***) 60 | function GetPages(out pages: TCAGUID): HResult; stdcall; 61 | 62 | (*** IFreeTrack methods ***) 63 | function SetMaxPointSize(Size : Byte): HResult;stdcall; 64 | function GetMaxPointSize(pSize : PByte): HResult;stdcall; 65 | function SetMinPointSize(Size : Byte): HResult;stdcall; 66 | function GetMinPointSize(pSize : PByte): HResult;stdcall; 67 | 68 | function SetNoise(noise1, noise2 : byte): HResult;stdcall; 69 | 70 | function GetSeuil( pbSeuil : PByte): HResult;stdcall; 71 | function SetSeuil(bSeuil : Byte): HResult;stdcall; 72 | 73 | function GetActive( pIsActive : PBoolean): HResult;stdcall; 74 | function SetActive(isActive : Boolean): HResult;stdcall; 75 | 76 | function SetCallback(pCallback : TOnLedDetectedCB ): HResult; stdcall; 77 | function GetCallBack(var pCallback: TOnLedDetectedCB ): HResult; stdcall; 78 | end; 79 | 80 | 81 | 82 | implementation 83 | 84 | uses SeuilProp_fm; 85 | 86 | const 87 | {$ifdef SSE2} 88 | SignOffset : TMaskSeuil = ($80, $80, $80, $80, $80, $80, $80, $80, 89 | $80, $80, $80, $80, $80, $80, $80, $80); 90 | {$else} 91 | SignOffset : TMaskSeuil = ($80, $80, $80, $80, $80, $80, $80, $80); 92 | {$endif} 93 | 94 | constructor TSeuillage.CreateFromFactory(Factory: TBCClassFactory; const Controller: IInterface); 95 | begin 96 | inherited; 97 | 98 | fIsActive := False; 99 | 100 | fSeuil := 127; 101 | MinPointSize := 0; 102 | MaxPointSize := 119; 103 | end; 104 | 105 | 106 | 107 | Destructor TSeuillage.Destroy; 108 | begin 109 | {$ifdef DEBUG} 110 | DbgLog('!!!!!!!!!!!!!! TSeuillage.Destroy'); 111 | {$endif} 112 | FreeAndNil(fSeuillageProcessor); 113 | 114 | inherited; 115 | end; 116 | 117 | 118 | 119 | /////////////////////////////////////////////////////////////////////// 120 | // canPerformTransform: We support RGB24 and RGB32 input 121 | /////////////////////////////////////////////////////////////////////// 122 | function TSeuillage.CanPerformTransform(const pMediaType : PAMMediaType) : boolean; 123 | begin 124 | Result := False; 125 | 126 | // we accept the following image type: (RGB24, ARGB32 or RGB32) 127 | if (IsEqualGUID(pMediaType.majortype, MEDIATYPE_Video)) then begin 128 | FreeAndNil(fSeuillageProcessor); 129 | fSeuillageProcessor := TSeuillageProcessorFactory.CreateSeuillageProcessor(pMediaType); 130 | if Assigned(fSeuillageProcessor) then begin 131 | fSeuillageProcessor.SetSeuil(fSeuil); 132 | fSeuillageProcessor.SetCallback(FOnLedDetected); 133 | fSeuillageProcessor.SetMaxPointSize(MaxPointSize); 134 | fSeuillageProcessor.SetMinPointSize(MinPointSize); 135 | Result := True; 136 | end else 137 | Result := False; 138 | end; 139 | end; 140 | 141 | 142 | 143 | function TSeuillage.CheckInputType(mtIn: PAMMediaType): HRESULT; 144 | begin 145 | {$ifdef DEBUG} 146 | DbgLog('!!!!!!!!!!!!!! TSeuillage.CheckInputType'); 147 | {$endif} 148 | if (canPerformTransform(mtIn)) then 149 | Result := S_OK 150 | else 151 | Result := VFW_E_TYPE_NOT_ACCEPTED; 152 | end; 153 | 154 | 155 | 156 | 157 | function TSeuillage.GetPages(out pages: TCAGUID): HResult; 158 | begin 159 | {$ifdef DEBUG} 160 | DbgLog('!!!!!!!!!!!!!! TSeuillage.GetPages'); 161 | {$endif} 162 | Pages.cElems := 1; 163 | Pages.pElems := CoTaskMemAlloc(sizeof(TGUID) * Pages.cElems); 164 | if (Pages.pElems = nil) then begin 165 | Result := E_OUTOFMEMORY; 166 | Exit; 167 | end; 168 | Pages.pElems^[0] := CLSID_SeuilPageSettings; 169 | Result := S_OK; 170 | end; 171 | 172 | 173 | 174 | function TSeuillage.SetMinPointSize(Size : Byte): HResult; 175 | begin 176 | MinPointSize := Size - 1; 177 | Result := S_OK; 178 | 179 | if Assigned(fSeuillageProcessor) then 180 | Result := fSeuillageProcessor.SetMinPointSize(MinPointSize); // 0 point size is diameter 1 181 | end; 182 | 183 | 184 | 185 | function TSeuillage.SetMaxPointSize(Size : Byte): HResult; 186 | begin 187 | MaxPointSize := Size-1; 188 | Result := S_OK; 189 | 190 | if Assigned(fSeuillageProcessor) then 191 | Result := fSeuillageProcessor.SetMaxPointSize(MaxPointSize); // 0 point size is diameter 1 192 | end; 193 | 194 | 195 | 196 | function TSeuillage.GetSeuil( pbSeuil : PByte): HResult; 197 | begin 198 | pbSeuil^ := fSeuil; 199 | Result := S_OK; 200 | end; 201 | 202 | 203 | 204 | function TSeuillage.SetSeuil(bSeuil : Byte): HResult; 205 | begin 206 | fSeuil := bSeuil; 207 | Result := S_OK; 208 | 209 | if Assigned(fSeuillageProcessor) then 210 | Result := fSeuillageProcessor.SetSeuil(bSeuil); 211 | end; 212 | 213 | 214 | 215 | function TSeuillage.SetNoise(noise1, noise2 : Byte): HResult; 216 | begin 217 | Result := S_OK; 218 | 219 | if Assigned(fSeuillageProcessor) then 220 | Result := fSeuillageProcessor.SetNoise(noise1, noise2); 221 | end; 222 | 223 | 224 | 225 | function TSeuillage.GetActive(pIsActive: PBoolean): HResult; 226 | begin 227 | pIsActive^ := fIsActive; 228 | Result := S_OK; 229 | end; 230 | 231 | 232 | 233 | function TSeuillage.SetActive(isActive: Boolean): HResult; 234 | begin 235 | fIsActive := isActive; 236 | Result := S_OK; 237 | end; 238 | 239 | 240 | 241 | function TSeuillage.SetCallback(pCallback: TOnLedDetectedCB): HResult; 242 | begin 243 | FOnLedDetected := pCallback; 244 | if Assigned(fSeuillageProcessor) then 245 | Result := fSeuillageProcessor.SetCallback(pCallback) 246 | else 247 | Result := S_OK; 248 | end; 249 | 250 | 251 | 252 | function TSeuillage.GetCallBack(var pCallback: TOnLedDetectedCB): HResult; 253 | begin 254 | pCallback := FOnLedDetected; 255 | Result := S_OK; 256 | end; 257 | 258 | 259 | 260 | function TSeuillage.Transform(Sample: IMediaSample): HRESULT; 261 | var 262 | pData : pByte; // Pointer to the actual image buffer 263 | begin 264 | if not (Assigned(fSeuillageProcessor) and fIsActive) then begin 265 | Result := S_OK; 266 | Exit; 267 | end; 268 | 269 | FLock.Lock; 270 | try 271 | Sample.GetPointer(pData); 272 | fSeuillageProcessor.Threshold(pData); 273 | fSeuillageProcessor.Locate(pData, FClock); 274 | finally 275 | FLock.UnLock; 276 | end; 277 | 278 | Result := S_OK; 279 | end; 280 | 281 | 282 | function TSeuillage.GetMaxPointSize(pSize: PByte): HResult; 283 | begin 284 | pSize^ := MaxPointSize + 1; 285 | Result := S_OK; 286 | end; 287 | 288 | 289 | 290 | function TSeuillage.GetMinPointSize(pSize: PByte): HResult; 291 | begin 292 | pSize^ := MinPointSize + 1; 293 | Result := S_OK; 294 | end; 295 | 296 | 297 | 298 | initialization 299 | TBCClassFactory.CreateFilter(TSeuillage, 'FreeTrackFilter', CLSID_Seuillage, 300 | CLSID_LegacyAmFilterCategory, MERIT_DO_NOT_USE, 0, nil); 301 | 302 | 303 | end. 304 | -------------------------------------------------------------------------------- /DShowFilter/SeuillageProcessor_YUYV.pas: -------------------------------------------------------------------------------- 1 | unit SeuillageProcessor_YUYV; 2 | 3 | interface 4 | 5 | uses 6 | BaseClass, DirectShow9, DSUtil, ActiveX, Windows, Math, Types, 7 | Seuillage_inc, SeuillageProcessor, SeuillageProcessor_CbCr; 8 | 9 | type 10 | TSeuillageProcessor_YUYV = class (TSeuillageProcessor_CbCr) 11 | protected 12 | procedure DrawCenterCross; override; 13 | procedure DrawCross(aPoint : TPoint); override; 14 | procedure Find(pPixel : Pointer); override; 15 | function PointCenterWeightedMean: TPoint; override; 16 | function TestPixel(pPixel: Pointer): Boolean; override; 17 | public 18 | function SetSeuil(bSeuil: Byte): HResult; override; 19 | end; 20 | 21 | {$i FreetrackFilter.inc} 22 | 23 | implementation 24 | 25 | 26 | type 27 | tagYUYVDouble = packed record 28 | Y : Byte; 29 | UV : Byte; 30 | end; 31 | YUYVDouble = tagYUYVDouble; 32 | PYUYVDouble = ^YUYVDouble; 33 | 34 | { 35 | *************************** TSeuillageProcessor_YUYV *************************** 36 | } 37 | procedure TSeuillageProcessor_YUYV.DrawCenterCross; 38 | var 39 | pPixelVert, pPixelHor: PYUYVDouble; 40 | i: Integer; 41 | iPixelSizeXSampleWidth: Integer; 42 | begin 43 | pPixelHor := PYUYVDouble(AddrStart + iPixelSize*(round(0.5 * SampleHeight)) * SampleWidth); 44 | pPixelVert := PYUYVDouble(AddrStart + iPixelSize*(round(0.5 * SampleWidth))); 45 | iPixelSizeXSampleWidth := iPixelSize*SampleWidth; 46 | 47 | for i := 0 to SampleWidth do begin 48 | if (Longint(pPixelHor) >= FAddrStart) and (Longint(pPixelHor) <= FAddrEnd) then 49 | pPixelHor^.Y := X_CENTER_COL; 50 | if (Longint(pPixelVert) >= FAddrStart) and (Longint(pPixelVert) <= FAddrEnd) then 51 | pPixelVert^.Y := X_CENTER_COL; 52 | 53 | pPixelHor := PYUYVDouble(Longint(pPixelHor) + iPixelSize); 54 | pPixelVert := PYUYVDouble(Longint(pPixelVert) + iPixelSizeXSampleWidth); 55 | end; 56 | end; 57 | 58 | procedure TSeuillageProcessor_YUYV.DrawCross(aPoint : TPoint); 59 | var 60 | pPixelLeft, pPixelRight, pPixelUp, pPixelDown: PYUYVDouble; 61 | i: Integer; 62 | iPixelSizeXSampleWidth: Integer; 63 | begin 64 | pPixelLeft := PYUYVDouble(AddrStart + iPixelSize*(aPoint.X + aPoint.Y * SampleWidth)); 65 | pPixelRight := pPixelLeft; 66 | pPixelUp := pPixelLeft; 67 | pPixelDown := pPixelLeft; 68 | iPixelSizeXSampleWidth := iPixelSize*SampleWidth; 69 | 70 | for i := 0 to X_POINT_SIZE do begin 71 | if (aPoint.Y - i) > 0 then 72 | pPixelUp^.Y := X_POINT_COL; 73 | if (aPoint.X - i) > 0 then 74 | pPixelLeft^.Y := X_POINT_COL; 75 | 76 | if (aPoint.Y + i) < SampleHeight then 77 | pPixelDown^.Y := X_POINT_COL; 78 | if (aPoint.X + i) < SampleWidth then 79 | pPixelRight^.Y := X_POINT_COL; 80 | 81 | pPixelRight := PYUYVDouble(Longint(pPixelRight) + iPixelSize); 82 | pPixelLeft := PYUYVDouble(Longint(pPixelLeft) - iPixelSize); 83 | pPixelUp := PYUYVDouble(Longint(pPixelUp) - iPixelSizeXSampleWidth); 84 | pPixelDown := PYUYVDouble(Longint(pPixelDown) + iPixelSizeXSampleWidth); 85 | end; 86 | end; 87 | 88 | procedure TSeuillageProcessor_YUYV.Find(pPixel : Pointer); 89 | var 90 | x, y: Integer; 91 | iPixelSizeXSampleWidth, aPixAddr: Integer; 92 | _AddrStart: Integer; 93 | begin 94 | _AddrStart := FAddrStart; 95 | 96 | if ((aLed.Bottom - aLed.Top) > POINT_MAX_DIM) or 97 | ((aLed.Right - aLed.Left) > POINT_MAX_DIM) then 98 | Exit; 99 | 100 | try 101 | if (PYUYVDouble(pPixel).Y = PIX_LIGHT) then begin 102 | PYUYVDouble(pPixel).Y := PIX_USED; // set the pixel as used 103 | 104 | asm 105 | mov esi, Self 106 | mov eax, Longint(pPixel) 107 | sub eax, _AddrStart 108 | xor edx, edx 109 | mov ecx, 2 110 | div ecx 111 | div [esi].TSeuillageProcessor.SampleWidth 112 | mov x, edx 113 | //x := ((Longint(pPixel) - AddrStart)div iPixelSize) mod SampleWidth; 114 | 115 | mov y, eax 116 | //y := SampleHeight - ((Longint(pPixel) - AddrStart)div iPixelSize) div SampleWidth; 117 | end; 118 | 119 | aLed := Rect(Min(aLed.Left, x), Min(aLed.Top, y), Max(aLed.Right, x), Max(aLed.Bottom, y)); 120 | 121 | iPixelSizeXSampleWidth := iPixelSize*SampleWidth; 122 | 123 | aPixAddr := Longint(pPixel) - iPixelSizeXSampleWidth - iPixelSize; 124 | if inside(aPixAddr) then Find(PYUYVDouble(aPixAddr)); //x-1,y+1 125 | inc(aPixAddr, iPixelSize); 126 | if inside(aPixAddr) then Find(PYUYVDouble(aPixAddr)); //x,y-1 127 | inc(aPixAddr, iPixelSize); 128 | if inside(aPixAddr) then Find(PYUYVDouble(aPixAddr)); //x+1,y-1 129 | 130 | inc(aPixAddr, iPixelSizeXSampleWidth - iPixelSize shl 1); 131 | if inside(aPixAddr) then Find(PYUYVDouble(aPixAddr)); //x-1,y 132 | inc(aPixAddr, iPixelSize shl 1); 133 | if inside(aPixAddr) then Find(PYUYVDouble(aPixAddr)); //x+1,y 134 | 135 | inc(aPixAddr, iPixelSizeXSampleWidth - iPixelSize shl 1); 136 | if inside(aPixAddr) then Find(PYUYVDouble(aPixAddr)); //x-1,y-1 137 | inc(aPixAddr, iPixelSize); 138 | if inside(aPixAddr) then Find(PYUYVDouble(aPixAddr)); //x,y+1 139 | inc(aPixAddr, iPixelSize); 140 | if inside(aPixAddr) then Find(PYUYVDouble(aPixAddr)); //x+1,y+1 141 | end; 142 | 143 | except 144 | {On E : EAbort do 145 | Raise; 146 | else 147 | Raise Exception.Create('Error in TfmGrabber.Find');} 148 | end; 149 | end; 150 | 151 | function TSeuillageProcessor_YUYV.PointCenterWeightedMean: TPoint; 152 | var 153 | jPixel, xPixel, yPixel, iPixelSizeXSampleWidth: Integer; 154 | pixelCount, average_x, average_y: Integer; 155 | ledXWeight, ledYWeight: array[0..200] of Integer; 156 | aPixel: PYUYVDouble; 157 | startPixel: LongInt; 158 | begin 159 | 160 | pixelCount := 0; 161 | average_x := 0; 162 | average_y := 0; 163 | for jPixel := 0 to High(ledXWeight) do begin 164 | ledXWeight[jPixel] := 0; 165 | ledYWeight[jPixel] := 0; 166 | end; 167 | 168 | iPixelSizeXSampleWidth := iPixelSize * SampleWidth; 169 | 170 | // range limits used to avoid integer overflow 171 | startPixel := AddrStart + iPixelSize * (aLed.Left + aLed.Top * SampleWidth); 172 | for xPixel := 0 to Min(aLed.Right - aLed.Left, MaxPointSize) do 173 | for yPixel := 0 to Min(aLed.Bottom - aLed.Top, MaxPointSize) do begin 174 | aPixel := PYUYVDouble(startPixel + iPixelSize * xPixel + iPixelSizeXSampleWidth * yPixel); 175 | if aPixel.Y = PIX_USED then begin 176 | aPixel^.Y := PIX_TRACKED; 177 | Inc(ledXWeight[xPixel]); 178 | Inc(ledYWeight[yPixel]); 179 | Inc(pixelCount); 180 | end; 181 | end; 182 | 183 | for jPixel := 0 to Min(Max(aLed.Right - aLed.Left, aLed.Bottom - aLed.Top), MaxPointSize) do begin 184 | average_x := average_x + ledXWeight[jPixel] * (jPixel + 1); 185 | average_y := average_y + ledYWeight[jPixel] * (jPixel + 1); 186 | end; 187 | 188 | average_x := round((aLed.Left + (average_x / pixelCount) - 1) * LISTPOINT_SCALER); 189 | average_y := round((aLed.Top + (average_y / pixelCount) - 1) * LISTPOINT_SCALER); 190 | 191 | Result := Point(average_x, average_y); 192 | end; 193 | 194 | function TSeuillageProcessor_YUYV.SetSeuil(bSeuil: Byte): HResult; 195 | begin 196 | FillChar(Mask1, SizeOf(TMaskSeuil), $00); 197 | FillChar(UVMask, SizeOf(TMaskSeuil), $00); 198 | FillChar(GreyMask, SizeOf(TMaskSeuil), $00); 199 | {$ifdef SSE2} 200 | //15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 201 | //V Y U Y V Y U Y V Y U Y V Y U Y 202 | Mask1[0] := bSeuil - $80; 203 | Mask1[2] := bSeuil - $80; 204 | Mask1[4] := bSeuil - $80; 205 | Mask1[6] := bSeuil - $80; 206 | Mask1[8] := bSeuil - $80; 207 | Mask1[10] := bSeuil - $80; 208 | Mask1[12] := bSeuil - $80; 209 | Mask1[14] := bSeuil - $80; 210 | 211 | UVMask[1] := $80; 212 | UVMask[3] := $80; 213 | UVMask[5] := $80; 214 | UVMask[7] := $80; 215 | UVMask[9] := $80; 216 | UVMask[11] := $80; 217 | UVMask[13] := $80; 218 | UVMask[15] := $80; 219 | 220 | GreyMask[0] := PIX_LIGHT; 221 | GreyMask[2] := PIX_LIGHT; 222 | GreyMask[4] := PIX_LIGHT; 223 | GreyMask[6] := PIX_LIGHT; 224 | GreyMask[8] := PIX_LIGHT; 225 | GreyMask[10] := PIX_LIGHT; 226 | GreyMask[12] := PIX_LIGHT; 227 | GreyMask[14] := PIX_LIGHT; 228 | 229 | {$else} 230 | Mask1[0] := bSeuil - $80; 231 | Mask1[2] := bSeuil - $80; 232 | Mask1[4] := bSeuil - $80; 233 | Mask1[6] := bSeuil - $80; 234 | 235 | UVMask[1] := $80; 236 | UVMask[3] := $80; 237 | UVMask[5] := $80; 238 | UVMask[7] := $80; 239 | 240 | GreyMask[0] := PIX_LIGHT; 241 | GreyMask[2] := PIX_LIGHT; 242 | GreyMask[4] := PIX_LIGHT; 243 | GreyMask[6] := PIX_LIGHT; 244 | {$endif} 245 | Result := S_OK; 246 | 247 | 248 | end; 249 | 250 | function TSeuillageProcessor_YUYV.TestPixel(pPixel: Pointer): Boolean; 251 | begin 252 | Result := YUYVDouble(pPixel^).Y = PIX_LIGHT; 253 | end; 254 | 255 | 256 | 257 | 258 | 259 | 260 | 261 | 262 | 263 | end. 264 | -------------------------------------------------------------------------------- /DShowFilter/SeuillageProcessor_UYVY.pas: -------------------------------------------------------------------------------- 1 | unit SeuillageProcessor_UYVY; 2 | 3 | interface 4 | 5 | uses 6 | BaseClass, DirectShow9, DSUtil, ActiveX, Windows, Math, Types, 7 | Seuillage_inc, SeuillageProcessor, SeuillageProcessor_CbCr; 8 | 9 | type 10 | TSeuillageProcessor_UYVY = class (TSeuillageProcessor_CbCr) 11 | protected 12 | procedure DrawCenterCross; override; 13 | procedure DrawCross(aPoint : TPoint); override; 14 | procedure Find(pPixel : Pointer); override; 15 | function PointCenterWeightedMean: TPoint; override; 16 | function TestPixel(pPixel: Pointer): Boolean; override; 17 | public 18 | function SetSeuil(bSeuil: Byte): HResult; override; 19 | end; 20 | 21 | {$i FreetrackFilter.inc} 22 | 23 | implementation 24 | 25 | type 26 | tagUYVYDouble = packed record 27 | UV : Byte; 28 | Y : Byte; 29 | end; 30 | UYVYDouble = tagUYVYDouble; 31 | PUYVYDouble = ^UYVYDouble; 32 | 33 | 34 | { 35 | *************************** TSeuillageProcessor_UYVY *************************** 36 | } 37 | procedure TSeuillageProcessor_UYVY.DrawCenterCross; 38 | var 39 | pPixelVert, pPixelHor: PUYVYDouble; 40 | i: Integer; 41 | iPixelSizeXSampleWidth: Integer; 42 | begin 43 | pPixelHor := PUYVYDouble(AddrStart + iPixelSize*(round(0.5 * SampleHeight)) * SampleWidth); 44 | pPixelVert := PUYVYDouble(AddrStart + iPixelSize*(round(0.5 * SampleWidth))); 45 | iPixelSizeXSampleWidth := iPixelSize*SampleWidth; 46 | 47 | for i := 0 to SampleWidth do begin 48 | if (Longint(pPixelHor) >= FAddrStart) and (Longint(pPixelHor) <= FAddrEnd) then 49 | pPixelHor^.Y := X_CENTER_COL; 50 | if (Longint(pPixelVert) >= FAddrStart) and (Longint(pPixelVert) <= FAddrEnd) then 51 | pPixelVert^.Y := X_CENTER_COL; 52 | 53 | pPixelHor := PUYVYDouble(Longint(pPixelHor) + iPixelSize); 54 | pPixelVert := PUYVYDouble(Longint(pPixelVert) + iPixelSizeXSampleWidth); 55 | end; 56 | end; 57 | 58 | 59 | 60 | procedure TSeuillageProcessor_UYVY.DrawCross(aPoint : TPoint); 61 | var 62 | pPixelLeft, pPixelRight, pPixelUp, pPixelDown: PUYVYDouble; 63 | i: Integer; 64 | iPixelSizeXSampleWidth: Integer; 65 | begin 66 | pPixelLeft := PUYVYDouble(AddrStart + iPixelSize*(aPoint.X + aPoint.Y * SampleWidth)); 67 | pPixelRight := pPixelLeft; 68 | pPixelUp := pPixelLeft; 69 | pPixelDown := pPixelLeft; 70 | iPixelSizeXSampleWidth := iPixelSize*SampleWidth; 71 | 72 | for i := 0 to X_POINT_SIZE do begin 73 | if (aPoint.Y - i) > 0 then 74 | pPixelUp^.Y := X_POINT_COL; 75 | if (aPoint.X - i) > 0 then 76 | pPixelLeft^.Y := X_POINT_COL; 77 | 78 | if (aPoint.Y + i) < SampleHeight then 79 | pPixelDown^.Y := X_POINT_COL; 80 | if (aPoint.X + i) < SampleWidth then 81 | pPixelRight^.Y := X_POINT_COL; 82 | 83 | pPixelRight := PUYVYDouble(Longint(pPixelRight) + iPixelSize); 84 | pPixelLeft := PUYVYDouble(Longint(pPixelLeft) - iPixelSize); 85 | pPixelUp := PUYVYDouble(Longint(pPixelUp) - iPixelSizeXSampleWidth); 86 | pPixelDown := PUYVYDouble(Longint(pPixelDown) + iPixelSizeXSampleWidth); 87 | end; 88 | end; 89 | 90 | procedure TSeuillageProcessor_UYVY.Find(pPixel : Pointer); 91 | var 92 | x, y: Integer; 93 | iPixelSizeXSampleWidth, aPixAddr: Integer; 94 | _AddrStart: Integer; 95 | 96 | begin 97 | _AddrStart := FAddrStart; 98 | 99 | if ((aLed.Bottom - aLed.Top) > POINT_MAX_DIM) or 100 | ((aLed.Right - aLed.Left) > POINT_MAX_DIM) then 101 | Exit; 102 | 103 | try 104 | if (PUYVYDouble(pPixel).Y = PIX_LIGHT) then begin 105 | PUYVYDouble(pPixel).Y := PIX_USED; // set the pixel as used 106 | 107 | asm 108 | mov esi, Self 109 | mov eax, Longint(pPixel) 110 | sub eax, _AddrStart 111 | xor edx, edx 112 | mov ecx, 2 113 | div ecx 114 | div [esi].TSeuillageProcessor.SampleWidth 115 | mov x, edx 116 | //x := ((Longint(pPixel) - AddrStart)div iPixelSize) mod SampleWidth; 117 | 118 | mov y, eax 119 | //y := ((Longint(pPixel) - AddrStart)div iPixelSize) div SampleWidth; 120 | end; 121 | 122 | aLed := Rect(Min(aLed.Left, x), Min(aLed.Top, y), Max(aLed.Right, x), Max(aLed.Bottom, y)); 123 | 124 | iPixelSizeXSampleWidth := iPixelSize*SampleWidth; 125 | 126 | aPixAddr := Longint(pPixel) - iPixelSizeXSampleWidth - iPixelSize; 127 | if inside(aPixAddr) then Find(PUYVYDouble(aPixAddr)); //x-1,y+1 128 | inc(aPixAddr, iPixelSize); 129 | if inside(aPixAddr) then Find(PUYVYDouble(aPixAddr)); //x,y-1 130 | inc(aPixAddr, iPixelSize); 131 | if inside(aPixAddr) then Find(PUYVYDouble(aPixAddr)); //x+1,y-1 132 | 133 | inc(aPixAddr, iPixelSizeXSampleWidth - iPixelSize shl 1); 134 | if inside(aPixAddr) then Find(PUYVYDouble(aPixAddr)); //x-1,y 135 | inc(aPixAddr, iPixelSize shl 1); 136 | if inside(aPixAddr) then Find(PUYVYDouble(aPixAddr)); //x+1,y 137 | 138 | inc(aPixAddr, iPixelSizeXSampleWidth - iPixelSize shl 1); 139 | if inside(aPixAddr) then Find(PUYVYDouble(aPixAddr)); //x-1,y-1 140 | inc(aPixAddr, iPixelSize); 141 | if inside(aPixAddr) then Find(PUYVYDouble(aPixAddr)); //x,y+1 142 | inc(aPixAddr, iPixelSize); 143 | if inside(aPixAddr) then Find(PUYVYDouble(aPixAddr)); //x+1,y+1 144 | end; 145 | 146 | except 147 | {On E : EAbort do 148 | Raise; 149 | else 150 | Raise Exception.Create('Error in TfmGrabber.Find');} 151 | end; 152 | end; 153 | 154 | function TSeuillageProcessor_UYVY.PointCenterWeightedMean: TPoint; 155 | var 156 | jPixel, xPixel, yPixel, iPixelSizeXSampleWidth: Integer; 157 | pixelCount, average_x, average_y: Integer; 158 | ledXWeight, ledYWeight: array[0..200] of Integer; 159 | aPixel: PUYVYDouble; 160 | startPixel: LongInt; 161 | begin 162 | 163 | pixelCount := 0; 164 | average_x := 0; 165 | average_y := 0; 166 | for jPixel := 0 to High(ledXWeight) do begin 167 | ledXWeight[jPixel] := 0; 168 | ledYWeight[jPixel] := 0; 169 | end; 170 | 171 | iPixelSizeXSampleWidth := iPixelSize * SampleWidth; 172 | 173 | // range limits used to avoid integer overflow 174 | startPixel := AddrStart + iPixelSize * (aLed.Left + aLed.Top * SampleWidth); 175 | for xPixel := 0 to Min(aLed.Right - aLed.Left, MaxPointSize) do 176 | for yPixel := 0 to Min(aLed.Bottom - aLed.Top, MaxPointSize) do begin 177 | aPixel := PUYVYDouble(startPixel + iPixelSize * xPixel + iPixelSizeXSampleWidth * yPixel); 178 | if aPixel.Y = PIX_USED then begin 179 | aPixel^.Y := PIX_TRACKED; 180 | Inc(ledXWeight[xPixel]); 181 | Inc(ledYWeight[yPixel]); 182 | Inc(pixelCount); 183 | end; 184 | end; 185 | 186 | for jPixel := 0 to Min(Max(aLed.Right - aLed.Left, aLed.Bottom - aLed.Top), MaxPointSize) do begin 187 | average_x := average_x + ledXWeight[jPixel] * (jPixel + 1); 188 | average_y := average_y + ledYWeight[jPixel] * (jPixel + 1); 189 | end; 190 | 191 | average_x := round((aLed.Left + (average_x / pixelCount) - 1) * LISTPOINT_SCALER); 192 | average_y := round((aLed.Top + (average_y / pixelCount) - 1) * LISTPOINT_SCALER); 193 | 194 | Result := Point(average_x, average_y); 195 | end; 196 | 197 | function TSeuillageProcessor_UYVY.SetSeuil(bSeuil: Byte): HResult; 198 | begin 199 | FillChar(Mask1, SizeOf(TMaskSeuil), $00); 200 | FillChar(UVMask, SizeOf(TMaskSeuil), $00); 201 | FillChar(GreyMask, SizeOf(TMaskSeuil), $00); 202 | 203 | {$ifdef SSE2} 204 | //15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 205 | //Y V Y U Y V Y U Y V Y U Y V Y U 206 | Mask1[1] := bSeuil - $80; 207 | Mask1[3] := bSeuil - $80; 208 | Mask1[5] := bSeuil - $80; 209 | Mask1[7] := bSeuil - $80; 210 | Mask1[9] := bSeuil - $80; 211 | Mask1[11] := bSeuil - $80; 212 | Mask1[13] := bSeuil - $80; 213 | Mask1[15] := bSeuil - $80; 214 | 215 | UVMask[0] := $80; 216 | UVMask[2] := $80; 217 | UVMask[4] := $80; 218 | UVMask[6] := $80; 219 | UVMask[8] := $80; 220 | UVMask[10] := $80; 221 | UVMask[12] := $80; 222 | UVMask[14] := $80; 223 | 224 | GreyMask[1] := PIX_LIGHT; 225 | GreyMask[3] := PIX_LIGHT; 226 | GreyMask[5] := PIX_LIGHT; 227 | GreyMask[7] := PIX_LIGHT; 228 | GreyMask[9] := PIX_LIGHT; 229 | GreyMask[11] := PIX_LIGHT; 230 | GreyMask[13] := PIX_LIGHT; 231 | GreyMask[15] := PIX_LIGHT; 232 | 233 | 234 | {$else} 235 | Mask1[1] := bSeuil - $80; 236 | Mask1[3] := bSeuil - $80; 237 | Mask1[5] := bSeuil - $80; 238 | Mask1[7] := bSeuil - $80; 239 | 240 | UVMask[0] := $80; 241 | UVMask[2] := $80; 242 | UVMask[4] := $80; 243 | UVMask[6] := $80; 244 | 245 | GreyMask[1] := PIX_LIGHT; 246 | GreyMask[3] := PIX_LIGHT; 247 | GreyMask[5] := PIX_LIGHT; 248 | GreyMask[7] := PIX_LIGHT; 249 | {$endif} 250 | Result := S_OK; 251 | end; 252 | 253 | function TSeuillageProcessor_UYVY.TestPixel(pPixel: Pointer): Boolean; 254 | begin 255 | Result := UYVYDouble(pPixel^).Y = PIX_LIGHT; 256 | end; 257 | 258 | 259 | 260 | 261 | 262 | 263 | 264 | 265 | 266 | 267 | 268 | 269 | end. 270 | 271 | -------------------------------------------------------------------------------- /DShowFilter/SeuillageProcessor.pas: -------------------------------------------------------------------------------- 1 | unit SeuillageProcessor; 2 | 3 | interface 4 | 5 | uses 6 | BaseClass, DirectShow9, DSUtil, ActiveX, Windows, Math, Types, Dialogs, 7 | Seuillage_inc, cpuid; 8 | 9 | {$i FreetrackFilter.inc} 10 | 11 | const 12 | {$ifdef SSE2} 13 | MM_SIZE = 16; 14 | {$else} 15 | MM_SIZE = 8; 16 | {$endif} 17 | 18 | type 19 | TMaskSeuil = array[0..MM_SIZE-1] of byte; 20 | 21 | TSeuillageProcessor = class (TObject) 22 | protected 23 | aLed: TRect; 24 | FAddrEnd: LongInt; 25 | FAddrStart: LongInt; 26 | FOnLedDetected: TOnLedDetectedCB; 27 | iPixelSize: Integer; 28 | ledXWeight: array[0..200] of Integer; 29 | ledYWeight: array[0..200] of Integer; 30 | ListPoint: TListPoint; 31 | Mask1, Mask2, Mask3: TMaskSeuil; 32 | GreyMask : TMaskSeuil; 33 | Noise1, Noise2 : TMaskSeuil; 34 | MaxPointSize: Integer; 35 | MinPointSize: Integer; 36 | NbPixelInLed: Integer; 37 | nbPixels: Integer; 38 | SampleHeight: LongInt; 39 | SampleSize: LongInt; 40 | SampleWidth: LongInt; 41 | procedure DrawCenterCross; virtual; abstract; 42 | procedure DrawCross(aPoint : TPoint); virtual; abstract; 43 | procedure Find(pPixel : Pointer); dynamic; abstract; // dynamic: required to avoid exception errors 44 | function Inside(aPixAddr: LongInt): Boolean; virtual; 45 | function PointCenterWeightedMean: TPoint; virtual; abstract; 46 | procedure SetAddrStart(const Value: LongInt); virtual; 47 | function TestPixel(pPixel: Pointer): Boolean; virtual; abstract; 48 | public 49 | constructor Create(pMediaType : PAMMediaType); virtual; 50 | destructor Destroy; override; 51 | procedure Locate(pPixel : Pointer; aClock : IReferenceClock); 52 | function SetCallback(pCallback : TOnLedDetectedCB): HResult; 53 | function SetMaxPointSize(Size : Integer): HResult; 54 | function SetMinPointSize(Size : Integer): HResult; 55 | function SetSeuil(bSeuil : Byte): HResult; virtual; 56 | function SetNoise(n1, n2: Byte): HResult; virtual; 57 | procedure Threshold(pData : pByte); virtual; 58 | property AddrStart: LongInt read FAddrStart write SetAddrStart; 59 | end; 60 | 61 | 62 | 63 | TSeuillageProcessorFactory = class (TObject) 64 | class function CreateSeuillageProcessor(pMediaType : PAMMediaType): 65 | TSeuillageProcessor; 66 | end; 67 | 68 | const 69 | NB_MAX_PIXELS = 120;//80; 70 | NB_MIN_PIXELS = 3; 71 | MIN_LENGTH = 1; 72 | 73 | PIX_LIGHT = $A0; 74 | PIX_USED = PIX_LIGHT + 1; 75 | PIX_TRACKED = $FF; 76 | 77 | POINT_MAX_DIM = 100; 78 | 79 | {$ifdef SSE2} 80 | SignOffset : TMaskSeuil = ($80, $80, $80, $80, $80, $80, $80, $80, 81 | $80, $80, $80, $80, $80, $80, $80, $80); 82 | {$else} 83 | SignOffset : TMaskSeuil = ($80, $80, $80, $80, $80, $80, $80, $80); 84 | {$endif} 85 | 86 | 87 | implementation 88 | 89 | uses 90 | SeuillageProcessor_RGB24, SeuillageProcessor_CbCr, SeuillageProcessor_RGB32, 91 | SeuillageProcessor_YUV, SeuillageProcessor_YUYV, SeuillageProcessor_UYVY; 92 | 93 | { TSeuillageProcessor } 94 | 95 | 96 | { 97 | ***************************** TSeuillageProcessor ****************************** 98 | } 99 | constructor TSeuillageProcessor.Create(pMediaType : PAMMediaType); 100 | var 101 | pvi: PVideoInfoHeader; 102 | begin 103 | pvi := pMediaType.pbFormat; 104 | 105 | iPixelSize := pvi.bmiHeader.biBitCount div 8; 106 | nbPixels := abs(pvi.bmiHeader.biWidth * pvi.bmiHeader.biHeight); 107 | SampleWidth := pvi.bmiHeader.biWidth; 108 | SampleHeight := abs(pvi.bmiHeader.biHeight); 109 | SampleSize := pvi.bmiHeader.biSizeImage; 110 | 111 | ListPoint := TListPoint.Create; 112 | end; 113 | 114 | 115 | 116 | destructor TSeuillageProcessor.Destroy; 117 | begin 118 | FreeAndNil(ListPoint); 119 | inherited; 120 | end; 121 | 122 | 123 | 124 | function TSeuillageProcessor.Inside(aPixAddr: LongInt): Boolean; 125 | begin 126 | result := (aPixAddr > FAddrStart) and (aPixAddr < FAddrEnd); 127 | end; 128 | 129 | 130 | 131 | procedure TSeuillageProcessor.Locate(pPixel : Pointer; aClock : 132 | IReferenceClock); 133 | var 134 | iPixel: Integer; 135 | aPoint: TPoint; 136 | aPointXDim, aPointYDim: Integer; 137 | begin 138 | AddrStart := longint(pPixel); 139 | ListPoint.Clear; 140 | for iPixel := 0 to (nbPixels shr 1)-1 do begin 141 | if TestPixel(pPixel) then begin 142 | aLed.Top := SampleHeight; 143 | aLed.Bottom := -1; 144 | aLed.Left := SampleWidth; 145 | aLed.Right := -1; 146 | NbPixelInLed := 0; 147 | 148 | Find(pByte(pPixel)); 149 | 150 | aPointXDim := abs(aLed.Right - aLed.Left + 1); 151 | aPointYDim := abs(aLed.Bottom - aLed.Top + 1); 152 | 153 | if (aPointXDim > MinPointSize) and (aPointYDim > MinPointSize) and 154 | (aPointXDim < MaxPointSize) and (aPointYDim < MaxPointSize) then begin 155 | 156 | aPoint := PointCenterWeightedMean; 157 | ListPoint.Add(aPoint); 158 | 159 | aPoint := Point(aLed.Left + (aLed.Right - aLed.Left) shr 1, aLed.Top + (aLed.Bottom - aLed.Top) shr 1); 160 | DrawCross(aPoint); 161 | end; 162 | 163 | if ListPoint.Count > 4 then 164 | Break; 165 | end; 166 | pPixel := Pointer(Longint(pPixel) + iPixelSize shl 1 ); //on test un pixel sur deux 167 | end; 168 | DrawCenterCross; 169 | 170 | ListPoint.ReferenceClock := aClock; 171 | if Assigned(FOnLedDetected) then 172 | FOnLedDetected(ListPoint); 173 | 174 | end; 175 | 176 | 177 | 178 | procedure TSeuillageProcessor.SetAddrStart(const Value: LongInt); 179 | begin 180 | FAddrStart := Value; 181 | FAddrEnd := AddrStart + SampleSize; 182 | end; 183 | 184 | 185 | 186 | function TSeuillageProcessor.SetCallback(pCallback : TOnLedDetectedCB): 187 | HResult; 188 | begin 189 | FOnLedDetected := pCallback; 190 | Result := S_OK; 191 | end; 192 | 193 | 194 | 195 | function TSeuillageProcessor.SetMaxPointSize(Size : Integer): HResult; 196 | begin 197 | MaxPointSize := Size; 198 | Result := S_OK; 199 | end; 200 | 201 | 202 | 203 | function TSeuillageProcessor.SetMinPointSize(Size : Integer): HResult; 204 | begin 205 | MinPointSize := Size; 206 | Result := S_OK; 207 | end; 208 | 209 | 210 | 211 | function TSeuillageProcessor.SetSeuil(bSeuil : Byte): HResult; 212 | begin 213 | FillChar(Mask1, SizeOf(TMaskSeuil), 127); 214 | FillChar(Mask2, SizeOf(TMaskSeuil), 127); 215 | FillChar(Mask3, SizeOf(TMaskSeuil), 127); 216 | FillChar(GreyMask, SizeOF(TMaskSeuil), 0); 217 | Result := S_OK; 218 | end; 219 | 220 | 221 | function TSeuillageProcessor.SetNoise(n1, n2: Byte): HResult; 222 | begin 223 | FillChar(Noise1, SizeOf(TMaskSeuil), n1 - $80); 224 | FillChar(Noise2, SizeOf(TMaskSeuil), n2 - $80); 225 | Result := S_OK; 226 | end; 227 | 228 | 229 | 230 | procedure TSeuillageProcessor.Threshold(pData : pByte); 231 | begin 232 | AddrStart := longint(pData); 233 | end; 234 | 235 | 236 | { 237 | ************************** TSeuillageProcessorFactory ************************** 238 | } 239 | class function TSeuillageProcessorFactory.CreateSeuillageProcessor(pMediaType : 240 | PAMMediaType): TSeuillageProcessor; 241 | begin 242 | Result := nil; 243 | 244 | if IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_RGB8) then 245 | Result := TSeuillageProcessor_YUV.Create(pMediaType); 246 | 247 | if IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_YVU9) or 248 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_IF09) or // need codec to test 249 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_YV12) or 250 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_YV16) or // need codec to test 251 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_IYUV) or 252 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_I420) or 253 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_NV12) or // USB Video Class (USB) 254 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_IMC1) or 255 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_IMC2) or 256 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_IMC3) or 257 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_IMC4) or 258 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_Y800) or // need codec to test 259 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_Y8) or // need codec to test 260 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_RGB8) or 261 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_GREY) then begin 262 | 263 | Result := TSeuillageProcessor_YUV.Create(pMediaType); 264 | Exit; 265 | end; 266 | 267 | if (IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_RGB24))then begin 268 | Result := TSeuillageProcessor_RGB24.Create(pMediaType); 269 | Exit; 270 | end; 271 | 272 | if (IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_RGB32))then begin 273 | Result := TSeuillageProcessor_RGB32.Create(pMediaType); 274 | Exit; 275 | end; 276 | 277 | if IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_YUYV) or 278 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_YUY2) or // USB Video Class (USB) 279 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_YVYU) then begin 280 | 281 | Result := TSeuillageProcessor_YUYV.Create(pMediaType); 282 | Exit; 283 | end; 284 | 285 | if IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_UYVY) or 286 | IsEqualGUID(pMediaType.subtype, MEDIASUBTYPE_Y422) then begin 287 | Result := TSeuillageProcessor_UYVY.Create(pMediaType); 288 | Exit; 289 | end; 290 | 291 | 292 | end; 293 | 294 | 295 | 296 | end. 297 | 298 | -------------------------------------------------------------------------------- /FreetrackClient/FTTest.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 943 3 | Top = 188 4 | Width = 227 5 | Height = 531 6 | Caption = 'FreeTrack Interface Test' 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnClose = FormClose 15 | OnCreate = FormCreate 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object TLabel 19 | Left = 24 20 | Top = 136 21 | Width = 21 22 | Height = 13 23 | Alignment = taCenter 24 | Caption = 'Yaw' 25 | end 26 | object Label1: TLabel 27 | Left = 24 28 | Top = 152 29 | Width = 24 30 | Height = 13 31 | Alignment = taCenter 32 | Caption = 'Pitch' 33 | end 34 | object Label2: TLabel 35 | Left = 24 36 | Top = 168 37 | Width = 18 38 | Height = 13 39 | Alignment = taCenter 40 | Caption = 'Roll' 41 | end 42 | object Label3: TLabel 43 | Left = 24 44 | Top = 184 45 | Width = 7 46 | Height = 13 47 | Alignment = taCenter 48 | Caption = 'X' 49 | end 50 | object Label4: TLabel 51 | Left = 24 52 | Top = 200 53 | Width = 7 54 | Height = 13 55 | Alignment = taCenter 56 | Caption = 'Y' 57 | end 58 | object Label5: TLabel 59 | Left = 24 60 | Top = 216 61 | Width = 7 62 | Height = 13 63 | Alignment = taCenter 64 | Caption = 'Z' 65 | end 66 | object laYaw: TLabel 67 | Left = 96 68 | Top = 136 69 | Width = 9 70 | Height = 13 71 | Alignment = taRightJustify 72 | Caption = '...' 73 | end 74 | object laPitch: TLabel 75 | Left = 96 76 | Top = 152 77 | Width = 9 78 | Height = 13 79 | Alignment = taRightJustify 80 | Caption = '...' 81 | end 82 | object laRoll: TLabel 83 | Left = 96 84 | Top = 168 85 | Width = 9 86 | Height = 13 87 | Alignment = taRightJustify 88 | Caption = '...' 89 | end 90 | object laPanX: TLabel 91 | Left = 96 92 | Top = 184 93 | Width = 9 94 | Height = 13 95 | Alignment = taRightJustify 96 | Caption = '...' 97 | end 98 | object laPanY: TLabel 99 | Left = 96 100 | Top = 200 101 | Width = 9 102 | Height = 13 103 | Alignment = taRightJustify 104 | Caption = '...' 105 | end 106 | object laPanZ: TLabel 107 | Left = 96 108 | Top = 216 109 | Width = 9 110 | Height = 13 111 | Alignment = taRightJustify 112 | Caption = '...' 113 | end 114 | object Label6: TLabel 115 | Left = 24 116 | Top = 32 117 | Width = 133 118 | Height = 13 119 | Caption = 'FreeTrack interface version:' 120 | end 121 | object laVersion: TLabel 122 | Left = 168 123 | Top = 32 124 | Width = 9 125 | Height = 13 126 | Caption = '...' 127 | end 128 | object Label9: TLabel 129 | Left = 24 130 | Top = 96 131 | Width = 40 132 | Height = 13 133 | Caption = 'Data ID:' 134 | end 135 | object laDllLoaded: TLabel 136 | Left = 88 137 | Top = 8 138 | Width = 25 139 | Height = 13 140 | Caption = 'False' 141 | end 142 | object laDataID: TLabel 143 | Left = 128 144 | Top = 96 145 | Width = 9 146 | Height = 13 147 | Alignment = taRightJustify 148 | Caption = '...' 149 | end 150 | object Label7: TLabel 151 | Left = 128 152 | Top = 264 153 | Width = 15 154 | Height = 13 155 | Caption = 'rad' 156 | end 157 | object TLabel 158 | Left = 24 159 | Top = 264 160 | Width = 21 161 | Height = 13 162 | Alignment = taCenter 163 | Caption = 'Yaw' 164 | end 165 | object Label12: TLabel 166 | Left = 24 167 | Top = 280 168 | Width = 24 169 | Height = 13 170 | Alignment = taCenter 171 | Caption = 'Pitch' 172 | end 173 | object Label13: TLabel 174 | Left = 24 175 | Top = 296 176 | Width = 18 177 | Height = 13 178 | Alignment = taCenter 179 | Caption = 'Roll' 180 | end 181 | object Label14: TLabel 182 | Left = 24 183 | Top = 312 184 | Width = 7 185 | Height = 13 186 | Alignment = taCenter 187 | Caption = 'X' 188 | end 189 | object Label15: TLabel 190 | Left = 24 191 | Top = 328 192 | Width = 7 193 | Height = 13 194 | Alignment = taCenter 195 | Caption = 'Y' 196 | end 197 | object Label16: TLabel 198 | Left = 24 199 | Top = 344 200 | Width = 7 201 | Height = 13 202 | Alignment = taCenter 203 | Caption = 'Z' 204 | end 205 | object laRawYaw: TLabel 206 | Left = 96 207 | Top = 264 208 | Width = 9 209 | Height = 13 210 | Alignment = taRightJustify 211 | Caption = '...' 212 | end 213 | object laRawPitch: TLabel 214 | Left = 96 215 | Top = 280 216 | Width = 9 217 | Height = 13 218 | Alignment = taRightJustify 219 | Caption = '...' 220 | end 221 | object laRawRoll: TLabel 222 | Left = 96 223 | Top = 296 224 | Width = 9 225 | Height = 13 226 | Alignment = taRightJustify 227 | Caption = '...' 228 | end 229 | object laRawX: TLabel 230 | Left = 96 231 | Top = 312 232 | Width = 9 233 | Height = 13 234 | Alignment = taRightJustify 235 | Caption = '...' 236 | end 237 | object laRawY: TLabel 238 | Left = 96 239 | Top = 328 240 | Width = 9 241 | Height = 13 242 | Alignment = taRightJustify 243 | Caption = '...' 244 | end 245 | object laRawZ: TLabel 246 | Left = 96 247 | Top = 344 248 | Width = 9 249 | Height = 13 250 | Alignment = taRightJustify 251 | Caption = '...' 252 | end 253 | object Label23: TLabel 254 | Left = 16 255 | Top = 248 256 | Width = 48 257 | Height = 13 258 | Caption = 'Raw pose' 259 | end 260 | object Label24: TLabel 261 | Left = 16 262 | Top = 120 263 | Width = 55 264 | Height = 13 265 | Caption = 'Virtual pose' 266 | end 267 | object Label25: TLabel 268 | Left = 16 269 | Top = 408 270 | Width = 29 271 | Height = 13 272 | Caption = 'Points' 273 | end 274 | object Label11: TLabel 275 | Left = 128 276 | Top = 280 277 | Width = 15 278 | Height = 13 279 | Caption = 'rad' 280 | end 281 | object Label26: TLabel 282 | Left = 128 283 | Top = 296 284 | Width = 15 285 | Height = 13 286 | Caption = 'rad' 287 | end 288 | object laPoint1: TLabel 289 | Left = 48 290 | Top = 424 291 | Width = 9 292 | Height = 13 293 | Caption = '...' 294 | end 295 | object laPoint2: TLabel 296 | Left = 48 297 | Top = 440 298 | Width = 9 299 | Height = 13 300 | Caption = '...' 301 | end 302 | object laPoint3: TLabel 303 | Left = 48 304 | Top = 456 305 | Width = 9 306 | Height = 13 307 | Caption = '...' 308 | end 309 | object laPoint4: TLabel 310 | Left = 48 311 | Top = 472 312 | Width = 9 313 | Height = 13 314 | Caption = '...' 315 | end 316 | object Label18: TLabel 317 | Left = 16 318 | Top = 376 319 | Width = 90 320 | Height = 13 321 | Caption = 'Camera resolution: ' 322 | end 323 | object laCamResolution: TLabel 324 | Left = 128 325 | Top = 376 326 | Width = 9 327 | Height = 13 328 | Caption = '...' 329 | end 330 | object Label19: TLabel 331 | Left = 24 332 | Top = 64 333 | Width = 76 334 | Height = 13 335 | Caption = 'Program Name: ' 336 | end 337 | object laProgramName: TLabel 338 | Left = 112 339 | Top = 64 340 | Width = 9 341 | Height = 13 342 | Caption = '...' 343 | end 344 | object Label17: TLabel 345 | Left = 128 346 | Top = 136 347 | Width = 43 348 | Height = 13 349 | Caption = 'rad +/-pi' 350 | end 351 | object Label22: TLabel 352 | Left = 24 353 | Top = 424 354 | Width = 9 355 | Height = 13 356 | Caption = '1:' 357 | end 358 | object Label27: TLabel 359 | Left = 24 360 | Top = 440 361 | Width = 9 362 | Height = 13 363 | Caption = '2:' 364 | end 365 | object Label28: TLabel 366 | Left = 24 367 | Top = 456 368 | Width = 9 369 | Height = 13 370 | Caption = '3:' 371 | end 372 | object Label29: TLabel 373 | Left = 24 374 | Top = 472 375 | Width = 9 376 | Height = 13 377 | Caption = '4:' 378 | end 379 | object Label8: TLabel 380 | Left = 24 381 | Top = 8 382 | Width = 54 383 | Height = 13 384 | Caption = 'Dll Loaded:' 385 | end 386 | object Label10: TLabel 387 | Left = 128 388 | Top = 312 389 | Width = 16 390 | Height = 13 391 | Caption = 'mm' 392 | end 393 | object Label30: TLabel 394 | Left = 128 395 | Top = 328 396 | Width = 16 397 | Height = 13 398 | Caption = 'mm' 399 | end 400 | object Label31: TLabel 401 | Left = 128 402 | Top = 344 403 | Width = 16 404 | Height = 13 405 | Caption = 'mm' 406 | end 407 | object Label32: TLabel 408 | Left = 128 409 | Top = 184 410 | Width = 54 411 | Height = 13 412 | Caption = 'mm +/-500' 413 | end 414 | object Label20: TLabel 415 | Left = 128 416 | Top = 216 417 | Width = 54 418 | Height = 13 419 | Caption = 'mm +/-500' 420 | end 421 | object Label21: TLabel 422 | Left = 128 423 | Top = 200 424 | Width = 54 425 | Height = 13 426 | Caption = 'mm +/-500' 427 | end 428 | object Label33: TLabel 429 | Left = 128 430 | Top = 152 431 | Width = 43 432 | Height = 13 433 | Caption = 'rad +/-pi' 434 | end 435 | object Label34: TLabel 436 | Left = 128 437 | Top = 168 438 | Width = 43 439 | Height = 13 440 | Caption = 'rad +/-pi' 441 | end 442 | object timerData: TTimer 443 | Enabled = False 444 | Interval = 50 445 | OnTimer = timerDataTimer 446 | Left = 176 447 | Top = 8 448 | end 449 | end 450 | -------------------------------------------------------------------------------- /Bpl/SideBar.pas: -------------------------------------------------------------------------------- 1 | { Under GNU License 2 | check http://www.opensource.org/ 3 | project by 4 | Nicolas Camil 5 | http://n.camil.chez.tiscali.fr 6 | ------------------------------ 7 | 8 | This library is free software; you can redistribute it and/or 9 | modify it under the terms of the GNU Library General Public 10 | License as published by the Free Software Foundation. 11 | 12 | This library is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | Library General Public License for more details.} 16 | unit SideBar; 17 | 18 | interface 19 | 20 | uses 21 | Windows, Messages, Classes, ExtCtrls, ComCtrls, Controls, Forms, Graphics, SysUtils, 22 | Dialogs; 23 | 24 | type 25 | TAnimateDir = (adDown, adUp); 26 | 27 | TSideBar = Class(TCustomPanel) 28 | private 29 | FPageCtrl : TPageControl; 30 | FButtonHeight: integer; 31 | DownIndex: integer; 32 | Leaved : Boolean; 33 | FTabVisible: Boolean; 34 | procedure SetButtonHeight(const Value: integer); 35 | procedure DrawButtons; 36 | procedure GestOnChange(Sender : TObject); 37 | procedure RedrawButton(Index : integer); 38 | procedure SetTabVisible(const Value: Boolean); 39 | procedure CreateComponent(Reader: TReader; ComponentClass: TComponentClass; var Component: TComponent); 40 | procedure AnimateChange(Index : integer; aDir : TAnimateDir); 41 | protected 42 | procedure Paint; override; 43 | procedure Loaded; override; 44 | procedure GetChildren (Proc : TGetChildProc; Root: TComponent);override; 45 | procedure ReadState(Reader: TReader); override; 46 | procedure CustomAlignPosition(Control: TControl; var NewLeft, NewTop, NewWidth, 47 | NewHeight: Integer; var AlignRect: TRect; AlignInfo: TAlignInfo); override; 48 | procedure MouseDown(Button: TMouseButton; Shift: TShiftState; 49 | X, Y: Integer); override; 50 | procedure MouseUp(Button: TMouseButton; Shift: TShiftState; 51 | X, Y: Integer); override; 52 | procedure CMMouseLeave(var msg : TMessage); message CM_MOUSELEAVE; 53 | procedure CMMouseEnter(var msg : TMessage); message CM_MOUSEENTER; 54 | public 55 | Constructor Create(AOwner : TComponent);override; 56 | Destructor Destroy;override; 57 | published 58 | property PageCtrl : TPageControl read FPageCtrl write FPageCtrl;// stored false; 59 | property ButtonHeight : integer read FButtonHeight write SetButtonHeight; 60 | property TabVisible : Boolean read FTabVisible write SetTabVisible; 61 | end; 62 | 63 | 64 | 65 | implementation 66 | 67 | uses Types; 68 | 69 | const 70 | STEP_SIZE = 5; 71 | 72 | { TSideBar } 73 | 74 | constructor TSideBar.Create(AOwner: TComponent); 75 | begin 76 | inherited Create(AOwner); 77 | 78 | FButtonHeight := 25; 79 | 80 | //BorderStyle := bsNone; 81 | FPageCtrl := TPageControl.Create(Self); 82 | FPageCtrl.Name := AOwner.name + '_PC'; 83 | FPageCtrl.Parent := Self; 84 | FPageCtrl.Width := Width; 85 | FPageCtrl.SetSubComponent(True); 86 | FPageCtrl.Align := alCustom; 87 | FPageCtrl.OnChange := GestOnChange; 88 | 89 | DownIndex := -1; 90 | Leaved := False; 91 | FPageCtrl.Style := tsFlatButtons; 92 | try 93 | FPageCtrl.TabHeight := 1; 94 | except 95 | end; 96 | end; 97 | 98 | 99 | 100 | destructor TSideBar.Destroy; 101 | begin 102 | FreeAndNil(FPageCtrl); 103 | inherited; 104 | end; 105 | 106 | 107 | procedure TSideBar.DrawButtons; 108 | var 109 | TextPos, i : integer; 110 | aRect, R1 : TRect; 111 | begin 112 | aRect := Self.ClientRect; 113 | aRect.Bottom := FButtonHeight; 114 | for i := 0 to FPageCtrl.PageCount - 1 do begin 115 | R1 := aRect; 116 | if (i <> DownIndex) or Leaved then 117 | Frame3D(Canvas,R1,clBtnHighlight,clBtnShadow,1) 118 | else 119 | Frame3D(Canvas,R1,clBtnShadow,clBtnHighlight,1); 120 | 121 | TextPos := (Width - Canvas.TextWidth(FPageCtrl.Pages[i].Caption)) div 2; 122 | Canvas.TextOut(TextPos, aRect.Top + 5, FPageCtrl.Pages[i].Caption); 123 | 124 | OffsetRect(aRect, 0, FButtonHeight); 125 | if i = FPageCtrl.ActivePageIndex then 126 | OffsetRect(aRect, 0, FPageCtrl.Height); 127 | 128 | end; 129 | end; 130 | 131 | 132 | 133 | procedure TSideBar.GetChildren(Proc: TGetChildProc; Root: TComponent); 134 | begin 135 | inherited; 136 | Proc(FPageCtrl); 137 | end; 138 | 139 | 140 | procedure TSideBar.Paint; 141 | var 142 | aRect : TRect; 143 | begin 144 | inherited; 145 | 146 | //Draw frame 147 | aRect := FPageCtrl.ClientRect; 148 | FPageCtrl.Canvas.Pen.Color := clBtnShadow; 149 | FPageCtrl.Canvas.PenPos := Point(aRect.Left, 0); 150 | FPageCtrl.Canvas.LineTo(0, 0); 151 | FPageCtrl.Canvas.LineTo(0, aRect.Bottom-1); 152 | FPageCtrl.Canvas.Pen.Color := clBtnHighlight; 153 | FPageCtrl.Canvas.LineTo(aRect.Right-1, aRect.Bottom-1); 154 | FPageCtrl.Canvas.LineTo(aRect.Right-1, 0); 155 | 156 | if Assigned(FPageCtrl) then 157 | DrawButtons; 158 | end; 159 | 160 | 161 | 162 | procedure TSideBar.SetButtonHeight(const Value: integer); 163 | begin 164 | FButtonHeight := Value; 165 | GestOnChange(Self); 166 | Invalidate; 167 | end; 168 | 169 | 170 | 171 | procedure TSideBar.CreateComponent(Reader: TReader; 172 | ComponentClass: TComponentClass; var Component: TComponent); 173 | begin 174 | //if Assigned(Component) and Assigned(Component.Owner)then 175 | // ShowMessage(Reader.Parent.Name); 176 | 177 | if ComponentClass = TPageControl then 178 | Component := FPageCtrl; 179 | end; 180 | 181 | 182 | 183 | procedure TSideBar.ReadState(Reader: TReader); 184 | begin 185 | Reader.OnCreateComponent := CreateComponent; 186 | inherited; 187 | end; 188 | 189 | 190 | 191 | procedure TSideBar.GestOnChange(Sender: TObject); 192 | var 193 | aRect : TRect; 194 | begin 195 | 196 | //Realign 197 | aRect := ClientRect; 198 | AlignControls(FPageCtrl, aRect); 199 | end; 200 | 201 | 202 | 203 | procedure TSideBar.Loaded; 204 | begin 205 | inherited; 206 | 207 | if not (csDesigning in ComponentState) then begin 208 | TabVisible := False; 209 | 210 | Invalidate; 211 | end else 212 | if not TabVisible then 213 | GestOnChange(Self); 214 | end; 215 | 216 | 217 | 218 | procedure TSideBar.CustomAlignPosition(Control: TControl; var NewLeft, NewTop, NewWidth, 219 | NewHeight: Integer; var AlignRect: TRect; AlignInfo: TAlignInfo); 220 | begin 221 | inherited; 222 | if Control = FPageCtrl then begin 223 | NewWidth := Width; 224 | NewTop := FButtonHeight * (FPageCtrl.ActivePageIndex+1); 225 | NewHeight := Self.Height - FButtonHeight * FPageCtrl.PageCount ; 226 | end; 227 | end; 228 | 229 | 230 | 231 | procedure TSideBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 232 | begin 233 | inherited; 234 | if DownIndex <= FPageCtrl.ActivePageIndex then begin 235 | If not leaved and (Y <= (DownIndex+1) * FButtonHeight) then begin 236 | AnimateChange(DownIndex, adDown); 237 | FPageCtrl.ActivePageIndex := DownIndex; 238 | GestOnChange(Self); 239 | end; 240 | end else 241 | If not leaved and (Y <= (DownIndex+1) * FButtonHeight + FPageCtrl.Height) then begin 242 | AnimateChange(DownIndex, adUp); 243 | FPageCtrl.ActivePageIndex := DownIndex; 244 | GestOnChange(Self); 245 | end; 246 | 247 | RedrawButton( DownIndex); 248 | Leaved := False; 249 | DownIndex := -1; 250 | end; 251 | 252 | 253 | 254 | 255 | 256 | procedure TSideBar.RedrawButton(Index : integer); 257 | var 258 | aRect : TRect; 259 | begin 260 | aRect := ClientRect; 261 | aRect.Bottom := FButtonHeight; 262 | OffsetRect(aRect, 0, DownIndex*FButtonHeight); 263 | 264 | if DownIndex > FPageCtrl.ActivePageIndex then 265 | OffsetRect(aRect, 0, FPageCtrl.Height); 266 | 267 | InvalidateRect(Handle, @aRect, False); 268 | //Invalidate; 269 | FPageCtrl.Refresh; 270 | end; 271 | 272 | 273 | 274 | procedure TSideBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 275 | var 276 | i, NewDownIndex : integer; 277 | ClickPos : integer; 278 | begin 279 | inherited; 280 | NewDownIndex := -1; 281 | Leaved := False; 282 | 283 | //find clicked button 284 | ClickPos := ButtonHeight; 285 | i := 0; 286 | while i <= FPageCtrl.PageCount - 1 do begin 287 | if Y <= ClickPos then begin 288 | NewDownIndex := i; 289 | Break; 290 | end else 291 | if i = FPageCtrl.ActivePageIndex then 292 | inc(ClickPos, FPageCtrl.Height); 293 | inc(ClickPos, FButtonHeight); 294 | inc(i); 295 | end; 296 | if NewDownIndex <> FPageCtrl.ActivePageIndex then begin 297 | DownIndex := NewDownIndex; 298 | RedrawButton( DownIndex); 299 | end; 300 | end; 301 | 302 | 303 | 304 | procedure TSideBar.CMMouseLeave(var msg: TMessage); 305 | begin 306 | Leaved := True; 307 | RedrawButton( DownIndex); 308 | end; 309 | 310 | 311 | 312 | procedure TSideBar.CMMouseEnter(var msg: TMessage); 313 | begin 314 | if Leaved then 315 | Leaved := False; 316 | RedrawButton( DownIndex); 317 | end; 318 | 319 | 320 | 321 | procedure TSideBar.SetTabVisible(const Value: Boolean); 322 | var 323 | i, j : integer; 324 | begin 325 | FTabVisible := Value; 326 | 327 | if FTabVisible then 328 | FPageCtrl.TabHeight := 0 329 | else 330 | FPageCtrl.TabHeight := 1; 331 | 332 | j := FPageCtrl.ActivePageIndex; 333 | if j < 0 then 334 | j := 0; 335 | 336 | for i := 0 to FPageCtrl.PageCount - 1 do 337 | FPageCtrl.Pages[i].TabVisible := Value; 338 | 339 | FPageCtrl.ActivePageIndex := j; 340 | GestOnChange(Self); 341 | end; 342 | 343 | 344 | procedure TSideBar.AnimateChange(Index: integer; aDir: TAnimateDir); 345 | var 346 | i : integer; 347 | aSrcRect, aDeltaRect : TRect; 348 | aDC: HDC; 349 | brushf: hbrush; 350 | begin 351 | aSrcRect := FPageCtrl.BoundsRect; 352 | aDC := GetWindowDC(Handle); 353 | brushf := CreateSolidBrush(ColorToRGB(clBtnFace)); 354 | try 355 | case aDir of 356 | adDown : begin 357 | aSrcRect.Top := (Index+1) * FButtonHeight + 1; 358 | 359 | repeat 360 | BitBlt(aDC, //dest 361 | aSrcRect.Left, aSrcRect.Top + STEP_SIZE, aSrcRect.Right, aSrcRect.Bottom - aSrcRect.Top - STEP_SIZE, 362 | aDC, //src 363 | aSrcRect.Left, aSrcRect.Top, 364 | SRCCOPY ); 365 | 366 | CopyRect(aDeltaRect, aSrcRect); 367 | aDeltaRect.Bottom := aDeltaRect.Top + STEP_SIZE; 368 | 369 | //Clean up behind 370 | FillRect(aDC, aDeltaRect, brushf ); 371 | 372 | aSrcRect.Top := aSrcRect.Top + STEP_SIZE; 373 | 374 | //pause to make the effect visible 375 | for i := 0 to 50000 do 376 | Application.ProcessMessages; 377 | 378 | until aSrcRect.Top >= aSrcRect.Bottom; 379 | end; 380 | 381 | adUp : begin 382 | aSrcRect.Top := Index * FButtonHeight + 1; 383 | repeat 384 | BitBlt(aDC, //dest 385 | aSrcRect.Left, aSrcRect.Top, aSrcRect.Right, aSrcRect.Bottom - aSrcRect.Top - STEP_SIZE, 386 | aDC, //src 387 | aSrcRect.Left, aSrcRect.Top + STEP_SIZE, 388 | SRCCOPY ); 389 | 390 | CopyRect(aDeltaRect, aSrcRect); 391 | aSrcRect.Bottom := aSrcRect.Bottom - STEP_SIZE; 392 | 393 | //Clean up behind 394 | aDeltaRect.Top := aDeltaRect.Bottom - STEP_SIZE; 395 | FillRect(aDC, aDeltaRect, brushf ); 396 | 397 | //pause to make the effect visible 398 | for i := 0 to 50000 do 399 | Application.ProcessMessages; 400 | 401 | until aSrcRect.Top >= aSrcRect.Bottom; 402 | 403 | end; 404 | end; 405 | 406 | finally 407 | ReleaseDC(Handle, aDC); 408 | DeleteObject(brushf); 409 | end; 410 | end; 411 | 412 | initialization 413 | RegisterClasses([TPageControl, TTabSheet]); 414 | 415 | 416 | end. 417 | -------------------------------------------------------------------------------- /Freetrack/ProfilesMngr_fm.dfm: -------------------------------------------------------------------------------- 1 | object ProfilesMngr: TProfilesMngr 2 | Left = 476 3 | Top = 34 4 | Align = alClient 5 | BorderStyle = bsNone 6 | ClientHeight = 137 7 | ClientWidth = 439 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'MS Sans Serif' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object butSaveProfile: TPngSpeedButton 18 | Left = 279 19 | Top = 34 20 | Width = 90 21 | Height = 25 22 | Caption = 'Save' 23 | OnClick = butSaveProfileClick 24 | PngImage.Data = { 25 | 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF 26 | 610000001974455874536F6674776172650041646F626520496D616765526561 27 | 647971C9653C000002A04944415478DA8D924B4894611486DF6FC699B10BA6A6 28 | 74752A17BA8816DE6D0CDA0546102D8B16455AA99578CB16A545178A042D3349 29 | 87891645814952C6384A174A94F19E894269E122B3209C1975749CFF3F9DEF53 30 | 8236E2371CCE59FCEF732EEF8894DCD60200DB38F670C472AC052884B300413D 31 | A341C0C041A443D7316536E1AB7F7EE15657EDFE06C1807AFBF98C2CF97DFC16 32 | 8BD2904E0804391674255E6531400860DAAF637A4EA3D18969ED9173D433FCFD 33 | 77A9048CD84B32E21BDD3E941E8A96729CBDD385DBA79310D481509380D964C0 34 | 3CC33CB31A67C2D8E42C8CD071E561EFBC044CD59764AC7BDEE945F1C1283572 35 | 614D376E9C4C84C9C8DDCD061E1DF0FA35CCCCC915088EB65FC84C0A43617507 36 | 4940A0B6C8666A727B9197B95E012ED9FB702D2B01AB438D30F10AFE002F3EA3 37 | F144EA060C9844C2760B2A9EF482012EFD5EA14DBCE415B2F7452A006BB0C662 38 | E4EE02418DBBF3E8B3014D89897F0ED74FECB29A51F5AC4F01E86EBE0DCDDD5E 39 | 4CFC18E76309053085F0E11816E491837C8C2543D40B0F8FC44EAB05350D030C 40 | C87151657E3A5E7779D4AE52A5FC530A02EBB9330348D6A46A033789DB2850F7 41 | 6270115071261DCE1E8FA2FF335F401D4C0A97FC579964C1DFC4460B385E7D5E 42 | 04DCCC49455BBF77694062AD50599300D95D4EA2CBD0D47F842B5823098F9DC3 43 | 12D042D74FA5E2ED800FE547B66225AFB86E08311184A7AD2310697CC4CB5929 44 | 783FE845F9E11854B59F58569C6FB3A3E8C1276C0E2734BEF9C2803C17951D4F 45 | C6C7211FCA18E01E7FB72C2025662F0AEEF7635318A1E9030352735BF48BC792 46 | 45C7B004585734C1B9EA1E6C604073FB2889E49C96B10B471377480F0FA445AD 47 | E806571D6E756067E7B73FF288956C551C5F7D374322D83C651DA465A4FF9741 48 | 8BB6AA02E483300CFE058C4769232FDE7CCE0000000049454E44AE426082} 49 | end 50 | object butNewProfile: TPngSpeedButton 51 | Left = 279 52 | Top = 2 53 | Width = 90 54 | Height = 25 55 | Caption = 'New' 56 | PngImage.Data = { 57 | 89504E470D0A1A0A0000000D4948445200000010000000100804000000B5FA37 58 | EA0000000467414D410000AFC837058AE90000001974455874536F6674776172 59 | 650041646F626520496D616765526561647971C9653C000000DE4944415478DA 60 | 75D13B0A02311006E07FB28B8A20A282367A0A5FD8791B0BBD8BB0B5ADAD37B0 61 | B0F2857710EDB417D7DD649CECAEEF754242C87C4926841854470D0E3EE38403 62 | 1B3B2101CDEBDC29907A65434CBCD13826167482A5AF284919DC50C119336F18 63 | 1102A11DAE03289808680165E906536F30E67D0274B4DF8085F8282557B95D6C 64 | 132017C902CB7E2D24101AA2FA0E1EE5C5C43683621A888991CEC8A783B8125B 65 | 53E61FE0E83D0CF717F073B4E40FE0E7492AFD15AFA037B002E1378CDBE38DFD 66 | 8B96BF707250DF697DC9F679674143BE5BA59CA071E2E31D933A79137EE3A2F9 67 | 0000000049454E44AE426082} 68 | end 69 | object butRefreshProfileList: TPngSpeedButton 70 | Left = 279 71 | Top = 66 72 | Width = 90 73 | Height = 25 74 | Caption = 'Refresh' 75 | PngImage.Data = { 76 | 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF 77 | 610000001974455874536F6674776172650041646F626520496D616765526561 78 | 647971C9653C000002774944415478DA8D536D485351187EEF364AB7248BE9BE 79 | 528C1512850442B03FE1A0B0C8329811146596F6A35C1A610D4C88CAB0245256 80 | 426499F52F8A90024B4BA3AF61392109BB6B9BD3C24CF6A31ABAED9E73EED6BB 81 | 0F876B8A1D38BCF79EFB3ECF7DDFE7790F170E8761B1B5F7FE2E0B09D2E6C755 82 | DDE2BFDFB8FF2128BD593C4C82E443774D7FE58204275E1DC9619499A8C08A89 83 | 400BA940B284200504826EA50E08A1C0BB1CADEFCF0FD6A61098FB0E1B286567 84 | 74725DE9F2B44C902F518084E380862850C6A2314804B07F1A029E77347EB63A 85 | CE26088EF796E750C2ACF9CA75A5D98A6C9826D308960215698C8062151809BE 86 | DB0787C0C13B9B9DB7464F27082A9FECABD528B4D7F44A3D8218FC09FA80F7F0 87 | E0F438B17C0A02B6B04AAB4322065F79E775D7ED3173520B071E98BAD7AB376C 88 | 5B26CF8099801F7A6C3DDFB0EF87AF1B064ECD26E51FD50FA33E7677C778458A 89 | 8865774B7E2220137748089000C6B6B7E73E36CC4D5A5D9E5B2F32B1A968B7E1 90 | 60A422121737F2CC95DCD852113B24899231F11E022C2D9BDB1BE712EDE9DC79 91 | 01F38EE14EC79F4930FE9E770ED0D20E2CB9B06D6B67C1EC99E9CE8EAB082833 92 | 6E34E67232094C4E4DC2CB37FDCF5208D052AB5AAEA96684817BCA0DB3256B57 93 | 68214F9507B2A532208C462D1D19F9723289A0FAC5A12BAA344DDD1AE55A1045 94 | 116D64313BE396FA023E904A64303AE6019B6DA00BED372711543DDD7F5195AE 95 | AED767E9410C85A2FE47C09119F0FB67C0FBCB0B13133F801F7174A1AD97D152 96 | 5B4A0B78715A5419EA9AC8E8BAC65D71B59148205E1C713B8EFA73D4E7115AFA 97 | 7DC1CBB4BDD5D88E2A6FEAB3BC2B8045D6BC0445970C5214AE0E2F4ED362047F 98 | 01BF2299BDF1621A240000000049454E44AE426082} 99 | end 100 | object TreeView: TTreeView 101 | Left = 0 102 | Top = 0 103 | Width = 273 104 | Height = 137 105 | Align = alLeft 106 | DragMode = dmAutomatic 107 | HideSelection = False 108 | Indent = 19 109 | ParentShowHint = False 110 | PopupMenu = PopProfile 111 | ReadOnly = True 112 | ShowHint = False 113 | TabOrder = 0 114 | ToolTips = False 115 | OnChange = TreeViewChange 116 | OnChanging = TreeViewChanging 117 | OnCompare = TreeViewCompare 118 | OnDragDrop = TreeViewDragDrop 119 | OnDragOver = TreeViewDragOver 120 | OnMouseDown = TreeViewMouseDown 121 | OnMouseMove = TreeViewMouseMove 122 | OnStartDrag = TreeViewStartDrag 123 | end 124 | object PopProfile: TPopupMenu 125 | Images = imlistPopProfile 126 | Left = 104 127 | Top = 56 128 | object Add1: TMenuItem 129 | Caption = 'Add' 130 | ImageIndex = 0 131 | OnClick = Add1Click 132 | end 133 | object Saveas1: TMenuItem 134 | Caption = 'Save as' 135 | ImageIndex = 1 136 | OnClick = butSaveAsProfileClick 137 | end 138 | object Rename1: TMenuItem 139 | Caption = 'Rename' 140 | ImageIndex = 2 141 | OnClick = Rename1Click 142 | end 143 | object Delete1: TMenuItem 144 | Caption = 'Delete' 145 | ImageIndex = 3 146 | OnClick = Delete1Click 147 | end 148 | end 149 | object imlistPopProfile: TPngImageList 150 | PngImages = < 151 | item 152 | PngImage.Data = { 153 | 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF 154 | 610000001974455874536F6674776172650041646F626520496D616765526561 155 | 647971C9653C0000023E4944415478DAA5535D48D35114FF5D1759C9BF201FCC 156 | C80721931404311142480A066668BD1488C9287DC8D59248722D8A62B63E1CB2 157 | 6A12856416A2F430197D907D2014B1A2C86A3143A528C587221B61C4B67B6FE7 158 | DEFF56D143685DF871CEB91FBF7BEEEF9EC3A494F89FC13637F7D9CB2B4A4F7E 159 | FE263334971090042E3859092129E69CACD496D3DAE2F9B1994864F240A0639B 160 | 9FB9AF8D73C3C8489BEBCDE39111E16B5E6761077BC7FEE90D1F273EE0424B05 161 | 63CE2BA3F278DDCA3913ECF4DC4397730363AD3D6FA467FB2AC412F4665A50EF 162 | E682A4A048689FF4484813A4478C4BE42E33606B1B44B7CB4A049747A4A73E1F 163 | 71DA082514B17065CD907C6841B930E7041165652E44FDD15BE83952C958CBA5 164 | D7F294AD40DFA43350904A7DE80C14898680265159641AE9A83B7C03578F5531 165 | B6BF2B2C4FEF28346F25B024894812494AC1F4A14955602C9A87DA4341F4BAAB 166 | 19DB77F185F436146982D44815578A885176779E0D6068F83AA233D38827E2F8 167 | 329D8F80A7833147E753E9DB5502AE36FE7138E5DF0CF56378721025056B90B3 168 | 340FF7C30308851FE0DDD8272FDB73F6893CB3BBF4D7213305FC5E1C8DED55A8 169 | A9B4029634D4AC76A0FD6E232C48435F20F89DD97D2179CE51F6D73FDFE42A46 170 | 53AD1D1B0B1B7ECE055FF9D176DEAD7BA13F2B67F956A1EA9D0A802BABFE3E1E 171 | D756F5C0FBE85E6CA95E8F0429E2B476C373DB860596743383D97463993DDBBD 172 | 2277896B6D5139F2B28B313AF51C8F5E3EC4C4DBA8775604499213649A0806E1 173 | 2BA1F3B17FAAF507617E4D9CCABDA07D0000000049454E44AE426082} 174 | Name = 'PngImage0' 175 | Background = clWindow 176 | end 177 | item 178 | PngImage.Data = { 179 | 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF 180 | 610000001974455874536F6674776172650041646F626520496D616765526561 181 | 647971C9653C000002804944415478DAA5925F48137100C7BFB76A97CE6C422F 182 | 92857F2A63E10EA7B9316A25B3282A52D21E8C1E12945EF2B15E82B0280A09B2 183 | 20411FCA0243B29784208B06FD593BE794992B9BCDC9DC66CC6A354BE7EE76D7 184 | EF772B68B107A31FF7833BEE7E9FDFE73EFC185996F13F83A180D64E0FBF8605 185 | 161222F272D4084716C1A8809CEC15906406D1D8229E8D069BA67B8F7832029A 186 | AFBAF803D5A5A835E460C011C4215341DA473DB639D886FCB87DA6CA981170EC 187 | 9283B79AB7C21F8870492101B55A85B59A55F8F8294EBE80321382846FDFE361 188 | 6252474CDC6980E39779BEC6588A716F80B39A4BB0AF4C832723B3A831E42BEB 189 | E7174508421203AE58F89749F15FBFE0E42BB715C2EEF6733B2A37E18D77965D 190 | 4613233119520027DA87F872DD068CBE0D713BCB4BF0DA3DC52EB309A300EADB 191 | 5EF2D6EDA5F8100872FA2D051874F858DAA469B716AD375CB87EAA4259181749 192 | 8B24D0F52804CFE40C6E9D36A50075E75EF0FB8D65F04CFBB8E2C26C0C8FC558 193 | DAA4D1924B1A30509110F4B448920C86DC5FB93F8D91773378D0B62B0568B860 194 | E79B0FEAD06F9BE0AAF4F9E0DD119636097D9E57168B4909129914A21C3C7285 195 | C261DC3D5B9D02549C1CECDE5C90A51744156735E8E07C3FC9D226D198489740 196 | 1493647749319064893C0B0806C3E83BBF2705F83D88C91435E97A385E449BD4 197 | 5BB2204A09F246A5EC2A331256AF54A3BD3700E7B8174FAFD5A60388493F3131 198 | 2C0928A24D0E5B04743B5BB04EB39196C0DC8F19B45475A0E3DE126CAE61D83B 199 | 8FA603FE3091A9C9DEF22F7044FBA055AF5724BEC62330E535E0E29D241E3B5C 200 | 787EB321338098BC2226662D9B479473C96F0860480346262D98054C047C88C4 201 | 048CF5346606FCCBF809E37B59F0CEBED2370000000049454E44AE426082} 202 | Name = 'PngImage3' 203 | Background = clWindow 204 | end 205 | item 206 | PngImage.Data = { 207 | 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF 208 | 610000001974455874536F6674776172650041646F626520496D616765526561 209 | 647971C9653C000002934944415478DAA5535B485451145D674627CAA641CD89 210 | 4C0B4D94B20719D68F9210E44785493612D853FB304B4413B5CF5E83A9856606 211 | 968516F92AEC41444896845394856672675253B0A1669C06A7749EF7DED3B957 212 | 8D90FAB0366CF6D99CB3D77E9CB509A514FF2364575E534E42527CA9DD490364 213 | 2C5104652A8802B3142265BE20304B652BB0BB452AEF24C7998BDA2EA65F2667 214 | 5A8704B53A4031D7CC439C51ACCCDBA224276F0FFE530F639F47515B984448C9 215 | CD017A2E236ACE0099FAA7A82BD94A48718389EAF745C3CBB39ED985D4B720B2 216 | 51304F94CF6C1E3C95D567EB80F3ED2D2817AEC5A4AD13C46D3E408AEB8D54BF 217 | 3F063EF610D2A0188A20D929979D210FD46B79003AD28DF92189D044C4617CD8 218 | 00E3936B165278A39F9E3FB85ACE2457202995A60FB90209C463790C32F90E01 219 | EA0DB00F9AA059BC122AB5165C47839B9CA8FB40CB0EC74E65654AA641C46920 220 | AFB513BCFD193491C9F07C6982EB1B81D5E8C47727E380C71E43F2AFF6D28AAC 221 | 7532C08CCC90CB697D0EC1D60E4D540ADCE62B50A878F8265660FC0D87B2C1ED 222 | A83A9545486E4D37ADCCDE084162D56FC15FB9FB503A5F42BB269505D740E1CF 223 | C3FB2302B6AE1E84A69423A3BC1F77CAD208397EE935AD3A163F95795A2DDC43 224 | 38465F203A71071B5E3D88D20BB7238C05F762A9AE160B02C3B0BBA005772B74 225 | 84E454BEA2D5B99B7F95FFB1AB11BCA30F3CD12238B80B815A150B0EC778B709 226 | E169D5F0D72C93DFA5E637A3ED423A9176A1794978A84E94F8CE08B08D9C85EE 227 | E875981A0B601E3160DEF2F570585C78E4DE0B0B1F24EF89F4E34C5AD82EA493 228 | D9DB78FA48ACAF2833DB0F0A013DEDF730323C30A109094A48D6BFEFFDE336CE 229 | 06D89318E48A8BD4FA6D5A1501EAEF31B8AC63877696F67DFA1BA57F02DC2163 230 | 088E58AB0E0000000049454E44AE426082} 231 | Name = 'PngImage1' 232 | Background = clWindow 233 | end 234 | item 235 | PngImage.Data = { 236 | 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF 237 | 610000001974455874536F6674776172650041646F626520496D616765526561 238 | 647971C9653C0000022D4944415478DAA5535F48535118FF7DDE91C8583E442C 239 | A66B11F8D4DBC2B74449E80F51D80CD78B8F62CC1A239274A38C90202A9A4546 240 | 7FC4B43023280A7AB11EA2B90A71B641EE6EAC61A4A386A531A756DBBDA773EE 241 | E89291A0F571CFFD71CEF79DDFF7FBC1F9883186FF09AAF30CB66CABA93C3BB3 242 | C08C1A97AA82F1A5A80A470695F1BDA270641A2A3CB776CD8F79594E1D7F78D1 243 | 79853AEF271593C958B4DACE4939A67679AA25F20EBCFB270FD35393B8DE5A43 244 | D47E3BC14ED497AD9AE0B0FF257ADA6B89DAFAE39CA01C05194CFB4084B15068 245 | D9CB5BED76B8FC41DCF2EDE0047D31E6DD6F4193FFBD5E70D3B3096FC2615455 246 | 55FD95209BCDC2752180FE8EDD44ADBDE3CCE72807699D8502E2084422916509 247 | 32990C5CE703B8737A0FD1B19EB75C4199500DFD4950C1CA92B34242B329FE42 248 | C140E73EA2A337221A01FBAD446CA2727469DBB1C750461E20FF6912D27A335E 249 | 956C87B7B78FC8DD3DCA7CF556B8AFA5F5DA4BCD66C4E371DDC2D4A36ECC06EF 250 | A2A2BA0EC59BB760313284F1C033CCC664371DB93CC2BC07ACBABC5F91482474 251 | 82178D15A83C780825C9E7402A089496E2B3C186D0D0F004B574BDE6041B756F 252 | EC0FBF02A38D36D49E1B04D91D7AF66BC7068C06BE30310BF7CC564B832ADEBB 253 | C26740A098855C4E4331030DE126EC74EC85F1C3137C5F4C638113CC6524C849 254 | A46825D318705A4E159B8C3EEBBABCC15094C2DC741E136949C97D6327574420 255 | 62D8696D9B9FF9D82C2964532496E2B7AEEE7A9A3FF313796C0BA07E0D8F0600 256 | 00000049454E44AE426082} 257 | Name = 'PngImage2' 258 | Background = clWindow 259 | end> 260 | Left = 44 261 | Top = 15 262 | Bitmap = {} 263 | end 264 | object DKLanguageController1: TDKLanguageController 265 | Left = 168 266 | Top = 24 267 | LangData = { 268 | 0C0050726F66696C65734D6E677200010A0000000E006275745361766550726F 269 | 66696C65010100000002000000070043617074696F6E000D006275744E657750 270 | 726F66696C65010100000003000000070043617074696F6E0015006275745265 271 | 667265736850726F66696C654C69737401010000000400000007004361707469 272 | 6F6E000800547265655669657700000A00506F7050726F66696C650000040041 273 | 646431010100000007000000070043617074696F6E00070052656E616D653101 274 | 0100000008000000070043617074696F6E00070044656C657465310101000000 275 | 09000000070043617074696F6E001000696D6C697374506F7050726F66696C65 276 | 01040000000A0000001100506E67496D616765735B305D2E4E616D650B000000 277 | 1100506E67496D616765735B315D2E4E616D650C0000001100506E67496D6167 278 | 65735B325D2E4E616D650E0000001100506E67496D616765735B335D2E4E616D 279 | 650007005361766561733101010000000D000000070043617074696F6E00} 280 | end 281 | end 282 | -------------------------------------------------------------------------------- /Freetrack/ForceCamProp_fm.pas: -------------------------------------------------------------------------------- 1 | unit ForceCamProp_fm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, ExtCtrls, ComCtrls, Commctrl, ActiveX, DSPack, DirectShow9, DSUtil, 8 | BaseClass, IniFiles, Math, DKLang; 9 | 10 | type 11 | 12 | TControl = record 13 | Checked : Integer; 14 | TrackbarPos : Integer; 15 | end; 16 | 17 | TPropertyPageSite = class(TObject, IPropertyPageSite) 18 | private 19 | FRefCount : Cardinal; 20 | public 21 | function QueryInterface(const IID : TGUID; out Obj) : HRESULT; stdcall; 22 | function _AddRef : Integer; stdcall; 23 | function _Release : Integer; stdcall; 24 | 25 | function OnStatusChange(flags: Longint): HRESULT; stdcall; 26 | function GetLocaleID(out localeID: TLCID): HRESULT; stdcall; 27 | function GetPageContainer(out unk: IUnknown): HRESULT; stdcall; 28 | function TranslateAccelerator(msg: PMsg): HRESULT; stdcall; 29 | end; 30 | 31 | 32 | TForceCamProp = class(TForm) 33 | DKLanguageController1: TDKLanguageController; 34 | pcPropPages: TPageControl; 35 | Panel1: TPanel; 36 | Panel2: TPanel; 37 | butApply: TButton; 38 | butCancel: TButton; 39 | butOK: TButton; 40 | clickTimer: TTimer; 41 | procedure butApplyClick(Sender: TObject); 42 | procedure butCancelClick(Sender: TObject); 43 | procedure butOKClick(Sender: TObject); 44 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 45 | procedure clickTimerTimer(Sender: TObject); 46 | 47 | private 48 | Camera: TFilter; 49 | fOwner : TDataModule; 50 | exposureSetting : Integer; 51 | tsPages : TList; 52 | hPropPage : array[0..100] of THandle; 53 | ControlNumber : array[0..2] of Integer; 54 | pPageSite : TPropertyPageSite; 55 | pPage : array[0..100] of IPropertyPage; 56 | CAGUID : TCAGUID; 57 | Control : array[0..299] of TControl; 58 | FSelectedCam : String; 59 | SavedCam : String; 60 | function AddSheet(name : String; rectPage : TRect) : THandle; 61 | procedure HandleClick; 62 | procedure SaveProperties; 63 | procedure Cleanup; 64 | procedure ApplyPage; 65 | 66 | public 67 | Constructor Create(AOwner : TComponent); override; 68 | procedure ShowStreamProp; 69 | procedure ForceProperties; 70 | procedure LoadCfgFromIni(aIni: TIniFile); 71 | procedure SaveCfgToIni(aIni: TIniFile); 72 | property SelectedCam : String read FSelectedCam write FSelectedCam; 73 | end; 74 | 75 | 76 | var 77 | ForceCamProp: TForceCamProp; 78 | 79 | implementation 80 | 81 | uses DInputMap; 82 | 83 | const 84 | PAGE_NUM = 4; 85 | 86 | {$R *.dfm} 87 | 88 | 89 | constructor TForceCamProp.Create(AOwner : TComponent); 90 | begin 91 | Inherited; 92 | fOwner := AOwner as TDataModule; 93 | Camera := fOwner.FindComponent('Camera') as TFilter; 94 | tsPages := TList.Create; 95 | 96 | end; 97 | 98 | 99 | function TForceCamProp.AddSheet(name : String; rectPage : TRect) : THandle; 100 | var 101 | i : Integer; 102 | begin 103 | tsPages.Add(TTabSheet.Create(pcPropPages)); 104 | i := tsPages.Count - 1; 105 | TTabSheet(tsPages.Items[i]).PageControl := pcPropPages; 106 | TTabSheet(tsPages.Items[i]).Caption := name; 107 | if pcPropPages.Width < rectPage.Right + 10 then 108 | pcPropPages.Width := rectPage.Right + 10; 109 | if pcPropPages.Height < rectPage.Bottom + 10 then 110 | pcPropPages.Height := rectPage.Bottom + 10; 111 | if Self.Width < rectPage.Right + 25 then 112 | Self.Width := rectPage.Right + 25; 113 | if Self.Height < rectPage.Bottom + 80 then 114 | Self.Height := rectPage.Bottom + 80; 115 | Result := TTabSheet(tsPages.Items[i]).Handle; 116 | end; 117 | 118 | 119 | procedure TForceCamProp.ForceProperties; 120 | var 121 | dsSpecifyPropertyPages : ISpecifyPropertyPages; 122 | pPageSite : TPropertyPageSite; 123 | pPage : array[0..100] of IPropertyPage; 124 | CAGUID : TCAGUID; 125 | dsCameraControl : IAMCameraControl; 126 | rectTiny : TRect; 127 | hDlg, hCtrl : THandle; 128 | TrackBarRange, TrackBarMin, aControl : Integer; 129 | pCamera : IBaseFilter; 130 | i, ctrlNum : Integer; 131 | aPAnsiChar : PAnsiChar; 132 | ctrlName : String; 133 | kplus, kminus : Cardinal; 134 | 135 | begin 136 | // create property pages - don't confuse this hidden local property page site with the global visible one 137 | if Camera.QueryInterface(IID_ISpecifyPropertyPages, dsSpecifyPropertyPages) <> S_OK then Exit; 138 | if dsSpecifyPropertyPages.GetPages(CAGUID) <> S_OK then Exit; 139 | pPageSite := TPropertyPageSite.Create; 140 | pPageSite._AddRef; 141 | pCamera := Camera as IBaseFilter; 142 | for i := 0 to PAGE_NUM do 143 | if CoCreateInstance(CAGUID.pElems[i], nil, CLSCTX_INPROC_SERVER, IPropertyPage, pPage[i]) = S_OK then begin 144 | pPage[i].SetPageSite(pPageSite); 145 | if pPage[i].SetObjects(1, @pCamera) = S_OK then begin 146 | rectTiny.Top := 0; 147 | rectTiny.Left := 0; 148 | rectTiny.Right := 1; 149 | rectTiny.Bottom := 1; 150 | pPage[i].Activate(Application.Handle, rectTiny, FALSE); 151 | end; 152 | end; 153 | 154 | {get current cam settings if camera device changed 155 | memoryless settings lost when changing cameras 156 | don't filter by class name because it is unreliable} 157 | if AnsiCompareStr(FSelectedCam, SavedCam) <> 0 then begin 158 | // save current settings 159 | SavedCam := FSelectedCam; 160 | ctrlNum := 0; 161 | hDlg := 0; 162 | hDlg := FindWindowExA(Application.Handle, hDlg, nil, nil); 163 | while (hDlg <> 0) do begin 164 | hCtrl := 0; 165 | hCtrl := FindWindowExA(hDlg, hCtrl, nil, nil); 166 | while (hCtrl <> 0) do begin 167 | if ctrlNum < High(Control) then begin 168 | Control[ctrlNum].Checked := SendMessage(hCtrl, BM_GETCHECK, 0, 0); 169 | Control[ctrlNum].TrackbarPos := SendMessage(hCtrl, TBM_GETPOS, 0, 0); 170 | end; 171 | Inc(ctrlNum); 172 | hCtrl := FindWindowExA(hDlg, hCtrl, nil, nil); 173 | end; 174 | hDlg := FindWindowExA(Application.Handle, hDlg, nil, nil); 175 | end; 176 | end else begin 177 | // apply settings twice with a time delay in-between to ensure correctly applied 178 | for i := 0 to 1 do begin 179 | GetMem(aPAnsiChar, 30); 180 | ctrlNum := 0; 181 | hDlg := 0; 182 | hDlg := FindWindowExA(Application.Handle, hDlg, nil, nil); 183 | while (hDlg <> 0) do begin 184 | hCtrl := 0; 185 | hCtrl := FindWindowExA(hDlg, hCtrl, nil, nil); 186 | while (hCtrl <> 0) do begin 187 | EnableWindow(hCtrl, TRUE); // enable control 188 | // can't identify control type so send trackbar and checkbox messages 189 | 190 | {TRACKBAR 191 | Use keypress so that trackbar doesn't reset to default with every setpos attempt 192 | WM_COMMAND to a button is registered as a click} 193 | SendMessage(hCtrl, WM_KEYDOWN, VK_LEFT, 0); 194 | SendMessage(hCtrl, TBM_SETPOS, WPARAM(TRUE), Control[ctrlNum].TrackbarPos); 195 | 196 | {CHECKBOXES 197 | Do not want to press buttons, especially the Default button! 198 | Difficult to identify checkboxes vs buttons 199 | WM_COMMAND to a button is registered as a click 200 | Use special property of checkboxes, can change using key plus/minus} 201 | if Control[ctrlNum].Checked = BST_CHECKED then 202 | SendMessage(hCtrl, WM_CHAR, Byte('+'), 0) 203 | else 204 | SendMessage(hCtrl, WM_CHAR, Byte('-'), 0); 205 | 206 | Inc(ctrlNum); 207 | hCtrl := FindWindowExA(hDlg, hCtrl, nil, nil); 208 | end; 209 | hDlg := FindWindowExA(Application.Handle, hDlg, nil, nil); 210 | end; 211 | Sleep(100); 212 | end; 213 | end; 214 | 215 | // apply and deactivate 216 | for i := 0 to CAGUID.cElems - 1 do 217 | if pPage[i] <> nil then begin 218 | pPage[i].Apply; 219 | pPage[i].Deactivate; 220 | pPage[i].SetPageSite(nil); 221 | end; 222 | end; 223 | 224 | 225 | 226 | procedure TForceCamProp.ShowStreamProp; 227 | var 228 | SpecifyPropertyPages : ISpecifyPropertyPages; 229 | pFilter : IBaseFilter; 230 | rectPage : TRect; 231 | i : Integer; 232 | pPageInfo : tagPROPPAGEINFO; 233 | 234 | begin 235 | if Self.Visible then Exit; 236 | 237 | // allow for vfw? 238 | 239 | {create property pages - build manually instead of using OleCreatePropertyFrame so that handle 240 | counting starts from the first page instead of the current page. Count needs to be unique because it is 241 | used to identify each control } 242 | if Camera.QueryInterface(IID_ISpecifyPropertyPages, SpecifyPropertyPages) <> S_OK then Exit; 243 | if SpecifyPropertyPages.GetPages(CAGUID) <> S_OK then Exit; 244 | pPageSite := TPropertyPageSite.Create; 245 | pPageSite._AddRef; 246 | pFilter := Camera as IBaseFilter; 247 | for i := 0 to PAGE_NUM do begin 248 | if CoCreateInstance(CAGUID.pElems[i], nil, CLSCTX_INPROC_SERVER, IPropertyPage, pPage[i]) = S_OK then begin 249 | pPage[i].GetPageInfo(pPageInfo); 250 | pPage[i].SetPageSite(pPageSite); 251 | if pPage[i].SetObjects(1, @pFilter) = S_OK then begin 252 | rectPage.Top := 0; 253 | rectPage.Left := 0; 254 | rectPage.Right := pPageInfo.size.cx; 255 | rectPage.Bottom := pPageInfo.size.cy; 256 | hPropPage[i] := AddSheet(pPageInfo.pszTitle, rectPage); 257 | pPage[i].Activate(hPropPage[i], rectPage, FALSE); 258 | end; 259 | end; 260 | end; 261 | ForceCamProp.Visible := True; 262 | clickTimer.Enabled := True; 263 | end; 264 | 265 | 266 | procedure TForceCamProp.HandleClick; 267 | var 268 | hWind, hControl, hParent : THandle; 269 | aPoint : TPoint; 270 | i : Integer; 271 | begin 272 | if ((DInput.MouseBut[0] and $80) > 0) then begin 273 | 274 | // enable apply button when dirty 275 | if not butApply.Enabled then 276 | for i := 0 to PAGE_NUM do 277 | if (pPage[i] <> nil) and (pPage[i].IsPageDirty = 0) then begin 278 | butApply.Enabled := True; 279 | Break; 280 | end; 281 | 282 | // enable property page control on click (for cameras with disabled auto-exposure checkboxes) 283 | // restrict to controls that are parents of the camera property pages 284 | GetCursorPos(aPoint); 285 | hWind := WindowFromPoint(aPoint); 286 | if hWind <> 0 then begin 287 | Windows.ScreenToClient(hWind, aPoint); 288 | hControl := ChildWindowFromPoint(hWind, aPoint); 289 | if hControl <> 0 then begin 290 | hParent := GetParent(GetParent(hControl)); 291 | for i := 0 to PAGE_NUM do 292 | if hPropPage[i] = hParent then 293 | EnableWindow(hControl, TRUE); 294 | end; 295 | end; 296 | end; 297 | end; 298 | 299 | 300 | procedure TForceCamProp.clickTimerTimer(Sender: TObject); 301 | begin 302 | HandleClick; 303 | end; 304 | 305 | 306 | procedure TForceCamProp.SaveProperties; 307 | var 308 | hDlg, hCtrl : THandle; 309 | ctrlNum, pageNum : Integer; 310 | aPAnsiChar : PAnsiChar; 311 | ctrlName : String; 312 | Checked, TrackBarPos : Integer; 313 | begin 314 | SavedCam := FSelectedCam; 315 | GetMem(aPAnsiChar, 30); 316 | ctrlNum := 0; 317 | for pageNum := 0 to PAGE_NUM do 318 | if hPropPage[pageNum] <> 0 then begin 319 | hDLg := 0; 320 | hDlg := FindWindowExA(hPropPage[pageNum], hDlg, nil, nil); 321 | while hDlg <> 0 do begin 322 | hCtrl := 0; 323 | hCtrl := FindWindowExA(hDlg, hCtrl, nil, nil); 324 | while hCtrl <> 0 do begin 325 | //GetDlgItemTextA(hDlg, GetDlgCtrlID(hCtrl), aPAnsiChar, 25); 326 | if ctrlNum < High(Control) then begin 327 | Control[ctrlNum].Checked := SendMessage(hCtrl, BM_GETCHECK, 0, 0); 328 | Control[ctrlNum].TrackbarPos := SendMessage(hCtrl, TBM_GETPOS, 0, 0); 329 | end; 330 | Inc(ctrlNum); 331 | hCtrl := FindWindowExA(hDlg, hCtrl, nil, nil); 332 | end; 333 | hDlg := FindWindowExA(hPropPage[pageNum], hDlg, nil, nil); 334 | end; 335 | end; 336 | end; 337 | 338 | 339 | procedure TForceCamProp.ApplyPage; 340 | var 341 | i : Integer; 342 | begin 343 | for i := 0 to CAGUID.cElems - 1 do 344 | if pPage[i] <> nil then 345 | pPage[i].Apply; 346 | butApply.Enabled := False; 347 | end; 348 | 349 | 350 | procedure TForceCamProp.Cleanup; 351 | var 352 | i : Integer; 353 | begin 354 | for i := 0 to CAGUID.cElems - 1 do 355 | if pPage[i] <> nil then begin 356 | pPage[i].Deactivate; 357 | pPage[i].SetPageSite(nil); 358 | end; 359 | CoTaskMemFree(CAGUID.pElems); 360 | 361 | for i := 0 to tsPages.Count - 1 do 362 | TTabSheet(tsPages.Items[i]).PageControl := nil; 363 | tsPages.Clear; 364 | butApply.Enabled := False; 365 | end; 366 | 367 | 368 | procedure TForceCamProp.butOKClick(Sender: TObject); 369 | begin 370 | butApplyClick(Self); 371 | butCancelClick(Self); 372 | end; 373 | 374 | 375 | procedure TForceCamProp.butCancelClick(Sender: TObject); 376 | begin 377 | ForceCamProp.Visible := False; 378 | clickTimer.Enabled := False; 379 | Cleanup; 380 | end; 381 | 382 | 383 | procedure TForceCamProp.butApplyClick(Sender: TObject); 384 | begin 385 | SaveProperties; 386 | ApplyPage; 387 | end; 388 | 389 | 390 | procedure TForceCamProp.FormClose(Sender: TObject; 391 | var Action: TCloseAction); 392 | begin 393 | butCancelClick(Self); 394 | end; 395 | 396 | 397 | procedure TForceCamProp.LoadCfgFromIni(aIni: TIniFile); 398 | var 399 | i : Integer; 400 | begin 401 | SavedCam := aIni.ReadString('CameraProp', 'SavedCam', ''); 402 | for i := 0 to High(Control) do begin 403 | Control[i].Checked := aIni.ReadInteger('CameraProp', 'Checkbox' + InttoStr(i), 0); 404 | Control[i].TrackbarPos := aIni.ReadInteger('CameraProp', 'Trackbar' + InttoStr(i), 0); 405 | end; 406 | end; 407 | 408 | 409 | procedure TForceCamProp.SaveCfgToIni(aIni: TIniFile); 410 | var 411 | i : Integer; 412 | begin 413 | {need to erase the cameraprop section because only non-zero values are being saved 414 | so last saved changes will remain otherwise} 415 | aIni.EraseSection('CameraProp'); 416 | aIni.WriteString('CameraProp', 'SavedCam', SavedCam); 417 | for i := 0 to High(Control) do begin 418 | // only store non-zero values 419 | if (Control[i].Checked <> 0) then 420 | aIni.WriteInteger('CameraProp', 'Checkbox' + InttoStr(i), Control[i].Checked); 421 | if (Control[i].TrackbarPos <> 0) then 422 | aIni.WriteInteger('CameraProp', 'Trackbar' + InttoStr(i), Control[i].TrackbarPos); 423 | end; 424 | end; 425 | 426 | 427 | 428 | 429 | // ***************************** TPropertyPageSite ************************** 430 | 431 | function TPropertyPageSite.QueryInterface(const IID : TGUID; out Obj) : HRESULT; 432 | begin 433 | if GetInterface(IID, Obj) then begin 434 | result := S_OK; 435 | end else 436 | result := E_NOINTERFACE; 437 | end; 438 | 439 | 440 | function TPropertyPageSite._AddRef : Integer; 441 | begin 442 | Inc(FRefCount); 443 | result := FRefCount; 444 | end; 445 | 446 | 447 | function TPropertyPageSite._Release : Integer; 448 | begin 449 | Dec(FRefCount); 450 | result := FRefCount; 451 | end; 452 | 453 | 454 | function TPropertyPageSite.OnStatusChange(flags: Longint): HRESULT; 455 | begin 456 | result := S_OK; 457 | end; 458 | 459 | 460 | function TPropertyPageSite.GetLocaleID(out localeID: TLCID): HRESULT; 461 | begin 462 | localeID := 0; 463 | result := S_OK; 464 | end; 465 | 466 | 467 | function TPropertyPageSite.GetPageContainer(out unk: IUnknown): HRESULT; 468 | begin 469 | unk := nil; 470 | result := E_NOTIMPL; 471 | end; 472 | 473 | 474 | function TPropertyPageSite.TranslateAccelerator(msg: PMsg): HRESULT; 475 | begin 476 | msg := nil; 477 | result := E_NOTIMPL; 478 | end; 479 | 480 | 481 | 482 | 483 | 484 | 485 | 486 | 487 | 488 | 489 | 490 | 491 | 492 | 493 | 494 | 495 | end. 496 | -------------------------------------------------------------------------------- /Freetrack/gpl.txt: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 2, June 1991 3 | 4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc. 5 | 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | Preamble 10 | 11 | The licenses for most software are designed to take away your 12 | freedom to share and change it. By contrast, the GNU General Public 13 | License is intended to guarantee your freedom to share and change free 14 | software--to make sure the software is free for all its users. This 15 | General Public License applies to most of the Free Software 16 | Foundation's software and to any other program whose authors commit to 17 | using it. (Some other Free Software Foundation software is covered by 18 | the GNU Library General Public License instead.) You can apply it to 19 | your programs, too. 20 | 21 | When we speak of free software, we are referring to freedom, not 22 | price. Our General Public Licenses are designed to make sure that you 23 | have the freedom to distribute copies of free software (and charge for 24 | this service if you wish), that you receive source code or can get it 25 | if you want it, that you can change the software or use pieces of it 26 | in new free programs; and that you know you can do these things. 27 | 28 | To protect your rights, we need to make restrictions that forbid 29 | anyone to deny you these rights or to ask you to surrender the rights. 30 | These restrictions translate to certain responsibilities for you if you 31 | distribute copies of the software, or if you modify it. 32 | 33 | For example, if you distribute copies of such a program, whether 34 | gratis or for a fee, you must give the recipients all the rights that 35 | you have. You must make sure that they, too, receive or can get the 36 | source code. And you must show them these terms so they know their 37 | rights. 38 | 39 | We protect your rights with two steps: (1) copyright the software, and 40 | (2) offer you this license which gives you legal permission to copy, 41 | distribute and/or modify the software. 42 | 43 | Also, for each author's protection and ours, we want to make certain 44 | that everyone understands that there is no warranty for this free 45 | software. If the software is modified by someone else and passed on, we 46 | want its recipients to know that what they have is not the original, so 47 | that any problems introduced by others will not reflect on the original 48 | authors' reputations. 49 | 50 | Finally, any free program is threatened constantly by software 51 | patents. We wish to avoid the danger that redistributors of a free 52 | program will individually obtain patent licenses, in effect making the 53 | program proprietary. To prevent this, we have made it clear that any 54 | patent must be licensed for everyone's free use or not licensed at all. 55 | 56 | The precise terms and conditions for copying, distribution and 57 | modification follow. 58 | 59 | GNU GENERAL PUBLIC LICENSE 60 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 61 | 62 | 0. This License applies to any program or other work which contains 63 | a notice placed by the copyright holder saying it may be distributed 64 | under the terms of this General Public License. The "Program", below, 65 | refers to any such program or work, and a "work based on the Program" 66 | means either the Program or any derivative work under copyright law: 67 | that is to say, a work containing the Program or a portion of it, 68 | either verbatim or with modifications and/or translated into another 69 | language. (Hereinafter, translation is included without limitation in 70 | the term "modification".) Each licensee is addressed as "you". 71 | 72 | Activities other than copying, distribution and modification are not 73 | covered by this License; they are outside its scope. The act of 74 | running the Program is not restricted, and the output from the Program 75 | is covered only if its contents constitute a work based on the 76 | Program (independent of having been made by running the Program). 77 | Whether that is true depends on what the Program does. 78 | 79 | 1. You may copy and distribute verbatim copies of the Program's 80 | source code as you receive it, in any medium, provided that you 81 | conspicuously and appropriately publish on each copy an appropriate 82 | copyright notice and disclaimer of warranty; keep intact all the 83 | notices that refer to this License and to the absence of any warranty; 84 | and give any other recipients of the Program a copy of this License 85 | along with the Program. 86 | 87 | You may charge a fee for the physical act of transferring a copy, and 88 | you may at your option offer warranty protection in exchange for a fee. 89 | 90 | 2. You may modify your copy or copies of the Program or any portion 91 | of it, thus forming a work based on the Program, and copy and 92 | distribute such modifications or work under the terms of Section 1 93 | above, provided that you also meet all of these conditions: 94 | 95 | a) You must cause the modified files to carry prominent notices 96 | stating that you changed the files and the date of any change. 97 | 98 | b) You must cause any work that you distribute or publish, that in 99 | whole or in part contains or is derived from the Program or any 100 | part thereof, to be licensed as a whole at no charge to all third 101 | parties under the terms of this License. 102 | 103 | c) If the modified program normally reads commands interactively 104 | when run, you must cause it, when started running for such 105 | interactive use in the most ordinary way, to print or display an 106 | announcement including an appropriate copyright notice and a 107 | notice that there is no warranty (or else, saying that you provide 108 | a warranty) and that users may redistribute the program under 109 | these conditions, and telling the user how to view a copy of this 110 | License. (Exception: if the Program itself is interactive but 111 | does not normally print such an announcement, your work based on 112 | the Program is not required to print an announcement.) 113 | 114 | These requirements apply to the modified work as a whole. If 115 | identifiable sections of that work are not derived from the Program, 116 | and can be reasonably considered independent and separate works in 117 | themselves, then this License, and its terms, do not apply to those 118 | sections when you distribute them as separate works. But when you 119 | distribute the same sections as part of a whole which is a work based 120 | on the Program, the distribution of the whole must be on the terms of 121 | this License, whose permissions for other licensees extend to the 122 | entire whole, and thus to each and every part regardless of who wrote it. 123 | 124 | Thus, it is not the intent of this section to claim rights or contest 125 | your rights to work written entirely by you; rather, the intent is to 126 | exercise the right to control the distribution of derivative or 127 | collective works based on the Program. 128 | 129 | In addition, mere aggregation of another work not based on the Program 130 | with the Program (or with a work based on the Program) on a volume of 131 | a storage or distribution medium does not bring the other work under 132 | the scope of this License. 133 | 134 | 3. You may copy and distribute the Program (or a work based on it, 135 | under Section 2) in object code or executable form under the terms of 136 | Sections 1 and 2 above provided that you also do one of the following: 137 | 138 | a) Accompany it with the complete corresponding machine-readable 139 | source code, which must be distributed under the terms of Sections 140 | 1 and 2 above on a medium customarily used for software interchange; or, 141 | 142 | b) Accompany it with a written offer, valid for at least three 143 | years, to give any third party, for a charge no more than your 144 | cost of physically performing source distribution, a complete 145 | machine-readable copy of the corresponding source code, to be 146 | distributed under the terms of Sections 1 and 2 above on a medium 147 | customarily used for software interchange; or, 148 | 149 | c) Accompany it with the information you received as to the offer 150 | to distribute corresponding source code. (This alternative is 151 | allowed only for noncommercial distribution and only if you 152 | received the program in object code or executable form with such 153 | an offer, in accord with Subsection b above.) 154 | 155 | The source code for a work means the preferred form of the work for 156 | making modifications to it. For an executable work, complete source 157 | code means all the source code for all modules it contains, plus any 158 | associated interface definition files, plus the scripts used to 159 | control compilation and installation of the executable. However, as a 160 | special exception, the source code distributed need not include 161 | anything that is normally distributed (in either source or binary 162 | form) with the major components (compiler, kernel, and so on) of the 163 | operating system on which the executable runs, unless that component 164 | itself accompanies the executable. 165 | 166 | If distribution of executable or object code is made by offering 167 | access to copy from a designated place, then offering equivalent 168 | access to copy the source code from the same place counts as 169 | distribution of the source code, even though third parties are not 170 | compelled to copy the source along with the object code. 171 | 172 | 4. You may not copy, modify, sublicense, or distribute the Program 173 | except as expressly provided under this License. Any attempt 174 | otherwise to copy, modify, sublicense or distribute the Program is 175 | void, and will automatically terminate your rights under this License. 176 | However, parties who have received copies, or rights, from you under 177 | this License will not have their licenses terminated so long as such 178 | parties remain in full compliance. 179 | 180 | 5. You are not required to accept this License, since you have not 181 | signed it. However, nothing else grants you permission to modify or 182 | distribute the Program or its derivative works. These actions are 183 | prohibited by law if you do not accept this License. Therefore, by 184 | modifying or distributing the Program (or any work based on the 185 | Program), you indicate your acceptance of this License to do so, and 186 | all its terms and conditions for copying, distributing or modifying 187 | the Program or works based on it. 188 | 189 | 6. Each time you redistribute the Program (or any work based on the 190 | Program), the recipient automatically receives a license from the 191 | original licensor to copy, distribute or modify the Program subject to 192 | these terms and conditions. You may not impose any further 193 | restrictions on the recipients' exercise of the rights granted herein. 194 | You are not responsible for enforcing compliance by third parties to 195 | this License. 196 | 197 | 7. If, as a consequence of a court judgment or allegation of patent 198 | infringement or for any other reason (not limited to patent issues), 199 | conditions are imposed on you (whether by court order, agreement or 200 | otherwise) that contradict the conditions of this License, they do not 201 | excuse you from the conditions of this License. If you cannot 202 | distribute so as to satisfy simultaneously your obligations under this 203 | License and any other pertinent obligations, then as a consequence you 204 | may not distribute the Program at all. For example, if a patent 205 | license would not permit royalty-free redistribution of the Program by 206 | all those who receive copies directly or indirectly through you, then 207 | the only way you could satisfy both it and this License would be to 208 | refrain entirely from distribution of the Program. 209 | 210 | If any portion of this section is held invalid or unenforceable under 211 | any particular circumstance, the balance of the section is intended to 212 | apply and the section as a whole is intended to apply in other 213 | circumstances. 214 | 215 | It is not the purpose of this section to induce you to infringe any 216 | patents or other property right claims or to contest validity of any 217 | such claims; this section has the sole purpose of protecting the 218 | integrity of the free software distribution system, which is 219 | implemented by public license practices. Many people have made 220 | generous contributions to the wide range of software distributed 221 | through that system in reliance on consistent application of that 222 | system; it is up to the author/donor to decide if he or she is willing 223 | to distribute software through any other system and a licensee cannot 224 | impose that choice. 225 | 226 | This section is intended to make thoroughly clear what is believed to 227 | be a consequence of the rest of this License. 228 | 229 | 8. If the distribution and/or use of the Program is restricted in 230 | certain countries either by patents or by copyrighted interfaces, the 231 | original copyright holder who places the Program under this License 232 | may add an explicit geographical distribution limitation excluding 233 | those countries, so that distribution is permitted only in or among 234 | countries not thus excluded. In such case, this License incorporates 235 | the limitation as if written in the body of this License. 236 | 237 | 9. The Free Software Foundation may publish revised and/or new versions 238 | of the General Public License from time to time. Such new versions will 239 | be similar in spirit to the present version, but may differ in detail to 240 | address new problems or concerns. 241 | 242 | Each version is given a distinguishing version number. If the Program 243 | specifies a version number of this License which applies to it and "any 244 | later version", you have the option of following the terms and conditions 245 | either of that version or of any later version published by the Free 246 | Software Foundation. If the Program does not specify a version number of 247 | this License, you may choose any version ever published by the Free Software 248 | Foundation. 249 | 250 | 10. If you wish to incorporate parts of the Program into other free 251 | programs whose distribution conditions are different, write to the author 252 | to ask for permission. For software which is copyrighted by the Free 253 | Software Foundation, write to the Free Software Foundation; we sometimes 254 | make exceptions for this. Our decision will be guided by the two goals 255 | of preserving the free status of all derivatives of our free software and 256 | of promoting the sharing and reuse of software generally. 257 | 258 | NO WARRANTY 259 | 260 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 261 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 263 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 264 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 265 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 266 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 267 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 268 | REPAIR OR CORRECTION. 269 | 270 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 272 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 273 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 274 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 275 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 276 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 277 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 278 | POSSIBILITY OF SUCH DAMAGES. 279 | 280 | END OF TERMS AND CONDITIONS --------------------------------------------------------------------------------