GitHub-Mirror/G940LEDControl
1
0
Fork 0
mirror of synced 2024-11-22 01:53:50 +00:00
Code Issues Projects Releases Wiki Activity

- Forgot to commit the release version

Browse Source 
- Added nav/strobe/beacon lights, flaps status, exit door status and master switch states
This commit is contained in:
Mark van Renswoude 2012-08-13 11:58:54 +00:00
parent c2fd94d9cd
commit b01ca9b9e7
9 changed files with 1438 additions and 321 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
G940LEDControl/Forms/ButtonSelectFrm.dfm Normal file
View File

@ -0,0 +1,94 @@
object ButtonSelectForm: TButtonSelectForm
Left = 0
Top = 0
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'Select joystick button'
ClientHeight = 134
ClientWidth = 484
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poMainFormCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
DesignSize = (
484
134)
PixelsPerInch = 96
TextHeight = 13
object lblDevice: TLabel
Left = 8
Top = 11
Width = 42
Height = 13
Caption = 'Joystick:'
end
object lblStatus: TLabel
Left = 80
Top = 48
Width = 396
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: acquired status]'
ExplicitWidth = 296
end
object lblButton: TLabel
Left = 8
Top = 70
Width = 36
Height = 13
Caption = 'Button:'
end
object cmbDevice: TComboBox
Left = 80
Top = 8
Width = 396
Height = 21
Style = csDropDownList
Anchors = [akLeft, akTop, akRight]
DropDownCount = 20
TabOrder = 0
OnChange = cmbDeviceChange
end
object btnOK: TButton
Left = 320
Top = 101
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 1
ExplicitTop = 94
end
object btnCancel: TButton
Left = 401
Top = 101
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 2
ExplicitTop = 94
end
object edtButton: TEdit
Left = 80
Top = 67
Width = 396
Height = 21
Anchors = [akLeft, akTop, akRight]
Color = clBtnFace
ReadOnly = True
TabOrder = 3
end
end

441
G940LEDControl/Forms/ButtonSelectFrm.pas Normal file
View File

@ -0,0 +1,441 @@
unit ButtonSelectFrm;
interface
uses
Classes,
Controls,
Forms,
StdCtrls,
SyncObjs,
DirectInput,
OtlComm,
OtlEventMonitor,
OtlTaskControl;
type
TDeviceType = (dtGeneric, dtG940Joystick, dtG940Throttle);
TButtonSelectForm = class(TForm)
lblDevice: TLabel;
cmbDevice: TComboBox;
btnOK: TButton;
btnCancel: TButton;
lblStatus: TLabel;
lblButton: TLabel;
edtButton: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure cmbDeviceChange(Sender: TObject);
private
FDirectInput: IDirectInput8;
FDeviceIndex: Integer;
FDevice: IDirectInputDevice8;
FDeviceType: TDeviceType;
FEventMonitor: TOmniEventMonitor;
FEventTask: IOmniTaskControl;
FDeviceEvent: TEvent;
FButtons: array[0..31] of Boolean;
FLastButtonIndex: Integer;
FLastButtonText: string;
function GetDeviceName: string;
protected
procedure AcquireDevice;
procedure DoAcquireDevice;
procedure ReleaseDevice;
procedure CheckDeviceState;
procedure ButtonPressed(AButtonIndex: Integer);
procedure SetAcquiredStatus(AAcquired: Boolean; const AMessage: string);
procedure TaskMessage(const ATask: IOmniTaskControl; const AMessage: TOmniMessage);
procedure TaskTerminated(const ATask: IOmniTaskControl);
property DirectInput: IDirectInput8 read FDirectInput;
property DeviceIndex: Integer read FDeviceIndex;
property Device: IDirectInputDevice8 read FDevice;
property DeviceType: TDeviceType read FDeviceType;
property DeviceName: string read GetDeviceName;
public
class function Execute(var ADeviceGUID: TGUID; var AButton: Integer; out ADisplayText: string): Boolean;
end;
implementation
uses
Graphics,
SysUtils,
Windows,
LogiJoystickDLL;
type
TDeviceInfo = class(TObject)
private
FInstanceGUID: TGUID;
FProductGUID: TGUID;
public
property InstanceGUID: TGUID read FInstanceGUID write FInstanceGUID;
property ProductGUID: TGUID read FProductGUID write FProductGUID;
end;
TEventTask = class(TOmniWorker)
private
FEvent: THandle;
protected
function Initialize: Boolean; override;
procedure EventSignaled;
public
constructor Create(AEvent: THandle);
end;
const
MSG_EVENT_SIGNALED = 1;
{$R *.dfm}
function EnumDevicesProc(var lpddi: TDIDeviceInstanceW; pvRef: Pointer): BOOL; stdcall;
var
items: TStrings;
info: TDeviceInfo;
begin
items := TStrings(pvRef);
info := TDeviceInfo.Create;
info.InstanceGUID := lpddi.guidInstance;
info.ProductGUID := lpddi.guidProduct;
items.AddObject(String(lpddi.tszProductName), info);
Result := True;
end;
{ TButtonSelectForm }
class function TButtonSelectForm.Execute(var ADeviceGUID: TGUID; var AButton: Integer;
out ADisplayText: string): Boolean;
begin
with Self.Create(Application) do
try
Result := (ShowModal = mrOk);
if Result then
begin
AButton := FLastButtonIndex;
ADisplayText := FLastButtonText;
end;
finally
Free;
end;
end;
procedure TButtonSelectForm.FormCreate(Sender: TObject);
begin
FEventMonitor := TOmniEventMonitor.Create(Self);
FEventMonitor.OnTaskMessage := TaskMessage;
FEventMonitor.OnTaskTerminated := TaskTerminated;
FDeviceEvent := TEvent.Create(nil, False, False, '');
lblStatus.Caption := '';
FDeviceIndex := -1;
end;
procedure TButtonSelectForm.FormDestroy(Sender: TObject);
var
itemIndex: Integer;
begin
ReleaseDevice;
for itemIndex := Pred(cmbDevice.Items.Count) downto 0 do
TDeviceInfo(cmbDevice.Items.Objects[itemIndex]).Free;
FreeAndNil(FDeviceEvent);
end;
procedure TButtonSelectForm.FormShow(Sender: TObject);
begin
Screen.Cursor := crHourGlass;
try
Self.Show;
Self.Update;
if DirectInput8Create(SysInit.HInstance, DIRECTINPUT_VERSION, IDirectInput8, FDirectInput, nil) <> S_OK then
raise Exception.Create('Failed to initialize DirectInput');
cmbDevice.Items.BeginUpdate;
try
cmbDevice.Items.Clear;
DirectInput.EnumDevices(DI8DEVCLASS_GAMECTRL,
EnumDevicesProc,
Pointer(cmbDevice.Items),
DIEDFL_ATTACHEDONLY);
// todo set ItemIndex to previous productGUID
cmbDevice.ItemIndex := 0;
finally
cmbDevice.Items.EndUpdate;
end;
if cmbDevice.ItemIndex > -1 then
AcquireDevice;
finally
Screen.Cursor := crDefault;
end;
end;
procedure TButtonSelectForm.cmbDeviceChange(Sender: TObject);
begin
AcquireDevice;
end;
procedure TButtonSelectForm.AcquireDevice;
var
info: TDeviceInfo;
vendorID: Word;
productID: Word;
begin
if cmbDevice.ItemIndex <> DeviceIndex then
begin
ReleaseDevice;
if cmbDevice.ItemIndex > -1 then
begin
info := TDeviceInfo(cmbDevice.Items.Objects[cmbDevice.ItemIndex]);
FDeviceType := dtGeneric;
vendorID := LOWORD(info.ProductGUID.D1);
productID := HIWORD(info.ProductGUID.D1);
if vendorID = VENDOR_LOGITECH then
begin
case productID of
PRODUCT_G940_JOYSTICK: FDeviceType := dtG940Joystick;
PRODUCT_G940_THROTTLE: FDeviceType := dtG940Throttle;
end;
end;
if DirectInput.CreateDevice(info.InstanceGUID, FDevice, nil) = S_OK then
begin
Device.SetCooperativeLevel(0, DISCL_NONEXCLUSIVE or DISCL_BACKGROUND);
Device.SetDataFormat(c_dfDIJoystick);
DoAcquireDevice;
end else
begin
ReleaseDevice;
SetAcquiredStatus(False, 'Could not connect to device (CreateDevice failed)');
end;
end;
end;
end;
procedure TButtonSelectForm.DoAcquireDevice;
begin
FDeviceEvent.ResetEvent;
Device.SetEventNotification(FDeviceEvent.Handle);
if Device.Acquire = DI_OK then
begin
FDeviceIndex := cmbDevice.ItemIndex;
SetAcquiredStatus(True, 'Press a button on the joystick to select it');
FEventTask := FEventMonitor.Monitor(CreateTask(TEventTask.Create(FDeviceEvent.Handle))).Run;
end else
begin
ReleaseDevice;
SetAcquiredStatus(False, 'Could not connect to device (acquire failed)');
end;
end;
procedure TButtonSelectForm.ReleaseDevice;
begin
if Assigned(Device) then
begin
Device.SetEventNotification(0);
FDevice := nil;
end;
FDeviceIndex := -1;
FDeviceType := dtGeneric;
if Assigned(FEventTask) then
begin
FEventTask.Terminate;
FEventTask := nil;
end;
FillChar(FButtons, SizeOf(FButtons), 0);
edtButton.Text := '';
FLastButtonIndex := -1;
FLastButtonText := '';
end;
procedure TButtonSelectForm.CheckDeviceState;
var
state: DIJOYSTATE;
status: Integer;
buttonIndex: Integer;
down: Boolean;
begin
FillChar(state, SizeOf(state), 0);
status := Device.GetDeviceState(SizeOf(state), @state);
case status of
DI_OK:
begin
for buttonIndex := Low(state.rgbButtons) to High(state.rgbButtons) do
begin
down := ((state.rgbButtons[buttonIndex] and $80) <> 0);
if down and (not FButtons[buttonIndex]) then
ButtonPressed(buttonIndex);
FButtons[buttonIndex] := down;
end;
end;
DIERR_INPUTLOST,
DIERR_NOTACQUIRED:
DoAcquireDevice;
end;
end;
procedure TButtonSelectForm.ButtonPressed(AButtonIndex: Integer);
const
G940_JOYSTICK_BUTTONS: array[0..8] of string =
(
'Trigger',
'Fire',
'S1',
'S2',
'S3',
'S4',
'S5',
'Mini Button',
'Trigger Button'
);
G940_THROTTLE_BUTTONS: array[0..11] of string =
(
'T1',
'T2',
'T3',
'T4',
'P1',
'P2',
'P3',
'P4',
'P5',
'P6',
'P7',
'P8'
);
var
buttonText: string;
begin
buttonText := Format('Button #%d', [Succ(AButtonIndex)]);
case DeviceType of
dtG940Joystick:
if AButtonIndex in [Low(G940_JOYSTICK_BUTTONS)..High(G940_JOYSTICK_BUTTONS)] then
buttonText := G940_JOYSTICK_BUTTONS[AButtonIndex];
dtG940Throttle:
if AButtonIndex in [Low(G940_THROTTLE_BUTTONS)..High(G940_THROTTLE_BUTTONS)] then
buttonText := G940_THROTTLE_BUTTONS[AButtonIndex];
end;
edtButton.Text := buttonText;
FLastButtonIndex := AButtonIndex;
FLastButtonText := Format('%s on %s', [buttonText, GetDeviceName]);
end;
procedure TButtonSelectForm.SetAcquiredStatus(AAcquired: Boolean; const AMessage: string);
begin
if AAcquired then
lblStatus.Font.Color := clGreen
else
lblStatus.Font.Color := clMaroon;
lblStatus.Caption := AMessage;
end;
procedure TButtonSelectForm.TaskMessage(const ATask: IOmniTaskControl; const AMessage: TOmniMessage);
begin
if AMessage.MsgID = MSG_EVENT_SIGNALED then
CheckDeviceState;
end;
procedure TButtonSelectForm.TaskTerminated(const ATask: IOmniTaskControl);
begin
if ATask = FEventTask then
FEventTask := nil;
end;
function TButtonSelectForm.GetDeviceName: string;
begin
Result := '';
if cmbDevice.ItemIndex > -1 then
Result := cmbDevice.Items[cmbDevice.ItemIndex];
end;
{ TEventTask }
constructor TEventTask.Create(AEvent: THandle);
begin
inherited Create;
FEvent := AEvent;
end;
function TEventTask.Initialize: Boolean;
begin
Result := inherited Initialize;
Task.RegisterWaitObject(FEvent, EventSignaled);
end;
procedure TEventTask.EventSignaled;
begin
Task.Comm.Send(MSG_EVENT_SIGNALED);
end;
end.

621
G940LEDControl/Forms/MainFrm.dfm
View File

@ -4,7 +4,7 @@ object MainForm: TMainForm
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'G940 LED Control'
ClientHeight = 461
ClientHeight = 513
ClientWidth = 465
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
@ -23,7 +23,7 @@ object MainForm: TMainForm
Left = 8
Top = 80
Width = 449
Height = 373
Height = 425
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
@ -33,188 +33,6 @@ object MainForm: TMainForm
TabOrder = 1
object tsFSX: TTabSheet
Caption = 'Flight Simulator X'
object gbFSXButtons: TGroupBox
AlignWithMargins = True
Left = 6
Top = 75
Width = 429
Height = 251
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
Align = alTop
Caption = ' Button configuration '
TabOrder = 1
DesignSize = (
429
251)
object lblFSXP1: TLabel
Left = 12
Top = 27
Width = 12
Height = 13
Caption = 'P1'
end
object lblFSXP2: TLabel
Left = 12
Top = 54
Width = 12
Height = 13
Caption = 'P2'
end
object lblFSXP3: TLabel
Left = 12
Top = 81
Width = 12
Height = 13
Caption = 'P3'
end
object lblFSXP4: TLabel
Left = 12
Top = 108
Width = 12
Height = 13
Caption = 'P4'
end
object lblFSXP5: TLabel
Left = 12
Top = 135
Width = 12
Height = 13
Caption = 'P5'
end
object lblFSXP6: TLabel
Left = 12
Top = 162
Width = 12
Height = 13
Caption = 'P6'
end
object lblFSXP7: TLabel
Left = 12
Top = 189
Width = 12
Height = 13
Caption = 'P7'
end
object lblFSXP8: TLabel
Left = 12
Top = 216
Width = 12
Height = 13
Caption = 'P8'
end
object cmbFSXP1: TComboBoxEx
Left = 69
Top = 24
Width = 348
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 0
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP2: TComboBoxEx
Tag = 1
Left = 69
Top = 50
Width = 348
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 1
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP3: TComboBoxEx
Tag = 2
Left = 69
Top = 78
Width = 348
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 2
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP4: TComboBoxEx
Tag = 3
Left = 69
Top = 105
Width = 348
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 3
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP5: TComboBoxEx
Tag = 4
Left = 69
Top = 131
Width = 348
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 4
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP6: TComboBoxEx
Tag = 5
Left = 69
Top = 159
Width = 348
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 5
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP7: TComboBoxEx
Tag = 6
Left = 69
Top = 186
Width = 348
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 6
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP8: TComboBoxEx
Tag = 7
Left = 69
Top = 213
Width = 348
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 7
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
end
object gbFSXConnection: TGroupBox
AlignWithMargins = True
Left = 6
@ -255,6 +73,441 @@ object MainForm: TMainForm
OnClick = btnFSXDisconnectClick
end
end
object pcFSXOptions: TPageControl
AlignWithMargins = True
Left = 6
Top = 75
Width = 429
Height = 316
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
ActivePage = tsFSXLEDButtons
Align = alClient
TabOrder = 1
object tsFSXLEDButtons: TTabSheet
Caption = 'LED Buttons'
object gbFSXButtons: TGroupBox
AlignWithMargins = True
Left = 6
Top = 6
Width = 409
Height = 251
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
Align = alTop
Caption = ' Button configuration '
TabOrder = 0
DesignSize = (
409
251)
object lblFSXP1: TLabel
Left = 12
Top = 27
Width = 12
Height = 13
Caption = 'P1'
end
object lblFSXP2: TLabel
Left = 12
Top = 54
Width = 12
Height = 13
Caption = 'P2'
end
object lblFSXP3: TLabel
Left = 12
Top = 81
Width = 12
Height = 13
Caption = 'P3'
end
object lblFSXP4: TLabel
Left = 12
Top = 108
Width = 12
Height = 13
Caption = 'P4'
end
object lblFSXP5: TLabel
Left = 12
Top = 135
Width = 12
Height = 13
Caption = 'P5'
end
object lblFSXP6: TLabel
Left = 12
Top = 162
Width = 12
Height = 13
Caption = 'P6'
end
object lblFSXP7: TLabel
Left = 12
Top = 189
Width = 12
Height = 13
Caption = 'P7'
end
object lblFSXP8: TLabel
Left = 12
Top = 216
Width = 12
Height = 13
Caption = 'P8'
end
object cmbFSXP1: TComboBoxEx
Left = 69
Top = 24
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 0
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP2: TComboBoxEx
Tag = 1
Left = 69
Top = 50
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 1
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP3: TComboBoxEx
Tag = 2
Left = 69
Top = 78
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 2
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP4: TComboBoxEx
Tag = 3
Left = 69
Top = 105
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 3
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP5: TComboBoxEx
Tag = 4
Left = 69
Top = 131
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 4
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP6: TComboBoxEx
Tag = 5
Left = 69
Top = 159
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 5
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP7: TComboBoxEx
Tag = 6
Left = 69
Top = 186
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 6
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP8: TComboBoxEx
Tag = 7
Left = 69
Top = 213
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 7
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
end
end
object tsFSXExtra: TTabSheet
Caption = 'Extra'
ImageIndex = 1
TabVisible = False
object GroupBox1: TGroupBox
AlignWithMargins = True
Left = 6
Top = 6
Width = 409
Height = 171
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 0
Align = alTop
Caption = ' Zoom '
TabOrder = 0
object lblFSXToggleZoomButton: TLabel
Left = 57
Top = 56
Width = 77
Height = 13
Caption = 'Joystick button:'
end
object lblFSXZoomDepressed: TLabel
Left = 59
Top = 111
Width = 151
Height = 13
Caption = 'Zoom level (button depressed):'
end
object lblFSXZoomPressed: TLabel
Left = 59
Top = 142
Width = 139
Height = 13
Caption = 'Zoom level (button pressed):'
end
object lblFSXToggleZoomButtonName: TLabel
Left = 57
Top = 75
Width = 305
Height = 13
AutoSize = False
Caption = '[runtime]'
EllipsisPosition = epEndEllipsis
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object cbFSXToggleZoom: TCheckBox
Left = 16
Top = 24
Width = 161
Height = 17
Caption = ' Toggle zoom level'
Checked = True
State = cbChecked
TabOrder = 0
end
object btnFSXToggleZoom: TButton
Left = 368
Top = 70
Width = 34
Height = 25
Caption = '...'
TabOrder = 1
OnClick = btnFSXToggleZoomClick
end
object cmbFSXZoomDepressed: TComboBox
Left = 288
Top = 106
Width = 114
Height = 21
Style = csDropDownList
DropDownCount = 20
ItemIndex = 5
TabOrder = 2
Text = '80%'
Items.Strings = (
'30%'
'40%'
'50%'
'60%'
'70%'
'80%'
'90%'
'100%'
'110%'
'120%'
'130%'
'140%'
'150%'
'175%'
'200%'
'250%'
'300%'
'400%')
end
object cmbFSXZoomPressed: TComboBox
Left = 288
Top = 133
Width = 114
Height = 21
Style = csDropDownList
DropDownCount = 20
ItemIndex = 16
TabOrder = 3
Text = '300%'
Items.Strings = (
'30%'
'40%'
'50%'
'60%'
'70%'
'80%'
'90%'
'100%'
'110%'
'120%'
'130%'
'140%'
'150%'
'175%'
'200%'
'250%'
'300%'
'400%')
end
end
object GroupBox2: TGroupBox
AlignWithMargins = True
Left = 6
Top = 183
Width = 409
Height = 98
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 0
Align = alTop
Caption = ' Engine thrust match '
TabOrder = 1
object TLabel
Left = 104
Top = 40
Width = 201
Height = 13
Caption = 'Sorry, configuration not implemented yet!'
end
object TLabel
Left = 120
Top = 59
Width = 160
Height = 13
Caption = 'Engine 1 links to 4, engine 2 to 3.'
end
end
end
end
end
object tsAbout: TTabSheet
Caption = 'About'
ImageIndex = 1
object lblVersionCaption: TLabel
Left = 16
Top = 67
Width = 39
Height = 13
Caption = 'Version:'
end
object lblVersion: TLabel
Left = 75
Top = 67
Width = 45
Height = 13
Caption = 'lblVersion'
end
object Label1: TLabel
Left = 16
Top = 16
Width = 96
Height = 13
Caption = 'G940 LED Control'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object Label2: TLabel
Left = 16
Top = 35
Width = 95
Height = 13
Caption = #169' 2011 X'#178'Software'
end
object lblWebsite: TLabel
Left = 16
Top = 112
Width = 43
Height = 13
Caption = 'Website:'
end
object lblEmail: TLabel
Left = 16
Top = 135
Width = 32
Height = 13
Caption = 'E-mail:'
end
object lblWebsiteLink: TLinkLabel
Left = 75
Top = 111
Width = 143
Height = 17
Caption =
'<a href="http://g940.x2software.net/">http://g940.x2software.net' +
'/</a>'
TabOrder = 0
OnLinkClick = lblLinkLinkClick
end
object lblEmailLink: TLinkLabel
Left = 75
Top = 134
Width = 126
Height = 17
Caption =
'<a href="mailto:support@x2software.net">support@x2software.net</' +
'a>'
TabOrder = 1
OnLinkClick = lblLinkLinkClick
end
end
end
object pnlG940: TPanel

162
G940LEDControl/Forms/MainFrm.pas
View File

@ -57,28 +57,58 @@ type
btnFSXConnect: TButton;
btnFSXDisconnect: TButton;
lblFSXLocal: TLabel;
pcFSXOptions: TPageControl;
tsFSXLEDButtons: TTabSheet;
tsFSXExtra: TTabSheet;
GroupBox1: TGroupBox;
cbFSXToggleZoom: TCheckBox;
lblFSXToggleZoomButton: TLabel;
lblFSXZoomDepressed: TLabel;
lblFSXZoomPressed: TLabel;
lblFSXToggleZoomButtonName: TLabel;
btnFSXToggleZoom: TButton;
cmbFSXZoomDepressed: TComboBox;
cmbFSXZoomPressed: TComboBox;
GroupBox2: TGroupBox;
tsAbout: TTabSheet;
lblVersionCaption: TLabel;
lblVersion: TLabel;
Label1: TLabel;
Label2: TLabel;
lblWebsiteLink: TLinkLabel;
lblEmailLink: TLinkLabel;
lblWebsite: TLabel;
lblEmail: TLabel;
procedure FormCreate(Sender: TObject);
procedure btnRetryClick(Sender: TObject);
procedure btnFSXConnectClick(Sender: TObject);
procedure btnFSXDisconnectClick(Sender: TObject);
procedure btnFSXToggleZoomClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FunctionComboBoxChange(Sender: TObject);
procedure lblLinkLinkClick(Sender: TObject; const Link: string;
LinkType: TSysLinkType);
private
FEventMonitor: TOmniEventMonitor;
FStateConsumerTask: IOmniTaskControl;
FFSXComboBoxes: TComboBoxArray;
FFSXToggleZoomDeviceGUID: TGUID;
FFSXToggleZoomButtonIndex: Integer;
protected
procedure LoadFunctions(AProviderClass: TLEDStateProviderClass; AComboBoxes: TComboBoxArray);
procedure SetFunctions(AComboBoxes: TComboBoxArray);
procedure ReadFunctions(AReader: IX2PersistReader; AComboBoxes: TComboBoxArray);
procedure ReadFSXExtra(AReader: IX2PersistReader);
procedure WriteFunctions(AWriter: IX2PersistWriter; AComboBoxes: TComboBoxArray);
procedure WriteFSXExtra(AWriter: IX2PersistWriter);
procedure LoadDefaultProfile;
procedure SaveDefaultProfile;
procedure SetDeviceState(const AMessage: string; AFound: Boolean);
procedure SetFSXToggleZoomButton(const ADeviceGUID: TGUID; AButtonIndex: Integer; const ADisplayText: string);
procedure InitializeStateProvider(AProviderClass: TLEDStateProviderClass);
procedure FinalizeStateProvider;
@ -102,12 +132,15 @@ implementation
uses
ComObj,
Dialogs,
ShellAPI,
SysUtils,
OtlCommon,
OtlTask,
X2UtApp,
X2UtPersistRegistry,
ButtonSelectFrm,
FSXLEDStateProvider,
G940LEDStateConsumer;
@ -147,8 +180,14 @@ type
procedure TMainForm.FormCreate(Sender: TObject);
var
consumer: IOmniWorker;
begin
lblVersion.Caption := App.Version.FormatVersion(False);
pcConnections.ActivePageIndex := 0;
pcFSXOptions.ActivePageIndex := 0;
lblFSXToggleZoomButtonName.Caption := '';
FEventMonitor := TOmniEventMonitor.Create(Self);
consumer := TG940LEDStateConsumer.Create;
@ -193,53 +232,12 @@ begin
end;
(*
procedure TMainForm.tmrG940InitTimer(Sender: TObject);
procedure TurnOn(ALEDPosition: Integer);
begin
FInitGreenState := FInitGreenState or (1 shl Pred(ALEDPosition));
end;
procedure TurnOff(ALEDPosition: Integer);
begin
FInitGreenState := FInitGreenState and not (1 shl Pred(ALEDPosition));
FInitRedState := FInitRedState and not (1 shl Pred(ALEDPosition));
end;
procedure TMainForm.SetFSXToggleZoomButton(const ADeviceGUID: TGUID; AButtonIndex: Integer; const ADisplayText: string);
begin
if not Assigned(ThrottleDevice) then
begin
tmrG940Init.Enabled := False;
exit;
end;
if FInitCounter = 0 then
GetLEDs(ThrottleDevice, FInitRedState, FInitGreenState);
Inc(FInitCounter);
if FInitCounter > 8 then
begin
tmrG940Init.Enabled := False;
exit;
end;
{ Clear all the LEDs in a right-to-left pattern for the top row and a
left-to-right pattern for the bottom row. Then light only the green LEDs
in the same pattern. }
if FInitCounter in [1..4] then
begin
TurnOff(5 - FInitCounter);
TurnOff(4 + FInitCounter);
end else
begin
TurnOn(5 - (FInitCounter - 4));
TurnOn(4 + (FInitCounter - 4));
end;
SetLEDs(ThrottleDevice, FInitRedState, FInitGreenState);
FFSXToggleZoomDeviceGUID := ADeviceGUID;
FFSXToggleZoomButtonIndex := AButtonIndex;
lblFSXToggleZoomButtonName.Caption := ADisplayText;
end;
*)
procedure TMainForm.LoadFunctions(AProviderClass: TLEDStateProviderClass; AComboBoxes: TComboBoxArray);
@ -304,6 +302,31 @@ begin
end;
procedure TMainForm.ReadFSXExtra(AReader: IX2PersistReader);
var
deviceGUID: string;
buttonIndex: Integer;
displayText: string;
begin
if AReader.BeginSection(SECTION_FSX) then
try
if AReader.ReadString('ToggleZoomDeviceGUID', deviceGUID) and
AReader.ReadInteger('ToggleZoomButtonIndex', buttonIndex) and
AReader.ReadString('ToggleZoomDisplayText', displayText) then
begin
try
SetFSXToggleZoomButton(StringToGUID(deviceGUID), buttonIndex, displayText);
except
on E:EConvertError do;
end;
end;
finally
AReader.EndSection;
end;
end;
procedure TMainForm.WriteFunctions(AWriter: IX2PersistWriter; AComboBoxes: TComboBoxArray);
var
comboBox: TComboBoxEx;
@ -326,9 +349,24 @@ begin
end;
procedure TMainForm.WriteFSXExtra(AWriter: IX2PersistWriter);
begin
if AWriter.BeginSection(SECTION_FSX) then
try
AWriter.WriteString('ToggleZoomDeviceGUID', GUIDToString(FFSXToggleZoomDeviceGUID));
AWriter.WriteInteger('ToggleZoomButtonIndex', FFSXToggleZoomButtonIndex);
AWriter.WriteString('ToggleZoomDisplayText', lblFSXToggleZoomButtonName.Caption);
// ToDo pressed / depressed levels
finally
AWriter.EndSection;
end;
end;
procedure TMainForm.LoadDefaultProfile;
var
registryReader: TX2UtPersistRegistry;
reader: IX2PersistReader;
begin
registryReader := TX2UtPersistRegistry.Create;
@ -336,7 +374,10 @@ begin
registryReader.RootKey := HKEY_CURRENT_USER;
registryReader.Key := KEY_DEFAULTPROFILE;
ReadFunctions(registryReader.CreateReader, FFSXComboBoxes);
reader := registryReader.CreateReader;
ReadFunctions(reader, FFSXComboBoxes);
ReadFSXExtra(reader);
finally
FreeAndNil(registryReader);
end;
@ -346,6 +387,7 @@ end;
procedure TMainForm.SaveDefaultProfile;
var
registryWriter: TX2UtPersistRegistry;
writer: IX2PersistWriter;
begin
registryWriter := TX2UtPersistRegistry.Create;
@ -353,7 +395,9 @@ begin
registryWriter.RootKey := HKEY_CURRENT_USER;
registryWriter.Key := KEY_DEFAULTPROFILE;
WriteFunctions(registryWriter.CreateWriter, FFSXComboBoxes);
writer := registryWriter.CreateWriter;
WriteFunctions(writer, FFSXComboBoxes);
WriteFSXExtra(writer);
finally
FreeAndNil(registryWriter);
end;
@ -470,6 +514,21 @@ begin
end;
procedure TMainForm.btnFSXToggleZoomClick(Sender: TObject);
var
deviceGUID: TGUID;
button: Integer;
displayText: string;
begin
FillChar(deviceGUID, SizeOf(deviceGUID), 0);
button := -1;
if TButtonSelectForm.Execute(deviceGUID, button, displayText) then
SetFSXToggleZoomButton(deviceGUID, button, displayText);
end;
procedure TMainForm.btnRetryClick(Sender: TObject);
begin
btnRetry.Visible := False;
@ -490,6 +549,13 @@ begin
end;
end;
procedure TMainForm.lblLinkLinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType);
begin
ShellExecute(Self.Handle, 'open', PChar(Link), nil, nil, SW_SHOWNORMAL);
end;
{ TComboBoxFunctionConsumer }
constructor TComboBoxFunctionConsumer.Create(AComboBox: TComboBoxEx);
begin

3
G940LEDControl/G940LEDControl.dpr
View File

@ -9,7 +9,8 @@ uses
LEDFunctionMap in 'Units\LEDFunctionMap.pas',
G940LEDStateConsumer in 'Units\G940LEDStateConsumer.pas',
LogiJoystickDLL in '..\Shared\LogiJoystickDLL.pas',
SimConnect in '..\Shared\SimConnect.pas';
SimConnect in '..\Shared\SimConnect.pas',
ButtonSelectFrm in 'Forms\ButtonSelectFrm.pas' {ButtonSelectForm};
{$R *.res}

38
G940LEDControl/G940LEDControl.dproj
View File

@ -8,7 +8,7 @@
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>13.4</ProjectVersion>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Config Condition="'$(Config)'==''">Release</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
@ -31,11 +31,23 @@
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
@ -46,12 +58,14 @@
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_PACKAGE_NO_LINK>false</DCC_PACKAGE_NO_LINK>
<DCC_UNIT_PLATFORM>false</DCC_UNIT_PLATFORM>
<DCC_SYMBOL_PLATFORM>false</DCC_SYMBOL_PLATFORM>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<Icon_MainIcon>G940LEDControl_Icon.ico</Icon_MainIcon>
<DCC_Namespace>Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<Version>7.0</Version>
@ -60,6 +74,10 @@
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<Version>7.0</Version>
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
@ -74,6 +92,14 @@
<DCC_SYMBOL_PLATFORM>False</DCC_SYMBOL_PLATFORM>
<DCC_UNIT_PLATFORM>False</DCC_UNIT_PLATFORM>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<VerInfo_MinorVer>2</VerInfo_MinorVer>
<VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=0.2.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=0.2;Comments=</VerInfo_Keys>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<Manifest_File>F:\Components\X2Utils\Resources\VistaManAsInvoker.manifest</Manifest_File>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
@ -115,9 +141,7 @@
<Source Name="MainSource">G940LEDControl.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="P:\algemeen\bin\D2007\wpViewPDF_D2007.bpl">WPViewPDF - PDFViewClass</Excluded_Packages>
<Excluded_Packages Name="P:\algemeen\bin\D2007\madExceptVcl_.bpl">madExceptVcl 2.0c - www.madshi.net</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi11\dclcxPivotGridOLAPD11.bpl">ExpressPivotGrid 2 OLAP by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxPivotGridOLAPD16.bpl">ExpressPivotGrid 2 OLAP by Developer Express Inc.</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Platforms>
@ -142,6 +166,10 @@
<DCCReference Include="Units\G940LEDStateConsumer.pas"/>
<DCCReference Include="..\Shared\LogiJoystickDLL.pas"/>
<DCCReference Include="..\Shared\SimConnect.pas"/>
<DCCReference Include="Forms\ButtonSelectFrm.pas">
<Form>ButtonSelectForm</Form>
<FormType>dfm</FormType>
</DCCReference>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>

395
G940LEDControl/Units/FSXLEDStateProvider.pas
View File

@ -3,6 +3,7 @@ unit FSXLEDStateProvider;
interface
uses
Classes,
Messages,
SyncObjs,
Windows,
@ -13,30 +14,50 @@ uses
const
{ Note: do not change these values, the config demands it! }
FUNCTION_FSX_GEAR = FUNCTION_PROVIDER_OFFSET + 1;
FUNCTION_FSX_LANDINGLIGHTS = FUNCTION_PROVIDER_OFFSET + 2;
FUNCTION_FSX_INSTRUMENTLIGHTS = FUNCTION_PROVIDER_OFFSET + 3;
FUNCTION_FSX_PARKINGBRAKE = FUNCTION_PROVIDER_OFFSET + 4;
FUNCTION_FSX_ENGINE = FUNCTION_PROVIDER_OFFSET + 5;
FUNCTION_FSX_EXITDOOR = FUNCTION_PROVIDER_OFFSET + 6;
FUNCTION_FSX_STROBELIGHTS = FUNCTION_PROVIDER_OFFSET + 7;
FUNCTION_FSX_NAVLIGHTS = FUNCTION_PROVIDER_OFFSET + 8;
FUNCTION_FSX_BEACONLIGHTS = FUNCTION_PROVIDER_OFFSET + 9;
FUNCTION_FSX_FLAPS = FUNCTION_PROVIDER_OFFSET + 10;
FUNCTION_FSX_BATTERYMASTER = FUNCTION_PROVIDER_OFFSET + 11;
FUNCTION_FSX_AVIONICSMASTER = FUNCTION_PROVIDER_OFFSET + 12;
type
TFSXLEDStateProvider = class(TLEDStateProvider)
private
FSimConnectHandle: THandle;
FDefinitions: TList;
// FLastDown: Boolean;
protected
function GetProcessMessagesInterval: Integer; override;
procedure UpdateMap;
procedure HandleDispatch(AData: PSimConnectRecv);
procedure HandleGearData(AData: Pointer);
procedure HandleLightsData(AData: Pointer);
procedure HandleParkingBrakeData(AData: Pointer);
procedure HandleEngineData(AData: Pointer);
procedure HandleExitDoorData(AData: Pointer);
procedure HandleFlapsData(AData: Pointer);
procedure HandleSwitchesData(AData: Pointer);
procedure AddVariable(ADefineID: Cardinal; ADatumName, AUnitsName: string;
ADatumType: SIMCONNECT_DATAType = SIMCONNECT_DATAType_FLOAT64;
AEpsilon: Single = 0; ADatumID: DWORD = SIMCONNECT_UNUSED);
procedure AddDefinition(ADefinition: Cardinal);
procedure ClearDefinitions;
procedure SetFSXLightState(AStates: Cardinal; AMask, AFunction: Integer);
property SimConnectHandle: THandle read FSimConnectHandle;
public
class procedure EnumFunctions(AConsumer: IFunctionConsumer); override;
@ -67,6 +88,12 @@ const
DEFINITION_INSTRUMENTLIGHTS = 3;
DEFINITION_PARKINGBRAKE = 4;
DEFINITION_ENGINE = 5;
DEFINITION_THROTTLE = 6;
DEFINITION_EXITDOOR = 7;
DEFINITION_FLAPS = 8;
DEFINITION_SWITCHES = 9;
EVENT_ZOOM = 10;
FSX_VARIABLE_ISGEARRETRACTABLE = 'IS GEAR RETRACTABLE';
FSX_VARIABLE_GEARTOTALPCTEXTENDED = 'GEAR TOTAL PCT EXTENDED';
@ -76,8 +103,14 @@ const
FSX_VARIABLE_ENGCOMBUSTION = 'GENERAL ENG COMBUSTION:%d';
FSX_VARIABLE_ENGFAILED = 'ENG FAILED:%d';
FSX_VARIABLE_ENGONFIRE = 'ENG ON FIRE:%d';
FSX_VARIABLE_ENGTHROTTLELEVERPOS = 'GENERAL ENG THROTTLE LEVER POSITION:%d';
FSX_VARIABLE_GEARDAMAGEBYSPEED = 'GEAR DAMAGE BY SPEED';
FSX_VARIABLE_GEARSPEEDEXCEEDED = 'GEAR SPEED EXCEEDED';
FSX_VARIABLE_CANOPYOPEN = 'CANOPY OPEN';
FSX_VARIABLE_FLAPSHANDLEPERCENT = 'FLAPS HANDLE PERCENT';
FSX_VARIABLE_AVIONICSMASTERSWITCH = 'AVIONICS MASTER SWITCH';
FSX_VARIABLE_ELECTRICALMASTERBATTERY = 'ELECTRICAL MASTER BATTERY';
FSX_UNIT_PERCENT = 'percent';
@ -85,7 +118,10 @@ const
FSX_UNIT_BOOL = 'bool';
FSX_UNIT_NUMBER = 'number';
FSX_LIGHTON_NAV = $0001;
FSX_LIGHTON_BEACON = $0002;
FSX_LIGHTON_LANDING = $0004;
FSX_LIGHTON_STROBE = $0010;
FSX_LIGHTON_PANEL = $0020;
FSX_LIGHTON_CABIN = $0200;
@ -97,23 +133,20 @@ const
FUNCTION_DESC_FSX_LANDINGLIGHTS = 'Landing lights';
FUNCTION_DESC_FSX_PARKINGBRAKE = 'Parking brake';
FUNCTION_DESC_FSX_EXITDOOR = 'Exit door';
FUNCTION_DESC_FSX_STROBELIGHTS = 'Strobe lights';
FUNCTION_DESC_FSX_NAVLIGHTS = 'Nav lights';
FUNCTION_DESC_FSX_BEACONLIGHTS = 'Beacon lights';
FUNCTION_DESC_FSX_FLAPS = 'Flaps';
FUNCTION_DESC_FSX_BATTERYMASTER = 'Battery master switch';
FUNCTION_DESC_FSX_AVIONICSMASTER = 'Avionics master switch';
type
TGearData = packed record
IsGearRetractable: Integer;
TotalPctExtended: Double;
DamageBySpeed: Integer;
SpeedExceeded: Integer;
end;
PGearData = ^TGearData;
TEngineData = packed record
TThrottleData = packed record
NumberOfEngines: Integer;
Combustion: array[1..MAX_ENGINES] of Integer;
Failed: array[1..MAX_ENGINES] of Integer;
OnFire: array[1..MAX_ENGINES] of Integer;
ThrottleLeverPos: array[1..MAX_ENGINES] of Double;
end;
PEngineData = ^TEngineData;
{ TFSXLEDStateProvider }
@ -127,6 +160,14 @@ begin
AConsumer.AddFunction(FUNCTION_FSX_GEAR, FUNCTION_DESC_FSX_GEAR);
AConsumer.AddFunction(FUNCTION_FSX_LANDINGLIGHTS, FUNCTION_DESC_FSX_LANDINGLIGHTS);
AConsumer.AddFunction(FUNCTION_FSX_PARKINGBRAKE, FUNCTION_DESC_FSX_PARKINGBRAKE);
AConsumer.AddFunction(FUNCTION_FSX_EXITDOOR, FUNCTION_DESC_FSX_EXITDOOR);
AConsumer.AddFunction(FUNCTION_FSX_STROBELIGHTS, FUNCTION_DESC_FSX_STROBELIGHTS);
AConsumer.AddFunction(FUNCTION_FSX_NAVLIGHTS, FUNCTION_DESC_FSX_NAVLIGHTS);
AConsumer.AddFunction(FUNCTION_FSX_BEACONLIGHTS, FUNCTION_DESC_FSX_BEACONLIGHTS);
AConsumer.AddFunction(FUNCTION_FSX_FLAPS, FUNCTION_DESC_FSX_FLAPS);
AConsumer.AddFunction(FUNCTION_FSX_BATTERYMASTER, FUNCTION_DESC_FSX_BATTERYMASTER);
AConsumer.AddFunction(FUNCTION_FSX_AVIONICSMASTER, FUNCTION_DESC_FSX_AVIONICSMASTER);
end;
@ -154,9 +195,11 @@ begin
raise EInitializeError.Create('SimConnect.dll could not be loaded');
if SimConnect_Open(FSimConnectHandle, APPNAME, 0, 0, 0, 0) <> S_OK then
raise EInitializeError.Create('Connection to Flight Simulator could not be established');
raise EInitializeError.Create('Connection to Flight Simulator could not be established. Is it running?');
UpdateMap;
SimConnect_MapClientEventToSimEvent(SimConnectHandle, EVENT_ZOOM, 'VIEW_ZOOM_SET');
end;
@ -178,12 +221,30 @@ procedure TFSXLEDStateProvider.ProcessMessages;
var
data: PSimConnectRecv;
dataSize: Cardinal;
// down: Boolean;
// level: Integer;
// state: Integer;
begin
inherited;
while SimConnect_GetNextDispatch(SimConnectHandle, data, dataSize) = S_OK do
HandleDispatch(data);
{
state := GetKeyState(VK_CONTROL);
down := ((state and $8000) <> 0);
if down <> FLastDown then
begin
if down then
level := 4 * 64
else
level := 26;
SimConnect_TransmitClientEvent(SimConnectHandle, 0, EVENT_ZOOM, level, SIMCONNECT_GROUP_PRIORITY_STANDARD, SIMCONNECT_EVENT_FLAG_GROUPID_IS_PRIORITY);
FLastDown := down;
end;
}
end;
@ -198,7 +259,7 @@ begin
if Consumer.FunctionMap.HasFunction(FUNCTION_FSX_GEAR) then
begin
AddVariable(DEFINITION_GEAR, FSX_VARIABLE_ISGEARRETRACTABLE, FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
AddVariable(DEFINITION_GEAR, FSX_VARIABLE_GEARTOTALPCTEXTENDED, FSX_UNIT_PERCENT);
AddVariable(DEFINITION_GEAR, FSX_VARIABLE_GEARTOTALPCTEXTENDED, FSX_UNIT_PERCENT, SIMCONNECT_DATAType_FLOAT64);
AddVariable(DEFINITION_GEAR, FSX_VARIABLE_GEARDAMAGEBYSPEED, FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
AddVariable(DEFINITION_GEAR, FSX_VARIABLE_GEARSPEEDEXCEEDED, FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
AddDefinition(DEFINITION_GEAR);
@ -206,7 +267,10 @@ begin
{ Lights }
if Consumer.FunctionMap.HasFunction(FUNCTION_FSX_LANDINGLIGHTS) or
Consumer.FunctionMap.HasFunction(FUNCTION_FSX_INSTRUMENTLIGHTS) then
Consumer.FunctionMap.HasFunction(FUNCTION_FSX_INSTRUMENTLIGHTS) or
Consumer.FunctionMap.HasFunction(FUNCTION_FSX_STROBELIGHTS) or
Consumer.FunctionMap.HasFunction(FUNCTION_FSX_NAVLIGHTS) or
Consumer.FunctionMap.HasFunction(FUNCTION_FSX_BEACONLIGHTS) then
begin
AddVariable(DEFINITION_LIGHTS, FSX_VARIABLE_LIGHTONSTATES, FSX_UNIT_MASK, SIMCONNECT_DATATYPE_INT32);
AddDefinition(DEFINITION_LIGHTS);
@ -235,93 +299,91 @@ begin
AddDefinition(DEFINITION_ENGINE);
end;
{ Exit door }
if Consumer.FunctionMap.HasFunction(FUNCTION_FSX_EXITDOOR) then
begin
AddVariable(DEFINITION_EXITDOOR, FSX_VARIABLE_CANOPYOPEN, FSX_UNIT_PERCENT, SIMCONNECT_DATAType_FLOAT64);
AddDefinition(DEFINITION_EXITDOOR);
end;
{ Flaps }
if Consumer.FunctionMap.HasFunction(FUNCTION_FSX_FLAPS) then
begin
AddVariable(DEFINITION_FLAPS, FSX_VARIABLE_FLAPSHANDLEPERCENT, FSX_UNIT_PERCENT, SIMCONNECT_DATAType_FLOAT64);
AddDefinition(DEFINITION_FLAPS);
end;
{ Master switches }
if Consumer.FunctionMap.HasFunction(FUNCTION_FSX_BATTERYMASTER) or
Consumer.FunctionMap.HasFunction(FUNCTION_FSX_AVIONICSMASTER) then
begin
AddVariable(DEFINITION_SWITCHES, FSX_VARIABLE_AVIONICSMASTERSWITCH, FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
AddVariable(DEFINITION_SWITCHES, FSX_VARIABLE_ELECTRICALMASTERBATTERY, FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
AddDefinition(DEFINITION_SWITCHES);
end;
{ Throttle }
{
AddVariable(DEFINITION_THROTTLE, FSX_VARIABLE_NUMBEROFENGINES, FSX_UNIT_NUMBER, SIMCONNECT_DATAType_INT32);
for engineIndex := 1 to MAX_ENGINES do
AddVariable(DEFINITION_THROTTLE, Format(FSX_VARIABLE_ENGTHROTTLELEVERPOS, [engineIndex]), FSX_UNIT_PERCENT);
AddDefinition(DEFINITION_THROTTLE);
}
end;
procedure TFSXLEDStateProvider.SetFSXLightState(AStates: Cardinal; AMask: Integer; AFunction: Integer);
begin
if (AStates and AMask) <> 0 then
Consumer.SetStateByFunction(AFunction, lsGreen)
else
Consumer.SetStateByFunction(AFunction, lsRed);
end;
procedure TFSXLEDStateProvider.HandleDispatch(AData: PSimConnectRecv);
var
simObjectData: PSimConnectRecvSimObjectData;
states: Cardinal;
gearData: PGearData;
engineData: PEngineData;
engineIndex: Integer;
state: TLEDState;
data: Pointer;
// throttleData: PThrottleData;
begin
case SIMCONNECT_RECV_ID(AData^.dwID) of
SIMCONNECT_RECV_ID_SIMOBJECT_DATA:
begin
simObjectData := PSimConnectRecvSimObjectData(AData);
data := @simObjectData^.dwData;
case simObjectData^.dwRequestID of
DEFINITION_GEAR:
DEFINITION_GEAR: HandleGearData(data);
DEFINITION_LIGHTS: HandleLightsData(data);
DEFINITION_PARKINGBRAKE: HandleParkingBrakeData(data);
DEFINITION_ENGINE: HandleEngineData(data);
DEFINITION_EXITDOOR: HandleExitDoorData(data);
DEFINITION_FLAPS: HandleFlapsData(data);
DEFINITION_SWITCHES: HandleSwitchesData(data);
{
DEFINITION_THROTTLE:
begin
gearData := @simObjectData^.dwData;
throttleData := @simObjectData^.dwData;
if gearData^.DamageBySpeed <> 0 then
Consumer.SetStateByFunction(FUNCTION_FSX_GEAR, lsError)
else if gearData^.SpeedExceeded <> 0 then
Consumer.SetStateByFunction(FUNCTION_FSX_GEAR, lsWarning)
else if gearData^.IsGearRetractable <> 0 then
if throttleData^.NumberOfEngines > 2 then
begin
case Trunc(gearData^.TotalPctExtended * 100) of
0: Consumer.SetStateByFunction(FUNCTION_FSX_GEAR, lsRed);
100: Consumer.SetStateByFunction(FUNCTION_FSX_GEAR, lsGreen);
else Consumer.SetStateByFunction(FUNCTION_FSX_GEAR, lsAmber);
end;
end else
Consumer.SetStateByFunction(FUNCTION_FSX_GEAR, lsOff);
end;
DEFINITION_LIGHTS:
begin
states := simObjectData^.dwData;
if (states and FSX_LIGHTON_LANDING) <> 0 then
Consumer.SetStateByFunction(FUNCTION_FSX_LANDINGLIGHTS, lsGreen)
else
Consumer.SetStateByFunction(FUNCTION_FSX_LANDINGLIGHTS, lsRed);
if (states and FSX_LIGHTON_PANEL) <> 0 then
Consumer.SetStateByFunction(FUNCTION_FSX_INSTRUMENTLIGHTS, lsGreen)
else
Consumer.SetStateByFunction(FUNCTION_FSX_INSTRUMENTLIGHTS, lsRed);
end;
DEFINITION_PARKINGBRAKE:
if simObjectData^.dwData <> 0 then
Consumer.SetStateByFunction(FUNCTION_FSX_PARKINGBRAKE, lsRed)
else
Consumer.SetStateByFunction(FUNCTION_FSX_PARKINGBRAKE, lsGreen);
DEFINITION_ENGINE:
begin
engineData := @simObjectData^.dwData;
if engineData^.NumberOfEngines > 0 then
begin
state := lsGreen;
for engineIndex := 1 to Min(engineData^.NumberOfEngines, MAX_ENGINES) do
if (throttleData^.ThrottleLeverPos[4] <> throttleData^.ThrottleLeverPos[1]) or
(throttleData^.ThrottleLeverPos[3] <> throttleData^.ThrottleLeverPos[2]) then
begin
if engineData.OnFire[engineIndex] <> 0 then
begin
state := lsError;
break;
throttleData^.ThrottleLeverPos[4] := throttleData^.ThrottleLeverPos[1];
throttleData^.ThrottleLeverPos[3] := throttleData^.ThrottleLeverPos[2];
end else if engineData.Failed[engineIndex] <> 0 then
state := lsWarning
else if (engineData.Combustion[engineIndex] = 0) and
(state = lsGreen) then
state := lsRed;
SimConnect_SetDataOnSimObject(SimConnectHandle, DEFINITION_THROTTLE, SIMCONNECT_OBJECT_ID_USER,
0, 0, SizeOf(throttleData^), throttleData);
end;
Consumer.SetStateByFunction(FUNCTION_FSX_ENGINE, state);
end else
Consumer.SetStateByFunction(FUNCTION_FSX_ENGINE, lsOff);
end;
end;
}
end;
end;
@ -331,6 +393,175 @@ begin
end;
procedure TFSXLEDStateProvider.HandleGearData(AData: Pointer);
type
PGearData = ^TGearData;
TGearData = packed record
IsGearRetractable: Integer;
TotalPctExtended: Double;
DamageBySpeed: Integer;
SpeedExceeded: Integer;
end;
var
gearData: PGearData;
begin
gearData := AData;
if gearData^.DamageBySpeed <> 0 then
Consumer.SetStateByFunction(FUNCTION_FSX_GEAR, lsError)
else if gearData^.SpeedExceeded <> 0 then
Consumer.SetStateByFunction(FUNCTION_FSX_GEAR, lsWarning)
else if gearData^.IsGearRetractable <> 0 then
begin
case Trunc(gearData ^.TotalPctExtended * 100) of
0: Consumer.SetStateByFunction(FUNCTION_FSX_GEAR, lsRed);
100: Consumer.SetStateByFunction(FUNCTION_FSX_GEAR, lsGreen);
else Consumer.SetStateByFunction(FUNCTION_FSX_GEAR, lsAmber);
end;
end else
Consumer.SetStateByFunction(FUNCTION_FSX_GEAR, lsOff);
end;
procedure TFSXLEDStateProvider.HandleLightsData(AData: Pointer);
var
state: Cardinal;
begin
state := PCardinal(AData)^;
SetFSXLightState(state, FSX_LIGHTON_LANDING, FUNCTION_FSX_LANDINGLIGHTS);
SetFSXLightState(state, FSX_LIGHTON_PANEL, FUNCTION_FSX_INSTRUMENTLIGHTS);
SetFSXLightState(state, FSX_LIGHTON_BEACON, FUNCTION_FSX_BEACONLIGHTS);
SetFSXLightState(state, FSX_LIGHTON_NAV, FUNCTION_FSX_NAVLIGHTS);
SetFSXLightState(state, FSX_LIGHTON_STROBE, FUNCTION_FSX_STROBELIGHTS);
end;
procedure TFSXLEDStateProvider.HandleParkingBrakeData(AData: Pointer);
begin
if PCardinal(AData)^ <> 0 then
Consumer.SetStateByFunction(FUNCTION_FSX_PARKINGBRAKE, lsRed)
else
Consumer.SetStateByFunction(FUNCTION_FSX_PARKINGBRAKE, lsGreen);
end;
procedure TFSXLEDStateProvider.HandleEngineData(AData: Pointer);
type
PEngineData = ^TEngineData;
TEngineData = packed record
NumberOfEngines: Integer;
Combustion: array[1..MAX_ENGINES] of Integer;
Failed: array[1..MAX_ENGINES] of Integer;
OnFire: array[1..MAX_ENGINES] of Integer;
end;
var
engineData: PEngineData;
engineIndex: Integer;
state: TLEDState;
begin
engineData := AData;
if engineData^.NumberOfEngines > 0 then
begin
state := lsGreen;
for engineIndex := 1 to Min(engineData^.NumberOfEngines, MAX_ENGINES) do
begin
if engineData^.OnFire[engineIndex] <> 0 then
begin
state := lsError;
break;
end else if engineData^.Failed[engineIndex] <> 0 then
state := lsWarning
else if (engineData^.Combustion[engineIndex] = 0) and
(state = lsGreen) then
state := lsRed;
end;
Consumer.SetStateByFunction(FUNCTION_FSX_ENGINE, state);
end else
Consumer.SetStateByFunction(FUNCTION_FSX_ENGINE, lsOff);
end;
procedure TFSXLEDStateProvider.HandleExitDoorData(AData: Pointer);
type
PExitDoorData = ^TExitDoorData;
TExitDoorData = packed record
PercentOpen: Double;
end;
var
exitDoorData: PExitDoorData;
begin
exitDoorData := AData;
case Trunc(exitDoorData^.PercentOpen) of
0: Consumer.SetStateByFunction(FUNCTION_FSX_EXITDOOR, lsGreen);
100: Consumer.SetStateByFunction(FUNCTION_FSX_EXITDOOR, lsRed);
else Consumer.SetStateByFunction(FUNCTION_FSX_EXITDOOR, lsAmber);
end;
end;
procedure TFSXLEDStateProvider.HandleFlapsData(AData: Pointer);
type
PFlapsData = ^TFlapsData;
TFlapsData = packed record
HandlePercent: Double;
end;
var
flapsData: PFlapsData;
begin
flapsData := AData;
case Trunc(flapsData^.HandlePercent) of
0: Consumer.SetStateByFunction(FUNCTION_FSX_FLAPS, lsGreen);
100: Consumer.SetStateByFunction(FUNCTION_FSX_FLAPS, lsRed);
else Consumer.SetStateByFunction(FUNCTION_FSX_FLAPS, lsAmber);
end;
end;
procedure TFSXLEDStateProvider.HandleSwitchesData(AData: Pointer);
type
PSwitchesData = ^TSwitchesData;
TSwitchesData = packed record
AvionicsSwitch: Cardinal;
BatterySwitch: Cardinal;
end;
var
switchesData: PSwitchesData;
begin
switchesData := AData;
if switchesData^.AvionicsSwitch <> 0 then
Consumer.SetStateByFunction(FUNCTION_FSX_AVIONICSMASTER, lsGreen)
else
Consumer.SetStateByFunction(FUNCTION_FSX_AVIONICSMASTER, lsRed);
if switchesData^.BatterySwitch <> 0 then
Consumer.SetStateByFunction(FUNCTION_FSX_BATTERYMASTER, lsGreen)
else
Consumer.SetStateByFunction(FUNCTION_FSX_BATTERYMASTER, lsRed);
end;
procedure TFSXLEDStateProvider.AddDefinition(ADefinition: Cardinal);
begin
FDefinitions.Add(Pointer(ADefinition));

3
G940LEDControl/Units/G940LEDStateConsumer.pas
View File

@ -84,13 +84,14 @@ type
FRed: Byte;
FGreen: Byte;
protected
{ IRunInMainThread }
procedure Execute;
public
constructor Create(ADevice: IDirectInputDevice8; ARed, AGreen: Byte);
end;
function EnumDevicesProc(var lpddi: TDIDeviceInstanceA; pvRef: Pointer): BOOL; stdcall;
function EnumDevicesProc(var lpddi: TDIDeviceInstanceW; pvRef: Pointer): BOOL; stdcall;
var
vendorID: Word;
productID: Word;

2
G940LEDControl/Units/LEDFunctionMap.pas
View File

@ -57,6 +57,8 @@ const
FUNCTION_AMBER = 3;
FUNCTION_GREEN = 4;
{ Note: if this offset ever changes, make sure to write a conversion for
existing configurations. And probably reserve a bit more. }
FUNCTION_PROVIDER_OFFSET = FUNCTION_GREEN;