GitHub-Mirror/G940LEDControl
1
0
Fork 0
mirror of synced 2024-11-22 10:03:51 +00:00
Code Issues Projects Releases Wiki Activity

Reintegrated branches/longterm

Browse Source
This commit is contained in:
Mark van Renswoude 2013-02-24 21:04:48 +00:00
parent 0940df6214
commit 4fb7b842f5
41 changed files with 7463 additions and 2107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

265
G940LEDControl/Forms/ButtonFunctionFrm.dfm Normal file
View File

@ -0,0 +1,265 @@
object ButtonFunctionForm: TButtonFunctionForm
Left = 0
Top = 0
ActiveControl = vstFunctions
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'Configure button'
ClientHeight = 484
ClientWidth = 692
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
PixelsPerInch = 96
TextHeight = 13
object bvlHeader: TBevel
Left = 0
Top = 50
Width = 692
Height = 2
Align = alTop
Shape = bsTopLine
ExplicitTop = 41
end
object pnlButtons: TPanel
AlignWithMargins = True
Left = 0
Top = 441
Width = 692
Height = 43
Margins.Left = 0
Margins.Top = 8
Margins.Right = 0
Margins.Bottom = 0
Align = alBottom
BevelOuter = bvNone
TabOrder = 3
DesignSize = (
692
43)
object bvlFooter: TBevel
Left = 0
Top = 0
Width = 692
Height = 8
Align = alTop
Shape = bsTopLine
end
object btnOK: TButton
Left = 528
Top = 10
Width = 75
Height = 25
Anchors = [akTop, akRight]
Caption = 'OK'
Default = True
TabOrder = 0
OnClick = btnOKClick
end
object btnCancel: TButton
Left = 609
Top = 10
Width = 75
Height = 25
Anchors = [akTop, akRight]
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
end
object vstFunctions: TVirtualStringTree
AlignWithMargins = True
Left = 8
Top = 60
Width = 257
Height = 373
Margins.Left = 8
Margins.Top = 8
Margins.Right = 0
Margins.Bottom = 0
Align = alLeft
Header.AutoSizeIndex = 0
Header.Font.Charset = DEFAULT_CHARSET
Header.Font.Color = clWindowText
Header.Font.Height = -11
Header.Font.Name = 'Tahoma'
Header.Font.Style = []
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]
IncrementalSearch = isAll
TabOrder = 1
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toInitOnSave, toWheelPanning, toEditOnClick]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowTreeLines, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect]
OnFocusChanged = vstFunctionsFocusChanged
OnGetText = vstFunctionsGetText
OnPaintText = vstFunctionsPaintText
OnIncrementalSearch = vstFunctionsIncrementalSearch
Columns = <
item
Position = 0
Width = 253
WideText = 'Available functions'
end>
end
object pnlFunction: TPanel
AlignWithMargins = True
Left = 273
Top = 60
Width = 411
Height = 373
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 0
Align = alClient
BevelOuter = bvNone
TabOrder = 2
object pnlName: TPanel
Left = 0
Top = 0
Width = 411
Height = 97
Align = alTop
BevelOuter = bvNone
TabOrder = 0
DesignSize = (
411
97)
object lblFunctionName: TLabel
Left = 0
Top = 19
Width = 405
Height = 19
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = 'runtime: function'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
ExplicitWidth = 401
end
object lblCategoryName: TLabel
Left = 0
Top = 0
Width = 405
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = 'runtime: category'
Font.Charset = DEFAULT_CHARSET
Font.Color = clGrayText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
ExplicitWidth = 401
end
object lblHasStates: TLabel
Left = 0
Top = 47
Width = 401
Height = 31
AutoSize = False
Caption =
'This function provides the following states. Each state can be c' +
'ustomized by changing the color below.'
WordWrap = True
end
object lblNoStates: TLabel
Left = 0
Top = 47
Width = 195
Height = 13
Caption = 'This function has no configurable states.'
Visible = False
end
end
object sbStates: TScrollBox
Left = 0
Top = 97
Width = 411
Height = 276
Align = alClient
BorderStyle = bsNone
TabOrder = 1
end
end
object pnlHeader: TPanel
Left = 0
Top = 0
Width = 692
Height = 50
Align = alTop
BevelOuter = bvNone
Color = clWindow
ParentBackground = False
TabOrder = 0
DesignSize = (
692
50)
object lblButton: TLabel
Left = 8
Top = 13
Width = 24
Height = 23
Caption = 'P1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -19
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object lblCurrentAssignment: TLabel
Left = 586
Top = 8
Width = 98
Height = 13
Alignment = taRightJustify
Anchors = [akTop, akRight]
Caption = 'Current assignment:'
end
object lblCurrentFunction: TLabel
Left = 587
Top = 27
Width = 97
Height = 13
Alignment = taRightJustify
Anchors = [akTop, akRight]
Caption = 'runtime: function'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object lblCurrentCategory: TLabel
Left = 478
Top = 27
Width = 86
Height = 13
Alignment = taRightJustify
Anchors = [akTop, akRight]
Caption = 'runtime: category'
Font.Charset = DEFAULT_CHARSET
Font.Color = clGrayText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
end
end
end

498
G940LEDControl/Forms/ButtonFunctionFrm.pas Normal file
View File

@ -0,0 +1,498 @@
unit ButtonFunctionFrm;
interface
uses
Generics.Collections,
System.Classes,
Vcl.Controls,
Vcl.ExtCtrls,
Vcl.Forms,
Vcl.Graphics,
Vcl.StdCtrls,
Winapi.Messages,
VirtualTrees,
LEDColorIntf,
LEDFunctionIntf,
LEDStateIntf,
Profile;
type
TStateControlInfo = class;
TStateControlInfoList = TObjectList<TStateControlInfo>;
TButtonFunctionForm = class(TForm)
pnlButtons: TPanel;
btnOK: TButton;
btnCancel: TButton;
vstFunctions: TVirtualStringTree;
pnlFunction: TPanel;
pnlName: TPanel;
lblFunctionName: TLabel;
lblCategoryName: TLabel;
lblHasStates: TLabel;
lblNoStates: TLabel;
sbStates: TScrollBox;
pnlHeader: TPanel;
bvlHeader: TBevel;
lblButton: TLabel;
lblCurrentAssignment: TLabel;
lblCurrentFunction: TLabel;
lblCurrentCategory: TLabel;
bvlFooter: TBevel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure vstFunctionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure vstFunctionsPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType);
procedure vstFunctionsFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
procedure vstFunctionsIncrementalSearch(Sender: TBaseVirtualTree; Node: PVirtualNode; const SearchText: string; var Result: Integer);
procedure btnOKClick(Sender: TObject);
private
FProfile: TProfile;
FButtonIndex: Integer;
FButton: TProfileButton;
FCurrentProvider: ILEDFunctionProvider;
FCurrentFunction: ILEDFunction;
FSelectedProvider: ILEDFunctionProvider;
FSelectedFunction: ILEDFunction;
FStateControls: TStateControlInfoList;
protected
procedure Initialize(AProfile: TProfile; AButtonIndex: Integer);
procedure LoadFunctions;
procedure SetFunction(AProvider: ILEDFunctionProvider; AFunction: ILEDFunction);
procedure LoadStates(AProvider: ILEDFunctionProvider; AFunction: ILEDMultiStateFunction);
property Button: TProfileButton read FButton;
property CurrentProvider: ILEDFunctionProvider read FCurrentProvider;
property CurrentFunction: ILEDFunction read FCurrentFunction;
property SelectedProvider: ILEDFunctionProvider read FSelectedProvider;
property SelectedFunction: ILEDFunction read FSelectedFunction;
property Profile: TProfile read FProfile;
property ButtonIndex: Integer read FButtonIndex;
public
class function Execute(AProfile: TProfile; AButtonIndex: Integer): Boolean;
end;
TStateControlInfo = class(TObject)
private
FState: ILEDState;
FStateLabel: TLabel;
FComboBox: TComboBox;
public
constructor Create(AState: ILEDState; AStateLabel: TLabel; AComboBox: TComboBox);
destructor Destroy; override;
property State: ILEDState read FState;
property StateLabel: TLabel read FStateLabel;
property ComboBox: TComboBox read FComboBox;
end;
implementation
uses
System.Math,
System.SysUtils,
Winapi.Windows,
LEDFunctionRegistry,
LEDResources;
type
TFunctionNodeType = (ntCategory, ntFunction);
TFunctionNodeData = record
NodeType: TFunctionNodeType;
Provider: ILEDFunctionProvider;
LEDFunction: ILEDFunction;
end;
PFunctionNodeData = ^TFunctionNodeData;
TStateNodeData = record
State: ILEDState;
Color: TLEDColor;
end;
PStateNodeData = ^TStateNodeData;
const
ColumnState = 0;
ColumnColor = 1;
{$R *.dfm}
{ TButtonFunctionForm }
class function TButtonFunctionForm.Execute(AProfile: TProfile; AButtonIndex: Integer): Boolean;
begin
with Self.Create(nil) do
try
Initialize(AProfile, AButtonIndex);
Result := (ShowModal = mrOk);
finally
Free;
end;
end;
procedure TButtonFunctionForm.FormCreate(Sender: TObject);
begin
FStateControls := TStateControlInfoList.Create(True);
vstFunctions.NodeDataSize := SizeOf(TFunctionNodeData);
lblButton.Caption := '';
lblCurrentCategory.Caption := '';
lblCurrentFunction.Caption := '';
lblCategoryName.Caption := '';
lblFunctionName.Caption := '';
end;
procedure TButtonFunctionForm.FormDestroy(Sender: TObject);
begin
FreeAndNil(FStateControls);
end;
procedure TButtonFunctionForm.LoadFunctions;
var
categoryNodes: TDictionary<string,PVirtualNode>;
function GetCategoryNode(AProvider: ILEDFunctionProvider; AFunction: ILEDFunction): PVirtualNode;
var
category: string;
nodeData: PFunctionNodeData;
begin
category := AFunction.GetCategoryName;
if not categoryNodes.ContainsKey(category) then
begin
Result := vstFunctions.AddChild(nil);
Include(Result^.States, vsExpanded);
nodeData := vstFunctions.GetNodeData(Result);
nodeData^.NodeType := ntCategory;
nodeData^.Provider := AProvider;
nodeData^.LEDFunction := AFunction;
categoryNodes.Add(category, Result);
end else
Result := categoryNodes.Items[category];
end;
var
node: PVirtualNode;
nodeData: PFunctionNodeData;
provider: ILEDFunctionProvider;
ledFunction: ILEDFunction;
isCurrentProvider: Boolean;
begin
vstFunctions.BeginUpdate;
try
vstFunctions.Clear;
categoryNodes := TDictionary<string, PVirtualNode>.Create;
try
for provider in TLEDFunctionRegistry.Providers do
begin
isCurrentProvider := Assigned(CurrentProvider) and (provider.GetUID = CurrentProvider.GetUID);
for ledFunction in provider do
begin
node := vstFunctions.AddChild(GetCategoryNode(provider, ledFunction));
nodeData := vstFunctions.GetNodeData(node);
nodeData^.NodeType := ntFunction;
nodeData^.Provider := provider;
nodeData^.LEDFunction := ledFunction;
if isCurrentProvider and Assigned(CurrentFunction) and (ledFunction.GetUID = CurrentFunction.GetUID) then
vstFunctions.Selected[node] := True;
end;
end;
finally
FreeAndNil(categoryNodes);
end;
finally
vstFunctions.EndUpdate;
end;
end;
procedure TButtonFunctionForm.SetFunction(AProvider: ILEDFunctionProvider; AFunction: ILEDFunction);
var
multiStateFunction: ILEDMultiStateFunction;
begin
FSelectedProvider := AProvider;
FSelectedFunction := AFunction;
lblCategoryName.Caption := SelectedFunction.GetCategoryName;
lblFunctionName.Caption := SelectedFunction.GetDisplayName;
if Supports(SelectedFunction, ILEDMultiStateFunction, multiStateFunction) then
begin
lblNoStates.Visible := False;
lblHasStates.Visible := True;
LoadStates(AProvider, multiStateFunction);
sbStates.Visible := True;
end else
begin
lblNoStates.Visible := True;
lblHasStates.Visible := False;
sbStates.Visible := False;
FStateControls.Clear;
end;
end;
procedure TButtonFunctionForm.Initialize(AProfile: TProfile; AButtonIndex: Integer);
begin
FProfile := AProfile;
FButtonIndex := AButtonIndex;
FButton := nil;
FCurrentProvider := nil;
FCurrentFunction := nil;
lblButton.Caption := 'P' + IntToStr(Succ(ButtonIndex));
if Profile.HasButton(ButtonIndex) then
begin
FButton := Profile.Buttons[ButtonIndex];
FCurrentProvider := TLEDFunctionRegistry.Find(Button.ProviderUID);
if Assigned(CurrentProvider) then
FCurrentFunction := CurrentProvider.Find(Button.FunctionUID);
end;
LoadFunctions;
if Assigned(CurrentFunction) then
begin
lblCurrentCategory.Caption := CurrentFunction.GetCategoryName + ': ';
lblCurrentFunction.Caption := CurrentFunction.GetDisplayName;
lblCurrentCategory.Left := lblCurrentFunction.Left - lblCurrentCategory.Width;
SetFunction(CurrentProvider, CurrentFunction);
end else
begin
lblCurrentCategory.Caption := '';
lblCurrentFunction.Caption := 'Unassigned';
end;
end;
procedure TButtonFunctionForm.LoadStates(AProvider: ILEDFunctionProvider; AFunction: ILEDMultiStateFunction);
procedure FillColorComboBox(AComboBox: TComboBox; ASelectedColor: TLEDColor);
var
color: TLEDColor;
itemIndex: Integer;
begin
AComboBox.Items.BeginUpdate;
try
AComboBox.Items.Clear;
for color := Low(TLEDColor) to High(TLEDColor) do
begin
itemIndex := AComboBox.Items.AddObject(LEDColorDisplayName[color], TObject(color));
if color = ASelectedColor then
AComboBox.ItemIndex := itemIndex;
end;
finally
AComboBox.Items.EndUpdate;
end;
end;
var
state: ILEDState;
stateLabel: TLabel;
colorCombobox: TComboBox;
comboBoxWidth: Integer;
currentY: Integer;
selectedColor: TLEDColor;
isCurrent: Boolean;
begin
FStateControls.Clear;
currentY := 0;
comboBoxWidth := sbStates.ClientWidth div 2;
isCurrent := Assigned(CurrentProvider) and (AProvider.GetUID = CurrentProvider.GetUID) and
Assigned(CurrentFunction) and (AFunction.GetUID = CurrentFunction.GetUID);
for state in AFunction do
begin
stateLabel := TLabel.Create(nil);
stateLabel.AutoSize := False;
stateLabel.Caption := state.GetDisplayName;
stateLabel.EllipsisPosition := epEndEllipsis;
stateLabel.Left := 0;
stateLabel.Top := currentY + 4;
stateLabel.Width := comboBoxWidth - 8;
stateLabel.Parent := sbStates;
colorCombobox := TComboBox.Create(nil);
colorCombobox.DropDownCount := Length(LEDColorDisplayName);
colorCombobox.Style := csDropDownList;
colorCombobox.Left := sbStates.ClientWidth - comboBoxWidth;
colorCombobox.Top := currentY;
colorCombobox.Width := comboBoxWidth;
colorCombobox.Parent := sbStates;
if (not isCurrent) or (not Button.GetStateColor(state.GetUID, selectedColor)) then
selectedColor := state.GetDefaultColor;
FillColorComboBox(colorComboBox, selectedColor);
FStateControls.Add(TStateControlInfo.Create(state, stateLabel, colorCombobox));
Inc(currentY, colorCombobox.Height + 8);
end;
end;
procedure TButtonFunctionForm.btnOKClick(Sender: TObject);
var
multiStateFunction: ILEDMultiStateFunction;
stateControlInfo: TStateControlInfo;
comboBox: TComboBox;
color: TLEDColor;
begin
if not Assigned(Button) then
FButton := Profile.Buttons[ButtonIndex];
Button.ProviderUID := SelectedProvider.GetUID;
Button.FunctionUID := SelectedFunction.GetUID;
Button.ClearStateColors;
if Supports(SelectedFunction, ILEDMultiStateFunction, multiStateFunction) then
begin
for stateControlInfo in FStateControls do
begin
comboBox := stateControlInfo.ComboBox;
if comboBox.ItemIndex > -1 then
begin
color := TLEDColor(comboBox.Items.Objects[comboBox.ItemIndex]);
Button.SetStateColor(stateControlInfo.State.GetUID, color);
end;
end;
end;
ModalResult := mrOk;
end;
procedure TButtonFunctionForm.vstFunctionsFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
var
nodeData: PFunctionNodeData;
functionNode: PVirtualNode;
begin
if Assigned(Node) then
begin
nodeData := Sender.GetNodeData(Node);
if nodeData^.NodeType = ntCategory then
begin
{ Get first child (function) node instead }
functionNode := Sender.GetFirstChild(Node);
if not Assigned(functionNode) then
exit;
nodeData := Sender.GetNodeData(functionNode);
end;
SetFunction(nodeData^.Provider, nodeData^.LEDFunction);
end;
end;
procedure TButtonFunctionForm.vstFunctionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: string);
var
nodeData: PFunctionNodeData;
begin
nodeData := Sender.GetNodeData(Node);
case nodeData^.NodeType of
ntCategory: CellText := nodeData^.LEDFunction.GetCategoryName;
ntFunction: CellText := nodeData^.LEDFunction.GetDisplayName;
end;
end;
procedure TButtonFunctionForm.vstFunctionsIncrementalSearch(Sender: TBaseVirtualTree; Node: PVirtualNode;
const SearchText: string; var Result: Integer);
var
nodeData: PFunctionNodeData;
displayName: string;
begin
nodeData := Sender.GetNodeData(Node);
if nodeData^.NodeType = ntFunction then
begin
displayName := nodeData^.LEDFunction.GetDisplayName;
Result := StrLIComp(PChar(displayName), PChar(SearchText), Min(Length(displayName), Length(searchText)));
end else
Result := -1;
end;
procedure TButtonFunctionForm.vstFunctionsPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType);
var
nodeData: PFunctionNodeData;
begin
nodeData := Sender.GetNodeData(Node);
if nodeData^.NodeType = ntCategory then
TargetCanvas.Font.Style := [fsBold]
else
TargetCanvas.Font.Style := [];
end;
{ TStateControlInfo }
constructor TStateControlInfo.Create(AState: ILEDState; AStateLabel: TLabel; AComboBox: TComboBox);
begin
inherited Create;
FState := AState;
FStateLabel := AStateLabel;
FComboBox := AComboBox;
end;
destructor TStateControlInfo.Destroy;
begin
FreeAndNil(FComboBox);
FreeAndNil(FStateLabel);
inherited Destroy;
end;
end.

2
G940LEDControl/Forms/ButtonSelectFrm.dfm
View File

@ -67,7 +67,6 @@ object ButtonSelectForm: TButtonSelectForm
Default = True
ModalResult = 1
TabOrder = 1
ExplicitTop = 94
end
object btnCancel: TButton
Left = 401
@ -79,7 +78,6 @@ object ButtonSelectForm: TButtonSelectForm
Caption = 'Cancel'
ModalResult = 2
TabOrder = 2
ExplicitTop = 94
end
object edtButton: TEdit
Left = 80

2
G940LEDControl/Forms/ButtonSelectFrm.pas
View File

@ -116,7 +116,7 @@ begin
info.InstanceGUID := lpddi.guidInstance;
info.ProductGUID := lpddi.guidProduct;
items.AddObject(String(lpddi.tszProductName), info);
items.AddObject(string(lpddi.tszProductName), info);
Result := True;
end;

1614
G940LEDControl/Forms/MainFrm.dfm
View File

File diff suppressed because it is too large Load Diff

1182
G940LEDControl/Forms/MainFrm.pas
View File

File diff suppressed because it is too large Load Diff

28
G940LEDControl/G940LEDControl.dpr
View File

@ -5,12 +5,32 @@ uses
MainFrm in 'Forms\MainFrm.pas' {MainForm},
LogiJoystickDLL in '..\Shared\LogiJoystickDLL.pas',
SimConnect in '..\Shared\SimConnect.pas',
ButtonSelectFrm in 'Forms\ButtonSelectFrm.pas' {ButtonSelectForm},
FSXLEDStateProvider in 'Units\FSXLEDStateProvider.pas',
G940LEDStateConsumer in 'Units\G940LEDStateConsumer.pas',
LEDFunctionMap in 'Units\LEDFunctionMap.pas',
LEDStateConsumer in 'Units\LEDStateConsumer.pas',
LEDStateProvider in 'Units\LEDStateProvider.pas';
LEDColorIntf in 'Units\LEDColorIntf.pas',
LEDColor in 'Units\LEDColor.pas',
LEDFunctionIntf in 'Units\LEDFunctionIntf.pas',
LEDFunction in 'Units\LEDFunction.pas',
StaticLEDFunction in 'Units\StaticLEDFunction.pas',
ConfigConversion in 'Units\ConfigConversion.pas',
LEDFunctionRegistry in 'Units\LEDFunctionRegistry.pas',
StaticLEDColor in 'Units\StaticLEDColor.pas',
DynamicLEDColor in 'Units\DynamicLEDColor.pas',
LEDStateIntf in 'Units\LEDStateIntf.pas',
LEDState in 'Units\LEDState.pas',
Profile in 'Units\Profile.pas',
LEDColorPool in 'Units\LEDColorPool.pas',
ButtonFunctionFrm in 'Forms\ButtonFunctionFrm.pas' {ButtonFunctionForm},
FSXLEDFunctionProvider in 'Units\FSXLEDFunctionProvider.pas',
StaticResources in 'Units\StaticResources.pas',
FSXResources in 'Units\FSXResources.pas',
FSXSimConnectClient in 'Units\FSXSimConnectClient.pas',
FSXSimConnectIntf in 'Units\FSXSimConnectIntf.pas',
FSXLEDFunction in 'Units\FSXLEDFunction.pas',
LEDResources in 'Units\LEDResources.pas',
Settings in 'Units\Settings.pas',
FSXLEDFunctionWorker in 'Units\FSXLEDFunctionWorker.pas',
FSXSimConnectStateMonitor in 'Units\FSXSimConnectStateMonitor.pas';
{$R *.res}

147
G940LEDControl/G940LEDControl.dproj
View File

@ -8,7 +8,7 @@
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>13.4</ProjectVersion>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Release</Config>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
@ -49,6 +49,7 @@
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_UsePackage>rtl;dbrtl;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_DcuOutput>Lib</DCC_DcuOutput>
<VerInfo_MajorVer>0</VerInfo_MajorVer>
<DCC_ExeOutput>Bin</DCC_ExeOutput>
@ -81,9 +82,9 @@
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<VerInfo_Release>1</VerInfo_Release>
<VerInfo_MinorVer>6</VerInfo_MinorVer>
<VerInfo_Keys>CompanyName=X²Software;FileDescription=G940 LED Control;FileVersion=0.6.1.0;InternalName=;LegalCopyright=© 2011 X²Software;LegalTrademarks=;OriginalFilename=G940LEDControl.exe;ProductName=G940 LED Control;ProductVersion=0.6.1;Comments=</VerInfo_Keys>
<VerInfo_MajorVer>1</VerInfo_MajorVer>
<VerInfo_MinorVer>0</VerInfo_MinorVer>
<VerInfo_Keys>CompanyName=X²Software;FileDescription=G940 LED Control;FileVersion=1.0.0.0;InternalName=;LegalCopyright=© 2011 X²Software;LegalTrademarks=;OriginalFilename=G940LEDControl.exe;ProductName=G940 LED Control;ProductVersion=1.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
</PropertyGroup>
@ -145,6 +146,110 @@
<Source Name="MainSource">G940LEDControl.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxCoreD16.bpl">ExpressCoreLibrary by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxLibraryD16.bpl">Express Cross Platform Library by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxPageControlD16.bpl">ExpressPageControl by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxEditorsD16.bpl">ExpressEditors Library by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxBarD16.bpl">ExpressBars by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxRibbonD16.bpl">ExpressBars Ribbon controls by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxSchedulerD16.bpl">ExpressScheduler by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSkinsCoreD16.bpl">ExpressSkins Library by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSCoreD16.bpl">ExpressPrinting System by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxPivotGridD16.bpl">ExpressPivotGrid by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxorgcD16.bpl">ExpressOrgChart by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSkinsDesignHelperD16.bpl">ExpressSkins Library Uses Clause Auto Fill Helper by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinscxPCPainterD16.bpl">ExpressSkins Library Painter for PageControl by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinscxSchedulerPainterD16.bpl">ExpressSkins Library Painter for Scheduler by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinsdxBarPainterD16.bpl">ExpressSkins Library Painter for Bars by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinsdxNavBarPainterD16.bpl">ExpressSkins Library Painter for NavBar by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinsdxRibbonPainterD16.bpl">ExpressSkins Library Painter for Ribbon by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinsdxDLPainterD16.bpl">ExpressSkins Library Painter for Docking Library by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSdxLCLnkD16.bpl">ExpressPrinting System ReportLink for ExpressLayoutControl by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxEditorFieldLinkD16.bpl">ExpressEditors FieldLink by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxBarDBNavD16.bpl">ExpressBars DBNavigator by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxBarExtDBItemsD16.bpl">ExpressBars extended DB items by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxBarExtItemsD16.bpl">ExpressBars extended items by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxTabbedMDID16.bpl">ExpressBars Tabbed MDI by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxLayoutControlD16.bpl">ExpressLayout Control by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxTreeListD16.bpl">ExpressQuantumTreeList 5 by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxGridD16.bpl">ExpressQuantumGrid by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxVerticalGridD16.bpl">ExpressVerticalGrid by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxmdsD16.bpl">ExpressMemData by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSpellCheckerD16.bpl">ExpressSpellChecker 2 by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxSpreadSheetD16.bpl">ExpressSpreadSheet by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxDockingD16.bpl">ExpressDocking Library by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxNavBarD16.bpl">ExpressNavBar by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinBlackD16.bpl">ExpressSkins - Black Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinBlueD16.bpl">ExpressSkins - Blue Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinBlueprintD16.bpl">ExpressSkins - Blueprint Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinCaramelD16.bpl">ExpressSkins - Caramel Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinCoffeeD16.bpl">ExpressSkins - Coffee Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinDarkRoomD16.bpl">ExpressSkins - Darkroom Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinDarkSideD16.bpl">ExpressSkins - DarkSide Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinDevExpressDarkStyleD16.bpl">ExpressSkins - DevExpressDarkStyle Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinDevExpressStyleD16.bpl">ExpressSkins - DevExpressStyle Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinFoggyD16.bpl">ExpressSkins - Foggy Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinGlassOceansD16.bpl">ExpressSkins - GlassOceans Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinHighContrastD16.bpl">ExpressSkins - HighContrast Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkiniMaginaryD16.bpl">ExpressSkins - iMaginary Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinLilianD16.bpl">ExpressSkins - Lilian Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinLiquidSkyD16.bpl">ExpressSkins - LiquidSky Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinLondonLiquidSkyD16.bpl">ExpressSkins - LondonLiquidSky Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinMcSkinD16.bpl">ExpressSkins - McSkin Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinMoneyTwinsD16.bpl">ExpressSkins - MoneyTwins Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2007BlackD16.bpl">ExpressSkins - Office2007Black Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2007BlueD16.bpl">ExpressSkins - Office2007Blue Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2007GreenD16.bpl">ExpressSkins - Office2007Green Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2007PinkD16.bpl">ExpressSkins - Office2007Pink Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2007SilverD16.bpl">ExpressSkins - Office2007Silver Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2010BlackD16.bpl">ExpressSkins - Office2010Black Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2010BlueD16.bpl">ExpressSkins - Office2010Blue Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2010SilverD16.bpl">ExpressSkins - Office2010Silver Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinPumpkinD16.bpl">ExpressSkins - Pumpkin Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinSevenClassicD16.bpl">ExpressSkins - SevenClassic Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinSevenD16.bpl">ExpressSkins - Seven Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinSharpD16.bpl">ExpressSkins - Sharp Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinSharpPlusD16.bpl">ExpressSkins - SharpPlus Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinSilverD16.bpl">ExpressSkins - Silver Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinSpringTimeD16.bpl">ExpressSkins - Springtime Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinStardustD16.bpl">ExpressSkins - Stardust Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinSummer2008D16.bpl">ExpressSkins - Summer2008 Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinTheAsphaltWorldD16.bpl">ExpressSkins - TheAsphaltWorld Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinValentineD16.bpl">ExpressSkins - Valentine Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinVS2010D16.bpl">ExpressSkins - VS2010 Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinWhiteprintD16.bpl">ExpressSkins - Whiteprint Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinXmas2008BlueD16.bpl">ExpressSkins - Xmas2008Blue Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSLnksD16.bpl">ExpressPrinting System ReportLinks (Standard) by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxPScxPCProdD16.bpl">ExpressPrinting System ContainerProducer for ExpressPageControl by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxdbtrD16.bpl">ExpressDBTree by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxtrmdD16.bpl">ExpressTreePrintedDataSet by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxDBOrD16.bpl">ExpressDBOrgChart by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxFlowChartD16.bpl">ExpressFlowChart by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxPageControldxBarPopupMenuD16.bpl">ExpressPageControl dxBar Popup Menu by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxBarEditItemD16.bpl">ExpressBars cxEditor item by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxSchedulerGridD16.bpl">ExpressScheduler connection to ExpressQuantumGrid by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxTreeListdxBarPopupMenuD16.bpl">ExpressQuantumTreeList 5 dxBar Built-In Menu by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSkinscxEditorsHelperD16.bpl">ExpressSkins Library Uses Clause Auto Fill Helper for ExpressEditors by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSkinscxPCPainterD16.bpl">ExpressSkins Library Uses Clause Auto Fill Helper for PageControl Painter by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSkinscxSchedulerPainterD16.bpl">ExpressSkins Library Uses Clause Auto Fill Helper for Scheduler Painter by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSkinsdxBarsPaintersD16.bpl">ExpressSkins Library Uses Clause Auto Fill Helper for Bars Painters by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSkinsdxNavBarPainterD16.bpl">ExpressSkins Library Uses Clause Auto Fill Helper for NavBar Painter by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSkinsdxRibbonPaintersD16.bpl">ExpressSkins Library Uses Clause Auto Fill Helper for Ribbon Painters by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxCommonD16.bpl">ExpressPrinting System Cross Platform Library by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxExtCommonD16.bpl">ExpressPrinting System Extended Cross Platform Library by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxPivotGridLnkD16.bpl">ExpressPrinting System ReportLink for ExpressPivotGrid by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxSchedulerLnkD16.bpl">ExpressPrinting System ReportLink for ExpressScheduler by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxSSLnkD16.bpl">ExpressPrinting System ReportLink for ExpressSpreadSheet by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxTLLnkD16.bpl">ExpressPrinting System ReportLink for ExpressQuantumTreeList by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxVGridLnkD16.bpl">ExpressPrinting System ReportLink for ExpressVerticalGrid by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSdxDBOCLnkD16.bpl">ExpressPrinting System ReportLinks for ExpressDBOrgChart by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSdxDBTVLnkD16.bpl">ExpressPrinting System ReportLink for ExpressDBTree by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSdxFCLnkD16.bpl">ExpressPrinting System ReportLinks for ExpressFlowChart by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxGridLnkD16.bpl">ExpressPrinting System ReportLink for ExpressQuantumGrid by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSdxOCLnkD16.bpl">ExpressPrinting System ReportLinks for ExpressOrgChart by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSPrVwAdvD16.bpl">ExpressPrinting System Advanced Preview Window by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSPrVwRibbonD16.bpl">ExpressPrinting System Ribbon Preview Window by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxPivotGridChartD16.bpl">ExpressPivotGrid 2 connection to ExpressQuantumGrid Chart View 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>
@ -165,15 +270,35 @@
</DCCReference>
<DCCReference Include="..\Shared\LogiJoystickDLL.pas"/>
<DCCReference Include="..\Shared\SimConnect.pas"/>
<DCCReference Include="Forms\ButtonSelectFrm.pas">
<Form>ButtonSelectForm</Form>
<DCCReference Include="Units\G940LEDStateConsumer.pas"/>
<DCCReference Include="Units\LEDStateConsumer.pas"/>
<DCCReference Include="Units\LEDColorIntf.pas"/>
<DCCReference Include="Units\LEDColor.pas"/>
<DCCReference Include="Units\LEDFunctionIntf.pas"/>
<DCCReference Include="Units\LEDFunction.pas"/>
<DCCReference Include="Units\StaticLEDFunction.pas"/>
<DCCReference Include="Units\ConfigConversion.pas"/>
<DCCReference Include="Units\LEDFunctionRegistry.pas"/>
<DCCReference Include="Units\StaticLEDColor.pas"/>
<DCCReference Include="Units\DynamicLEDColor.pas"/>
<DCCReference Include="Units\LEDStateIntf.pas"/>
<DCCReference Include="Units\LEDState.pas"/>
<DCCReference Include="Units\Profile.pas"/>
<DCCReference Include="Units\LEDColorPool.pas"/>
<DCCReference Include="Forms\ButtonFunctionFrm.pas">
<Form>ButtonFunctionForm</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="Units\FSXLEDStateProvider.pas"/>
<DCCReference Include="Units\G940LEDStateConsumer.pas"/>
<DCCReference Include="Units\LEDFunctionMap.pas"/>
<DCCReference Include="Units\LEDStateConsumer.pas"/>
<DCCReference Include="Units\LEDStateProvider.pas"/>
<DCCReference Include="Units\FSXLEDFunctionProvider.pas"/>
<DCCReference Include="Units\StaticResources.pas"/>
<DCCReference Include="Units\FSXResources.pas"/>
<DCCReference Include="Units\FSXSimConnectClient.pas"/>
<DCCReference Include="Units\FSXSimConnectIntf.pas"/>
<DCCReference Include="Units\FSXLEDFunction.pas"/>
<DCCReference Include="Units\LEDResources.pas"/>
<DCCReference Include="Units\Settings.pas"/>
<DCCReference Include="Units\FSXLEDFunctionWorker.pas"/>
<DCCReference Include="Units\FSXSimConnectStateMonitor.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>

BIN
G940LEDControl/G940LEDControl.res
View File

Binary file not shown.

BIN
G940LEDControl/Resources/Images/FSXConnected.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
G940LEDControl/Resources/Images/FSXDisconnected.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
G940LEDControl/Resources/Images/Found.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 5.5 KiB

After

Width:  |  Height:  |  Size: 5.2 KiB

BIN
G940LEDControl/Resources/Images/NotFound.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 4.1 KiB

After

Width:  |  Height:  |  Size: 5.1 KiB

254
G940LEDControl/Units/ConfigConversion.pas Normal file
View File

@ -0,0 +1,254 @@
unit ConfigConversion;
interface
uses
Profile,
Settings;
{ Version 0.x: registry -> 1.x: XML }
function ConvertProfile0To1: TProfile;
function ConvertSettings0To1: TSettings;
implementation
uses
System.SysUtils,
Winapi.Windows,
X2UtPersistIntf,
X2UtPersistRegistry,
FSXResources,
LEDColorIntf,
StaticResources;
const
V0_FUNCTION_NONE = 0;
V0_FUNCTION_OFF = 1;
V0_FUNCTION_RED = 2;
V0_FUNCTION_AMBER = 3;
V0_FUNCTION_GREEN = 4;
V0_FUNCTIONPROVIDER_OFFSET = V0_FUNCTION_GREEN;
V0_FUNCTIONFSX_GEAR = V0_FUNCTIONPROVIDER_OFFSET + 1;
V0_FUNCTIONFSX_LANDINGLIGHTS = V0_FUNCTIONPROVIDER_OFFSET + 2;
V0_FUNCTIONFSX_INSTRUMENTLIGHTS = V0_FUNCTIONPROVIDER_OFFSET + 3;
V0_FUNCTIONFSX_PARKINGBRAKE = V0_FUNCTIONPROVIDER_OFFSET + 4;
V0_FUNCTIONFSX_ENGINE = V0_FUNCTIONPROVIDER_OFFSET + 5;
V0_FUNCTIONFSX_EXITDOOR = V0_FUNCTIONPROVIDER_OFFSET + 6;
V0_FUNCTIONFSX_STROBELIGHTS = V0_FUNCTIONPROVIDER_OFFSET + 7;
V0_FUNCTIONFSX_NAVLIGHTS = V0_FUNCTIONPROVIDER_OFFSET + 8;
V0_FUNCTIONFSX_BEACONLIGHTS = V0_FUNCTIONPROVIDER_OFFSET + 9;
V0_FUNCTIONFSX_FLAPS = V0_FUNCTIONPROVIDER_OFFSET + 10;
V0_FUNCTIONFSX_BATTERYMASTER = V0_FUNCTIONPROVIDER_OFFSET + 11;
V0_FUNCTIONFSX_AVIONICSMASTER = V0_FUNCTIONPROVIDER_OFFSET + 12;
V0_FUNCTIONFSX_SPOILERS = V0_FUNCTIONPROVIDER_OFFSET + 13;
V0_FUNCTIONFSX_PRESSURIZATIONDUMPSWITCH = V0_FUNCTIONPROVIDER_OFFSET + 14;
V0_FUNCTIONFSX_ENGINEANTIICE = V0_FUNCTIONPROVIDER_OFFSET + 15;
V0_FUNCTIONFSX_AUTOPILOT = V0_FUNCTIONPROVIDER_OFFSET + 16;
V0_FUNCTIONFSX_FUELPUMP = V0_FUNCTIONPROVIDER_OFFSET + 17;
V0_FUNCTIONFSX_TAILHOOK = V0_FUNCTIONPROVIDER_OFFSET + 18;
V0_FUNCTIONFSX_AUTOPILOT_AMBER = V0_FUNCTIONPROVIDER_OFFSET + 19;
V0_FUNCTIONFSX_AUTOPILOT_HEADING = V0_FUNCTIONPROVIDER_OFFSET + 20;
V0_FUNCTIONFSX_AUTOPILOT_APPROACH = V0_FUNCTIONPROVIDER_OFFSET + 21;
V0_FUNCTIONFSX_AUTOPILOT_BACKCOURSE = V0_FUNCTIONPROVIDER_OFFSET + 22;
V0_FUNCTIONFSX_AUTOPILOT_ALTITUDE = V0_FUNCTIONPROVIDER_OFFSET + 23;
V0_FUNCTIONFSX_AUTOPILOT_NAV = V0_FUNCTIONPROVIDER_OFFSET + 24;
V0_FUNCTIONFSX_TAXILIGHTS = V0_FUNCTIONPROVIDER_OFFSET + 25;
V0_FUNCTIONFSX_RECOGNITIONLIGHTS = V0_FUNCTIONPROVIDER_OFFSET + 26;
V0_FUNCTIONFSX_DEICE = V0_FUNCTIONPROVIDER_OFFSET + 27;
procedure ConvertProfileFunction0To1(AOldFunction: Integer; AButton: TProfileButton);
procedure SetButton(const AProviderUID, AFunctionUID: string);
begin
AButton.ProviderUID := AProviderUID;
AButton.FunctionUID := AFunctionUID;
end;
begin
{ Default states are handled by the specific functions }
case AOldFunction of
{ Static }
V0_FUNCTION_OFF: SetButton(StaticProviderUID, StaticFunctionUID[lcOff]);
V0_FUNCTION_RED: SetButton(StaticProviderUID, StaticFunctionUID[lcRed]);
V0_FUNCTION_AMBER: SetButton(StaticProviderUID, StaticFunctionUID[lcAmber]);
V0_FUNCTION_GREEN: SetButton(StaticProviderUID, StaticFunctionUID[lcGreen]);
{ FSX }
V0_FUNCTIONFSX_GEAR: SetButton(FSXProviderUID, FSXFunctionUIDGear);
V0_FUNCTIONFSX_LANDINGLIGHTS: SetButton(FSXProviderUID, FSXFunctionUIDLandingLights);
V0_FUNCTIONFSX_INSTRUMENTLIGHTS: SetButton(FSXProviderUID, FSXFunctionUIDInstrumentLights);
V0_FUNCTIONFSX_PARKINGBRAKE: SetButton(FSXProviderUID, FSXFunctionUIDParkingBrake);
V0_FUNCTIONFSX_ENGINE: SetButton(FSXProviderUID, FSXFunctionUIDEngine);
V0_FUNCTIONFSX_EXITDOOR: SetButton(FSXProviderUID, FSXFunctionUIDExitDoor);
V0_FUNCTIONFSX_STROBELIGHTS: SetButton(FSXProviderUID, FSXFunctionUIDStrobeLights);
V0_FUNCTIONFSX_NAVLIGHTS: SetButton(FSXProviderUID, FSXFunctionUIDNavLights);
V0_FUNCTIONFSX_BEACONLIGHTS: SetButton(FSXProviderUID, FSXFunctionUIDBeaconLights);
V0_FUNCTIONFSX_FLAPS: SetButton(FSXProviderUID, FSXFunctionUIDFlaps);
V0_FUNCTIONFSX_BATTERYMASTER: SetButton(FSXProviderUID, FSXFunctionUIDBatteryMaster);
V0_FUNCTIONFSX_AVIONICSMASTER: SetButton(FSXProviderUID, FSXFunctionUIDAvionicsMaster);
V0_FUNCTIONFSX_SPOILERS: SetButton(FSXProviderUID, FSXFunctionUIDSpoilers);
V0_FUNCTIONFSX_PRESSURIZATIONDUMPSWITCH: SetButton(FSXProviderUID, FSXFunctionUIDPressDumpSwitch);
V0_FUNCTIONFSX_ENGINEANTIICE: SetButton(FSXProviderUID, FSXFunctionUIDEngineAntiIce);
V0_FUNCTIONFSX_AUTOPILOT:
begin
{ The new default is Green / Off }
SetButton(FSXProviderUID, FSXFunctionUIDAutoPilot);
AButton.SetStateColor(FSXStateUIDOn, lcGreen);
AButton.SetStateColor(FSXStateUIDOff, lcRed);
end;
V0_FUNCTIONFSX_TAILHOOK: SetButton(FSXProviderUID, FSXFunctionUIDTailHook);
V0_FUNCTIONFSX_AUTOPILOT_AMBER:
begin
{ The new default is Green / Off }
SetButton(FSXProviderUID, FSXFunctionUIDAutoPilot);
AButton.SetStateColor(FSXStateUIDOn, lcAmber);
AButton.SetStateColor(FSXStateUIDOff, lcOff);
end;
V0_FUNCTIONFSX_AUTOPILOT_HEADING:
begin
{ The new default is Green / Off }
SetButton(FSXProviderUID, FSXFunctionUIDAutoPilotHeading);
AButton.SetStateColor(FSXStateUIDOn, lcAmber);
AButton.SetStateColor(FSXStateUIDOff, lcOff);
end;
V0_FUNCTIONFSX_AUTOPILOT_APPROACH:
begin
{ The new default is Green / Off }
SetButton(FSXProviderUID, FSXFunctionUIDAutoPilotApproach);
AButton.SetStateColor(FSXStateUIDOn, lcAmber);
AButton.SetStateColor(FSXStateUIDOff, lcOff);
end;
V0_FUNCTIONFSX_AUTOPILOT_BACKCOURSE:
begin
{ The new default is Green / Off }
SetButton(FSXProviderUID, FSXFunctionUIDAutoPilotBackcourse);
AButton.SetStateColor(FSXStateUIDOn, lcAmber);
AButton.SetStateColor(FSXStateUIDOff, lcOff);
end;
V0_FUNCTIONFSX_AUTOPILOT_ALTITUDE:
begin
{ The new default is Green / Off }
SetButton(FSXProviderUID, FSXFunctionUIDAutoPilotAltitude);
AButton.SetStateColor(FSXStateUIDOn, lcAmber);
AButton.SetStateColor(FSXStateUIDOff, lcOff);
end;
V0_FUNCTIONFSX_AUTOPILOT_NAV:
begin
{ The new default is Green / Off }
SetButton(FSXProviderUID, FSXFunctionUIDAutoPilotNav);
AButton.SetStateColor(FSXStateUIDOn, lcAmber);
AButton.SetStateColor(FSXStateUIDOff, lcOff);
end;
V0_FUNCTIONFSX_TAXILIGHTS: SetButton(FSXProviderUID, FSXFunctionUIDTaxiLights);
V0_FUNCTIONFSX_RECOGNITIONLIGHTS: SetButton(FSXProviderUID, FSXFunctionUIDRecognitionLights);
V0_FUNCTIONFSX_DEICE: SetButton(FSXProviderUID, FSXFunctionUIDDeIce);
end;
end;
function ConvertProfile0To1: TProfile;
const
KEY_SETTINGS = '\Software\X2Software\G940LEDControl\';
SECTION_DEFAULTPROFILE = 'DefaultProfile';
SECTION_FSX = 'FSX';
var
registryReader: TX2UtPersistRegistry;
reader: IX2PersistReader;
buttonIndex: Integer;
value: Integer;
begin
Result := nil;
registryReader := TX2UtPersistRegistry.Create;
try
registryReader.RootKey := HKEY_CURRENT_USER;
registryReader.Key := KEY_SETTINGS;
reader := registryReader.CreateReader;
if reader.BeginSection(SECTION_DEFAULTPROFILE) then
try
if reader.BeginSection(SECTION_FSX) then
try
for buttonIndex := 0 to 7 do
begin
if reader.ReadInteger('Function' + IntToStr(buttonIndex), value) then
begin
if not Assigned(Result) then
Result := TProfile.Create;
ConvertProfileFunction0To1(value, Result.Buttons[buttonIndex]);
end;
end;
finally
reader.EndSection;
end;
finally
reader.EndSection;
end;
finally
FreeAndNil(registryReader);
end;
end;
function ConvertSettings0To1: TSettings;
const
KEY_SETTINGS = '\Software\X2Software\G940LEDControl\';
SECTION_SETTINGS = 'Settings';
var
registryReader: TX2UtPersistRegistry;
reader: IX2PersistReader;
value: Boolean;
begin
Result := nil;
registryReader := TX2UtPersistRegistry.Create;
try
registryReader.RootKey := HKEY_CURRENT_USER;
registryReader.Key := KEY_SETTINGS;
reader := registryReader.CreateReader;
if reader.BeginSection(SECTION_SETTINGS) then
try
if reader.ReadBoolean('CheckUpdates', value) then
begin
Result := TSettings.Create;
Result.CheckUpdates := value;
end;
finally
reader.EndSection;
end;
finally
FreeAndNil(registryReader);
end;
end;
end.

83
G940LEDControl/Units/DynamicLEDColor.pas Normal file
View File

@ -0,0 +1,83 @@
unit DynamicLEDColor;
interface
uses
LEDColor,
LEDColorIntf;
const
TICKINTERVAL_NORMAL = 2;
TICKINTERVAL_FAST = 1;
type
TStaticLEDColorDynArray = array of TStaticLEDColor;
TDynamicLEDColor = class(TCustomLEDStateDynamicColor)
private
FCycleColors: TStaticLEDColorDynArray;
FCycleIndex: Integer;
FTickInterval: Integer;
FTickCount: Integer;
protected
{ ILEDState }
function GetCurrentColor: TStaticLEDColor; override;
{ ITickLEDState }
procedure Reset; override;
procedure Tick; override;
public
constructor Create(ACycleColors: TStaticLEDColorDynArray; ATickInterval: Integer = TICKINTERVAL_NORMAL);
end;
implementation
uses
SysUtils;
{ TDynamicLEDState }
constructor TDynamicLEDColor.Create(ACycleColors: TStaticLEDColorDynArray; ATickInterval: Integer);
begin
inherited Create;
if Length(ACycleColors) = 0 then
raise Exception.Create(Self.ClassName + ' must have at least one color in a cycle');
FCycleColors := ACycleColors;
FCycleIndex := Low(FCycleColors);
FTickInterval := ATickInterval;
Reset;
end;
function TDynamicLEDColor.GetCurrentColor: TStaticLEDColor;
begin
Result := FCycleColors[FCycleIndex];
end;
procedure TDynamicLEDColor.Reset;
begin
FCycleIndex := 0;
end;
procedure TDynamicLEDColor.Tick;
begin
Inc(FTickCount);
if FTickCount >= FTickInterval then
begin
Inc(FCycleIndex);
if FCycleIndex > High(FCycleColors) then
FCycleIndex := 0;
FTickCount := 0;
end;
end;
end.

555
G940LEDControl/Units/FSXLEDFunction.pas Normal file
View File

@ -0,0 +1,555 @@
unit FSXLEDFunction;
interface
uses
FSXLEDFunctionProvider,
LEDFunction,
LEDFunctionIntf;
type
TCustomFSXOnOffFunction = class(TCustomFSXFunction)
protected
procedure RegisterStates; override;
end;
TCustomFSXInvertedOnOffFunction = class(TCustomFSXFunction)
protected
procedure RegisterStates; override;
end;
{ Systems }
TCustomFSXSystemsFunction = class(TCustomFSXFunction)
protected
function GetCategoryName: string; override;
end;
TFSXBatteryMasterFunction = class(TCustomFSXOnOffFunction)
protected
function GetCategoryName: string; override;
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
TFSXDeIceFunction = class(TCustomFSXInvertedOnOffFunction)
protected
function GetCategoryName: string; override;
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
TFSXExitDoorFunction = class(TCustomFSXSystemsFunction)
protected
procedure RegisterStates; override;
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
TFSXGearFunction = class(TCustomFSXSystemsFunction)
protected
procedure RegisterStates; override;
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
TFSXParkingBrakeFunction = class(TCustomFSXInvertedOnOffFunction)
protected
function GetCategoryName: string; override;
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
TFSXPressDumpSwitchFunction = class(TCustomFSXInvertedOnOffFunction)
protected
function GetCategoryName: string; override;
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
TFSXTailHookFunction = class(TCustomFSXSystemsFunction)
protected
procedure RegisterStates; override;
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
{ Engines }
TFSXEngineAntiIceFunction = class(TCustomFSXFunction)
protected
function GetCategoryName: string; override;
procedure RegisterStates; override;
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
TFSXEngineFunction = class(TCustomFSXFunction)
protected
function GetCategoryName: string; override;
procedure RegisterStates; override;
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
{ Control surfaces }
TFSXFlapsFunction = class(TCustomFSXFunction)
protected
function GetCategoryName: string; override;
procedure RegisterStates; override;
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
TFSXSpoilersFunction = class(TCustomFSXFunction)
protected
function GetCategoryName: string; override;
procedure RegisterStates; override;
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
{ Lights }
TCustomFSXLightFunction = class(TCustomFSXOnOffFunction)
protected
function GetCategoryName: string; override;
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
function DoCreateWorker(ASettings: ILEDFunctionWorkerSettings; const APreviousState: string = ''): TCustomLEDFunctionWorker; override;
protected
function GetLightMask: Integer; virtual; abstract;
end;
TFSXLandingLightsFunction = class(TCustomFSXLightFunction)
protected
function GetLightMask: Integer; override;
end;
TFSXInstrumentLightsFunction = class(TCustomFSXLightFunction)
protected
function GetLightMask: Integer; override;
end;
TFSXBeaconLightsFunction = class(TCustomFSXLightFunction)
protected
function GetLightMask: Integer; override;
end;
TFSXNavLightsFunction = class(TCustomFSXLightFunction)
protected
function GetLightMask: Integer; override;
end;
TFSXStrobeLightsFunction = class(TCustomFSXLightFunction)
protected
function GetLightMask: Integer; override;
end;
TFSXTaxiLightsFunction = class(TCustomFSXLightFunction)
protected
function GetLightMask: Integer; override;
end;
TFSXRecognitionLightsFunction = class(TCustomFSXLightFunction)
protected
function GetLightMask: Integer; override;
end;
{ Autopilot }
TCustomFSXAutoPilotFunction = class(TCustomFSXFunction)
protected
procedure RegisterStates; override;
function GetCategoryName: string; override;
end;
TFSXAutoPilotFunction = class(TCustomFSXAutoPilotFunction)
protected
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
TFSXAutoPilotHeadingFunction = class(TCustomFSXAutoPilotFunction)
protected
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
TFSXAutoPilotApproachFunction = class(TCustomFSXAutoPilotFunction)
protected
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
TFSXAutoPilotBackcourseFunction = class(TCustomFSXAutoPilotFunction)
protected
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
TFSXAutoPilotAltitudeFunction = class(TCustomFSXAutoPilotFunction)
protected
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
TFSXAutoPilotNavFunction = class(TCustomFSXAutoPilotFunction)
protected
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
{ Radios }
TFSXAvionicsMasterFunction = class(TCustomFSXOnOffFunction)
protected
function GetCategoryName: string; override;
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override;
end;
implementation
uses
FSXLEDFunctionWorker,
FSXResources,
FSXSimConnectIntf,
LEDColorIntf,
LEDState;
{ TFSXOnOffFunction }
procedure TCustomFSXOnOffFunction.RegisterStates;
begin
RegisterState(TLEDState.Create(FSXStateUIDOn, FSXStateDisplayNameOn, lcGreen));
RegisterState(TLEDState.Create(FSXStateUIDOff, FSXStateDisplayNameOff, lcRed));
end;
{ TCustomFSXInvertedOnOffFunction }
procedure TCustomFSXInvertedOnOffFunction.RegisterStates;
begin
RegisterState(TLEDState.Create(FSXStateUIDOn, FSXStateDisplayNameOn, lcRed));
RegisterState(TLEDState.Create(FSXStateUIDOff, FSXStateDisplayNameOff, lcGreen));
end;
{ TCustomFSXSystemsFunction }
function TCustomFSXSystemsFunction.GetCategoryName: string;
begin
Result := FSXCategorySystems;
end;
{ TFSXBatteryMasterFunction }
function TFSXBatteryMasterFunction.GetCategoryName: string;
begin
Result := FSXCategorySystems;
end;
function TFSXBatteryMasterFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXBatteryMasterFunctionWorker;
end;
{ TFSXDeIceFunction }
function TFSXDeIceFunction.GetCategoryName: string;
begin
Result := FSXCategorySystems;
end;
function TFSXDeIceFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXDeIceFunctionWorker;
end;
{ TFSXExitDoorFunction }
procedure TFSXExitDoorFunction.RegisterStates;
begin
RegisterState(TLEDState.Create(FSXStateUIDExitDoorClosed, FSXStateDisplayNameExitDoorClosed, lcGreen));
RegisterState(TLEDState.Create(FSXStateUIDExitDoorBetween, FSXStateDisplayNameExitDoorBetween, lcAmber));
RegisterState(TLEDState.Create(FSXStateUIDExitDoorOpen, FSXStateDisplayNameExitDoorOpen, lcRed));
end;
function TFSXExitDoorFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXExitDoorFunctionWorker;
end;
{ TFSXGearFunction }
procedure TFSXGearFunction.RegisterStates;
begin
RegisterState(TLEDState.Create(FSXStateUIDGearNotRetractable, FSXStateDisplayNameGearNotRetractable, lcOff));
RegisterState(TLEDState.Create(FSXStateUIDGearRetracted, FSXStateDisplayNameGearRetracted, lcRed));
RegisterState(TLEDState.Create(FSXStateUIDGearBetween, FSXStateDisplayNameGearBetween, lcAmber));
RegisterState(TLEDState.Create(FSXStateUIDGearExtended, FSXStateDisplayNameGearExtended, lcGreen));
RegisterState(TLEDState.Create(FSXStateUIDGearSpeedExceeded, FSXStateDisplayNameGearSpeedExceeded, lcFlashingAmberNormal));
RegisterState(TLEDState.Create(FSXStateUIDGearDamageBySpeed, FSXStateDisplayNameGearDamageBySpeed, lcFlashingRedFast));
end;
function TFSXGearFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXGearFunctionWorker;
end;
{ TFSXParkingBrakeFunction }
function TFSXParkingBrakeFunction.GetCategoryName: string;
begin
Result := FSXCategorySystems;
end;
function TFSXParkingBrakeFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXParkingBrakeFunctionWorker;
end;
{ TFSXPressDumpSwitchFunction }
function TFSXPressDumpSwitchFunction.GetCategoryName: string;
begin
Result := FSXCategorySystems;
end;
function TFSXPressDumpSwitchFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXPressDumpSwitchFunctionWorker;
end;
{ TFSXTailHookFunction }
procedure TFSXTailHookFunction.RegisterStates;
begin
RegisterState(TLEDState.Create(FSXStateUIDTailHookRetracted, FSXStateDisplayNameTailHookRetracted, lcGreen));
RegisterState(TLEDState.Create(FSXStateUIDTailHookBetween, FSXStateDisplayNameTailHookBetween, lcAmber));
RegisterState(TLEDState.Create(FSXStateUIDTailHookExtended, FSXStateDisplayNameTailHookExtended, lcRed));
end;
function TFSXTailHookFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXTailHookFunctionWorker;
end;
{ TFSXEngineAntiIceFunction }
function TFSXEngineAntiIceFunction.GetCategoryName: string;
begin
Result := FSXCategoryEngines;
end;
procedure TFSXEngineAntiIceFunction.RegisterStates;
begin
RegisterState(TLEDState.Create(FSXStateUIDEngineAntiIceNoEngines, FSXStateDisplayNameEngineAntiIceNoEngines, lcOff));
RegisterState(TLEDState.Create(FSXStateUIDEngineAntiIceAll, FSXStateDisplayNameEngineAntiIceAll, lcRed));
RegisterState(TLEDState.Create(FSXStateUIDEngineAntiIcePartial, FSXStateDisplayNameEngineAntiIcePartial, lcAmber));
RegisterState(TLEDState.Create(FSXStateUIDEngineAntiIceNone, FSXStateDisplayNameEngineAntiIceNone, lcGreen));
end;
function TFSXEngineAntiIceFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXEngineAntiIceFunctionWorker;
end;
{ TFSXEngineFunction }
function TFSXEngineFunction.GetCategoryName: string;
begin
Result := FSXCategoryEngines;
end;
procedure TFSXEngineFunction.RegisterStates;
begin
RegisterState(TLEDState.Create(FSXStateUIDEngineNoEngines, FSXStateDisplayNameEngineNoEngines, lcOff));
RegisterState(TLEDState.Create(FSXStateUIDEngineAllRunning, FSXStateDisplayNameEngineAllRunning, lcGreen));
RegisterState(TLEDState.Create(FSXStateUIDEnginePartiallyRunning, FSXStateDisplayNameEnginePartiallyRunning, lcAmber));
RegisterState(TLEDState.Create(FSXStateUIDEngineAllOff, FSXStateDisplayNameEngineAllOff, lcRed));
RegisterState(TLEDState.Create(FSXStateUIDEngineFailed, FSXStateDisplayNameEngineFailed, lcFlashingRedNormal));
RegisterState(TLEDState.Create(FSXStateUIDEngineOnFire, FSXStateDisplayNameEngineOnFire, lcFlashingRedFast));
end;
function TFSXEngineFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXEngineFunctionWorker;
end;
{ TFSXFlapsFunction }
function TFSXFlapsFunction.GetCategoryName: string;
begin
Result := FSXCategoryControlSurfaces;
end;
procedure TFSXFlapsFunction.RegisterStates;
begin
RegisterState(TLEDState.Create(FSXStateUIDFlapsNotAvailable, FSXStateDisplayNameFlapsNotAvailable, lcOff));
RegisterState(TLEDState.Create(FSXStateUIDFlapsRetracted, FSXStateDisplayNameFlapsRetracted, lcGreen));
RegisterState(TLEDState.Create(FSXStateUIDFlapsBetween, FSXStateDisplayNameFlapsBetween, lcAmber));
RegisterState(TLEDState.Create(FSXStateUIDFlapsExtended, FSXStateDisplayNameFlapsExtended, lcRed));
RegisterState(TLEDState.Create(FSXStateUIDFlapsSpeedExceeded, FSXStateDisplayNameFlapsSpeedExceeded, lcFlashingAmberNormal));
RegisterState(TLEDState.Create(FSXStateUIDFlapsDamageBySpeed, FSXStateDisplayNameFlapsDamageBySpeed, lcFlashingRedFast));
end;
function TFSXFlapsFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXFlapsFunctionWorker;
end;
{ TFSXSpoilersFunction }
function TFSXSpoilersFunction.GetCategoryName: string;
begin
Result := FSXCategoryControlSurfaces;
end;
procedure TFSXSpoilersFunction.RegisterStates;
begin
RegisterState(TLEDState.Create(FSXStateUIDSpoilersNotAvailable, FSXStateDisplayNameSpoilersNotAvailable, lcOff));
RegisterState(TLEDState.Create(FSXStateUIDSpoilersRetracted, FSXStateDisplayNameSpoilersRetracted, lcGreen));
RegisterState(TLEDState.Create(FSXStateUIDSpoilersBetween, FSXStateDisplayNameSpoilersBetween, lcAmber));
RegisterState(TLEDState.Create(FSXStateUIDSpoilersExtended, FSXStateDisplayNameSpoilersExtended, lcRed));
end;
function TFSXSpoilersFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXSpoilersFunctionWorker;
end;
{ TFSXLightFunction }
function TCustomFSXLightFunction.GetCategoryName: string;
begin
Result := FSXCategoryLights;
end;
function TCustomFSXLightFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXLightStatesFunctionWorker;
end;
function TCustomFSXLightFunction.DoCreateWorker(ASettings: ILEDFunctionWorkerSettings; const APreviousState: string): TCustomLEDFunctionWorker;
begin
Result := inherited DoCreateWorker(ASettings, APreviousState);
(Result as TFSXLightStatesFunctionWorker).StateMask := GetLightMask;
end;
{ TFSXLandingLightsFunction }
function TFSXLandingLightsFunction.GetLightMask: Integer;
begin
Result := FSX_LIGHTON_LANDING;
end;
{ TFSXInstrumentLightsFunction }
function TFSXInstrumentLightsFunction.GetLightMask: Integer;
begin
Result := FSX_LIGHTON_PANEL;
end;
{ TFSXBeaconLightsFunction }
function TFSXBeaconLightsFunction.GetLightMask: Integer;
begin
Result := FSX_LIGHTON_BEACON;
end;
{ TFSXNavLightsFunction }
function TFSXNavLightsFunction.GetLightMask: Integer;
begin
Result := FSX_LIGHTON_NAV;
end;
{ TFSXStrobeLightsFunction }
function TFSXStrobeLightsFunction.GetLightMask: Integer;
begin
Result := FSX_LIGHTON_STROBE;
end;
{ TFSXTaxiLightsFunction }
function TFSXTaxiLightsFunction.GetLightMask: Integer;
begin
Result := FSX_LIGHTON_TAXI;
end;
{ TFSXRecognitionLightsFunction }
function TFSXRecognitionLightsFunction.GetLightMask: Integer;
begin
Result := FSX_LIGHTON_RECOGNITION;
end;
{ TCustomFSXAutoPilotFunction }
function TCustomFSXAutoPilotFunction.GetCategoryName: string;
begin
Result := FSXCategoryAutoPilot;
end;
procedure TCustomFSXAutoPilotFunction.RegisterStates;
begin
RegisterState(TLEDState.Create(FSXStateUIDAutoPilotNotAvailable, FSXStateDisplayNameAutoPilotNotAvailable, lcOff));
RegisterState(TLEDState.Create(FSXStateUIDOn, FSXStateDisplayNameOn, lcGreen));
RegisterState(TLEDState.Create(FSXStateUIDOff, FSXStateDisplayNameOff, lcOff));
end;
{ TFSXAutoPilotFunction }
function TFSXAutoPilotFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXAutoPilotFunctionWorker;
end;
{ TFSXAutoPilotHeadingFunction }
function TFSXAutoPilotHeadingFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXAutoPilotHeadingFunctionWorker;
end;
{ TFSXAutoPilotApproachFunction }
function TFSXAutoPilotApproachFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXAutoPilotApproachFunctionWorker;
end;
{ TFSXAutoPilotBackcourseFunction }
function TFSXAutoPilotBackcourseFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXAutoPilotBackcourseFunctionWorker;
end;
{ TFSXAutoPilotAltitudeFunction }
function TFSXAutoPilotAltitudeFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXAutoPilotAltitudeFunctionWorker;
end;
{ TFSXAutoPilotNavFunction }
function TFSXAutoPilotNavFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXAutoPilotNavFunctionWorker;
end;
{ TFSXAvionicsMasterFunction }
function TFSXAvionicsMasterFunction.GetCategoryName: string;
begin
Result := FSXCategoryRadios;
end;
function TFSXAvionicsMasterFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass;
begin
Result := TFSXAvionicsMasterFunctionWorker;
end;
end.

293
G940LEDControl/Units/FSXLEDFunctionProvider.pas Normal file
View File

@ -0,0 +1,293 @@
unit FSXLEDFunctionProvider;
interface
uses
Generics.Collections,
System.SyncObjs,
FSXSimConnectIntf,
LEDFunction,
LEDFunctionIntf,
LEDStateIntf;
type
TCustomFSXFunction = class;
TCustomFSXFunctionList = TObjectList<TCustomFSXFunction>;
TFSXLEDFunctionProvider = class(TCustomLEDFunctionProvider, IFSXSimConnectObserver)
private
FSimConnect: TInterfacedObject;
FSimConnectLock: TCriticalSection;
protected
procedure RegisterFunctions; override;
function GetUID: string; override;
protected
{ IFSXSimConnectObserver }
procedure ObserveDestroy(Sender: IFSXSimConnect);
public
constructor Create;
destructor Destroy; override;
function GetSimConnect: IFSXSimConnect;
end;
TCustomFSXFunction = class(TCustomMultiStateLEDFunction)
private
FProvider: TFSXLEDFunctionProvider;
FDisplayName: string;
FUID: string;
protected
function DoCreateWorker(ASettings: ILEDFunctionWorkerSettings; const APreviousState: string = ''): TCustomLEDFunctionWorker; override;
property Provider: TFSXLEDFunctionProvider read FProvider;
protected
function GetCategoryName: string; override;
function GetDisplayName: string; override;
function GetUID: string; override;
public
constructor Create(AProvider: TFSXLEDFunctionProvider; const ADisplayName, AUID: string);
end;
TCustomFSXFunctionClass = class of TCustomFSXFunction;
TCustomFSXFunctionWorker = class(TCustomLEDMultiStateFunctionWorker)
private
FDataHandler: IFSXSimConnectDataHandler;
FDefinitionID: Cardinal;
FSimConnect: IFSXSimConnect;
protected
procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); virtual; abstract;
procedure SetSimConnect(const Value: IFSXSimConnect); virtual;
property DataHandler: IFSXSimConnectDataHandler read FDataHandler;
property DefinitionID: Cardinal read FDefinitionID;
property SimConnect: IFSXSimConnect read FSimConnect write SetSimConnect;
protected
procedure HandleData(AData: Pointer); virtual; abstract;
public
constructor Create(const AProviderUID, AFunctionUID: string; AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings; const APreviousState: string = ''); override;
destructor Destroy; override;
end;
implementation
uses
System.SysUtils,
FSXLEDFunction,
FSXResources,
FSXSimConnectClient,
LEDFunctionRegistry,
SimConnect;
type
TCustomFSXFunctionWorkerDataHandler = class(TInterfacedObject, IFSXSimConnectDataHandler)
private
FWorker: TCustomFSXFunctionWorker;
protected
{ IFSXSimConnectDataHandler }
procedure HandleData(AData: Pointer);
property Worker: TCustomFSXFunctionWorker read FWorker;
public
constructor Create(AWorker: TCustomFSXFunctionWorker);
end;
{ TFSXLEDFunctionProvider }
constructor TFSXLEDFunctionProvider.Create;
begin
inherited Create;
FSimConnectLock := TCriticalSection.Create;
end;
destructor TFSXLEDFunctionProvider.Destroy;
begin
FreeAndNil(FSimConnectLock);
inherited Destroy;
end;
procedure TFSXLEDFunctionProvider.RegisterFunctions;
begin
{ Systems }
RegisterFunction(TFSXBatteryMasterFunction.Create( Self, FSXFunctionDisplayNameBatteryMaster, FSXFunctionUIDBatteryMaster));
RegisterFunction(TFSXDeIceFunction.Create( Self, FSXFunctionDisplayNameDeIce, FSXFunctionUIDDeIce));
RegisterFunction(TFSXExitDoorFunction.Create( Self, FSXFunctionDisplayNameExitDoor, FSXFunctionUIDExitDoor));
RegisterFunction(TFSXGearFunction.Create( Self, FSXFunctionDisplayNameGear, FSXFunctionUIDGear));
RegisterFunction(TFSXParkingBrakeFunction.Create( Self, FSXFunctionDisplayNameParkingBrake, FSXFunctionUIDParkingBrake));
RegisterFunction(TFSXPressDumpSwitchFunction.Create( Self, FSXFunctionDisplayNamePressDumpSwitch, FSXFunctionUIDPressDumpSwitch));
RegisterFunction(TFSXTailHookFunction.Create( Self, FSXFunctionDisplayNameTailHook, FSXFunctionUIDTailHook));
{ Engines }
RegisterFunction(TFSXEngineAntiIceFunction.Create( Self, FSXFunctionDisplayNameEngineAntiIce, FSXFunctionUIDEngineAntiIce));
RegisterFunction(TFSXEngineFunction.Create( Self, FSXFunctionDisplayNameEngine, FSXFunctionUIDEngine));
{ Control surfaces }
RegisterFunction(TFSXFlapsFunction.Create( Self, FSXFunctionDisplayNameFlaps, FSXFunctionUIDFlaps));
RegisterFunction(TFSXSpoilersFunction.Create( Self, FSXFunctionDisplayNameSpoilers, FSXFunctionUIDSpoilers));
{ Lights }
RegisterFunction(TFSXBeaconLightsFunction.Create( Self, FSXFunctionDisplayNameBeaconLights, FSXFunctionUIDBeaconLights));
RegisterFunction(TFSXInstrumentLightsFunction.Create( Self, FSXFunctionDisplayNameInstrumentLights, FSXFunctionUIDInstrumentLights));
RegisterFunction(TFSXLandingLightsFunction.Create( Self, FSXFunctionDisplayNameLandingLights, FSXFunctionUIDLandingLights));
RegisterFunction(TFSXNavLightsFunction.Create( Self, FSXFunctionDisplayNameNavLights, FSXFunctionUIDNavLights));
RegisterFunction(TFSXRecognitionLightsFunction.Create( Self, FSXFunctionDisplayNameRecognitionLights, FSXFunctionUIDRecognitionLights));
RegisterFunction(TFSXStrobeLightsFunction.Create( Self, FSXFunctionDisplayNameStrobeLights, FSXFunctionUIDStrobeLights));
RegisterFunction(TFSXTaxiLightsFunction.Create( Self, FSXFunctionDisplayNameTaxiLights, FSXFunctionUIDTaxiLights));
{ Autopilot }
RegisterFunction(TFSXAutoPilotFunction.Create( Self, FSXFunctionDisplayNameAutoPilot, FSXFunctionUIDAutoPilot));
RegisterFunction(TFSXAutoPilotAltitudeFunction.Create( Self, FSXFunctionDisplayNameAutoPilotAltitude, FSXFunctionUIDAutoPilotAltitude));
RegisterFunction(TFSXAutoPilotApproachFunction.Create( Self, FSXFunctionDisplayNameAutoPilotApproach, FSXFunctionUIDAutoPilotApproach));
RegisterFunction(TFSXAutoPilotBackcourseFunction.Create(Self, FSXFunctionDisplayNameAutoPilotBackcourse, FSXFunctionUIDAutoPilotBackcourse));
RegisterFunction(TFSXAutoPilotHeadingFunction.Create( Self, FSXFunctionDisplayNameAutoPilotHeading, FSXFunctionUIDAutoPilotHeading));
RegisterFunction(TFSXAutoPilotNavFunction.Create( Self, FSXFunctionDisplayNameAutoPilotNav, FSXFunctionUIDAutoPilotNav));
{ Radios }
RegisterFunction(TFSXAvionicsMasterFunction.Create( Self, FSXFunctionDisplayNameAvionicsMaster, FSXFunctionUIDAvionicsMaster));
end;
function TFSXLEDFunctionProvider.GetUID: string;
begin
Result := FSXProviderUID;
end;
procedure TFSXLEDFunctionProvider.ObserveDestroy(Sender: IFSXSimConnect);
begin
FSimConnectLock.Acquire;
try
FSimConnect := nil;
finally
FSimConnectLock.Release;
end;
end;
function TFSXLEDFunctionProvider.GetSimConnect: IFSXSimConnect;
begin
FSimConnectLock.Acquire;
try
if not Assigned(FSimConnect) then
begin
{ Keep an object reference so we don't increment the reference count.
We'll know when it's gone through the ObserveDestroy. }
FSimConnect := TFSXSimConnectInterface.Create;
(FSimConnect as IFSXSimConnect).Attach(Self);
end;
Result := (FSimConnect as IFSXSimConnect);
finally
FSimConnectLock.Release;
end;
end;
{ TCustomFSXFunction }
constructor TCustomFSXFunction.Create(AProvider: TFSXLEDFunctionProvider; const ADisplayName, AUID: string);
begin
inherited Create(AProvider.GetUID);
FProvider := AProvider;
FDisplayName := ADisplayName;
FUID := AUID;
end;
function TCustomFSXFunction.DoCreateWorker(ASettings: ILEDFunctionWorkerSettings; const APreviousState: string): TCustomLEDFunctionWorker;
begin
Result := inherited DoCreateWorker(ASettings, APreviousState);
(Result as TCustomFSXFunctionWorker).SimConnect := Provider.GetSimConnect;
end;
function TCustomFSXFunction.GetCategoryName: string;
begin
Result := FSXCategory;
end;
function TCustomFSXFunction.GetDisplayName: string;
begin
Result := FDisplayName;
end;
function TCustomFSXFunction.GetUID: string;
begin
Result := FUID;
end;
{ TCustomFSXFunctionWorker }
constructor TCustomFSXFunctionWorker.Create(const AProviderUID, AFunctionUID: string; AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings; const APreviousState: string);
begin
{ We can't pass ourselves as the Data Handler, as it would keep a reference to
this worker from the SimConnect interface. That'd mean the worker never
gets destroyed, and SimConnect never shuts down. Hence this proxy class. }
FDataHandler := TCustomFSXFunctionWorkerDataHandler.Create(Self);
inherited Create(AProviderUID, AFunctionUID, AStates, ASettings, APreviousState);
end;
destructor TCustomFSXFunctionWorker.Destroy;
begin
if DefinitionID <> 0 then
SimConnect.RemoveDefinition(DefinitionID, DataHandler);
inherited Destroy;
end;
procedure TCustomFSXFunctionWorker.SetSimConnect(const Value: IFSXSimConnect);
var
definition: IFSXSimConnectDefinition;
begin
FSimConnect := Value;
if Assigned(SimConnect) then
begin
definition := SimConnect.CreateDefinition;
RegisterVariables(definition);
FDefinitionID := SimConnect.AddDefinition(definition, DataHandler);
end;
end;
{ TCustomFSXFunctionWorkerDataHandler }
constructor TCustomFSXFunctionWorkerDataHandler.Create(AWorker: TCustomFSXFunctionWorker);
begin
inherited Create;
FWorker := AWorker;
end;
procedure TCustomFSXFunctionWorkerDataHandler.HandleData(AData: Pointer);
begin
Worker.HandleData(AData);
end;
initialization
TLEDFunctionRegistry.Register(TFSXLEDFunctionProvider.Create);
end.

629
G940LEDControl/Units/FSXLEDFunctionWorker.pas Normal file
View File

@ -0,0 +1,629 @@
unit FSXLEDFunctionWorker;
interface
uses
FSXLEDFunctionProvider,
FSXSimConnectIntf;
type
{ Systems }
TFSXBatteryMasterFunctionWorker = class(TCustomFSXFunctionWorker)
protected
procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); override;
procedure HandleData(AData: Pointer); override;
end;
TFSXDeIceFunctionWorker = class(TCustomFSXFunctionWorker)
protected
procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); override;
procedure HandleData(AData: Pointer); override;
end;
TFSXExitDoorFunctionWorker = class(TCustomFSXFunctionWorker)
protected
procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); override;
procedure HandleData(AData: Pointer); override;
end;
TFSXGearFunctionWorker = class(TCustomFSXFunctionWorker)
protected
procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); override;
procedure HandleData(AData: Pointer); override;
end;
TFSXParkingBrakeFunctionWorker = class(TCustomFSXFunctionWorker)
protected
procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); override;
procedure HandleData(AData: Pointer); override;
end;
TFSXPressDumpSwitchFunctionWorker = class(TCustomFSXFunctionWorker)
protected
procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); override;
procedure HandleData(AData: Pointer); override;
end;
TFSXTailHookFunctionWorker = class(TCustomFSXFunctionWorker)
protected
procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); override;
procedure HandleData(AData: Pointer); override;
end;
{ Engines }
TFSXEngineAntiIceFunctionWorker = class(TCustomFSXFunctionWorker)
protected
procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); override;
procedure HandleData(AData: Pointer); override;
end;
TFSXEngineFunctionWorker = class(TCustomFSXFunctionWorker)
protected
procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); override;
procedure HandleData(AData: Pointer); override;
end;
{ Control surfaces }
TFSXFlapsFunctionWorker = class(TCustomFSXFunctionWorker)
protected
procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); override;
procedure HandleData(AData: Pointer); override;
end;
TFSXSpoilersFunctionWorker = class(TCustomFSXFunctionWorker)
protected
procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); override;
procedure HandleData(AData: Pointer); override;
end;
{ Lights }
TFSXLightStatesFunctionWorker = class(TCustomFSXFunctionWorker)
private
FStateMask: Integer;
protected
procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); override;
procedure HandleData(AData: Pointer); override;
public
property StateMask: Integer read FStateMask write FStateMask;
end;
{ Autopilot }
PAutoPilotData = ^TAutoPilotData;
TAutoPilotData = packed record
AutoPilotAvailable: Cardinal;
AutoPilotMaster: Cardinal;
AutoPilotHeading: Cardinal;
AutoPilotApproach: Cardinal;
AutoPilotBackcourse: Cardinal;
AutoPilotAltitude: Cardinal;
AutoPilotNav: Cardinal;
end;
TCustomFSXAutoPilotFunctionWorker = class(TCustomFSXFunctionWorker)
protected
procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); override;
procedure HandleData(AData: Pointer); override;
procedure SetOnOffState(AState: Cardinal); virtual;
procedure HandleAutoPilotData(AData: PAutoPilotData); virtual; abstract;
end;
TFSXAutoPilotFunctionWorker = class(TCustomFSXAutoPilotFunctionWorker)
protected
procedure HandleAutoPilotData(AData: PAutoPilotData); override;
end;
TFSXAutoPilotHeadingFunctionWorker = class(TCustomFSXAutoPilotFunctionWorker)
protected
procedure HandleAutoPilotData(AData: PAutoPilotData); override;
end;
TFSXAutoPilotApproachFunctionWorker = class(TCustomFSXAutoPilotFunctionWorker)
protected
procedure HandleAutoPilotData(AData: PAutoPilotData); override;
end;
TFSXAutoPilotBackcourseFunctionWorker = class(TCustomFSXAutoPilotFunctionWorker)
protected
procedure HandleAutoPilotData(AData: PAutoPilotData); override;
end;
TFSXAutoPilotAltitudeFunctionWorker = class(TCustomFSXAutoPilotFunctionWorker)
protected
procedure HandleAutoPilotData(AData: PAutoPilotData); override;
end;
TFSXAutoPilotNavFunctionWorker = class(TCustomFSXAutoPilotFunctionWorker)
protected
procedure HandleAutoPilotData(AData: PAutoPilotData); override;
end;
{ Radios }
TFSXAvionicsMasterFunctionWorker = class(TCustomFSXFunctionWorker)
protected
procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); override;
procedure HandleData(AData: Pointer); override;
end;
implementation
uses
System.Math,
System.SysUtils,
FSXResources,
LEDStateIntf,
SimConnect;
{ TFSXBatteryMasterFunctionWorker }
procedure TFSXBatteryMasterFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition);
begin
ADefinition.AddVariable('ELECTRICAL MASTER BATTERY', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
end;
procedure TFSXBatteryMasterFunctionWorker.HandleData(AData: Pointer);
begin
if PCardinal(AData)^ <> 0 then
SetCurrentState(FSXStateUIDOn)
else
SetCurrentState(FSXStateUIDOff);
end;
{ TFSXDeIceFunctionWorker }
procedure TFSXDeIceFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition);
begin
ADefinition.AddVariable('STRUCTURAL DEICE SWITCH', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
end;
procedure TFSXDeIceFunctionWorker.HandleData(AData: Pointer);
begin
if PCardinal(AData)^ <> 0 then
SetCurrentState(FSXStateUIDOn)
else
SetCurrentState(FSXStateUIDOff);
end;
{ TFSXExitDoorFunctionWorker }
procedure TFSXExitDoorFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition);
begin
ADefinition.AddVariable('CANOPY OPEN', FSX_UNIT_PERCENT, SIMCONNECT_DATAType_FLOAT64);
end;
procedure TFSXExitDoorFunctionWorker.HandleData(AData: Pointer);
begin
case Trunc(PDouble(AData)^) of
0..5: SetCurrentState(FSXStateUIDExitDoorClosed);
95..100: SetCurrentState(FSXStateUIDExitDoorOpen);
else SetCurrentState(FSXStateUIDExitDoorBetween);
end;
end;
{ TFSXGearFunctionWorker }
procedure TFSXGearFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition);
begin
ADefinition.AddVariable('IS GEAR RETRACTABLE', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
ADefinition.AddVariable('GEAR TOTAL PCT EXTENDED', FSX_UNIT_PERCENT, SIMCONNECT_DATAType_FLOAT64);
ADefinition.AddVariable('GEAR DAMAGE BY SPEED', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
ADefinition.AddVariable('GEAR SPEED EXCEEDED', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
end;
procedure TFSXGearFunctionWorker.HandleData(AData: Pointer);
type
PGearData = ^TGearData;
TGearData = packed record
IsGearRetractable: Cardinal;
TotalPctExtended: Double;
DamageBySpeed: Integer;
SpeedExceeded: Integer;
end;
var
gearData: PGearData;
begin
gearData := AData;
if gearData^.DamageBySpeed <> 0 then
SetCurrentState(FSXStateUIDGearDamageBySpeed)
else if gearData^.SpeedExceeded <> 0 then
SetCurrentState(FSXStateUIDGearSpeedExceeded)
else if gearData^.IsGearRetractable <> 0 then
begin
case Trunc(gearData ^.TotalPctExtended * 100) of
0: SetCurrentState(FSXStateUIDGearRetracted);
95..100: SetCurrentState(FSXStateUIDGearExtended);
else SetCurrentState(FSXStateUIDGearBetween);
end;
end else
SetCurrentState(FSXStateUIDGearNotRetractable);
end;
{ TFSXParkingBrakeFunctionWorker }
procedure TFSXParkingBrakeFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition);
begin
ADefinition.AddVariable('BRAKE PARKING INDICATOR', FSX_UNIT_BOOL, SIMCONNECT_DATATYPE_INT32);
end;
procedure TFSXParkingBrakeFunctionWorker.HandleData(AData: Pointer);
begin
if PCardinal(AData)^ <> 0 then
SetCurrentState(FSXStateUIDOn)
else
SetCurrentState(FSXStateUIDOff);
end;
{ TFSXPressDumpSwitchFunctionWorker }
procedure TFSXPressDumpSwitchFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition);
begin
ADefinition.AddVariable('PRESSURIZATION DUMP SWITCH', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
end;
procedure TFSXPressDumpSwitchFunctionWorker.HandleData(AData: Pointer);
begin
if PCardinal(AData)^ <> 0 then
SetCurrentState(FSXStateUIDOn)
else
SetCurrentState(FSXStateUIDOff);
end;
{ TFSXTailHookFunctionWorker }
procedure TFSXTailHookFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition);
begin
ADefinition.AddVariable('TAILHOOK POSITION', FSX_UNIT_PERCENT, SIMCONNECT_DATAType_FLOAT64);
end;
procedure TFSXTailHookFunctionWorker.HandleData(AData: Pointer);
begin
case Trunc(PDouble(AData)^) of
0..5: SetCurrentState(FSXStateUIDTailHookRetracted);
95..100: SetCurrentState(FSXStateUIDTailHookBetween);
else SetCurrentState(FSXStateUIDTailHookExtended);
end;
end;
{ TFSXEngineAntiIceFunctionWorker }
procedure TFSXEngineAntiIceFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition);
var
engineIndex: Integer;
begin
ADefinition.AddVariable('NUMBER OF ENGINES', FSX_UNIT_NUMBER, SIMCONNECT_DATAType_INT32);
for engineIndex := 1 to FSX_MAX_ENGINES do
ADefinition.AddVariable(Format('ENG ANTI ICE:%d', [engineIndex]), FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
end;
procedure TFSXEngineAntiIceFunctionWorker.HandleData(AData: Pointer);
type
PAntiIceData = ^TAntiIceData;
TAntiIceData = packed record
NumberOfEngines: Integer;
EngineAntiIce: array[1..FSX_MAX_ENGINES] of Integer;
end;
var
antiIceData: PAntiIceData;
engineCount: Integer;
antiIceCount: Integer;
engineIndex: Integer;
begin
antiIceData := AData;
engineCount := Min(antiIceData^.NumberOfEngines, FSX_MAX_ENGINES);
antiIceCount := 0;
for engineIndex := 1 to engineCount do
begin
if antiIceData^.EngineAntiIce[engineIndex] <> 0 then
Inc(antiIceCount);
end;
if engineCount > 0 then
begin
if antiIceCount = 0 then
SetCurrentState(FSXStateUIDEngineAntiIceNone)
else if antiIceCount = engineCount then
SetCurrentState(FSXStateUIDEngineAntiIceAll)
else
SetCurrentState(FSXStateUIDEngineAntiIcePartial);
end else
SetCurrentState(FSXStateUIDEngineAntiIceNoEngines);
end;
{ TFSXEngineFunctionWorker }
procedure TFSXEngineFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition);
var
engineIndex: Integer;
begin
ADefinition.AddVariable('NUMBER OF ENGINES', FSX_UNIT_NUMBER, SIMCONNECT_DATAType_INT32);
for engineIndex := 1 to FSX_MAX_ENGINES do
ADefinition.AddVariable(Format('GENERAL ENG COMBUSTION:%d', [engineIndex]), FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
for engineIndex := 1 to FSX_MAX_ENGINES do
ADefinition.AddVariable(Format('ENG FAILED:%d', [engineIndex]), FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
for engineIndex := 1 to FSX_MAX_ENGINES do
ADefinition.AddVariable(Format('ENG ON FIRE:%d', [engineIndex]), FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
end;
procedure TFSXEngineFunctionWorker.HandleData(AData: Pointer);
type
PEngineData = ^TEngineData;
TEngineData = packed record
NumberOfEngines: Integer;
Combustion: array[1..FSX_MAX_ENGINES] of Integer;
Failed: array[1..FSX_MAX_ENGINES] of Integer;
OnFire: array[1..FSX_MAX_ENGINES] of Integer;
end;
var
engineData: PEngineData;
engineCount: Integer;
engineIndex: Integer;
hasFire: Boolean;
hasFailure: Boolean;
runningCount: Integer;
begin
engineData := AData;
if engineData^.NumberOfEngines > 0 then
begin
engineCount := Min(engineData^.NumberOfEngines, FSX_MAX_ENGINES);
hasFire := False;
hasFailure := False;
runningCount := 0;
for engineIndex := 1 to engineCount do
begin
if engineData^.OnFire[engineIndex] <> 0 then
hasFire := True;
if engineData^.Failed[engineIndex] <> 0 then
hasFailure := True;
if engineData^.Combustion[engineIndex] <> 0 then
Inc(runningCount);
end;
if hasFire then
SetCurrentState(FSXStateUIDEngineOnFire)
else if hasFailure then
SetCurrentState(FSXStateUIDEngineFailed)
else if runningCount = 0 then
SetCurrentState(FSXStateUIDEngineAllOff)
else if runningCount = engineCount then
SetCurrentState(FSXStateUIDEngineAllRunning)
else
SetCurrentState(FSXStateUIDEnginePartiallyRunning);
end else
SetCurrentState(FSXStateUIDEngineNoEngines);
end;
{ TFSXFlapsFunctionWorker }
procedure TFSXFlapsFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition);
begin
ADefinition.AddVariable('FLAPS AVAILABLE', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
ADefinition.AddVariable('FLAPS HANDLE PERCENT', FSX_UNIT_PERCENT, SIMCONNECT_DATAType_FLOAT64);
ADefinition.AddVariable('FLAP DAMAGE BY SPEED', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
ADefinition.AddVariable('FLAP SPEED EXCEEDED', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
end;
procedure TFSXFlapsFunctionWorker.HandleData(AData: Pointer);
type
PFlapsData = ^TFlapsData;
TFlapsData = packed record
FlapsAvailable: Cardinal;
FlapsHandlePercent: Double;
DamageBySpeed: Integer;
SpeedExceeded: Integer;
end;
var
flapsData: PFlapsData;
begin
flapsData := AData;
if flapsData^.FlapsAvailable <> 0 then
begin
if flapsData^.DamageBySpeed <> 0 then
SetCurrentState(FSXStateUIDFlapsDamageBySpeed)
else if flapsData^.SpeedExceeded <> 0 then
SetCurrentState(FSXStateUIDFlapsSpeedExceeded)
else
case Trunc(flapsData^.FlapsHandlePercent) of
0..5: SetCurrentState(FSXStateUIDFlapsRetracted);
95..100: SetCurrentState(FSXStateUIDFlapsExtended);
else SetCurrentState(FSXStateUIDFlapsBetween);
end;
end else
SetCurrentState(FSXStateUIDFlapsNotAvailable);
end;
{ TFSXSpoilersFunctionWorker }
procedure TFSXSpoilersFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition);
begin
ADefinition.AddVariable('SPOILER AVAILABLE', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
ADefinition.AddVariable('SPOILERS HANDLE POSITION', FSX_UNIT_PERCENT, SIMCONNECT_DATAType_FLOAT64);
end;
procedure TFSXSpoilersFunctionWorker.HandleData(AData: Pointer);
type
PSpoilersData = ^TSpoilersData;
TSpoilersData = packed record
SpoilersAvailable: Cardinal;
SpoilersHandlePercent: Double;
end;
var
spoilersData: PSpoilersData;
begin
SpoilersData := AData;
if SpoilersData^.SpoilersAvailable <> 0 then
begin
case Trunc(SpoilersData^.SpoilersHandlePercent) of
0..5: SetCurrentState(FSXStateUIDSpoilersRetracted);
95..100: SetCurrentState(FSXStateUIDSpoilersExtended);
else SetCurrentState(FSXStateUIDSpoilersBetween);
end;
end else
SetCurrentState(FSXStateUIDSpoilersNotAvailable);
end;
{ TFSXLightStatesFunctionWorker }
procedure TFSXLightStatesFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition);
begin
ADefinition.AddVariable('LIGHT ON STATES', FSX_UNIT_MASK, SIMCONNECT_DATATYPE_INT32);
end;
procedure TFSXLightStatesFunctionWorker.HandleData(AData: Pointer);
begin
if (PCardinal(AData)^ and StateMask) <> 0 then
SetCurrentState(FSXStateUIDOn)
else
SetCurrentState(FSXStateUIDOff);
end;
{ TCustomFSXAutoPilotFunctionWorker }
procedure TCustomFSXAutoPilotFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition);
begin
ADefinition.AddVariable('AUTOPILOT AVAILABLE', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
ADefinition.AddVariable('AUTOPILOT MASTER', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
ADefinition.AddVariable('AUTOPILOT HEADING LOCK', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
ADefinition.AddVariable('AUTOPILOT APPROACH HOLD', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
ADefinition.AddVariable('AUTOPILOT BACKCOURSE HOLD', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
ADefinition.AddVariable('AUTOPILOT ALTITUDE LOCK', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
ADefinition.AddVariable('AUTOPILOT NAV1 LOCK', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
end;
procedure TCustomFSXAutoPilotFunctionWorker.HandleData(AData: Pointer);
var
autoPilotData: PAutoPilotData;
begin
autoPilotData := AData;
if autoPilotData^.AutoPilotAvailable <> 0 then
HandleAutoPilotData(autoPilotData)
else
SetCurrentState(FSXStateUIDOff);
end;
procedure TCustomFSXAutoPilotFunctionWorker.SetOnOffState(AState: Cardinal);
begin
if AState <> 0 then
SetCurrentState(FSXStateUIDOn)
else
SetCurrentState(FSXStateUIDOff);
end;
{ TFSXAutoPilotFunctionWorker }
procedure TFSXAutoPilotFunctionWorker.HandleAutoPilotData(AData: PAutoPilotData);
begin
SetOnOffState(AData^.AutoPilotMaster);
end;
{ TFSXAutoPilotHeadingFunctionWorker }
procedure TFSXAutoPilotHeadingFunctionWorker.HandleAutoPilotData(AData: PAutoPilotData);
begin
SetOnOffState(AData^.AutoPilotHeading);
end;
{ TFSXAutoPilotApproachFunctionWorker }
procedure TFSXAutoPilotApproachFunctionWorker.HandleAutoPilotData(AData: PAutoPilotData);
begin
SetOnOffState(AData^.AutoPilotApproach);
end;
{ TFSXAutoPilotBackcourseFunctionWorker }
procedure TFSXAutoPilotBackcourseFunctionWorker.HandleAutoPilotData(AData: PAutoPilotData);
begin
SetOnOffState(AData^.AutoPilotBackcourse);
end;
{ TFSXAutoPilotAltitudeFunctionWorker }
procedure TFSXAutoPilotAltitudeFunctionWorker.HandleAutoPilotData(AData: PAutoPilotData);
begin
SetOnOffState(AData^.AutoPilotAltitude);
end;
{ TFSXAutoPilotNavFunctionWorker }
procedure TFSXAutoPilotNavFunctionWorker.HandleAutoPilotData(AData: PAutoPilotData);
begin
SetOnOffState(AData^.AutoPilotNav);
end;
{ TFSXAvionicsMasterFunctionWorker }
procedure TFSXAvionicsMasterFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition);
begin
ADefinition.AddVariable('AVIONICS MASTER SWITCH', FSX_UNIT_BOOL, SIMCONNECT_DATAType_INT32);
end;
procedure TFSXAvionicsMasterFunctionWorker.HandleData(AData: Pointer);
begin
if PCardinal(AData)^ <> 0 then
SetCurrentState(FSXStateUIDOn)
else
SetCurrentState(FSXStateUIDOff);
end;
end.

196
G940LEDControl/Units/FSXResources.pas Normal file
View File

@ -0,0 +1,196 @@
unit FSXResources;
interface
const
FSXSimConnectAppName = 'G940 LED Control';
FSXProviderUID = 'fsx';
FSXCategory = 'Flight Simulator X';
FSXCategorySystems = FSXCategory + ' - Systems';
FSXCategoryEngines = FSXCategory + ' - Engines';
FSXCategoryControlSurfaces = FSXCategory + ' - Control surfaces';
FSXCategoryLights = FSXCategory + ' - Lights';
FSXCategoryAutoPilot = FSXCategory + ' - Autopilot';
FSXCategoryRadios = FSXCategory + ' - Radios';
FSXStateUIDOn = 'on';
FSXStateUIDOff = 'off';
FSXStateDisplayNameOn = 'On';
FSXStateDisplayNameOff = 'Off';
FSXFunctionUIDEngine = 'engine';
FSXFunctionDisplayNameEngine = 'Engine';
FSXStateUIDEngineNoEngines = 'noEngines';
FSXStateUIDEngineAllRunning = 'allRunning';
FSXStateUIDEnginePartiallyRunning = 'partiallyRunning';
FSXStateUIDEngineAllOff = 'allOff';
FSXStateUIDEngineFailed = 'failed';
FSXStateUIDEngineOnFire = 'onFire';
FSXStateDisplayNameEngineNoEngines = 'No engines';
FSXStateDisplayNameEngineAllRunning = 'All running';
FSXStateDisplayNameEnginePartiallyRunning = 'Partially running';
FSXStateDisplayNameEngineAllOff = 'All off';
FSXStateDisplayNameEngineFailed = 'Engine failure';
FSXStateDisplayNameEngineOnFire = 'On fire';
FSXFunctionUIDGear = 'gear';
FSXFunctionDisplayNameGear = 'Landing gear';
FSXStateUIDGearNotRetractable = 'notRetractable';
FSXStateUIDGearRetracted = 'retracted';
FSXStateUIDGearBetween = 'between';
FSXStateUIDGearExtended = 'extended';
FSXStateUIDGearSpeedExceeded = 'speedExceeded';
FSXStateUIDGearDamageBySpeed = 'damageBySpeed';
FSXStateDisplayNameGearNotRetractable = 'Not retractable';
FSXStateDisplayNameGearRetracted = 'Retracted';
FSXStateDisplayNameGearBetween = 'Extending / retracting';
FSXStateDisplayNameGearExtended = 'Extended';
FSXStateDisplayNameGearSpeedExceeded = 'Speed exceeded';
FSXStateDisplayNameGearDamageBySpeed = 'Damage by speed';
FSXFunctionUIDLandingLights = 'landingLights';
FSXFunctionDisplayNameLandingLights = 'Landing lights';
FSXFunctionUIDInstrumentLights = 'instrumentLights';
FSXFunctionDisplayNameInstrumentLights = 'Instrument lights';
FSXFunctionUIDBeaconLights = 'beaconLights';
FSXFunctionDisplayNameBeaconLights = 'Beacon lights';
FSXFunctionUIDNavLights = 'navLights';
FSXFunctionDisplayNameNavLights = 'Nav lights';
FSXFunctionUIDStrobeLights = 'strobeLights';
FSXFunctionDisplayNameStrobeLights = 'Strobe lights';
FSXFunctionUIDTaxiLights = 'taxiLights';
FSXFunctionDisplayNameTaxiLights = 'Taxi lights';
FSXFunctionUIDRecognitionLights = 'recognitionLights';
FSXFunctionDisplayNameRecognitionLights = 'Recognition lights';
FSXFunctionUIDParkingBrake = 'parkingBrake';
FSXFunctionDisplayNameParkingBrake = 'Parking brake';
FSXFunctionUIDExitDoor = 'exitDoor';
FSXFunctionDisplayNameExitDoor = 'Exit door';
FSXStateUIDExitDoorClosed = 'closed';
FSXStateUIDExitDoorBetween = 'between';
FSXStateUIDExitDoorOpen = 'open';
FSXStateDisplayNameExitDoorClosed = 'Closed';
FSXStateDisplayNameExitDoorBetween = 'Opening / closing';
FSXStateDisplayNameExitDoorOpen = 'Open';
FSXFunctionUIDTailHook = 'tailHook';
FSXFunctionDisplayNameTailHook = 'Tail hook';
FSXStateUIDTailHookRetracted = 'retracted';
FSXStateUIDTailHookBetween = 'between';
FSXStateUIDTailHookExtended = 'extended';
FSXStateDisplayNameTailHookRetracted = 'Retracted';
FSXStateDisplayNameTailHookBetween = 'Extending / retracting';
FSXStateDisplayNameTailHookExtended = 'Extended';
FSXFunctionUIDFlaps = 'flaps';
FSXFunctionDisplayNameFlaps = 'Flaps';
FSXStateUIDFlapsNotAvailable = 'notAvailable';
FSXStateUIDFlapsRetracted = 'retracted';
FSXStateUIDFlapsBetween = 'between';
FSXStateUIDFlapsExtended = 'extended';
FSXStateUIDFlapsSpeedExceeded = 'speedExceeded';
FSXStateUIDFlapsDamageBySpeed = 'damageBySpeed';
FSXStateDisplayNameFlapsNotAvailable = 'No flaps';
FSXStateDisplayNameFlapsRetracted = 'Retracted';
FSXStateDisplayNameFlapsBetween = 'Extending / retracting';
FSXStateDisplayNameFlapsExtended = 'Extended';
FSXStateDisplayNameFlapsSpeedExceeded = 'Speed exceeded';
FSXStateDisplayNameFlapsDamageBySpeed = 'Damage by speed';
FSXFunctionUIDSpoilers = 'spoilers';
FSXFunctionDisplayNameSpoilers = 'Spoilers';
FSXStateUIDSpoilersNotAvailable = 'notAvailable';
FSXStateUIDSpoilersRetracted = 'retracted';
FSXStateUIDSpoilersBetween = 'between';
FSXStateUIDSpoilersExtended = 'extended';
FSXStateDisplayNameSpoilersNotAvailable = 'No spoilers';
FSXStateDisplayNameSpoilersRetracted = 'Retracted';
FSXStateDisplayNameSpoilersBetween = 'Extending / retracting';
FSXStateDisplayNameSpoilersExtended = 'Extended';
FSXFunctionUIDBatteryMaster = 'batteryMaster';
FSXFunctionDisplayNameBatteryMaster = 'Battery master';
FSXFunctionUIDAvionicsMaster = 'avionicsMaster';
FSXFunctionDisplayNameAvionicsMaster = 'Avionics master';
FSXFunctionUIDPressDumpSwitch = 'pressurizationDumpSwitch';
FSXFunctionDisplayNamePressDumpSwitch = 'Pressurization dump switch';
FSXFunctionUIDEngineAntiIce = 'engineAntiIce';
FSXFunctionDisplayNameEngineAntiIce = 'Engine anti-ice';
FSXStateUIDEngineAntiIceNoEngines = 'noEngines';
FSXStateUIDEngineAntiIceAll = 'all';
FSXStateUIDEngineAntiIcePartial = 'partial';
FSXStateUIDEngineAntiIceNone = 'none';
FSXStateDisplayNameEngineAntiIceNoEngines = 'No engines';
FSXStateDisplayNameEngineAntiIceAll = 'All';
FSXStateDisplayNameEngineAntiIcePartial = 'Partial';
FSXStateDisplayNameEngineAntiIceNone = 'None';
FSXFunctionUIDDeIce = 'structuralDeIce';
FSXFunctionDisplayNameDeIce = 'De-ice';
FSXStateUIDAutoPilotNotAvailable = 'notAvailable';
FSXStateDisplayNameAutoPilotNotAvailable = 'Not available';
FSXFunctionUIDAutoPilot = 'autoPilotMaster';
FSXFunctionDisplayNameAutoPilot = 'Autopilot master';
FSXFunctionUIDAutoPilotHeading = 'autoPilotHeading';
FSXFunctionDisplayNameAutoPilotHeading = 'Autopilot heading';
FSXFunctionUIDAutoPilotApproach = 'autoPilotApproach';
FSXFunctionDisplayNameAutoPilotApproach = 'Autopilot approach';
FSXFunctionUIDAutoPilotBackcourse = 'autoPilotBackcourse';
FSXFunctionDisplayNameAutoPilotBackcourse = 'Autopilot backcourse';
FSXFunctionUIDAutoPilotAltitude = 'autoPilotAltitude';
FSXFunctionDisplayNameAutoPilotAltitude = 'Autopilot altitude';
FSXFunctionUIDAutoPilotNav = 'autoPilotNav';
FSXFunctionDisplayNameAutoPilotNav = 'Autopilot nav';
implementation
end.

665
G940LEDControl/Units/FSXSimConnectClient.pas Normal file
View File

@ -0,0 +1,665 @@
unit FSXSimConnectClient;
interface
uses
Classes,
OtlTaskControl,
FSXSimConnectIntf;
type
TFSXSimConnectInterface = class(TInterfacedObject, IFSXSimConnect)
private
FClient: IOmniTaskControl;
FObservers: TInterfaceList;
protected
property Client: IOmniTaskControl read FClient;
property Observers: TInterfaceList read FObservers;
protected
{ IFSXSimConnect }
procedure Attach(AObserver: IFSXSimConnectObserver);
procedure Detach(AObserver: IFSXSimConnectObserver);
function CreateDefinition: IFSXSimConnectDefinition;
function AddDefinition(ADefinition: IFSXSimConnectDefinition; ADataHandler: IFSXSimConnectDataHandler): Integer;
procedure RemoveDefinition(ADefinitionID: Cardinal; ADataHandler: IFSXSimConnectDataHandler);
public
constructor Create;
destructor Destroy; override;
end;
implementation
uses
Generics.Collections,
System.Math,
System.SyncObjs,
System.SysUtils,
Winapi.Windows,
OtlComm,
OtlCommon,
SimConnect,
FSXResources,
FSXSimConnectStateMonitor;
const
TM_ADDDEFINITION = 3001;
TM_REMOVEDEFINITION = 3002;
TM_TRYSIMCONNECT = 3003;
TIMER_TRYSIMCONNECT = 201;
INTERVAL_TRYSIMCONNECT = 5000;
type
TFSXSimConnectDefinitionRef = class(TObject)
private
FDefinition: IFSXSimConnectDefinitionAccess;
FDataHandlers: TInterfaceList;
protected
property DataHandlers: TInterfaceList read FDataHandlers;
public
constructor Create(ADefinition: IFSXSimConnectDefinitionAccess);
destructor Destroy; override;
procedure Attach(ADataHandler: IFSXSimConnectDataHandler);
function Detach(ADataHandler: IFSXSimConnectDataHandler): Integer;
procedure HandleData(AData: Pointer);
property Definition: IFSXSimConnectDefinitionAccess read FDefinition;
end;
TFSXSimConnectDefinitionMap = class(TObjectDictionary<Cardinal, TFSXSimConnectDefinitionRef>)
public
constructor Create(ACapacity: Integer = 0); reintroduce;
end;
TFSXSimConnectClient = class(TOmniWorker)
private
FDefinitions: TFSXSimConnectDefinitionMap;
FLastDefinitionID: Cardinal;
FSimConnectHandle: THandle;
FSimConnectDataEvent: TEvent;
protected
procedure TMAddDefinition(var Msg: TOmniMessage); message TM_ADDDEFINITION;
procedure TMRemoveDefinition(var Msg: TOmniMessage); message TM_REMOVEDEFINITION;
procedure TMTrySimConnect(var Msg: TOmniMessage); message TM_TRYSIMCONNECT;
procedure HandleSimConnectDataEvent;
protected
function Initialize: Boolean; override;
procedure Cleanup; override;
procedure TrySimConnect;
procedure RegisterDefinitions;
procedure RegisterDefinition(ADefinitionID: Cardinal; ADefinition: IFSXSimConnectDefinitionAccess);
procedure UpdateDefinition(ADefinitionID: Cardinal);
procedure UnregisterDefinition(ADefinitionID: Cardinal);
function SameDefinition(ADefinition1, ADefinition2: IFSXSimConnectDefinitionAccess): Boolean;
property Definitions: TFSXSimConnectDefinitionMap read FDefinitions;
property LastDefinitionID: Cardinal read FLastDefinitionID;
property SimConnectHandle: THandle read FSimConnectHandle;
property SimConnectDataEvent: TEvent read FSimConnectDataEvent;
end;
TFSXSimConnectVariable = class(TInterfacedPersistent, IFSXSimConnectVariable)
private
FVariableName: string;
FUnitsName: string;
FDataType: SIMCONNECT_DATAType;
FEpsilon: Single;
protected
{ IFSXSimConnectVariable }
function GetVariableName: string;
function GetUnitsName: string;
function GetDataType: SIMCONNECT_DATAType;
function GetEpsilon: Single;
public
constructor Create(AVariableName, AUnitsName: string; ADataType: SIMCONNECT_DATAType; AEpsilon: Single);
end;
TFSXSimConnectVariableList = TObjectList<TFSXSimConnectVariable>;
TFSXSimConnectDefinition = class(TInterfacedObject, IFSXSimConnectDefinition, IFSXSimConnectDefinitionAccess)
private
FSimConnect: IFSXSimConnect;
FVariables: TFSXSimConnectVariableList;
protected
property SimConnect: IFSXSimConnect read FSimConnect;
property Variables: TFSXSimConnectVariableList read FVariables;
protected
{ IFSXSimConnectDefinition }
procedure AddVariable(AVariableName, AUnitsName: string; ADataType: SIMCONNECT_DATAType; AEpsilon: Single = 0);
{ IFSXSimConnectDefinitionAccess }
function GetVariableCount: Integer;
function GetVariable(AIndex: Integer): IFSXSimConnectVariable;
public
constructor Create;
destructor Destroy; override;
end;
TAddDefinitionValue = class(TOmniWaitableValue)
private
FDataHandler: IFSXSimConnectDataHandler;
FDefinition: IFSXSimConnectDefinition;
FDefinitionID: Cardinal;
procedure SetDefinitionID(const Value: Cardinal);
public
constructor Create(ADefinition: IFSXSimConnectDefinition; ADataHandler: IFSXSimConnectDataHandler);
property DataHandler: IFSXSimConnectDataHandler read FDataHandler;
property Definition: IFSXSimConnectDefinition read FDefinition;
property DefinitionID: Cardinal read FDefinitionID write SetDefinitionID;
end;
TRemoveDefinitionValue = class(TOmniWaitableValue)
private
FDataHandler: IFSXSimConnectDataHandler;
FDefinitionID: Cardinal;
public
constructor Create(ADefinitionID: Cardinal; ADataHandler: IFSXSimConnectDataHandler);
property DataHandler: IFSXSimConnectDataHandler read FDataHandler;
property DefinitionID: Cardinal read FDefinitionID;
end;
{ TFSXSimConnectInterface }
constructor TFSXSimConnectInterface.Create;
var
worker: IOmniWorker;
begin
inherited Create;
FObservers := TInterfaceList.Create;
worker := TFSXSimConnectClient.Create;
FClient := CreateTask(worker).Run;
end;
destructor TFSXSimConnectInterface.Destroy;
var
observer: IInterface;
begin
for observer in Observers do
(observer as IFSXSimConnectObserver).ObserveDestroy(Self);
FreeAndNil(FObservers);
FClient.Terminate;
FClient := nil;
inherited Destroy;
end;
procedure TFSXSimConnectInterface.Attach(AObserver: IFSXSimConnectObserver);
begin
Observers.Add(AObserver as IFSXSimConnectObserver);
end;
procedure TFSXSimConnectInterface.Detach(AObserver: IFSXSimConnectObserver);
begin
Observers.Remove(AObserver as IFSXSimConnectObserver);
end;
function TFSXSimConnectInterface.CreateDefinition: IFSXSimConnectDefinition;
begin
Result := TFSXSimConnectDefinition.Create;
end;
function TFSXSimConnectInterface.AddDefinition(ADefinition: IFSXSimConnectDefinition; ADataHandler: IFSXSimConnectDataHandler): Integer;
var
addDefinition: TAddDefinitionValue;
begin
addDefinition := TAddDefinitionValue.Create(ADefinition, ADataHandler);
Client.Comm.Send(TM_ADDDEFINITION, addDefinition);
addDefinition.WaitFor(INFINITE);
Result := addDefinition.DefinitionID;
end;
procedure TFSXSimConnectInterface.RemoveDefinition(ADefinitionID: Cardinal; ADataHandler: IFSXSimConnectDataHandler);
var
removeDefinition: TRemoveDefinitionValue;
begin
removeDefinition := TRemoveDefinitionValue.Create(ADefinitionID, ADataHandler);
Client.Comm.Send(TM_REMOVEDEFINITION, removeDefinition);
removeDefinition.WaitFor(INFINITE);
end;
{ TFSXSimConnectDefinition }
constructor TFSXSimConnectDefinition.Create;
begin
inherited Create;
FVariables := TFSXSimConnectVariableList.Create(True);
end;
destructor TFSXSimConnectDefinition.Destroy;
begin
FreeAndNil(FVariables);
inherited Destroy;
end;
procedure TFSXSimConnectDefinition.AddVariable(AVariableName, AUnitsName: string; ADataType: SIMCONNECT_DATAType; AEpsilon: Single);
begin
Variables.Add(TFSXSimConnectVariable.Create(AVariableName, AUnitsName, ADataType, AEpsilon));
end;
function TFSXSimConnectDefinition.GetVariable(AIndex: Integer): IFSXSimConnectVariable;
begin
Result := Variables[AIndex];
end;
function TFSXSimConnectDefinition.GetVariableCount: Integer;
begin
Result := Variables.Count;
end;
{ TFSXSimConnectClient }
function TFSXSimConnectClient.Initialize: Boolean;
begin
Result := inherited Initialize;
if not Result then
exit;
FDefinitions := TFSXSimConnectDefinitionMap.Create;
FSimConnectDataEvent := TEvent.Create(nil, False, False, '');
Task.RegisterWaitObject(SimConnectDataEvent.Handle, HandleSimConnectDataEvent);
TrySimConnect;
end;
procedure TFSXSimConnectClient.Cleanup;
begin
FreeAndNil(FSimConnectDataEvent);
FreeAndNil(FDefinitions);
if SimConnectHandle <> 0 then
SimConnect_Close(SimConnectHandle);
TFSXSimConnectStateMonitor.SetCurrentState(scsDisconnected);
inherited Cleanup;
end;
procedure TFSXSimConnectClient.TrySimConnect;
begin
if SimConnectHandle <> 0 then
exit;
if InitSimConnect then
begin
if SimConnect_Open(FSimConnectHandle, FSXSimConnectAppName, 0, 0, SimConnectDataEvent.Handle, 0) = S_OK then
begin
TFSXSimConnectStateMonitor.SetCurrentState(scsConnected);
Task.ClearTimer(TIMER_TRYSIMCONNECT);
RegisterDefinitions;
end;
end;
if SimConnectHandle = 0 then
begin
TFSXSimConnectStateMonitor.SetCurrentState(scsFailed);
Task.SetTimer(TIMER_TRYSIMCONNECT, INTERVAL_TRYSIMCONNECT, TM_TRYSIMCONNECT);
end;
end;
procedure TFSXSimConnectClient.HandleSimConnectDataEvent;
var
data: PSimConnectRecv;
dataSize: Cardinal;
simObjectData: PSimConnectRecvSimObjectData;
definitionRef: TFSXSimConnectDefinitionRef;
begin
while (SimConnectHandle <> 0) and
(SimConnect_GetNextDispatch(SimConnectHandle, data, dataSize) = S_OK) do
begin
case SIMCONNECT_RECV_ID(data^.dwID) of
SIMCONNECT_RECV_ID_SIMOBJECT_DATA:
begin
simObjectData := PSimConnectRecvSimObjectData(data);
if Definitions.ContainsKey(simObjectData^.dwDefineID) then
begin
definitionRef := Definitions[simObjectData^.dwDefineID];
definitionRef.HandleData(@simObjectData^.dwData);
end;
end;
SIMCONNECT_RECV_ID_QUIT:
begin
FSimConnectHandle := 0;
Task.SetTimer(TIMER_TRYSIMCONNECT, INTERVAL_TRYSIMCONNECT, TM_TRYSIMCONNECT);
TFSXSimConnectStateMonitor.SetCurrentState(scsDisconnected);
end;
end;
end;
end;
procedure TFSXSimConnectClient.RegisterDefinitions;
var
definitionID: Cardinal;
begin
if SimConnectHandle = 0 then
exit;
for definitionID in Definitions.Keys do
RegisterDefinition(definitionID, Definitions[definitionID].Definition);
end;
procedure TFSXSimConnectClient.RegisterDefinition(ADefinitionID: Cardinal; ADefinition: IFSXSimConnectDefinitionAccess);
var
variableIndex: Integer;
variable: IFSXSimConnectVariable;
begin
if SimConnectHandle = 0 then
exit;
for variableIndex := 0 to Pred(ADefinition.GetVariableCount) do
begin
variable := ADefinition.GetVariable(variableIndex);
SimConnect_AddToDataDefinition(SimConnectHandle, ADefinitionID,
AnsiString(variable.GetVariableName),
AnsiString(variable.GetUnitsName),
variable.GetDataType,
variable.GetEpsilon);
end;
SimConnect_RequestDataOnSimObject(SimConnectHandle, ADefinitionID, ADefinitionID,
SIMCONNECT_OBJECT_ID_USER,
SIMCONNECT_PERIOD_SIM_FRAME,
SIMCONNECT_DATA_REQUEST_FLAG_CHANGED);
end;
procedure TFSXSimConnectClient.UpdateDefinition(ADefinitionID: Cardinal);
begin
if SimConnectHandle <> 0 then
{ One-time data update; the RequestID is counted backwards to avoid conflicts with
the FLAG_CHANGED request which is still active }
SimConnect_RequestDataOnSimObject(SimConnectHandle, High(Cardinal) - ADefinitionID, ADefinitionID,
SIMCONNECT_OBJECT_ID_USER,
SIMCONNECT_PERIOD_SIM_FRAME,
0, 0, 0, 1);
end;
procedure TFSXSimConnectClient.UnregisterDefinition(ADefinitionID: Cardinal);
begin
if SimConnectHandle <> 0 then
SimConnect_ClearDataDefinition(SimConnectHandle, ADefinitionID);
end;
function TFSXSimConnectClient.SameDefinition(ADefinition1, ADefinition2: IFSXSimConnectDefinitionAccess): Boolean;
var
variableIndex: Integer;
variable1: IFSXSimConnectVariable;
variable2: IFSXSimConnectVariable;
begin
if ADefinition1.GetVariableCount = ADefinition2.GetVariableCount then
begin
Result := True;
{ Order is very important in the definitions, as the Data Handler depends
on it to interpret the data. }
for variableIndex := 0 to Pred(ADefinition1.GetVariableCount) do
begin
variable1 := ADefinition1.GetVariable(variableIndex);
variable2 := ADefinition2.GetVariable(variableIndex);
if (variable1.GetVariableName <> variable2.GetVariableName) or
(variable1.GetUnitsName <> variable2.GetUnitsName) or
(variable1.GetDataType <> variable2.GetDataType) or
(not SameValue(variable1.GetEpsilon, variable2.GetEpsilon, 0.00001)) then
begin
Result := False;
break;
end;
end;
end else
Result := False;
end;
procedure TFSXSimConnectClient.TMAddDefinition(var Msg: TOmniMessage);
var
addDefinition: TAddDefinitionValue;
definitionID: Cardinal;
definitionRef: TFSXSimConnectDefinitionRef;
definitionAccess: IFSXSimConnectDefinitionAccess;
hasDefinition: Boolean;
begin
addDefinition := Msg.MsgData;
definitionAccess := (addDefinition.Definition as IFSXSimConnectDefinitionAccess);
hasDefinition := False;
{ Attempt to re-use existing definition to save on SimConnect traffic }
for definitionID in Definitions.Keys do
begin
definitionRef := Definitions[definitionID];
if SameDefinition(definitionRef.Definition, definitionAccess) then
begin
definitionRef.Attach(addDefinition.DataHandler);
addDefinition.DefinitionID := definitionID;
{ Request an update on the definition to update the new worker }
UpdateDefinition(definitionID);
hasDefinition := True;
break;
end;
end;
if not hasDefinition then
begin
{ Add as new definition }
Inc(FLastDefinitionID);
definitionRef := TFSXSimConnectDefinitionRef.Create(definitionAccess);
definitionRef.Attach(addDefinition.DataHandler);
Definitions.Add(LastDefinitionID, definitionRef);
addDefinition.DefinitionID := LastDefinitionID;
{ Register with SimConnect }
RegisterDefinition(LastDefinitionID, definitionAccess);
end;
end;
procedure TFSXSimConnectClient.TMRemoveDefinition(var Msg: TOmniMessage);
var
removeDefinition: TRemoveDefinitionValue;
definitionRef: TFSXSimConnectDefinitionRef;
begin
removeDefinition := Msg.MsgData;
if Definitions.ContainsKey(removeDefinition.DefinitionID) then
begin
definitionRef := Definitions[removeDefinition.DefinitionID];
if definitionRef.Detach(removeDefinition.DataHandler) = 0 then
begin
{ Unregister with SimConnect }
UnregisterDefinition(removeDefinition.DefinitionID);
Definitions.Remove(removeDefinition.DefinitionID);
end;
end;
removeDefinition.Signal;
end;
procedure TFSXSimConnectClient.TMTrySimConnect(var Msg: TOmniMessage);
begin
TrySimConnect;
end;
{ TFSXSimConnectDefinitionRef }
constructor TFSXSimConnectDefinitionRef.Create(ADefinition: IFSXSimConnectDefinitionAccess);
begin
inherited Create;
FDataHandlers := TInterfaceList.Create;
FDefinition := ADefinition;
end;
destructor TFSXSimConnectDefinitionRef.Destroy;
begin
FreeAndNil(FDataHandlers);
inherited Destroy;
end;
procedure TFSXSimConnectDefinitionRef.HandleData(AData: Pointer);
var
dataHandler: IInterface;
begin
for dataHandler in DataHandlers do
(dataHandler as IFSXSimConnectDataHandler).HandleData(AData);
end;
procedure TFSXSimConnectDefinitionRef.Attach(ADataHandler: IFSXSimConnectDataHandler);
begin
DataHandlers.Add(ADataHandler as IFSXSimConnectDataHandler);
end;
function TFSXSimConnectDefinitionRef.Detach(ADataHandler: IFSXSimConnectDataHandler): Integer;
begin
DataHandlers.Remove(ADataHandler as IFSXSimConnectDataHandler);
Result := DataHandlers.Count;
end;
{ TFSXSimConnectDefinitionMap }
constructor TFSXSimConnectDefinitionMap.Create(ACapacity: Integer);
begin
inherited Create([doOwnsValues], ACapacity);
end;
{ TFSXSimConnectVariable }
constructor TFSXSimConnectVariable.Create(AVariableName, AUnitsName: string; ADataType: SIMCONNECT_DATAType; AEpsilon: Single);
begin
inherited Create;
FVariableName := AVariableName;
FUnitsName := AUnitsName;
FDataType := ADataType;
FEpsilon := AEpsilon;
end;
function TFSXSimConnectVariable.GetVariableName: string;
begin
Result := FVariableName;
end;
function TFSXSimConnectVariable.GetUnitsName: string;
begin
Result := FUnitsName;
end;
function TFSXSimConnectVariable.GetDataType: SIMCONNECT_DATAType;
begin
Result := FDataType;
end;
function TFSXSimConnectVariable.GetEpsilon: Single;
begin
Result := FEpsilon;
end;
{ TAddDefinitionValue }
constructor TAddDefinitionValue.Create(ADefinition: IFSXSimConnectDefinition; ADataHandler: IFSXSimConnectDataHandler);
begin
inherited Create;
FDefinition := ADefinition;
FDataHandler := ADataHandler;
end;
procedure TAddDefinitionValue.SetDefinitionID(const Value: Cardinal);
begin
FDefinitionID := Value;
Signal;
end;
{ TRemoveDefinitionValue }
constructor TRemoveDefinitionValue.Create(ADefinitionID: Cardinal; ADataHandler: IFSXSimConnectDataHandler);
begin
inherited Create;
FDefinitionID := ADefinitionID;
FDataHandler := ADataHandler;
end;
end.

86
G940LEDControl/Units/FSXSimConnectIntf.pas Normal file
View File

@ -0,0 +1,86 @@
unit FSXSimConnectIntf;
interface
uses
SimConnect;
type
IFSXSimConnect = interface;
IFSXSimConnectDefinition = interface;
IFSXSimConnectObserver = interface
['{ACE8979A-D656-4F97-A332-A54BB615C4D1}']
procedure ObserveDestroy(Sender: IFSXSimConnect);
end;
IFSXSimConnectDataHandler = interface
['{29F00FB8-00AB-419F-83A3-A6AB3582599F}']
procedure HandleData(AData: Pointer);
end;
IFSXSimConnect = interface
['{B6BE3E7C-0804-43D6-84DE-8010C5728A07}']
procedure Attach(AObserver: IFSXSimConnectObserver);
procedure Detach(AObserver: IFSXSimConnectObserver);
function CreateDefinition: IFSXSimConnectDefinition;
function AddDefinition(ADefinition: IFSXSimConnectDefinition; ADataHandler: IFSXSimConnectDataHandler): Integer;
procedure RemoveDefinition(ADefinitionID: Cardinal; ADataHandler: IFSXSimConnectDataHandler);
end;
IFSXSimConnectDefinition = interface
['{F1EAB3B1-0A3D-4B06-A75F-823E15C313B8}']
procedure AddVariable(AVariableName, AUnitsName: string; ADataType: SIMCONNECT_DATAType; AEpsilon: Single = 0);
end;
IFSXSimConnectVariable = interface
['{A41AD003-77C0-4E34-91E3-B0BAADD08FCE}']
function GetVariableName: string;
function GetUnitsName: string;
function GetDataType: SIMCONNECT_DATAType;
function GetEpsilon: Single;
end;
IFSXSimConnectDefinitionAccess = interface
['{2592534C-0344-4442-8A5F-1AB34B96E1B5}']
function GetVariableCount: Integer;
function GetVariable(AIndex: Integer): IFSXSimConnectVariable;
end;
TFSXSimConnectState = (scsDisconnected, scsConnected, scsFailed);
IFSXSimConnectStateObserver = interface
['{0508904F-8189-479D-AF70-E98B00C9D9B2}']
procedure ObserverStateUpdate(ANewState: TFSXSimConnectState);
end;
const
FSX_UNIT_PERCENT = 'percent';
FSX_UNIT_MASK = 'mask';
FSX_UNIT_BOOL = 'bool';
FSX_UNIT_NUMBER = 'number';
FSX_LIGHTON_NAV = $0001;
FSX_LIGHTON_BEACON = $0002;
FSX_LIGHTON_LANDING = $0004;
FSX_LIGHTON_TAXI = $0008;
FSX_LIGHTON_STROBE = $0010;
FSX_LIGHTON_PANEL = $0020;
FSX_LIGHTON_RECOGNITION = $0040;
FSX_LIGHTON_CABIN = $0200;
FSX_MAX_ENGINES = 4;
implementation
end.

114
G940LEDControl/Units/FSXSimConnectStateMonitor.pas Normal file
View File

@ -0,0 +1,114 @@
unit FSXSimConnectStateMonitor;
interface
uses
System.Classes,
System.SyncObjs,
FSXSimConnectIntf;
type
TFSXSimConnectStateMonitor = class(TObject)
private
FObservers: TInterfaceList;
FCurrentStateLock: TCriticalSection;
FCurrentState: TFSXSimConnectState;
procedure DoSetCurrentState(const Value: TFSXSimConnectState);
protected
property CurrentStateLock: TCriticalSection read FCurrentStateLock;
property Observers: TInterfaceList read FObservers;
public
constructor Create;
destructor Destroy; override;
class function Instance: TFSXSimConnectStateMonitor;
class procedure SetCurrentState(AState: TFSXSimConnectState);
procedure Attach(AObserver: IFSXSimConnectStateObserver);
procedure Detach(AObserver: IFSXSimConnectStateObserver);
property CurrentState: TFSXSimConnectState read FCurrentState write DoSetCurrentState;
end;
implementation
uses
System.SysUtils;
var
FSXSimConnectStateInstance: TFSXSimConnectStateMonitor;
{ TFSXSimConnectState }
class function TFSXSimConnectStateMonitor.Instance: TFSXSimConnectStateMonitor;
begin
Result := FSXSimConnectStateInstance;
end;
class procedure TFSXSimConnectStateMonitor.SetCurrentState(AState: TFSXSimConnectState);
begin
Instance.DoSetCurrentState(AState);
end;
constructor TFSXSimConnectStateMonitor.Create;
begin
inherited Create;
FCurrentStateLock := TCriticalSection.Create;
FObservers := TInterfaceList.Create;
end;
destructor TFSXSimConnectStateMonitor.Destroy;
begin
FreeAndNil(FObservers);
FreeAndNil(FCurrentStateLock);
inherited Destroy;
end;
procedure TFSXSimConnectStateMonitor.Attach(AObserver: IFSXSimConnectStateObserver);
begin
Observers.Add(AObserver as IFSXSimConnectStateObserver);
end;
procedure TFSXSimConnectStateMonitor.Detach(AObserver: IFSXSimConnectStateObserver);
begin
Observers.Remove(AObserver as IFSXSimConnectStateObserver);
end;
procedure TFSXSimConnectStateMonitor.DoSetCurrentState(const Value: TFSXSimConnectState);
var
observer: IInterface;
begin
CurrentStateLock.Acquire;
try
if Value <> FCurrentState then
begin
FCurrentState := Value;
for observer in Observers do
(observer as IFSXSimConnectStateObserver).ObserverStateUpdate(CurrentState);
end;
finally
CurrentStateLock.Release;
end;
end;
initialization
FSXSimConnectStateInstance := TFSXSimConnectStateMonitor.Create;
finalization
FreeAndNil(FSXSimConnectStateInstance);
end.

266
G940LEDControl/Units/G940LEDStateConsumer.pas
View File

@ -8,48 +8,39 @@ uses
OtlComm,
OtlTaskControl,
LEDFunctionMap,
LEDStateConsumer,
LEDStateProvider;
LEDStateConsumer;
const
MSG_FINDTHROTTLEDEVICE = MSG_CONSUMER_OFFSET + 1;
MSG_NOTIFY_DEVICESTATE = MSG_CONSUMER_OFFSET + 2;
MSG_TIMER_BLINK = MSG_CONSUMER_OFFSET + 3;
TM_FINDTHROTTLEDEVICE = 2001;
TM_TESTTHROTTLEDEVICE = 2002;
TM_NOTIFY_DEVICESTATE = 2003;
TIMER_BLINK = TIMER_CONSUMER_OFFSET + 1;
type
TG940LEDStateConsumer = class(TLEDStateConsumer)
private
FDirectInput: IDirectInput8;
FThrottleDevice: IDirectInputDevice8;
FRed: Byte;
FGreen: Byte;
FBlinkTimerStarted: Boolean;
FBlinkCounter: Integer;
FTHrottleDeviceGUID: TGUID;
protected
procedure MsgFindThrottleDevice(var msg: TOmniMessage); message MSG_FINDTHROTTLEDEVICE;
procedure MsgTimerBlink(var msg: TOmniMessage); message MSG_TIMER_BLINK;
procedure TMFindThrottleDevice(var Msg: TOmniMessage); message TM_FINDTHROTTLEDEVICE;
procedure TMTestThrottleDevice(var Msg: TOmniMessage); message TM_TESTTHROTTLEDEVICE;
protected
function Initialize: Boolean; override;
procedure ResetLEDState; override;
procedure LEDStateChanged(ALEDIndex: Integer; AState: TLEDState); override;
procedure Changed; override;
procedure StartBlinkTimer;
procedure StopBlinkTimer;
procedure Cleanup; override;
procedure FindThrottleDevice;
procedure FoundThrottleDevice(ADeviceGUID: TGUID);
procedure SetDeviceState(AState: Integer);
procedure Update; override;
property DirectInput: IDirectInput8 read FDirectInput;
property ThrottleDevice: IDirectInputDevice8 read FThrottleDevice;
property ThrottleDeviceGUID: TGUID read FTHrottleDeviceGUID;
end;
@ -58,8 +49,8 @@ const
DEVICESTATE_FOUND = 1;
DEVICESTATE_NOTFOUND = 2;
EXIT_ERROR_LOGIJOYSTICKDLL = EXIT_CONSUMER_OFFSET + 1;
EXIT_ERROR_DIRECTINPUT = EXIT_CONSUMER_OFFSET + 2;
EXIT_ERROR_LOGIJOYSTICKDLL = 9001;
EXIT_ERROR_DIRECTINPUT = 9002;
implementation
@ -68,27 +59,14 @@ uses
Windows,
OtlCommon,
OtlTask,
LEDColorIntf,
LogiJoystickDLL;
const
BLINK_INTERVAL = 500;
type
TRunInMainThreadSetLEDs = class(TOmniWaitableValue, IRunInMainThread)
private
FDevice: IDirectInputDevice8;
FRed: Byte;
FGreen: Byte;
protected
{ IRunInMainThread }
procedure Execute;
public
constructor Create(ADevice: IDirectInputDevice8; ARed, AGreen: Byte);
end;
G940_BUTTONCOUNT = 8;
function EnumDevicesProc(var lpddi: TDIDeviceInstanceW; pvRef: Pointer): BOOL; stdcall;
@ -134,101 +112,16 @@ begin
end;
Result := True;
Task.Comm.OtherEndpoint.Send(MSG_FINDTHROTTLEDEVICE);
Task.Comm.OtherEndpoint.Send(TM_FINDTHROTTLEDEVICE);
end;
procedure TG940LEDStateConsumer.ResetLEDState;
procedure TG940LEDStateConsumer.Cleanup;
begin
FRed := 0;
FGreen := $FF;
inherited;
end;
procedure TG940LEDStateConsumer.LEDStateChanged(ALEDIndex: Integer; AState: TLEDState);
procedure SetBit(var AMask: Byte; ABit: Integer; ASet: Boolean); inline;
begin
if ASet then
AMask := AMask or (1 shl ABit)
else
AMask := AMask and not (1 shl ABit);
end;
var
red: Boolean;
green: Boolean;
begin
red := False;
green := False;
case AState of
lsGreen:
green := True;
lsAmber:
begin
red := True;
green := True;
end;
lsRed:
red := True;
lsWarning:
begin
red := True;
green := True;
StartBlinkTimer;
end;
lsError:
begin
red := True;
StartBlinkTimer;
end;
end;
SetBit(FRed, ALEDIndex, red);
SetBit(FGreen, ALEDIndex, green);
inherited;
end;
procedure TG940LEDStateConsumer.Changed;
begin
inherited;
inherited Cleanup;
if Assigned(ThrottleDevice) then
{ Logitech SDK will not change the color outside of the main thread }
RunInMainThread(TRunInMainThreadSetLEDs.Create(ThrottleDevice, FRed, FGreen), Destroying);
end;
procedure TG940LEDStateConsumer.StartBlinkTimer;
begin
if FBlinkTimerStarted then
exit;
FBlinkCounter := 0;
Task.SetTimer(TIMER_BLINK, BLINK_INTERVAL, MSG_TIMER_BLINK);
FBlinkTimerStarted := True;
end;
procedure TG940LEDStateConsumer.StopBlinkTimer;
begin
if not FBlinkTimerStarted then
exit;
Task.ClearTimer(TIMER_BLINK);
FBlinkTimerStarted := False;
SetLEDs(ThrottleDevice, 0, $FF);
end;
@ -243,88 +136,89 @@ begin
if not Assigned(ThrottleDevice) then
SetDeviceState(DEVICESTATE_NOTFOUND)
else
Changed;
Update;
end;
procedure TG940LEDStateConsumer.FoundThrottleDevice(ADeviceGUID: TGUID);
begin
if DirectInput.CreateDevice(ADeviceGUID, FThrottleDevice, nil) = S_OK then
begin
FTHrottleDeviceGUID := ADeviceGUID;
SetDeviceState(DEVICESTATE_FOUND);
end;
end;
procedure TG940LEDStateConsumer.SetDeviceState(AState: Integer);
begin
Task.Comm.Send(MSG_NOTIFY_DEVICESTATE, AState);
Task.Comm.Send(TM_NOTIFY_DEVICESTATE, AState);
end;
procedure TG940LEDStateConsumer.MsgFindThrottleDevice(var msg: TOmniMessage);
procedure TG940LEDStateConsumer.Update;
procedure SetBit(var AMask: Byte; ABit: Integer); inline;
begin
AMask := AMask or (1 shl ABit)
end;
var
red: Byte;
green: Byte;
buttonIndex: Integer;
buttonColor: TStaticLEDColor;
begin
if not Assigned(ThrottleDevice) then
exit;
red := 0;
green := 0;
for buttonIndex := 0 to Pred(G940_BUTTONCOUNT) do
begin
if (buttonIndex >= ButtonColors.Count) or (not Assigned(ButtonColors[buttonIndex])) then
buttonColor := lcGreen
else
buttonColor := (ButtonColors[buttonIndex] as ILEDStateColor).GetCurrentColor;
case buttonColor of
lcGreen:
SetBit(green, buttonIndex);
lcAmber:
begin
SetBit(green, buttonIndex);
SetBit(red, buttonIndex);
end;
lcRed:
SetBit(red, buttonIndex);
end;
end;
SetLEDs(ThrottleDevice, red, green);
end;
procedure TG940LEDStateConsumer.TMFindThrottleDevice(var Msg: TOmniMessage);
begin
FindThrottleDevice;
end;
procedure TG940LEDStateConsumer.MsgTimerBlink(var msg: TOmniMessage);
var
warningState: TLEDState;
errorState: TLEDState;
ledIndex: Integer;
state: TLEDState;
procedure TG940LEDStateConsumer.TMTestThrottleDevice(var Msg: TOmniMessage);
begin
Inc(FBlinkCounter);
if FBlinkCounter > 3 then
FBlinkCounter := 0;
warningState := lsOff;
errorState := lsOff;
{ Error lights blink twice as fast }
if (FBlinkCounter in [0, 1]) then
warningState := lsAmber;
if (FBlinkCounter in [0, 2]) then
errorState := lsRed;
if StateMap.FindFirst([lsWarning, lsError], ledIndex, state) then
if Assigned(ThrottleDevice) then
begin
BeginUpdate;
try
repeat
case state of
lsWarning:
if StateMap.GetState(ledIndex) <> warningState then
LEDStateChanged(ledIndex, warningState);
lsError:
if StateMap.GetState(ledIndex) <> errorState then
LEDStateChanged(ledIndex, errorState);
end;
until not StateMap.FindNext([lsWarning, lsError], ledIndex, state);
finally
EndUpdate;
end;
end else
StopBlinkTimer;
end;
{ TRunInMainThreadSetLEDs }
constructor TRunInMainThreadSetLEDs.Create(ADevice: IDirectInputDevice8; ARed, AGreen: Byte);
if DirectInput.GetDeviceStatus(ThrottleDeviceGUID) = DI_NOTATTACHED then
begin
inherited Create;
FDevice := ADevice;
FRed := ARed;
FGreen := AGreen;
FThrottleDevice := nil;
SetDeviceState(DEVICESTATE_NOTFOUND);
end;
end;
procedure TRunInMainThreadSetLEDs.Execute;
begin
SetLEDs(FDevice, FRed, FGreen);
end;
end.

28
G940LEDControl/Units/LEDColor.pas Normal file
View File

@ -0,0 +1,28 @@
unit LEDColor;
interface
uses
SysUtils,
LEDColorIntf;
type
TCustomLEDStateColor = class(TInterfacedObject, ILEDStateColor)
protected
{ ILEDState }
function GetCurrentColor: TStaticLEDColor; virtual; abstract;
end;
TCustomLEDStateDynamicColor = class(TCustomLEDStateColor, ILEDStateDynamicColor)
protected
{ ITickLEDState }
procedure Reset; virtual; abstract;
procedure Tick; virtual; abstract;
end;
implementation
end.

29
G940LEDControl/Units/LEDColorIntf.pas Normal file
View File

@ -0,0 +1,29 @@
unit LEDColorIntf;
interface
type
TLEDColor = (lcOff, lcGreen, lcAmber, lcRed,
lcFlashingGreenFast, lcFlashingGreenNormal,
lcFlashingAmberFast, lcFlashingAmberNormal,
lcFlashingRedFast, lcFlashingRedNormal);
TStaticLEDColor = lcOff..lcRed;
ILEDStateColor = interface
['{B40DF462-B660-4002-A6B9-DD30AC69E8DB}']
function GetCurrentColor: TStaticLEDColor;
end;
ILEDStateDynamicColor = interface(ILEDStateColor)
['{9770E851-580D-4803-9979-0C608CB108A0}']
procedure Reset;
procedure Tick;
end;
implementation
end.

89
G940LEDControl/Units/LEDColorPool.pas Normal file
View File

@ -0,0 +1,89 @@
unit LEDColorPool;
interface
uses
LEDColorIntf;
type
TLEDColorPool = class(TObject)
private
FStates: array[TLEDColor] of ILEDStateColor;
protected
class function Instance: TLEDColorPool;
function DoGetColor(AColor: TLEDColor): ILEDStateColor;
public
class function GetColor(AColor: TLEDColor): ILEDStateColor; overload;
end;
implementation
uses
SysUtils,
DynamicLEDColor,
StaticLEDColor;
var
LEDColorPoolInstance: TLEDColorPool;
{ TLEDStatePool }
class function TLEDColorPool.GetColor(AColor: TLEDColor): ILEDStateColor;
begin
Result := Instance.DoGetColor(AColor);
end;
class function TLEDColorPool.Instance: TLEDColorPool;
begin
if not Assigned(LEDColorPoolInstance) then
LEDColorPoolInstance := TLEDColorPool.Create;
Result := LEDColorPoolInstance;
end;
function TLEDColorPool.DoGetColor(AColor: TLEDColor): ILEDStateColor;
function GetFlashingCycle(AColor: TLEDColor): TStaticLEDColorDynArray;
begin
SetLength(Result, 2);
Result[0] := AColor;
Result[1] := lcOff;
end;
var
state: ILEDStateColor;
begin
if not Assigned(FStates[AColor]) then
begin
case AColor of
lcOff: state := TLEDStateStaticColor.Create(lcOff);
lcGreen: state := TLEDStateStaticColor.Create(lcGreen);
lcAmber: state := TLEDStateStaticColor.Create(lcAmber);
lcRed: state := TLEDStateStaticColor.Create(lcRed);
lcFlashingGreenFast: state := TDynamicLEDColor.Create(GetFlashingCycle(lcGreen), TICKINTERVAL_FAST);
lcFlashingGreenNormal: state := TDynamicLEDColor.Create(GetFlashingCycle(lcGreen), TICKINTERVAL_NORMAL);
lcFlashingAmberFast: state := TDynamicLEDColor.Create(GetFlashingCycle(lcAmber), TICKINTERVAL_FAST);
lcFlashingAmberNormal: state := TDynamicLEDColor.Create(GetFlashingCycle(lcAmber), TICKINTERVAL_NORMAL);
lcFlashingRedFast: state := TDynamicLEDColor.Create(GetFlashingCycle(lcRed), TICKINTERVAL_FAST);
lcFlashingRedNormal: state := TDynamicLEDColor.Create(GetFlashingCycle(lcRed), TICKINTERVAL_NORMAL);
end;
FStates[AColor] := state;
Result := state;
end else
Result := FStates[AColor];
end;
initialization
finalization
FreeAndNil(LEDColorPoolInstance);
end.

437
G940LEDControl/Units/LEDFunction.pas Normal file
View File

@ -0,0 +1,437 @@
unit LEDFunction;
interface
uses
System.Classes,
System.SyncObjs,
LEDFunctionIntf,
LEDStateIntf;
type
TCustomLEDFunctionWorker = class;
TCustomLEDMultiStateFunctionWorkerClass = class of TCustomLEDMultiStateFunctionWorker;
TCustomLEDFunctionProvider = class(TInterfacedObject, ILEDFunctionProvider)
private
FFunctions: TInterfaceList;
protected
procedure RegisterFunctions; virtual; abstract;
function RegisterFunction(AFunction: ILEDFunction): ILEDFunction; virtual;
protected
{ ILEDFunctionProvider }
function GetUID: string; virtual; abstract;
function GetEnumerator: ILEDFunctionEnumerator; virtual;
function Find(const AFunctionUID: string): ILEDFunction; virtual;
public
constructor Create;
destructor Destroy; override;
end;
TCustomLEDFunction = class(TInterfacedObject, ILEDFunction)
protected
{ ILEDFunction }
function GetCategoryName: string; virtual; abstract;
function GetDisplayName: string; virtual; abstract;
function GetUID: string; virtual; abstract;
function CreateWorker(ASettings: ILEDFunctionWorkerSettings; const APreviousState: string = ''): ILEDFunctionWorker; virtual; abstract;
end;
TCustomMultiStateLEDFunction = class(TCustomLEDFunction, ILEDMultiStateFunction)
private
FStates: TInterfaceList;
FProviderUID: string;
protected
procedure RegisterStates; virtual; abstract;
function RegisterState(AState: ILEDState): ILEDState; virtual;
function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; virtual; abstract;
function DoCreateWorker(ASettings: ILEDFunctionWorkerSettings; const APreviousState: string = ''): TCustomLEDFunctionWorker; virtual;
protected
function CreateWorker(ASettings: ILEDFunctionWorkerSettings; const APreviousState: string = ''): ILEDFunctionWorker; override;
{ ILEDMultiStateFunction }
function GetEnumerator: ILEDStateEnumerator; virtual;
public
constructor Create(const AProviderUID: string);
destructor Destroy; override;
end;
TCustomLEDFunctionWorker = class(TInterfacedObject, ILEDFunctionWorker)
private
FObservers: TInterfaceList;
FProviderUID: string;
FFunctionUID: string;
protected
procedure NotifyObservers; virtual;
property Observers: TInterfaceList read FObservers;
protected
{ ILEDFunctionWorker }
procedure Attach(AObserver: ILEDFunctionObserver); virtual;
procedure Detach(AObserver: ILEDFunctionObserver); virtual;
function GetProviderUID: string; virtual;
function GetFunctionUID: string; virtual;
function GetCurrentState: ILEDStateWorker; virtual; abstract;
public
constructor Create(const AProviderUID, AFunctionUID: string);
destructor Destroy; override;
end;
TCustomLEDMultiStateFunctionWorker = class(TCustomLEDFunctionWorker)
private
FStates: TInterfaceList;
FCurrentStateLock: TCriticalSection;
FCurrentState: ILEDStateWorker;
protected
procedure RegisterStates(AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings); virtual;
function FindState(const AUID: string): ILEDStateWorker; virtual;
procedure SetCurrentState(const AUID: string; ANotifyObservers: Boolean = True); overload; virtual;
procedure SetCurrentState(AState: ILEDStateWorker; ANotifyObservers: Boolean = True); overload; virtual;
property States: TInterfaceList read FStates;
protected
function GetCurrentState: ILEDStateWorker; override;
public
constructor Create(const AProviderUID, AFunctionUID: string; AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings; const APreviousState: string = ''); virtual;
destructor Destroy; override;
end;
TLEDFunctionEnumerator = class(TInterfacedObject, ILEDFunctionEnumerator)
private
FList: TInterfaceList;
FIndex: Integer;
protected
{ ILEDFunctionEnumerator }
function GetCurrent: ILEDFunction; virtual;
function MoveNext: Boolean; virtual;
public
constructor Create(AList: TInterfaceList);
end;
TLEDStateEnumerator = class(TInterfacedObject, ILEDStateEnumerator)
private
FList: TInterfaceList;
FIndex: Integer;
protected
{ ILEDStateEnumerator }
function GetCurrent: ILEDState; virtual;
function MoveNext: Boolean; virtual;
public
constructor Create(AList: TInterfaceList);
end;
implementation
uses
System.SysUtils,
LEDColorIntf,
LEDColorPool,
LEDState;
{ TCustomMultiStateLEDFunction }
constructor TCustomMultiStateLEDFunction.Create(const AProviderUID: string);
begin
inherited Create;
FStates := TInterfaceList.Create;
FProviderUID := AProviderUID;
RegisterStates;
end;
destructor TCustomMultiStateLEDFunction.Destroy;
begin
FreeAndNil(FStates);
inherited Destroy;
end;
function TCustomMultiStateLEDFunction.RegisterState(AState: ILEDState): ILEDState;
begin
Result := AState as ILEDState;
FStates.Add(Result);
end;
function TCustomMultiStateLEDFunction.GetEnumerator: ILEDStateEnumerator;
begin
Result := TLEDStateEnumerator.Create(FStates);
end;
function TCustomMultiStateLEDFunction.CreateWorker(ASettings: ILEDFunctionWorkerSettings; const APreviousState: string): ILEDFunctionWorker;
begin
Result := DoCreateWorker(ASettings, APreviousState);
end;
function TCustomMultiStateLEDFunction.DoCreateWorker(ASettings: ILEDFunctionWorkerSettings; const APreviousState: string): TCustomLEDFunctionWorker;
begin
Result := GetWorkerClass.Create(FProviderUID, GetUID, Self, ASettings, APreviousState);
end;
{ TCustomLEDFunctionWorker }
constructor TCustomLEDFunctionWorker.Create(const AProviderUID, AFunctionUID: string);
begin
inherited Create;
FObservers := TInterfaceList.Create;
FProviderUID := AProviderUID;
FFunctionUID := AFunctionUID;
end;
destructor TCustomLEDFunctionWorker.Destroy;
begin
FreeAndNil(FObservers);
inherited Destroy;
end;
procedure TCustomLEDFunctionWorker.Attach(AObserver: ILEDFunctionObserver);
begin
{ TInterfaceList is thread-safe }
Observers.Add(AObserver as ILEDFunctionObserver);
end;
procedure TCustomLEDFunctionWorker.Detach(AObserver: ILEDFunctionObserver);
begin
Observers.Remove(AObserver as ILEDFunctionObserver);
end;
function TCustomLEDFunctionWorker.GetProviderUID: string;
begin
Result := FProviderUID;
end;
function TCustomLEDFunctionWorker.GetFunctionUID: string;
begin
Result := FFunctionUID;
end;
procedure TCustomLEDFunctionWorker.NotifyObservers;
var
observer: IInterface;
begin
for observer in Observers do
(observer as ILEDFunctionObserver).ObserveUpdate(Self);
end;
{ TCustomLEDMultiStateFunctionWorker }
constructor TCustomLEDMultiStateFunctionWorker.Create(const AProviderUID, AFunctionUID: string; AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings; const APreviousState: string);
begin
inherited Create(AProviderUID, AFunctionUID);
FCurrentStateLock := TCriticalSection.Create;
FStates := TInterfaceList.Create;
RegisterStates(AStates, ASettings);
if Length(APreviousState) > 0 then
FCurrentState := FindState(APreviousState);
{ Make sure we have a default state }
if (not Assigned(FCurrentState)) and (States.Count > 0) then
SetCurrentState((States[0] as ILEDStateWorker), False);
end;
destructor TCustomLEDMultiStateFunctionWorker.Destroy;
begin
FreeAndNil(FCurrentStateLock);
FreeAndNil(FStates);
inherited Destroy;
end;
procedure TCustomLEDMultiStateFunctionWorker.RegisterStates(AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings);
var
state: ILEDState;
color: TLEDColor;
begin
for state in AStates do
begin
if (not Assigned(ASettings)) or (not ASettings.GetStateColor(state.GetUID, color)) then
color := state.GetDefaultColor;
States.Add(TLEDStateWorker.Create(state.GetUID, TLEDColorPool.GetColor(color)));
end;
end;
function TCustomLEDMultiStateFunctionWorker.FindState(const AUID: string): ILEDStateWorker;
var
state: IInterface;
begin
Result := nil;
if not Assigned(States) then
exit;
for state in States do
if (state as ICustomLEDState).GetUID = AUID then
begin
Result := (state as ILEDStateWorker);
break;
end;
end;
procedure TCustomLEDMultiStateFunctionWorker.SetCurrentState(const AUID: string; ANotifyObservers: Boolean);
begin
SetCurrentState(FindState(AUID), ANotifyObservers);
end;
procedure TCustomLEDMultiStateFunctionWorker.SetCurrentState(AState: ILEDStateWorker; ANotifyObservers: Boolean);
begin
FCurrentStateLock.Acquire;
try
if AState <> FCurrentState then
begin
FCurrentState := AState;
if ANotifyObservers then
NotifyObservers;
end;
finally
FCurrentStateLock.Release;
end;
end;
function TCustomLEDMultiStateFunctionWorker.GetCurrentState: ILEDStateWorker;
begin
FCurrentStateLock.Acquire;
try
Result := FCurrentState;
finally
FCurrentStateLock.Release;
end;
end;
{ TCustomLEDFunctionProvider }
constructor TCustomLEDFunctionProvider.Create;
begin
inherited Create;
FFunctions := TInterfaceList.Create;
RegisterFunctions;
end;
destructor TCustomLEDFunctionProvider.Destroy;
begin
FreeAndNil(FFunctions);
inherited Destroy;
end;
function TCustomLEDFunctionProvider.Find(const AFunctionUID: string): ILEDFunction;
var
ledFunction: ILEDFunction;
begin
Result := nil;
for ledFunction in (Self as ILEDFunctionProvider) do
if ledFunction.GetUID = AFunctionUID then
begin
Result := ledFunction;
break;
end;
end;
function TCustomLEDFunctionProvider.RegisterFunction(AFunction: ILEDFunction): ILEDFunction;
begin
Result := AFunction as ILEDFunction;
FFunctions.Add(Result);
end;
function TCustomLEDFunctionProvider.GetEnumerator: ILEDFunctionEnumerator;
begin
Result := TLEDFunctionEnumerator.Create(FFunctions);
end;
{ TLEDFunctionEnumerator }
constructor TLEDFunctionEnumerator.Create(AList: TInterfaceList);
begin
inherited Create;
FList := AList;
FIndex := -1;
end;
function TLEDFunctionEnumerator.GetCurrent: ILEDFunction;
begin
Result := (FList[FIndex] as ILEDFunction);
end;
function TLEDFunctionEnumerator.MoveNext: Boolean;
begin
Result := (FIndex < Pred(FList.Count));
if Result then
Inc(FIndex);
end;
{ TLEDStateEnumerator }
constructor TLEDStateEnumerator.Create(AList: TInterfaceList);
begin
inherited Create;
FList := AList;
FIndex := -1;
end;
function TLEDStateEnumerator.GetCurrent: ILEDState;
begin
Result := (FList[FIndex] as ILEDState);
end;
function TLEDStateEnumerator.MoveNext: Boolean;
begin
Result := (FIndex < Pred(FList.Count));
if Result then
Inc(FIndex);
end;
end.

86
G940LEDControl/Units/LEDFunctionIntf.pas Normal file
View File

@ -0,0 +1,86 @@
unit LEDFunctionIntf;
interface
uses
LEDColorIntf,
LEDStateIntf;
type
ILEDFunction = interface;
ILEDFunctionWorker = interface;
ILEDFunctionWorkerSettings = interface;
ILEDFunctionEnumerator = interface;
ILEDStateEnumerator = interface;
ILEDFunctionProvider = interface
['{B38F6F90-DC96-42CE-B8F0-21F0DD8AA537}']
function GetUID: string;
function GetEnumerator: ILEDFunctionEnumerator;
function Find(const AFunctionUID: string): ILEDFunction;
end;
ILEDFunction = interface
['{7087067A-1016-4A7D-ACB1-BA1F388DAD6C}']
function GetCategoryName: string;
function GetDisplayName: string;
function GetUID: string;
function CreateWorker(ASettings: ILEDFunctionWorkerSettings; const APreviousState: string = ''): ILEDFunctionWorker;
end;
ILEDMultiStateFunction = interface(ILEDFunction)
['{F16ADF7E-1C1C-4676-8D4F-135B68A80B52}']
function GetEnumerator: ILEDStateEnumerator;
end;
ILEDFunctionObserver = interface
['{B78415C9-9F64-4AF1-8983-BACE2B7225EF}']
procedure ObserveUpdate(Sender: ILEDFunctionWorker);
end;
ILEDFunctionWorker = interface
['{5EF3230D-B52F-4BD6-8AD3-F3A035F155B1}']
procedure Attach(AObserver: ILEDFunctionObserver);
procedure Detach(AObserver: ILEDFunctionObserver);
function GetProviderUID: string;
function GetFunctionUID: string;
function GetCurrentState: ILEDStateWorker;
end;
ILEDFunctionWorkerSettings = interface
['{8FA287F6-9FE6-4A49-9C87-05C7F3F2B256}']
function GetStateColor(const AUID: string; out AColor: TLEDColor): Boolean;
end;
ILEDFunctionEnumerator = interface
['{A03E4E54-19CB-4C08-AD5F-20265817086D}']
function GetCurrent: ILEDFunction;
function MoveNext: Boolean;
property Current: ILEDFunction read GetCurrent;
end;
ILEDStateEnumerator = interface
['{045E8466-831A-4704-ABBB-31E85789F314}']
function GetCurrent: ILEDState;
function MoveNext: Boolean;
property Current: ILEDState read GetCurrent;
end;
implementation
end.

228
G940LEDControl/Units/LEDFunctionMap.pas
View File

@ -1,228 +0,0 @@
unit LEDFunctionMap;
interface
uses
Classes,
SyncObjs,
X2UtHashes;
type
TLEDState = (lsOff, lsGreen, lsAmber, lsRed, lsWarning, lsError);
TLEDStateSet = set of TLEDState;
TLEDFunctionMap = class(TObject)
private
FFunctions: TX2IIHash;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure SetFunction(ALEDIndex, AFunction: Integer);
function GetFunction(ALEDIndex: Integer): Integer;
function HasFunction(AFunction: Integer): Boolean; overload;
function HasFunction(AFunctions: array of Integer): Boolean; overload;
function FindFirst(AFunction: Integer; out ALEDIndex: Integer): Boolean;
function FindNext(AFunction: Integer; out ALEDIndex: Integer): Boolean;
end;
TLEDStateMap = class(TObject)
private
FStates: TX2IIHash;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
function GetState(ALEDIndex: Integer; ADefault: TLEDState = lsGreen): TLEDState;
function SetState(ALEDIndex: Integer; AState: TLEDState): Boolean;
function HasStates(AStates: TLEDStateSet): Boolean;
function FindFirst(AStates: TLEDStateSet; out ALEDIndex: Integer; out AState: TLEDState): Boolean;
function FindNext(AStates: TLEDStateSet; out ALEDIndex: Integer; out AState: TLEDState): Boolean;
end;
const
FUNCTION_NONE = 0;
FUNCTION_OFF = 1;
FUNCTION_RED = 2;
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;
implementation
uses
SysUtils;
{ TLEDFunctionMap }
constructor TLEDFunctionMap.Create;
begin
inherited;
FFunctions := TX2IIHash.Create;
end;
destructor TLEDFunctionMap.Destroy;
begin
FreeAndNil(FFunctions);
inherited;
end;
procedure TLEDFunctionMap.Clear;
begin
FFunctions.Clear;
end;
procedure TLEDFunctionMap.SetFunction(ALEDIndex, AFunction: Integer);
begin
FFunctions[ALEDIndex] := AFunction;
end;
function TLEDFunctionMap.GetFunction(ALEDIndex: Integer): Integer;
begin
Result := FFunctions[ALEDIndex];
end;
function TLEDFunctionMap.HasFunction(AFunctions: array of Integer): Boolean;
var
functionNo: Integer;
begin
Result := False;
for functionNo in AFunctions do
begin
Result := HasFunction(functionNo);
if Result then
break;
end;
end;
function TLEDFunctionMap.HasFunction(AFunction: Integer): Boolean;
var
ledIndex: Integer;
begin
Result := FindFirst(AFunction, ledIndex);
end;
function TLEDFunctionMap.FindFirst(AFunction: Integer; out ALEDIndex: Integer): Boolean;
begin
FFunctions.First;
Result := FindNext(AFunction, ALEDIndex);
end;
function TLEDFunctionMap.FindNext(AFunction: Integer; out ALEDIndex: Integer): Boolean;
begin
Result := False;
while FFunctions.Next do
begin
if FFunctions.CurrentValue = AFunction then
begin
ALEDIndex := FFunctions.CurrentKey;
Result := True;
break;
end;
end;
end;
{ TLEDStateMap }
constructor TLEDStateMap.Create;
begin
inherited;
FStates := TX2IIHash.Create;
end;
destructor TLEDStateMap.Destroy;
begin
FreeAndNil(FStates);
inherited;
end;
procedure TLEDStateMap.Clear;
begin
FStates.Clear;
end;
function TLEDStateMap.GetState(ALEDIndex: Integer; ADefault: TLEDState): TLEDState;
begin
Result := ADefault;
if FStates.Exists(ALEDIndex) then
Result := TLEDState(FStates[ALEDIndex]);
end;
function TLEDStateMap.SetState(ALEDIndex: Integer; AState: TLEDState): Boolean;
begin
if FStates.Exists(ALEDIndex) then
Result := (FStates[ALEDIndex] <> Ord(AState))
else
Result := True;
if Result then
FStates[ALEDIndex] := Ord(AState);
end;
function TLEDStateMap.HasStates(AStates: TLEDStateSet): Boolean;
var
ledIndex: Integer;
state: TLEDState;
begin
Result := FindFirst(AStates, ledIndex, state);
end;
function TLEDStateMap.FindFirst(AStates: TLEDStateSet; out ALEDIndex: Integer; out AState: TLEDState): Boolean;
begin
FStates.First;
Result := FindNext(AStates, ALEDIndex, AState);
end;
function TLEDStateMap.FindNext(AStates: TLEDStateSet; out ALEDIndex: Integer; out AState: TLEDState): Boolean;
begin
Result := False;
while FStates.Next do
if TLEDState(FStates.CurrentValue) in AStates then
begin
ALEDIndex := FStates.CurrentKey;
AState := TLEDState(FStates.CurrentValue);
Result := True;
break;
end;
end;
end.

216
G940LEDControl/Units/LEDFunctionRegistry.pas Normal file
View File

@ -0,0 +1,216 @@
unit LEDFunctionRegistry;
interface
uses
Classes,
LEDFunctionIntf;
type
TLEDFunctionProviderList = class;
TLEDFunctionRegistry = class(TObject)
private
FProviders: TLEDFunctionProviderList;
protected
class function Instance: TLEDFunctionRegistry;
procedure DoRegister(AProvider: ILEDFunctionProvider);
procedure DoUnregister(AProvider: ILEDFunctionProvider);
function DoFind(const AUID: string): ILEDFunctionProvider;
function GetProviders: TLEDFunctionProviderList;
public
constructor Create;
destructor Destroy; override;
class procedure Register(AProvider: ILEDFunctionProvider);
class procedure Unregister(AProvider: ILEDFunctionProvider);
class function Find(const AUID: string): ILEDFunctionProvider;
class function Providers: TLEDFunctionProviderList;
end;
TLEDFunctionProviderListEnumerator = class;
TLEDFunctionProviderList = class(TObject)
private
FList: TInterfaceList;
protected
procedure Add(AProvider: ILEDFunctionProvider);
procedure Remove(AProvider: ILEDFunctionProvider);
public
constructor Create;
destructor Destroy; override;
function Find(const AUID: string): ILEDFunctionProvider;
function GetEnumerator: TLEDFunctionProviderListEnumerator;
end;
TLEDFunctionProviderListEnumerator = class(TInterfaceListEnumerator)
public
function GetCurrent: ILEDFunctionProvider; inline;
property Current: ILEDFunctionProvider read GetCurrent;
end;
implementation
uses
SysUtils;
var
RegistryInstance: TLEDFunctionRegistry;
{ TLEDFunctionRegistry }
class procedure TLEDFunctionRegistry.Register(AProvider: ILEDFunctionProvider);
begin
Instance.DoRegister(AProvider);
end;
class procedure TLEDFunctionRegistry.Unregister(AProvider: ILEDFunctionProvider);
begin
Instance.DoUnregister(AProvider);
end;
class function TLEDFunctionRegistry.Find(const AUID: string): ILEDFunctionProvider;
begin
Result := Instance.DoFind(AUID);
end;
class function TLEDFunctionRegistry.Providers: TLEDFunctionProviderList;
begin
Result := Instance.GetProviders;
end;
class function TLEDFunctionRegistry.Instance: TLEDFunctionRegistry;
begin
if not Assigned(RegistryInstance) then
RegistryInstance := TLEDFunctionRegistry.Create;
Result := RegistryInstance;
end;
constructor TLEDFunctionRegistry.Create;
begin
inherited Create;
FProviders := TLEDFunctionProviderList.Create;
end;
destructor TLEDFunctionRegistry.Destroy;
begin
FreeAndNil(FProviders);
inherited Destroy;
end;
procedure TLEDFunctionRegistry.DoRegister(AProvider: ILEDFunctionProvider);
begin
FProviders.Add(AProvider);
end;
procedure TLEDFunctionRegistry.DoUnregister(AProvider: ILEDFunctionProvider);
begin
FProviders.Remove(AProvider);
end;
function TLEDFunctionRegistry.DoFind(const AUID: string): ILEDFunctionProvider;
begin
Result := FProviders.Find(AUID);
end;
function TLEDFunctionRegistry.GetProviders: TLEDFunctionProviderList;
begin
Result := FProviders;
end;
{ TLEDFunctionProviderList }
constructor TLEDFunctionProviderList.Create;
begin
inherited Create;
FList := TInterfaceList.Create;
end;
destructor TLEDFunctionProviderList.Destroy;
begin
FreeAndNil(FList);
inherited Destroy;
end;
function TLEDFunctionProviderList.Find(const AUID: string): ILEDFunctionProvider;
var
provider: ILEDFunctionProvider;
begin
Result := nil;
for provider in Self do
if provider.GetUID = AUID then
begin
Result := provider;
break;
end;
end;
procedure TLEDFunctionProviderList.Add(AProvider: ILEDFunctionProvider);
var
stableReference: ILEDFunctionProvider;
begin
stableReference := (AProvider as ILEDFunctionProvider);
if FList.IndexOf(stableReference) = -1 then
FList.Add(stableReference);
end;
procedure TLEDFunctionProviderList.Remove(AProvider: ILEDFunctionProvider);
var
index: Integer;
begin
index := FList.IndexOf(AProvider as ILEDFunctionProvider);
if index > -1 then
FList.Delete(index);
end;
function TLEDFunctionProviderList.GetEnumerator: TLEDFunctionProviderListEnumerator;
begin
Result := TLEDFunctionProviderListEnumerator.Create(FList);
end;
{ TLEDFunctionProviderListEnumerator }
function TLEDFunctionProviderListEnumerator.GetCurrent: ILEDFunctionProvider;
begin
Result := ((inherited GetCurrent) as ILEDFunctionProvider);
end;
initialization
finalization
FreeAndNil(RegistryInstance);
end.

61
G940LEDControl/Units/LEDResources.pas Normal file
View File

@ -0,0 +1,61 @@
unit LEDResources;
interface
uses
LEDColorIntf;
const
LEDColorUID: array[TLEDColor] of string =
(
'off',
'green',
'amber',
'red',
'green.flashing.fast',
'green.flashing',
'amber.flashing.fast',
'amber.flashing',
'red.flashing.fast',
'red.flashing'
);
LEDColorDisplayName: array[TLEDColor] of string =
(
'Off',
'Green',
'Amber',
'Red',
'Flashing green (fast)',
'Flashing green (normal)',
'Flashing amber (fast)',
'Flashing amber (normal)',
'Flashing red (fast)',
'Flashing red (normal)'
);
function StringToLEDColor(const AValue: string; out AColor: TLEDColor): Boolean;
implementation
function StringToLEDColor(const AValue: string; out AColor: TLEDColor): Boolean;
var
color: TLEDColor;
begin
Result := False;
for color := Low(TLEDColor) to High(TLEDColor) do
begin
if LEDColorUID[color] = AValue then
begin
Result := True;
AColor := color;
break;
end;
end;
end;
end.

99
G940LEDControl/Units/LEDState.pas Normal file
View File

@ -0,0 +1,99 @@
unit LEDState;
interface
uses
LEDColorIntf,
LEDStateIntf;
type
TCustomLEDState = class(TInterfacedObject, ICustomLEDState)
private
FUID: string;
protected
{ ICustomLEDState }
function GetUID: string;
public
constructor Create(const AUID: string);
end;
TLEDState = class(TCustomLEDState, ILEDState)
private
FDisplayName: string;
FDefaultColor: TLEDColor;
protected
{ ILEDState }
function GetDisplayName: string;
function GetDefaultColor: TLEDColor;
public
constructor Create(const AUID, ADisplayName: string; ADefaultColor: TLEDColor);
end;
TLEDStateWorker = class(TCustomLEDState, ILEDStateWorker)
private
FColor: ILEDStateColor;
protected
{ ILEDStateWorker }
function GetColor: ILEDStateColor;
public
constructor Create(const AUID: string; AColor: ILEDStateColor);
end;
implementation
{ TCustomLEDState }
constructor TCustomLEDState.Create(const AUID: string);
begin
inherited Create;
FUID := AUID;
end;
function TCustomLEDState.GetUID: string;
begin
Result := FUID;
end;
{ TLEDState }
constructor TLEDState.Create(const AUID, ADisplayName: string; ADefaultColor: TLEDColor);
begin
inherited Create(AUID);
FDisplayName := ADisplayName;
FDefaultColor := ADefaultColor;
end;
function TLEDState.GetDisplayName: string;
begin
Result := FDisplayName;
end;
function TLEDState.GetDefaultColor: TLEDColor;
begin
Result := FDefaultColor;
end;
{ TLEDStateWorker }
constructor TLEDStateWorker.Create(const AUID: string; AColor: ILEDStateColor);
begin
inherited Create(AUID);
FColor := AColor;
end;
function TLEDStateWorker.GetColor: ILEDStateColor;
begin
Result := FColor;
end;
end.

507
G940LEDControl/Units/LEDStateConsumer.pas
View File

@ -2,351 +2,308 @@ unit LEDStateConsumer;
interface
uses
System.Classes,
OtlComm,
OtlCommon,
OtlTaskControl,
LEDFunctionMap,
LEDStateProvider;
LEDColorIntf,
LEDFunctionIntf,
Profile;
const
MSG_CLEAR_FUNCTIONS = 1001;
MSG_SET_FUNCTION = 1002;
MSG_INITIALIZE_PROVIDER = 1003;
MSG_FINALIZE_PROVIDER = 1004;
MSG_PROCESS_MESSAGES = 1005;
MSG_FINALIZE = 1006;
TM_LOADPROFILE = 1001;
TM_TICK = 1002;
MSG_PROVIDER_KILLED = 1007;
MSG_RUN_IN_MAINTHREAD = 1008;
MSG_CONSUMER_OFFSET = MSG_RUN_IN_MAINTHREAD;
TIMER_PROCESSMESSAGES = 1001;
TIMER_CONSUMER_OFFSET = TIMER_PROCESSMESSAGES;
TIMER_TICK = 101;
type
{ This interface name made me giggle. Because it's true. }
IRunInMainThread = interface(IOmniWaitableValue)
['{68B8F2F7-ED40-4078-9D99-503D7AFA068B}']
procedure Execute;
end;
TLEDStateConsumer = class(TOmniWorker, ILEDStateConsumer)
TLEDStateConsumer = class(TOmniWorker, ILEDFunctionObserver)
private
FFunctionMap: TLEDFunctionMap;
FStateMap: TLEDStateMap;
FProvider: TLEDStateProvider;
FTimerSet: Boolean;
FChanged: Boolean;
FUpdateCount: Integer;
FDestroying: Boolean;
FButtonWorkers: TInterfaceList;
FButtonColors: TInterfaceList;
FHasTickTimer: Boolean;
protected
procedure MsgClearFunctions(var msg: TOmniMessage); message MSG_CLEAR_FUNCTIONS;
procedure MsgSetFunction(var msg: TOmniMessage); message MSG_SET_FUNCTION;
procedure MsgInitializeProvider(var msg: TOmniMessage); message MSG_INITIALIZE_PROVIDER;
procedure MsgFinalizeProvider(var msg: TOmniMessage); message MSG_FINALIZE_PROVIDER;
procedure MsgProcessMessages(var msg: TOmniMessage); message MSG_PROCESS_MESSAGES;
procedure MsgFinalize(var msg: TOmniMessage); message MSG_FINALIZE;
function Initialize: Boolean; override;
procedure Cleanup; override;
procedure InitializeProvider(AProviderClass: TLEDStateProviderClass);
procedure FinalizeProvider;
function CreateWorker(AProfileButton: TProfileButton; const APreviousState: string): ILEDFunctionWorker;
property ButtonWorkers: TInterfaceList read FButtonWorkers;
property ButtonColors: TInterfaceList read FButtonColors;
property HasTickTimer: Boolean read FHasTickTimer;
protected
{ ILEDFunctionObserver }
procedure ObserveUpdate(Sender: ILEDFunctionWorker);
procedure RunInMainThread(AExecutor: IRunInMainThread; AWait: Boolean = False);
procedure InitializeLEDState; virtual;
procedure ResetLEDState; virtual;
procedure LEDStateChanged(ALEDIndex: Integer; AState: TLEDState); virtual;
procedure Changed; virtual;
{ ILEDStateConsumer }
function GetFunctionMap: TLEDFunctionMap;
procedure SetStateByFunction(AFunction: Integer; AState: TLEDState);
property Destroying: Boolean read FDestroying;
property FunctionMap: TLEDFunctionMap read GetFunctionMap;
property StateMap: TLEDStateMap read FStateMap;
property Provider: TLEDStateProvider read FProvider;
property UpdateCount: Integer read FUpdateCount write FUpdateCount;
public
constructor Create;
procedure BeginUpdate;
procedure EndUpdate;
procedure Update; virtual; abstract;
protected
procedure TMLoadProfile(var Msg: TOmniMessage); message TM_LOADPROFILE;
procedure TMTick(var Msg: TOmniMessage); message TM_TICK;
end;
procedure ClearFunctions(AConsumer: IOmniTaskControl);
procedure SetFunction(AConsumer: IOmniTaskControl; ALEDIndex, AFunction: Integer);
procedure InitializeStateProvider(AConsumer: IOmniTaskControl; AProviderClass: TLEDStateProviderClass);
procedure FinalizeStateProvider(AConsumer: IOmniTaskControl);
procedure Finalize(AConsumer: IOmniTaskControl);
implementation
uses
SysUtils,
Windows;
Generics.Collections,
System.SysUtils,
Winapi.Windows,
LEDFunctionRegistry,
LEDStateIntf;
const
G940_LED_COUNT = 8;
INTERVAL_TICK = 500;
type
TProfileButtonWorkerSettings = class(TInterfacedObject, ILEDFunctionWorkerSettings)
private
FProfileButton: TProfileButton;
protected
{ ILEDFunctionWorkerSettings }
function GetStateColor(const AUID: string; out AColor: TLEDColor): Boolean;
property ProfileButton: TProfileButton read FProfileButton;
public
constructor Create(AProfileButton: TProfileButton);
end;
{ TLEDStateConsumer }
constructor TLEDStateConsumer.Create;
function TLEDStateConsumer.Initialize: Boolean;
begin
inherited;
Result := inherited Initialize;
if not Result then
exit;
FFunctionMap := TLEDFunctionMap.Create;
FStateMap := TLEDStateMap.Create;
InitializeLEDState;
FButtonWorkers := TInterfaceList.Create;
FButtonColors := TInterfaceList.Create;
end;
procedure TLEDStateConsumer.Cleanup;
begin
inherited;
FreeAndNil(FButtonColors);
FreeAndNil(FButtonWorkers);
FreeAndNil(FStateMap);
FreeAndNil(FFunctionMap);
inherited Cleanup;
end;
procedure TLEDStateConsumer.BeginUpdate;
begin
if FUpdateCount = 0 then
FChanged := False;
Inc(FUpdateCount);
end;
procedure TLEDStateConsumer.EndUpdate;
begin
if FUpdateCount > 0 then
Dec(FUpdateCount);
if (FUpdateCount = 0) and FChanged then
Changed;
end;
function TLEDStateConsumer.GetFunctionMap: TLEDFunctionMap;
begin
Result := FFunctionMap;
end;
procedure TLEDStateConsumer.SetStateByFunction(AFunction: Integer; AState: TLEDState);
function TLEDStateConsumer.CreateWorker(AProfileButton: TProfileButton; const APreviousState: string): ILEDFunctionWorker;
var
ledIndex: Integer;
provider: ILEDFunctionProvider;
ledFunction: ILEDFunction;
begin
if FunctionMap.FindFirst(AFunction, ledIndex) then
repeat
if StateMap.SetState(ledIndex, AState) then
LEDStateChanged(ledIndex, AState);
until not FunctionMap.FindNext(AFunction, ledIndex);
end;
Result := nil;
procedure TLEDStateConsumer.MsgClearFunctions(var msg: TOmniMessage);
provider := TLEDFunctionRegistry.Find(AProfileButton.ProviderUID);
if Assigned(provider) then
begin
FunctionMap.Clear;
ledFunction := provider.Find(AProfileButton.FunctionUID);
if Assigned(ledFunction) then
Result := ledFunction.CreateWorker(TProfileButtonWorkerSettings.Create(AProfileButton), APreviousState);
end;
procedure TLEDStateConsumer.MsgSetFunction(var msg: TOmniMessage);
var
values: TOmniValueContainer;
begin
values := msg.MsgData.AsArray;
FunctionMap.SetFunction(values[0], values[1]);
end;
procedure TLEDStateConsumer.MsgInitializeProvider(var msg: TOmniMessage);
begin
InitializeProvider(TLEDStateProviderClass(msg.MsgData.AsPointer));
end;
procedure TLEDStateConsumer.MsgFinalizeProvider(var msg: TOmniMessage);
begin
FinalizeProvider;
end;
procedure TLEDStateConsumer.MsgProcessMessages(var msg: TOmniMessage);
begin
BeginUpdate;
try
Provider.ProcessMessages;
if Provider.Terminated then
begin
FinalizeProvider;
Task.Comm.Send(MSG_PROVIDER_KILLED, '');
end;
finally
EndUpdate;
end;
end;
procedure TLEDStateConsumer.MsgFinalize(var msg: TOmniMessage);
begin
FDestroying := True;
FinalizeProvider;
Task.Terminate;
end;
procedure TLEDStateConsumer.InitializeProvider(AProviderClass: TLEDStateProviderClass);
begin
FinalizeProvider;
FProvider := AProviderClass.Create(Self);
try
Provider.Initialize;
if Provider.ProcessMessagesInterval > -1 then
begin
Task.SetTimer(TIMER_PROCESSMESSAGES, Provider.ProcessMessagesInterval, MSG_PROCESS_MESSAGES);
FTimerSet := True;
end;
InitializeLEDState;
except
on E:Exception do
begin
FProvider := nil;
Task.Comm.Send(MSG_PROVIDER_KILLED, E.Message);
end;
end;
end;
procedure TLEDStateConsumer.FinalizeProvider;
begin
if Assigned(Provider) then
begin
if FTimerSet then
begin
Task.ClearTimer(TIMER_PROCESSMESSAGES);
FTimerSet := False;
end;
Provider.Terminate;
Provider.Finalize;
FreeAndNil(FProvider);
StateMap.Clear;
ResetLEDState;
end;
end;
procedure TLEDStateConsumer.RunInMainThread(AExecutor: IRunInMainThread; AWait: Boolean);
begin
Task.Comm.Send(MSG_RUN_IN_MAINTHREAD, AExecutor);
if AWait then
AExecutor.WaitFor(INFINITE);
end;
procedure TLEDStateConsumer.InitializeLEDState;
var
ledIndex: Integer;
state: TLEDState;
newState: TLEDState;
begin
BeginUpdate;
try
ResetLEDState;
for ledIndex := 0 to Pred(G940_LED_COUNT) do
begin
state := StateMap.GetState(ledIndex, lsGreen);
newState := state;
case FunctionMap.GetFunction(ledIndex) of
FUNCTION_OFF: newState := lsOff;
FUNCTION_RED: newState := lsRed;
FUNCTION_AMBER: newState := lsAmber;
FUNCTION_GREEN: newState := lsGreen;
end;
if state <> newState then
LEDStateChanged(ledIndex, newState);
end;
finally
EndUpdate;
end;
end;
procedure TLEDStateConsumer.ResetLEDState;
begin
if UpdateCount = 0 then
Changed
else
FChanged := True;
end;
procedure TLEDStateConsumer.LEDStateChanged(ALEDIndex: Integer; AState: TLEDState);
begin
if UpdateCount = 0 then
Changed
else
FChanged := True;
end;
procedure TLEDStateConsumer.Changed;
var
hasDynamicColors: Boolean;
buttonIndex: Integer;
state: ILEDStateWorker;
color: ILEDStateColor;
dynamicColor: ILEDStateDynamicColor;
begin
FChanged := False;
hasDynamicColors := False;
ButtonColors.Clear;
for buttonIndex := 0 to Pred(ButtonWorkers.Count) do
begin
color := nil;
if Assigned(ButtonWorkers[buttonIndex]) then
begin
state := (ButtonWorkers[buttonIndex] as ILEDFunctionWorker).GetCurrentState;
if Assigned(state) then
begin
color := state.GetColor;
if Assigned(color) then
begin
if (hasDynamicColors = False) and Supports(color, ILEDStateDynamicColor, dynamicColor) then
begin
{ If the tick timer isn't currently running, there were no
dynamic colors before. Reset each dynamic colors now. }
if not HasTickTimer then
dynamicColor.Reset;
hasDynamicColors := True;
end;
ButtonColors.Add(color as ILEDStateColor);
end;
end;
end;
if not Assigned(color) then
ButtonColors.Add(nil);
end;
if hasDynamicColors <> HasTickTimer then
begin
if hasDynamicColors then
Task.SetTimer(TIMER_TICK, INTERVAL_TICK, TM_TICK)
else
Task.ClearTimer(TIMER_TICK);
end;
Update;
end;
{ Helpers }
procedure ClearFunctions(AConsumer: IOmniTaskControl);
procedure TLEDStateConsumer.ObserveUpdate(Sender: ILEDFunctionWorker);
begin
AConsumer.Comm.Send(MSG_CLEAR_FUNCTIONS);
Changed;
end;
procedure SetFunction(AConsumer: IOmniTaskControl; ALEDIndex, AFunction: Integer);
procedure TLEDStateConsumer.TMLoadProfile(var Msg: TOmniMessage);
function GetFunctionKey(const AProviderUID, AFunctionUID: string): string; inline;
begin
AConsumer.Comm.Send(MSG_SET_FUNCTION, [ALEDIndex, AFunction]);
Result := AProviderUID + '|' + AFunctionUID;
end;
procedure InitializeStateProvider(AConsumer: IOmniTaskControl; AProviderClass: TLEDStateProviderClass);
var
oldWorkers: TInterfaceList;
oldStates: TDictionary<string, string>;
oldWorker: IInterface;
profile: TProfile;
buttonIndex: Integer;
worker: ILEDFunctionWorker;
state: ILEDStateWorker;
previousState: string;
button: TProfileButton;
functionKey: string;
begin
AConsumer.Comm.Send(MSG_INITIALIZE_PROVIDER, Pointer(AProviderClass));
profile := Msg.MsgData;
oldStates := nil;
oldWorkers := nil;
try
oldStates := TDictionary<string, string>.Create;
oldWorkers := TInterfaceList.Create;
{ Keep a copy of the old workers until all the new ones are initialized,
so we don't get unneccessary SimConnect reconnects. }
for oldWorker in ButtonWorkers do
begin
if Assigned(oldWorker) then
begin
worker := (oldWorker as ILEDFunctionWorker);
try
worker.Detach(Self);
oldWorkers.Add(worker);
{ Keep the current state as well, to prevent the LEDs from flickering }
state := worker.GetCurrentState;
try
oldStates.AddOrSetValue(GetFunctionKey(worker.GetProviderUID, worker.GetFunctionUID), state.GetUID);
finally
state := nil;
end;
finally
worker := nil;
end;
end;
end;
ButtonWorkers.Clear;
for buttonIndex := 0 to Pred(profile.ButtonCount) do
begin
if profile.HasButton(buttonIndex) then
begin
button := profile.Buttons[buttonIndex];
previousState := '';
functionKey := GetFunctionKey(button.ProviderUID, button.FunctionUID);
if oldStates.ContainsKey(functionKey) then
previousState := oldStates[functionKey];
worker := CreateWorker(button, previousState) as ILEDFunctionWorker;
ButtonWorkers.Add(worker);
if Assigned(worker) then
worker.Attach(Self);
end else
ButtonWorkers.Add(nil);
end;
finally
FreeAndNil(oldWorkers);
FreeAndNil(oldStates);
end;
Changed;
end;
procedure FinalizeStateProvider(AConsumer: IOmniTaskControl);
procedure TLEDStateConsumer.TMTick(var Msg: TOmniMessage);
var
buttonIndex: Integer;
checkButtonIndex: Integer;
alreadyTicked: Boolean;
color: ILEDStateColor;
dynamicColor: ILEDStateDynamicColor;
begin
AConsumer.Comm.Send(MSG_FINALIZE_PROVIDER);
// (MvR) 19-2-2013: I could pass a tick count to Tick() so that they can all use modulus to blink synchronously... think about it.
for buttonIndex := 0 to Pred(ButtonColors.Count) do
begin
alreadyTicked := False;
color := (ButtonColors[buttonIndex] as ILEDStateColor);
if Supports(color, ILEDStateDynamicColor, dynamicColor) then
begin
{ Check if this color has already been ticked }
for checkButtonIndex := Pred(buttonIndex) downto 0 do
if (ButtonColors[checkButtonIndex] as ILEDStateColor) = color then
begin
alreadyTicked := True;
break;
end;
if not alreadyTicked then
dynamicColor.Tick;
end;
end;
Update;
end;
procedure Finalize(AConsumer: IOmniTaskControl);
{ TProfileButtonWorkerSettings }
constructor TProfileButtonWorkerSettings.Create(AProfileButton: TProfileButton);
begin
AConsumer.Comm.Send(MSG_FINALIZE);
inherited Create;
FProfileButton := AProfileButton;
end;
function TProfileButtonWorkerSettings.GetStateColor(const AUID: string; out AColor: TLEDColor): Boolean;
begin
Result := ProfileButton.GetStateColor(AUID, AColor);
end;
end.

30
G940LEDControl/Units/LEDStateIntf.pas Normal file
View File

@ -0,0 +1,30 @@
unit LEDStateIntf;
interface
uses
LEDColorIntf;
type
ICustomLEDState = interface
['{B5567129-74E1-4888-83F5-8A6174706671}']
function GetUID: string;
end;
ILEDState = interface(ICustomLEDState)
['{2C91D49C-2B67-42A3-B5EF-475976DD33F8}']
function GetDisplayName: string;
function GetDefaultColor: TLEDColor;
end;
ILEDStateWorker = interface(ICustomLEDState)
['{0361CBD5-E64E-4972-A8A4-D5FE0B0DFB1C}']
function GetColor: ILEDStateColor;
end;
implementation
end.

127
G940LEDControl/Units/LEDStateProvider.pas
View File

@ -1,127 +0,0 @@
unit LEDStateProvider;
interface
uses
Classes,
SyncObjs,
SysUtils,
LEDFunctionMap;
type
EInitializeError = class(Exception);
ILEDStateConsumer = interface
['{6E630C92-7C5C-4D16-8BED-AE27559FA584}']
function GetFunctionMap: TLEDFunctionMap;
procedure SetStateByFunction(AFunction: Integer; AState: TLEDState);
property FunctionMap: TLEDFunctionMap read GetFunctionMap;
end;
IFunctionConsumer = interface
['{97B47A29-BA7F-4C48-934D-EB66D2741647}']
procedure SetCategory(const ACategory: string);
procedure AddFunction(AFunction: Integer; const ADescription: string);
end;
TLEDStateProvider = class(TObject)
private
FConsumer: ILEDStateConsumer;
FTerminated: Boolean;
protected
procedure Execute; virtual; abstract;
function GetProcessMessagesInterval: Integer; virtual;
property Consumer: ILEDStateConsumer read FConsumer;
public
class procedure EnumFunctions(AConsumer: IFunctionConsumer); virtual;
constructor Create(AConsumer: ILEDStateConsumer); virtual;
destructor Destroy; override;
procedure Initialize; virtual;
procedure Finalize; virtual;
procedure ProcessMessages; virtual;
procedure Terminate; virtual;
property ProcessMessagesInterval: Integer read GetProcessMessagesInterval;
property Terminated: Boolean read FTerminated;
end;
TLEDStateProviderClass = class of TLEDStateProvider;
const
EXIT_SUCCESS = 0;
EXIT_ERROR = 1;
EXIT_CONSUMER_OFFSET = 100;
EXIT_PROVIDER_OFFSET = 200;
implementation
const
CATEGORY_STATIC = 'Static';
FUNCTION_DESC_OFF = 'Light off';
FUNCTION_DESC_GREEN = 'Green';
FUNCTION_DESC_AMBER = 'Amber';
FUNCTION_DESC_RED = 'Red';
{ TCustomLEDStateProvider }
class procedure TLEDStateProvider.EnumFunctions(AConsumer: IFunctionConsumer);
begin
AConsumer.SetCategory(CATEGORY_STATIC);
AConsumer.AddFunction(FUNCTION_OFF, FUNCTION_DESC_OFF);
AConsumer.AddFunction(FUNCTION_GREEN, FUNCTION_DESC_GREEN);
AConsumer.AddFunction(FUNCTION_AMBER, FUNCTION_DESC_AMBER);
AConsumer.AddFunction(FUNCTION_RED, FUNCTION_DESC_RED);
end;
constructor TLEDStateProvider.Create(AConsumer: ILEDStateConsumer);
begin
inherited Create;
FConsumer := AConsumer;
end;
destructor TLEDStateProvider.Destroy;
begin
inherited;
end;
procedure TLEDStateProvider.Initialize;
begin
end;
procedure TLEDStateProvider.Finalize;
begin
end;
procedure TLEDStateProvider.ProcessMessages;
begin
end;
procedure TLEDStateProvider.Terminate;
begin
FTerminated := True;
end;
function TLEDStateProvider.GetProcessMessagesInterval: Integer;
begin
Result := -1;
end;
end.

20
G940LEDControl/Units/ObserverIntf.pas Normal file
View File

@ -0,0 +1,20 @@
unit ObserverIntf;
interface
type
IObserver = interface
['{B78415C9-9F64-4AF1-8983-BACE2B7225EF}']
procedure Update(Sender: IInterface);
end;
IObservable = interface
['{BC004BDA-14E4-4923-BE6D-98A0746852F1}']
procedure Attach(AObserver: IObserver);
procedure Detach(AObserver: IObserver);
end;
implementation
end.

405
G940LEDControl/Units/Profile.pas Normal file
View File

@ -0,0 +1,405 @@
unit Profile;
interface
uses
Generics.Collections,
System.Classes,
X2UtPersistIntf,
LEDColorIntf;
type
TProfileButtonStateColors = TDictionary<string,TLEDColor>;
TProfileButton = class(TPersistent)
private
FProviderUID: string;
FFunctionUID: string;
FStateColors: TProfileButtonStateColors;
protected
function Load(AReader: IX2PersistReader): Boolean;
procedure Save(AWriter: IX2PersistWriter);
property StateColors: TProfileButtonStateColors read FStateColors;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure ClearStateColors;
function GetStateColor(const AStateUID: string; out AValue: TLEDColor): Boolean;
procedure SetStateColor(const AStateUID: string; const AValue: TLEDColor);
property ProviderUID: string read FProviderUID write FProviderUID;
property FunctionUID: string read FFunctionUID write FFunctionUID;
end;
TProfileButtonList = class(TObjectList<TProfileButton>);
TProfile = class(TPersistent)
private
FName: string;
FIsTemporary: Boolean;
FButtons: TProfileButtonList;
function GetButton(Index: Integer): TProfileButton;
function GetButtonCount: Integer;
protected
procedure Load(AReader: IX2PersistReader);
procedure Save(AWriter: IX2PersistWriter);
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
function HasButton(AIndex: Integer): Boolean;
property Name: string read FName write FName;
property IsTemporary: Boolean read FIsTemporary write FIsTemporary;
property ButtonCount: Integer read GetButtonCount;
property Buttons[Index: Integer]: TProfileButton read GetButton;
end;
TProfileList = class(TObjectList<TProfile>)
public
function Find(const AName: string): TProfile;
procedure Load(AReader: IX2PersistReader);
procedure Save(AWriter: IX2PersistWriter);
end;
implementation
uses
System.SysUtils,
LEDResources;
const
SectionProfiles = 'Profiles';
SectionButton = 'Button';
SectionStates = 'States';
KeyProviderUID = 'ProviderUID';
KeyFunctionUID = 'FunctionUID';
KeyIsTemporary = 'IsTemporary';
{ TProfileButton }
constructor TProfileButton.Create;
begin
inherited Create;
FStateColors := TProfileButtonStateColors.Create;
end;
destructor TProfileButton.Destroy;
begin
FreeAndNil(FStateColors);
inherited Destroy;
end;
procedure TProfileButton.Assign(Source: TPersistent);
var
sourceButton: TProfileButton;
stateUID: string;
begin
if Source is TProfileButton then
begin
sourceButton := TProfileButton(Source);
FProviderUID := sourceButton.ProviderUID;
FFunctionUID := sourceButton.FunctionUID;
FStateColors.Clear;
for stateUID in sourceButton.StateColors.Keys do
SetStateColor(stateUID, sourceButton.StateColors[stateUID]);
end else
inherited Assign(Source);
end;
procedure TProfileButton.ClearStateColors;
begin
FStateColors.Clear;
end;
function TProfileButton.GetStateColor(const AStateUID: string; out AValue: TLEDColor): Boolean;
begin
Result := StateColors.TryGetValue(AStateUID, AValue);
end;
procedure TProfileButton.SetStateColor(const AStateUID: string; const AValue: TLEDColor);
begin
StateColors.AddOrSetValue(AStateUID, AValue);
end;
function TProfileButton.Load(AReader: IX2PersistReader): Boolean;
var
stateUIDs: TStringList;
stateUID: string;
colorUID: string;
color: TLEDColor;
begin
Result := AReader.ReadString(KeyProviderUID, FProviderUID) and
AReader.ReadString(KeyFunctionUID, FFunctionUID);
if Result and AReader.BeginSection(SectionStates) then
try
StateColors.Clear;
stateUIDs := TStringList.Create;
try
AReader.GetKeys(stateUIDs);
for stateUID in stateUIDs do
begin
if AReader.ReadString(stateUID, colorUID) and
StringToLEDColor(colorUID, color) then
begin
StateColors.Add(stateUID, color);
end;
end;
finally
FreeAndNil(stateUIDs);
end;
finally
AReader.EndSection;
end;
end;
procedure TProfileButton.Save(AWriter: IX2PersistWriter);
var
stateUID: string;
begin
AWriter.WriteString(KeyProviderUID, FProviderUID);
AWriter.WriteString(KeyFunctionUID, FFunctionUID);
if AWriter.BeginSection(SectionStates) then
try
for stateUID in StateColors.Keys do
AWriter.WriteString(stateUID, LEDColorUID[StateColors[stateUID]]);
finally
AWriter.EndSection;
end;
end;
{ TProfile }
constructor TProfile.Create;
begin
inherited Create;
FButtons := TProfileButtonList.Create(True);
end;
destructor TProfile.Destroy;
begin
FreeAndNil(FButtons);
inherited Destroy;
end;
procedure TProfile.Assign(Source: TPersistent);
var
sourceProfile: TProfile;
buttonIndex: Integer;
begin
if Source is TProfile then
begin
sourceProfile := TProfile(Source);
FName := sourceProfile.Name;
FIsTemporary := sourceProfile.IsTemporary;
FButtons.Clear;
for buttonIndex := 0 to Pred(sourceProfile.ButtonCount) do
Buttons[buttonIndex].Assign(sourceProfile.Buttons[buttonIndex]);
end else
inherited Assign(Source);
end;
procedure TProfile.Load(AReader: IX2PersistReader);
var
buttonIndex: Integer;
button: TProfileButton;
begin
buttonIndex := 0;
if not AReader.ReadBoolean(KeyIsTemporary, FIsTemporary) then
FIsTemporary := False;
while AReader.BeginSection(SectionButton + IntToStr(buttonIndex)) do
try
button := TProfileButton.Create;
if button.Load(AReader) then
begin
FButtons.Add(button);
end else
begin
FButtons.Add(nil);
FreeAndNil(button);
end;
finally
AReader.EndSection;
Inc(buttonIndex);
end;
end;
procedure TProfile.Save(AWriter: IX2PersistWriter);
var
buttonIndex: Integer;
begin
AWriter.WriteBoolean(KeyIsTemporary, IsTemporary);
for buttonIndex := 0 to Pred(FButtons.Count) do
begin
if AWriter.BeginSection(SectionButton + IntToStr(buttonIndex)) then
try
if Assigned(FButtons[buttonIndex]) then
FButtons[buttonIndex].Save(AWriter);
finally
AWriter.EndSection;
end;
end;
end;
function TProfile.HasButton(AIndex: Integer): Boolean;
begin
Result := (FButtons.Count > AIndex) and
Assigned(FButtons[AIndex]);
end;
function TProfile.GetButtonCount: Integer;
begin
Result := FButtons.Count;
end;
function TProfile.GetButton(Index: Integer): TProfileButton;
var
oldCount: Integer;
buttonIndex: Integer;
begin
oldCount := FButtons.Count;
if Index >= oldCount then
begin
FButtons.Count := Succ(Index);
for buttonIndex := oldCount to Pred(FButtons.Count) do
FButtons[buttonIndex] := nil;
end;
Result := FButtons[Index];
if not Assigned(Result) then
begin
Result := TProfileButton.Create;
FButtons[Index] := Result;
end;
end;
{ TProfileList }
function TProfileList.Find(const AName: string): TProfile;
var
profile: TProfile;
begin
Result := nil;
for profile in Self do
if SameText(profile.Name, AName) then
begin
Result := profile;
break;
end;
end;
procedure TProfileList.Load(AReader: IX2PersistReader);
var
profiles: TStringList;
profileName: string;
profile: TProfile;
begin
if AReader.BeginSection(SectionProfiles) then
try
profiles := TStringList.Create;
try
AReader.GetSections(profiles);
for profileName in profiles do
begin
if AReader.BeginSection(profileName) then
try
profile := TProfile.Create;
profile.Name := profileName;
profile.Load(AReader);
Add(profile);
finally
AReader.EndSection;
end;
end;
finally
FreeAndNil(profiles);
end;
finally
AReader.EndSection;
end;
end;
procedure TProfileList.Save(AWriter: IX2PersistWriter);
var
profile: TProfile;
begin
if AWriter.BeginSection(SectionProfiles) then
try
for profile in Self do
begin
if AWriter.BeginSection(profile.Name) then
try
profile.Save(AWriter);
finally
AWriter.EndSection;
end;
end;
finally
AWriter.EndSection;
end;
end;
end.

71
G940LEDControl/Units/Settings.pas Normal file
View File

@ -0,0 +1,71 @@
unit Settings;
interface
uses
X2UtPersistIntf;
type
TSettings = class(TObject)
private
FCheckUpdates: Boolean;
FHasCheckUpdates: Boolean;
FActiveProfile: string;
procedure SetCheckUpdates(const Value: Boolean);
public
procedure Load(AReader: IX2PersistReader);
procedure Save(AWriter: IX2PersistWriter);
property CheckUpdates: Boolean read FCheckUpdates write SetCheckUpdates;
property HasCheckUpdates: Boolean read FHasCheckUpdates;
property ActiveProfile: string read FActiveProfile write FActiveProfile;
end;
implementation
const
SectionSettings = 'Settings';
KeyCheckUpdates = 'CheckUpdates';
KeyActiveProfile = 'ActiveProfile';
{ TSettings }
procedure TSettings.Load(AReader: IX2PersistReader);
var
value: Boolean;
begin
if AReader.BeginSection(SectionSettings) then
try
if AReader.ReadBoolean(KeyCheckUpdates, value) then
CheckUpdates := value;
if not AReader.ReadString(KeyActiveProfile, FActiveProfile) then
FActiveProfile := '';
finally
AReader.EndSection;
end;
end;
procedure TSettings.Save(AWriter: IX2PersistWriter);
begin
if AWriter.BeginSection(SectionSettings) then
try
AWriter.WriteBoolean(KeyCheckUpdates, CheckUpdates);
AWriter.WriteString(KeyActiveProfile, ActiveProfile);
finally
AWriter.EndSection;
end;
end;
procedure TSettings.SetCheckUpdates(const Value: Boolean);
begin
FCheckUpdates := Value;
FHasCheckUpdates := True;
end;
end.

38
G940LEDControl/Units/StaticLEDColor.pas Normal file
View File

@ -0,0 +1,38 @@
unit StaticLEDColor;
interface
uses
LEDColor,
LEDColorIntf;
type
TLEDStateStaticColor = class(TCustomLEDStateColor)
private
FColor: TStaticLEDColor;
protected
function GetCurrentColor: TStaticLEDColor; override;
public
constructor Create(AColor: TStaticLEDColor);
end;
implementation
{ TStaticLEDState }
constructor TLEDStateStaticColor.Create(AColor: TStaticLEDColor);
begin
inherited Create;
FColor := AColor;
end;
function TLEDStateStaticColor.GetCurrentColor: TStaticLEDColor;
begin
Result := FColor;
end;
end.

121
G940LEDControl/Units/StaticLEDFunction.pas Normal file
View File

@ -0,0 +1,121 @@
unit StaticLEDFunction;
interface
uses
LEDFunction,
LEDFunctionIntf,
LEDColorIntf,
LEDStateIntf;
type
TStaticLEDFunctionProvider = class(TCustomLEDFunctionProvider)
protected
procedure RegisterFunctions; override;
function GetUID: string; override;
end;
TStaticLEDFunction = class(TCustomLEDFunction)
private
FColor: TLEDColor;
protected
function GetCategoryName: string; override;
function GetDisplayName: string; override;
function GetUID: string; override;
function CreateWorker(ASettings: ILEDFunctionWorkerSettings; const APreviousState: string = ''): ILEDFunctionWorker; override;
public
constructor Create(AColor: TLEDColor);
end;
implementation
uses
LEDColorPool,
LEDFunctionRegistry,
LEDState,
StaticResources;
type
TStaticLEDFunctionWorker = class(TCustomLEDFunctionWorker)
private
FState: ILEDStateWorker;
protected
function GetCurrentState: ILEDStateWorker; override;
public
constructor Create(const AProviderUID, AFunctionUID: string; AColor: TLEDColor);
end;
{ TStaticLEDFunctionProvider }
procedure TStaticLEDFunctionProvider.RegisterFunctions;
var
color: TLEDColor;
begin
for color := Low(TStaticLEDColor) to High(TStaticLEDColor) do
RegisterFunction(TStaticLEDFunction.Create(color));
end;
function TStaticLEDFunctionProvider.GetUID: string;
begin
Result := StaticProviderUID;
end;
{ TStaticLEDFunction }
constructor TStaticLEDFunction.Create(AColor: TLEDColor);
begin
inherited Create;
FColor := AColor;
end;
function TStaticLEDFunction.GetCategoryName: string;
begin
Result := StaticCategory;
end;
function TStaticLEDFunction.GetDisplayName: string;
begin
Result := StaticFunctionDisplayName[FColor];
end;
function TStaticLEDFunction.GetUID: string;
begin
Result := StaticFunctionUID[FColor];
end;
function TStaticLEDFunction.CreateWorker(ASettings: ILEDFunctionWorkerSettings; const APreviousState: string): ILEDFunctionWorker;
begin
Result := TStaticLEDFunctionWorker.Create(StaticProviderUID, GetUID, FColor);
end;
{ TStaticLEDFunctionWorker }
constructor TStaticLEDFunctionWorker.Create(const AProviderUID, AFunctionUID: string; AColor: TLEDColor);
begin
inherited Create(AProviderUID, AFunctionUID);
FState := TLEDStateWorker.Create('', TLEDColorPool.GetColor(AColor));
end;
function TStaticLEDFunctionWorker.GetCurrentState: ILEDStateWorker;
begin
Result := FState;
end;
initialization
TLEDFunctionRegistry.Register(TStaticLEDFunctionProvider.Create);
end.

31
G940LEDControl/Units/StaticResources.pas Normal file
View File

@ -0,0 +1,31 @@
unit StaticResources;
interface
uses
LEDColorIntf;
const
StaticProviderUID = 'static';
StaticFunctionUID: array[TStaticLEDColor] of string =
(
'off',
'green',
'amber',
'red'
);
StaticCategory = 'Static';
StaticFunctionDisplayName: array[TStaticLEDColor] of string =
(
'Off',
'Green',
'Amber',
'Red'
);
implementation
end.