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

Refactored: separated definition and functionality by introducing the Function Worker

Browse Source 
Changed: button configuration form uses runtime components for the states intead of a VirtualTreeView
This commit is contained in:
Mark van Renswoude 2013-02-17 19:06:27 +00:00
parent 59fc110814
commit d665f2d979
23 changed files with 1145 additions and 671 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

175
G940LEDControl/Forms/ButtonFunctionFrm.dfm
View File

@ -1,10 +1,11 @@
object ButtonFunctionForm: TButtonFunctionForm object ButtonFunctionForm: TButtonFunctionForm
Left = 0 Left = 0
Top = 0 Top = 0
ActiveControl = vstFunctions
BorderIcons = [biSystemMenu] BorderIcons = [biSystemMenu]
BorderStyle = bsDialog BorderStyle = bsDialog
Caption = 'Configure button' Caption = 'Configure button'
ClientHeight = 401 ClientHeight = 484
ClientWidth = 692 ClientWidth = 692
Color = clBtnFace Color = clBtnFace
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@ -18,31 +19,53 @@ object ButtonFunctionForm: TButtonFunctionForm
OnDestroy = FormDestroy OnDestroy = FormDestroy
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object pnlButtons: TPanel object bvlHeader: TBevel
Left = 0 Left = 0
Top = 360 Top = 50
Width = 692 Width = 692
Height = 41 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 Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 0 TabOrder = 2
DesignSize = ( DesignSize = (
692 692
41) 43)
object bvlFooter: TBevel
Left = 0
Top = 0
Width = 692
Height = 8
Align = alTop
Shape = bsTopLine
end
object btnOK: TButton object btnOK: TButton
Left = 528 Left = 528
Top = 8 Top = 10
Width = 75 Width = 75
Height = 25 Height = 25
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Caption = 'OK' Caption = 'OK'
Default = True Default = True
ModalResult = 1
TabOrder = 0 TabOrder = 0
OnClick = btnOKClick
end end
object btnCancel: TButton object btnCancel: TButton
Left = 609 Left = 609
Top = 8 Top = 10
Width = 75 Width = 75
Height = 25 Height = 25
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
@ -55,9 +78,9 @@ object ButtonFunctionForm: TButtonFunctionForm
object vstFunctions: TVirtualStringTree object vstFunctions: TVirtualStringTree
AlignWithMargins = True AlignWithMargins = True
Left = 8 Left = 8
Top = 8 Top = 60
Width = 257 Width = 257
Height = 352 Height = 373
Margins.Left = 8 Margins.Left = 8
Margins.Top = 8 Margins.Top = 8
Margins.Right = 0 Margins.Right = 0
@ -70,7 +93,7 @@ object ButtonFunctionForm: TButtonFunctionForm
Header.Font.Name = 'Tahoma' Header.Font.Name = 'Tahoma'
Header.Font.Style = [] Header.Font.Style = []
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible] Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]
TabOrder = 1 TabOrder = 0
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoDeleteMovedNodes] TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toInitOnSave, toWheelPanning, toEditOnClick] TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toInitOnSave, toWheelPanning, toEditOnClick]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowTreeLines, toThemeAware, toUseBlendedImages] TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowTreeLines, toThemeAware, toUseBlendedImages]
@ -78,7 +101,7 @@ object ButtonFunctionForm: TButtonFunctionForm
OnFocusChanged = vstFunctionsFocusChanged OnFocusChanged = vstFunctionsFocusChanged
OnGetText = vstFunctionsGetText OnGetText = vstFunctionsGetText
OnPaintText = vstFunctionsPaintText OnPaintText = vstFunctionsPaintText
ExplicitTop = 5 ExplicitHeight = 383
Columns = < Columns = <
item item
Position = 0 Position = 0
@ -89,61 +112,28 @@ object ButtonFunctionForm: TButtonFunctionForm
object pnlFunction: TPanel object pnlFunction: TPanel
AlignWithMargins = True AlignWithMargins = True
Left = 273 Left = 273
Top = 8 Top = 60
Width = 411 Width = 411
Height = 352 Height = 373
Margins.Left = 8 Margins.Left = 8
Margins.Top = 8 Margins.Top = 8
Margins.Right = 8 Margins.Right = 8
Margins.Bottom = 0 Margins.Bottom = 0
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 2 TabOrder = 1
object vstStates: TVirtualStringTree ExplicitHeight = 383
Left = 0
Top = 81
Width = 411
Height = 271
Align = alClient
Header.AutoSizeIndex = 0
Header.Font.Charset = DEFAULT_CHARSET
Header.Font.Color = clWindowText
Header.Font.Height = -11
Header.Font.Name = 'Tahoma'
Header.Font.Style = []
Header.MainColumn = 1
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]
TabOrder = 0
TreeOptions.MiscOptions = [toAcceptOLEDrop, toEditable, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toExtendedFocus, toFullRowSelect]
OnChange = vstStatesChange
OnCreateEditor = vstStatesCreateEditor
OnEditing = vstStatesEditing
OnGetText = vstStatesGetText
Columns = <
item
Position = 0
Width = 207
WideText = 'State'
end
item
Position = 1
Width = 200
WideText = 'Colour'
end>
end
object pnlName: TPanel object pnlName: TPanel
Left = 0 Left = 0
Top = 0 Top = 0
Width = 411 Width = 411
Height = 81 Height = 97
Align = alTop Align = alTop
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 1 TabOrder = 0
DesignSize = ( DesignSize = (
411 411
81) 97)
object lblFunctionName: TLabel object lblFunctionName: TLabel
Left = 0 Left = 0
Top = 19 Top = 19
@ -184,8 +174,7 @@ object ButtonFunctionForm: TButtonFunctionForm
AutoSize = False AutoSize = False
Caption = Caption =
'This function provides the following states. Each state can be c' + 'This function provides the following states. Each state can be c' +
'ustomized by clicking on the state and changing the setting in t' + 'ustomized by changing the color below.'
'he Color column.'
WordWrap = True WordWrap = True
end end
object lblNoStates: TLabel object lblNoStates: TLabel
@ -197,5 +186,81 @@ object ButtonFunctionForm: TButtonFunctionForm
Visible = False Visible = False
end end
end end
object sbStates: TScrollBox
Left = 0
Top = 97
Width = 411
Height = 276
Align = alClient
BorderStyle = bsNone
TabOrder = 1
ExplicitHeight = 286
end
end
object pnlHeader: TPanel
Left = 0
Top = 0
Width = 692
Height = 50
Align = alTop
BevelOuter = bvNone
Color = clWindow
ParentBackground = False
TabOrder = 3
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
end end

304
G940LEDControl/Forms/ButtonFunctionFrm.pas
View File

@ -2,6 +2,7 @@ unit ButtonFunctionFrm;
interface interface
uses uses
Generics.Collections,
System.Classes, System.Classes,
Vcl.Controls, Vcl.Controls,
Vcl.ExtCtrls, Vcl.ExtCtrls,
@ -12,65 +13,95 @@ uses
VirtualTrees, VirtualTrees,
LEDColorIntf,
LEDFunctionIntf, LEDFunctionIntf,
LEDStateIntf,
Profile; Profile;
const
WM_STARTEDITING = WM_USER + 1;
type type
TStateControlInfo = class;
TStateControlInfoList = TObjectList<TStateControlInfo>;
TButtonFunctionForm = class(TForm) TButtonFunctionForm = class(TForm)
pnlButtons: TPanel; pnlButtons: TPanel;
btnOK: TButton; btnOK: TButton;
btnCancel: TButton; btnCancel: TButton;
vstFunctions: TVirtualStringTree; vstFunctions: TVirtualStringTree;
vstStates: TVirtualStringTree;
pnlFunction: TPanel; pnlFunction: TPanel;
pnlName: TPanel; pnlName: TPanel;
lblFunctionName: TLabel; lblFunctionName: TLabel;
lblCategoryName: TLabel; lblCategoryName: TLabel;
lblHasStates: TLabel; lblHasStates: TLabel;
lblNoStates: TLabel; lblNoStates: TLabel;
sbStates: TScrollBox;
pnlHeader: TPanel;
bvlHeader: TBevel;
lblButton: TLabel;
lblCurrentAssignment: TLabel;
lblCurrentFunction: TLabel;
lblCurrentCategory: TLabel;
bvlFooter: TBevel;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure vstFunctionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); 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 vstFunctionsPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType);
procedure vstFunctionsFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); procedure vstFunctionsFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
procedure vstStatesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure btnOKClick(Sender: TObject);
procedure vstStatesChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstStatesCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
procedure vstStatesEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
private private
FButtonIndex: Integer;
FProfile: TProfile; FProfile: TProfile;
FButtonIndex: Integer;
FButton: TProfileButton;
FCurrentProvider: ILEDFunctionProvider;
FCurrentFunction: ILEDFunction;
FSelectedProvider: ILEDFunctionProvider;
FSelectedFunction: ILEDFunction;
FStateControls: TStateControlInfoList;
protected protected
procedure WMStartEditing(var Msg: TMessage); message WM_STARTEDITING; procedure Initialize(AProfile: TProfile; AButtonIndex: Integer);
protected
procedure LoadFunctions; procedure LoadFunctions;
procedure SetFunction(AProvider: ILEDFunctionProvider; AFunction: ILEDFunction); procedure SetFunction(AProvider: ILEDFunctionProvider; AFunction: ILEDFunction);
procedure LoadStates(AFunction: ILEDMultiStateFunction); procedure LoadStates(AProvider: ILEDFunctionProvider; AFunction: ILEDMultiStateFunction);
property ButtonIndex: Integer read FButtonIndex write FButtonIndex; property Button: TProfileButton read FButton;
property Profile: TProfile read FProfile write FProfile; 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 public
class function Execute(AProfile: TProfile; AButtonIndex: Integer): Boolean; class function Execute(AProfile: TProfile; AButtonIndex: Integer): Boolean;
end; 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 implementation
uses uses
Generics.Collections,
System.SysUtils, System.SysUtils,
Winapi.Windows, Winapi.Windows,
ColourEditor,
LEDFunctionRegistry, LEDFunctionRegistry,
LEDStateIntf; LEDResources;
type type
@ -86,6 +117,7 @@ type
TStateNodeData = record TStateNodeData = record
State: ILEDState; State: ILEDState;
Color: TLEDColor;
end; end;
PStateNodeData = ^TStateNodeData; PStateNodeData = ^TStateNodeData;
@ -93,7 +125,7 @@ type
const const
ColumnState = 0; ColumnState = 0;
ColumnColour = 1; ColumnColor = 1;
{$R *.dfm} {$R *.dfm}
@ -104,9 +136,7 @@ class function TButtonFunctionForm.Execute(AProfile: TProfile; AButtonIndex: Int
begin begin
with Self.Create(nil) do with Self.Create(nil) do
try try
Profile := AProfile; Initialize(AProfile, AButtonIndex);
ButtonIndex := AButtonIndex;
Result := (ShowModal = mrOk); Result := (ShowModal = mrOk);
finally finally
Free; Free;
@ -115,19 +145,21 @@ end;
procedure TButtonFunctionForm.FormCreate(Sender: TObject); procedure TButtonFunctionForm.FormCreate(Sender: TObject);
begin begin
vstFunctions.NodeDataSize := SizeOf(TFunctionNodeData); FStateControls := TStateControlInfoList.Create(True);
vstStates.NodeDataSize := SizeOf(TStateNodeData);
vstFunctions.NodeDataSize := SizeOf(TFunctionNodeData);
lblButton.Caption := '';
lblCurrentCategory.Caption := '';
lblCurrentFunction.Caption := '';
lblCategoryName.Caption := ''; lblCategoryName.Caption := '';
lblFunctionName.Caption := ''; lblFunctionName.Caption := '';
LoadFunctions;
end; end;
procedure TButtonFunctionForm.FormDestroy(Sender: TObject); procedure TButtonFunctionForm.FormDestroy(Sender: TObject);
begin begin
// FreeAndNil(FStateControls);
end; end;
@ -163,6 +195,7 @@ var
nodeData: PFunctionNodeData; nodeData: PFunctionNodeData;
provider: ILEDFunctionProvider; provider: ILEDFunctionProvider;
ledFunction: ILEDFunction; ledFunction: ILEDFunction;
isCurrentProvider: Boolean;
begin begin
vstFunctions.BeginUpdate; vstFunctions.BeginUpdate;
@ -173,6 +206,8 @@ begin
try try
for provider in TLEDFunctionRegistry.Providers do for provider in TLEDFunctionRegistry.Providers do
begin begin
isCurrentProvider := Assigned(CurrentProvider) and (provider.GetUID = CurrentProvider.GetUID);
for ledFunction in provider do for ledFunction in provider do
begin begin
node := vstFunctions.AddChild(GetCategoryNode(provider, ledFunction)); node := vstFunctions.AddChild(GetCategoryNode(provider, ledFunction));
@ -181,6 +216,9 @@ begin
nodeData^.NodeType := ntFunction; nodeData^.NodeType := ntFunction;
nodeData^.Provider := provider; nodeData^.Provider := provider;
nodeData^.LEDFunction := ledFunction; nodeData^.LEDFunction := ledFunction;
if isCurrentProvider and Assigned(CurrentFunction) and (ledFunction.GetUID = CurrentFunction.GetUID) then
vstFunctions.Selected[node] := True;
end; end;
end; end;
finally finally
@ -197,47 +235,166 @@ var
multiStateFunction: ILEDMultiStateFunction; multiStateFunction: ILEDMultiStateFunction;
begin begin
lblCategoryName.Caption := AFunction.GetCategoryName; FSelectedProvider := AProvider;
lblFunctionName.Caption := AFunction.GetDisplayName; FSelectedFunction := AFunction;
if Supports(AFunction, ILEDMultiStateFunction, multiStateFunction) then lblCategoryName.Caption := SelectedFunction.GetCategoryName;
lblFunctionName.Caption := SelectedFunction.GetDisplayName;
if Supports(SelectedFunction, ILEDMultiStateFunction, multiStateFunction) then
begin begin
lblNoStates.Visible := False; lblNoStates.Visible := False;
lblHasStates.Visible := True; lblHasStates.Visible := True;
LoadStates(multiStateFunction); LoadStates(AProvider, multiStateFunction);
vstStates.Visible := True; sbStates.Visible := True;
end else end else
begin begin
lblNoStates.Visible := True; lblNoStates.Visible := True;
lblHasStates.Visible := False; lblHasStates.Visible := False;
vstStates.Visible := False; sbStates.Visible := False;
vstStates.Clear; FStateControls.Clear;
end; end;
end; end;
procedure TButtonFunctionForm.LoadStates(AFunction: ILEDMultiStateFunction); 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 var
node: PVirtualNode; color: TLEDColor;
nodeData: PStateNodeData; itemIndex: Integer;
state: ILEDState;
begin begin
vstStates.BeginUpdate; AComboBox.Items.BeginUpdate;
try try
vstStates.Clear; 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 for state in AFunction do
begin begin
node := vstStates.AddChild(nil); stateLabel := TLabel.Create(nil);
nodeData := vstStates.GetNodeData(node); stateLabel.AutoSize := False;
nodeData^.State := state; 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;
finally
vstStates.EndUpdate;
end; end;
procedure TButtonFunctionForm.btnOKClick(Sender: TObject);
var
multiStateFunction: ILEDMultiStateFunction;
stateControlInfo: TStateControlInfo;
comboBox: TComboBox;
color: TLEDColor;
begin
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; end;
@ -251,23 +408,19 @@ begin
begin begin
nodeData := Sender.GetNodeData(Node); nodeData := Sender.GetNodeData(Node);
case nodeData^.NodeType of if nodeData^.NodeType = ntCategory then
ntCategory:
begin begin
{ Select first child (function) node instead } { Get first child (function) node instead }
functionNode := Sender.GetFirstChild(Node); functionNode := Sender.GetFirstChild(Node);
if not Assigned(functionNode) then if not Assigned(functionNode) then
exit; exit;
Sender.FocusedNode := functionNode; nodeData := Sender.GetNodeData(functionNode);
Sender.Selected[functionNode] := True;
end; end;
ntFunction:
SetFunction(nodeData^.Provider, nodeData^.LEDFunction); SetFunction(nodeData^.Provider, nodeData^.LEDFunction);
end; end;
end; end;
end;
procedure TButtonFunctionForm.vstFunctionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; procedure TButtonFunctionForm.vstFunctionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
@ -300,48 +453,23 @@ begin
end; end;
procedure TButtonFunctionForm.vstStatesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; { TStateControlInfo }
TextType: TVSTTextType; var CellText: string); constructor TStateControlInfo.Create(AState: ILEDState; AStateLabel: TLabel; AComboBox: TComboBox);
var
nodeData: PStateNodeData;
begin begin
nodeData := Sender.GetNodeData(Node); inherited Create;
case Column of FState := AState;
ColumnState: CellText := nodeData^.State.GetDisplayName; FStateLabel := AStateLabel;
ColumnColour: CellText := 'Red'; FComboBox := AComboBox;
end;
end; end;
procedure TButtonFunctionForm.vstStatesChange(Sender: TBaseVirtualTree; Node: PVirtualNode); destructor TStateControlInfo.Destroy;
begin begin
if Assigned(Node) and not (tsIncrementalSearching in Sender.TreeStates) then FreeAndNil(FComboBox);
PostMessage(Self.Handle, WM_STARTEDITING, WPARAM(Node), 0); FreeAndNil(FStateLabel);
end;
inherited;
procedure TButtonFunctionForm.vstStatesCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; out EditLink: IVTEditLink);
begin
EditLink := TVTColourEditor.Create;
end;
procedure TButtonFunctionForm.vstStatesEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
Allowed := True;
end;
procedure TButtonFunctionForm.WMStartEditing(var Msg: TMessage);
var
node: PVirtualNode;
begin
node := Pointer(Msg.WParam);
vstStates.EditNode(Node, 1);
end; end;
end. end.

12
G940LEDControl/Forms/MainFrm.dfm
View File

@ -326,7 +326,7 @@ object MainForm: TMainForm
object cmbProfiles: TComboBox object cmbProfiles: TComboBox
Left = 64 Left = 64
Top = 16 Top = 16
Width = 213 Width = 234
Height = 21 Height = 21
Style = csDropDownList Style = csDropDownList
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
@ -335,12 +335,12 @@ object MainForm: TMainForm
OnClick = cmbProfilesClick OnClick = cmbProfilesClick
end end
object btnSaveProfile: TButton object btnSaveProfile: TButton
Left = 283 Left = 304
Top = 16 Top = 16
Width = 75 Width = 54
Height = 21 Height = 21
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Caption = 'Save as...' Caption = 'New'
TabOrder = 9 TabOrder = 9
end end
object btnDeleteProfile: TButton object btnDeleteProfile: TButton
@ -356,10 +356,6 @@ object MainForm: TMainForm
object tsAbout: TTabSheet object tsAbout: TTabSheet
Caption = 'About' Caption = 'About'
ImageIndex = 1 ImageIndex = 1
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 382
ExplicitHeight = 482
object lblVersionCaption: TLabel object lblVersionCaption: TLabel
Left = 16 Left = 16
Top = 67 Top = 67

5
G940LEDControl/Forms/MainFrm.pas
View File

@ -242,7 +242,7 @@ end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin begin
SaveProfiles; // SaveProfiles;
// if Assigned(StateConsumerTask) then // if Assigned(StateConsumerTask) then
// begin // begin
// SaveDefaultProfile; // SaveDefaultProfile;
@ -547,7 +547,10 @@ begin
buttonIndex := (Sender as TComponent).Tag; buttonIndex := (Sender as TComponent).Tag;
if TButtonFunctionForm.Execute(ActiveProfile, buttonIndex) then if TButtonFunctionForm.Execute(ActiveProfile, buttonIndex) then
begin
UpdateButton(ActiveProfile, buttonIndex); UpdateButton(ActiveProfile, buttonIndex);
SaveProfiles;
end;
end; end;

7
G940LEDControl/G940LEDControl.dpr
View File

@ -5,7 +5,6 @@ uses
MainFrm in 'Forms\MainFrm.pas' {MainForm}, MainFrm in 'Forms\MainFrm.pas' {MainForm},
LogiJoystickDLL in '..\Shared\LogiJoystickDLL.pas', LogiJoystickDLL in '..\Shared\LogiJoystickDLL.pas',
SimConnect in '..\Shared\SimConnect.pas', SimConnect in '..\Shared\SimConnect.pas',
ButtonSelectFrm in 'Forms\ButtonSelectFrm.pas' {ButtonSelectForm},
FSXLEDStateProvider in 'Units\FSXLEDStateProvider.pas', FSXLEDStateProvider in 'Units\FSXLEDStateProvider.pas',
G940LEDStateConsumer in 'Units\G940LEDStateConsumer.pas', G940LEDStateConsumer in 'Units\G940LEDStateConsumer.pas',
LEDFunctionMap in 'Units\LEDFunctionMap.pas', LEDFunctionMap in 'Units\LEDFunctionMap.pas',
@ -26,11 +25,13 @@ uses
Profile in 'Units\Profile.pas', Profile in 'Units\Profile.pas',
LEDColorPool in 'Units\LEDColorPool.pas', LEDColorPool in 'Units\LEDColorPool.pas',
ButtonFunctionFrm in 'Forms\ButtonFunctionFrm.pas' {ButtonFunctionForm}, ButtonFunctionFrm in 'Forms\ButtonFunctionFrm.pas' {ButtonFunctionForm},
FSXLEDFunction in 'Units\FSXLEDFunction.pas', FSXLEDFunctionProvider in 'Units\FSXLEDFunctionProvider.pas',
StaticResources in 'Units\StaticResources.pas', StaticResources in 'Units\StaticResources.pas',
FSXResources in 'Units\FSXResources.pas', FSXResources in 'Units\FSXResources.pas',
FSXSimConnectClient in 'Units\FSXSimConnectClient.pas', FSXSimConnectClient in 'Units\FSXSimConnectClient.pas',
ColourEditor in 'Units\ColourEditor.pas'; FSXSimConnectIntf in 'Units\FSXSimConnectIntf.pas',
FSXLEDFunction in 'Units\FSXLEDFunction.pas',
LEDResources in 'Units\LEDResources.pas';
{$R *.res} {$R *.res}

11
G940LEDControl/G940LEDControl.dproj
View File

@ -98,6 +98,7 @@
<DCC_UNIT_PLATFORM>False</DCC_UNIT_PLATFORM> <DCC_UNIT_PLATFORM>False</DCC_UNIT_PLATFORM>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''"> <PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<DCC_DebugDCUs>true</DCC_DebugDCUs>
<VerInfo_IncludeVerInfo>false</VerInfo_IncludeVerInfo> <VerInfo_IncludeVerInfo>false</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=0.2.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=0.2;Comments=</VerInfo_Keys> <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=0.2.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=0.2;Comments=</VerInfo_Keys>
<Manifest_File>F:\Components\X2Utils\Resources\VistaManAsInvoker.manifest</Manifest_File> <Manifest_File>F:\Components\X2Utils\Resources\VistaManAsInvoker.manifest</Manifest_File>
@ -164,10 +165,6 @@
</DCCReference> </DCCReference>
<DCCReference Include="..\Shared\LogiJoystickDLL.pas"/> <DCCReference Include="..\Shared\LogiJoystickDLL.pas"/>
<DCCReference Include="..\Shared\SimConnect.pas"/> <DCCReference Include="..\Shared\SimConnect.pas"/>
<DCCReference Include="Forms\ButtonSelectFrm.pas">
<Form>ButtonSelectForm</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="Units\FSXLEDStateProvider.pas"/> <DCCReference Include="Units\FSXLEDStateProvider.pas"/>
<DCCReference Include="Units\G940LEDStateConsumer.pas"/> <DCCReference Include="Units\G940LEDStateConsumer.pas"/>
<DCCReference Include="Units\LEDFunctionMap.pas"/> <DCCReference Include="Units\LEDFunctionMap.pas"/>
@ -191,11 +188,13 @@
<Form>ButtonFunctionForm</Form> <Form>ButtonFunctionForm</Form>
<FormType>dfm</FormType> <FormType>dfm</FormType>
</DCCReference> </DCCReference>
<DCCReference Include="Units\FSXLEDFunction.pas"/> <DCCReference Include="Units\FSXLEDFunctionProvider.pas"/>
<DCCReference Include="Units\StaticResources.pas"/> <DCCReference Include="Units\StaticResources.pas"/>
<DCCReference Include="Units\FSXResources.pas"/> <DCCReference Include="Units\FSXResources.pas"/>
<DCCReference Include="Units\FSXSimConnectClient.pas"/> <DCCReference Include="Units\FSXSimConnectClient.pas"/>
<DCCReference Include="Units\ColourEditor.pas"/> <DCCReference Include="Units\FSXSimConnectIntf.pas"/>
<DCCReference Include="Units\FSXLEDFunction.pas"/>
<DCCReference Include="Units\LEDResources.pas"/>
<BuildConfiguration Include="Debug"> <BuildConfiguration Include="Debug">
<Key>Cfg_2</Key> <Key>Cfg_2</Key>
<CfgParent>Base</CfgParent> <CfgParent>Base</CfgParent>

141
G940LEDControl/Units/ColourEditor.pas
View File

@ -1,141 +0,0 @@
unit ColourEditor;
interface
uses
System.Types,
System.Classes,
Vcl.StdCtrls,
Winapi.Messages,
VirtualTrees;
type
TVTColourEditor = class(TInterfacedObject, IVTEditLink)
private
FEdit: TComboBox;
FTree: TBaseVirtualTree;
FColumn: TColumnIndex;
protected
procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
protected
{ IVTEditLink }
function BeginEdit: Boolean; stdcall;
function CancelEdit: Boolean; stdcall;
function EndEdit: Boolean; stdcall;
function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall;
procedure ProcessMessage(var Message: TMessage); stdcall;
function GetBounds: TRect; stdcall;
procedure SetBounds(R: TRect); stdcall;
public
destructor Destroy; override;
end;
implementation
uses
System.SysUtils,
Winapi.Windows;
{ TVTColourEditor }
destructor TVTColourEditor.Destroy;
begin
FreeAndNil(FEdit);
inherited;
end;
function TVTColourEditor.BeginEdit: Boolean;
begin
Result := True;
FEdit.Show;
FEdit.SetFocus;
end;
function TVTColourEditor.CancelEdit: Boolean;
begin
Result := True;
FEdit.Hide;
end;
function TVTColourEditor.EndEdit: Boolean;
begin
Result := True;
// TODO update node data
end;
function TVTColourEditor.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
begin
Result := True;
FTree := Tree;
// FNode := Node;
FColumn := Column;
FreeAndNil(FEdit);
FEdit := TComboBox.Create(nil);
FEdit.Visible := False;
FEdit.Parent := Tree;
// FEdit.Text := Data.Value;
// FEdit.Items.Add();
FEdit.OnKeyDown := EditKeyDown;
end;
procedure TVTColourEditor.ProcessMessage(var Message: TMessage);
begin
FEdit.WindowProc(Message);
end;
function TVTColourEditor.GetBounds: TRect;
begin
Result := FEdit.BoundsRect;
end;
procedure TVTColourEditor.SetBounds(R: TRect);
var
dummy: Integer;
begin
(FTree as TVirtualStringTree).Header.Columns.GetColumnBounds(FColumn, dummy, R.Right);
FEdit.BoundsRect := R;
end;
procedure TVTColourEditor.EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
case Key of
VK_ESCAPE:
begin
FTree.CancelEditNode;
Key := 0;
end;
VK_RETURN:
begin
FTree.EndEditNode;
Key := 0;
end;
VK_UP,
VK_DOWN:
if (Shift = []) and (not FEdit.DroppedDown) then
begin
PostMessage(FTree.Handle, WM_KEYDOWN, Key, 0);
Key := 0;
end;
end;
end;
end.

2
G940LEDControl/Units/ConfigConversion.pas
View File

@ -62,6 +62,8 @@ const
V0_FUNCTIONFSX_TAXILIGHTS = V0_FUNCTIONPROVIDER_OFFSET + 25; V0_FUNCTIONFSX_TAXILIGHTS = V0_FUNCTIONPROVIDER_OFFSET + 25;
V0_FUNCTIONFSX_RECOGNITIONLIGHTS = V0_FUNCTIONPROVIDER_OFFSET + 26; V0_FUNCTIONFSX_RECOGNITIONLIGHTS = V0_FUNCTIONPROVIDER_OFFSET + 26;
// TODO 27 (de-ice)
procedure ConvertProfileFunction0To1(AOldFunction: Integer; AButton: TProfileButton); procedure ConvertProfileFunction0To1(AOldFunction: Integer; AButton: TProfileButton);

231
G940LEDControl/Units/FSXLEDFunction.pas
View File

@ -1,231 +0,0 @@
unit FSXLEDFunction;
interface
uses
Generics.Collections,
LEDFunction,
LEDStateIntf,
ObserverIntf;
type
TCustomFSXFunction = class;
TCustomFSXFunctionList = TObjectList<TCustomFSXFunction>;
TFSXLEDFunctionProvider = class(TCustomLEDFunctionProvider)
private
FConnectedFunctions: TCustomFSXFunctionList;
FSimConnectHandle: THandle;
protected
procedure SimConnect;
procedure SimDisconnect;
procedure Connect(AFunction: TCustomFSXFunction); virtual;
procedure Disconnect(AFunction: TCustomFSXFunction); virtual;
property ConnectedFunctions: TCustomFSXFunctionList read FConnectedFunctions;
property SimConnectHandle: THandle read FSimConnectHandle;
protected
procedure RegisterFunctions; override;
function GetUID: string; override;
end;
TCustomFSXFunction = class(TCustomMultiStateLEDFunction)
private
FProvider: TFSXLEDFunctionProvider;
protected
procedure SimConnected; virtual;
procedure SimDisconnected; virtual;
property Provider: TFSXLEDFunctionProvider read FProvider;
protected
procedure Attach(AObserver: IObserver); override;
procedure Detach(AObserver: IObserver); override;
function GetCategoryName: string; override;
public
constructor Create(AProvider: TFSXLEDFunctionProvider);
end;
TFSXGearFunction = class(TCustomFSXFunction)
private
FRetractedState: ILEDState;
FBetweenState: ILEDState;
FExtendedState: ILEDState;
FSpeedExceededState: ILEDState;
FDamageBySpeedState: ILEDState;
protected
procedure RegisterStates; override;
function GetDisplayName: string; override;
function GetUID: string; override;
function GetCurrentState: ILEDState; override;
end;
implementation
uses
FSXResources,
LEDColorPool,
LEDFunctionRegistry,
LEDState;
{ TFSXLEDFunctionProvider }
procedure TFSXLEDFunctionProvider.RegisterFunctions;
begin
RegisterFunction(TFSXGearFunction.Create(Self));
end;
function TFSXLEDFunctionProvider.GetUID: string;
begin
Result := FSXProviderUID;
end;
procedure TFSXLEDFunctionProvider.SimConnect;
var
fsxFunction: TCustomFSXFunction;
begin
if SimConnectHandle <> 0 then
exit;
// FSimConnectHandle :=
if SimConnectHandle <> 0 then
begin
for fsxFunction in ConnectedFunctions do
fsxFunction.SimConnected;
end;
end;
procedure TFSXLEDFunctionProvider.SimDisconnect;
begin
if SimConnectHandle = 0 then
exit;
end;
procedure TFSXLEDFunctionProvider.Connect(AFunction: TCustomFSXFunction);
begin
if ConnectedFunctions.IndexOf(AFunction) = -1 then
begin
ConnectedFunctions.Add(AFunction);
if ConnectedFunctions.Count > 0 then
SimConnect;
end;
end;
procedure TFSXLEDFunctionProvider.Disconnect(AFunction: TCustomFSXFunction);
begin
ConnectedFunctions.Remove(AFunction);
if ConnectedFunctions.Count = 0 then
SimDisconnect;
end;
{ TCustomFSXFunction }
constructor TCustomFSXFunction.Create(AProvider: TFSXLEDFunctionProvider);
begin
inherited Create;
FProvider := AProvider;
end;
procedure TCustomFSXFunction.Attach(AObserver: IObserver);
begin
if Observers.Count = 0 then
Provider.Connect(Self);
inherited Attach(AObserver);
end;
procedure TCustomFSXFunction.Detach(AObserver: IObserver);
begin
if Assigned(Provider) and (Observers.Count > 0) then
begin
inherited Detach(AObserver);
if Observers.Count = 0 then
Provider.Disconnect(Self);
end else
inherited Detach(AObserver);
end;
function TCustomFSXFunction.GetCategoryName: string;
begin
Result := FSXCategory;
end;
procedure TCustomFSXFunction.SimConnected;
begin
end;
procedure TCustomFSXFunction.SimDisconnected;
begin
end;
{ TFSXGearFunction }
procedure TFSXGearFunction.RegisterStates;
begin
FRetractedState := RegisterState(TLEDState.Create(FSXStateUIDGearRetracted,
FSXStateDisplayNameGearRetracted,
TLEDColorPool.GetColor(cpeStaticRed)));
FBetweenState := RegisterState(TLEDState.Create(FSXStateUIDGearBetween,
FSXStateDisplayNameGearBetween,
TLEDColorPool.GetColor(cpeStaticAmber)));
FExtendedState := RegisterState(TLEDState.Create(FSXStateUIDGearExtended,
FSXStateDisplayNameGearExtended,
TLEDColorPool.GetColor(cpeStaticGreen)));
FSpeedExceededState := RegisterState(TLEDState.Create(FSXStateUIDGearSpeedExceeded,
FSXStateDisplayNameGearSpeedExceeded,
TLEDColorPool.GetColor(cpeFlashingAmberNormal)));
FDamageBySpeedState := RegisterState(TLEDState.Create(FSXStateUIDGearDamageBySpeed,
FSXStateDisplayNameGearDamageBySpeed,
TLEDColorPool.GetColor(cpeFlashingRedFast)));
end;
function TFSXGearFunction.GetDisplayName: string;
begin
Result := FSXFunctionDisplayNameGear;
end;
function TFSXGearFunction.GetUID: string;
begin
Result := FSXFunctionUIDGear;
end;
function TFSXGearFunction.GetCurrentState: ILEDState;
begin
// TODO TFSXGearFunction.GetCurrentState
end;
initialization
TLEDFunctionRegistry.Register(TFSXLEDFunctionProvider.Create);
end.

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

@ -0,0 +1,251 @@
unit FSXLEDFunctionProvider;
interface
uses
Generics.Collections,
System.SyncObjs,
FSXSimConnectIntf,
LEDFunction,
LEDFunctionIntf,
LEDStateIntf,
ObserverIntf;
type
TCustomFSXFunction = class;
TCustomFSXFunctionList = TObjectList<TCustomFSXFunction>;
TFSXLEDFunctionProvider = class(TCustomLEDFunctionProvider)
private
FConnectedFunctions: TCustomFSXFunctionList;
FSimConnectHandle: THandle;
protected
procedure SimConnect;
procedure SimDisconnect;
procedure Connect(AFunction: TCustomFSXFunction); virtual;
procedure Disconnect(AFunction: TCustomFSXFunction); virtual;
property ConnectedFunctions: TCustomFSXFunctionList read FConnectedFunctions;
property SimConnectHandle: THandle read FSimConnectHandle;
protected
procedure RegisterFunctions; override;
function GetUID: string; override;
public
function GetSimConnect: IFSXSimConnect;
end;
TCustomFSXFunction = class(TCustomMultiStateLEDFunction)
private
FProvider: TFSXLEDFunctionProvider;
FDisplayName: string;
FUID: string;
protected
procedure SimConnected; virtual;
procedure SimDisconnected; virtual;
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;
TCustomFSXFunctionWorker = class(TCustomLEDFunctionWorker)
private
FSimConnect: IFSXSimConnect;
FDefinition: IFSXSimConnectDefinition;
FCurrentStateLock: TCriticalSection;
FCurrentState: ILEDStateWorker;
protected
procedure RegisterVariables; virtual; abstract;
procedure SetCurrentState(const AUID: string);
property Definition: IFSXSimConnectDefinition read FDefinition;
property SimConnect: IFSXSimConnect read FSimConnect;
protected
function GetCurrentState: ILEDStateWorker; override;
public
constructor Create(AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings; ASimConnect: IFSXSimConnect);
destructor Destroy; override;
end;
implementation
uses
System.SysUtils,
FSXLEDFunction,
FSXResources,
LEDFunctionRegistry,
SimConnect;
{ TFSXLEDFunctionProvider }
procedure TFSXLEDFunctionProvider.RegisterFunctions;
begin
RegisterFunction(TFSXGearFunction.Create(Self, FSXFunctionDisplayNameGear, FSXFunctionUIDGear));
end;
function TFSXLEDFunctionProvider.GetUID: string;
begin
Result := FSXProviderUID;
end;
function TFSXLEDFunctionProvider.GetSimConnect: IFSXSimConnect;
begin
// TODO
end;
procedure TFSXLEDFunctionProvider.SimConnect;
var
fsxFunction: TCustomFSXFunction;
begin
if SimConnectHandle <> 0 then
exit;
// FSimConnectHandle :=
if SimConnectHandle <> 0 then
begin
for fsxFunction in ConnectedFunctions do
fsxFunction.SimConnected;
end;
end;
procedure TFSXLEDFunctionProvider.SimDisconnect;
begin
if SimConnectHandle = 0 then
exit;
end;
procedure TFSXLEDFunctionProvider.Connect(AFunction: TCustomFSXFunction);
begin
if ConnectedFunctions.IndexOf(AFunction) = -1 then
begin
ConnectedFunctions.Add(AFunction);
if ConnectedFunctions.Count > 0 then
SimConnect;
end;
end;
procedure TFSXLEDFunctionProvider.Disconnect(AFunction: TCustomFSXFunction);
begin
ConnectedFunctions.Remove(AFunction);
if ConnectedFunctions.Count = 0 then
SimDisconnect;
end;
{ TCustomFSXFunction }
constructor TCustomFSXFunction.Create(AProvider: TFSXLEDFunctionProvider; const ADisplayName, AUID: string);
begin
inherited Create;
FProvider := AProvider;
FDisplayName := ADisplayName;
FUID := AUID;
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;
procedure TCustomFSXFunction.SimConnected;
begin
end;
procedure TCustomFSXFunction.SimDisconnected;
begin
end;
{ TCustomFSXFunctionWorker }
constructor TCustomFSXFunctionWorker.Create(AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings; ASimConnect: IFSXSimConnect);
begin
inherited Create(AStates, ASettings);
FCurrentStateLock := TCriticalSection.Create;
FSimConnect := ASimConnect;
FDefinition := ASimConnect.CreateDefinition;
RegisterVariables;
ASimConnect.AddDefinition(FDefinition);
end;
destructor TCustomFSXFunctionWorker.Destroy;
begin
FreeAndNil(FCurrentStateLock);
inherited;
end;
function TCustomFSXFunctionWorker.GetCurrentState: ILEDStateWorker;
begin
FCurrentStateLock.Acquire;
try
Result := FCurrentState;
finally
FCurrentStateLock.Release;
end;
end;
procedure TCustomFSXFunctionWorker.SetCurrentState(const AUID: string);
var
newState: ILEDStateWorker;
begin
FCurrentStateLock.Acquire;
try
newState := FindState(AUID);
if newState <> FCurrentState then
begin
FCurrentState := newState;
NotifyObservers;
end;
finally
FCurrentStateLock.Release;
end;
end;
initialization
TLEDFunctionRegistry.Register(TFSXLEDFunctionProvider.Create);
end.

2
G940LEDControl/Units/FSXResources.pas
View File

@ -7,7 +7,7 @@ const
FSXCategory = 'Flight Simulator X'; FSXCategory = 'Flight Simulator X';
FSXFunctionUIDGear = 'gear'; FSXFunctionUIDGear = 'gear';
FSXFunctionDisplayNameGear = 'Gear'; FSXFunctionDisplayNameGear = 'Landing gear';
FSXStateUIDGearRetracted = 'retracted'; FSXStateUIDGearRetracted = 'retracted';
FSXStateUIDGearBetween = 'between'; FSXStateUIDGearBetween = 'between';

95
G940LEDControl/Units/FSXSimConnectClient.pas
View File

@ -2,13 +2,104 @@ unit FSXSimConnectClient;
interface interface
uses uses
OtlTaskControl; OtlTaskControl,
FSXSimConnectIntf;
type
TFSXSimConnectInterface = class(TInterfacedObject, IFSXSimConnect)
private
FClient: IOmniTaskControl;
protected
property Client: IOmniTaskControl read FClient;
protected
{ IFSXSimConnect }
function CreateDefinition: IFSXSimConnectDefinition;
procedure AddDefinition(ADefinition: IFSXSimConnectDefinition);
public
constructor Create;
destructor Destroy; override;
end;
implementation
uses
System.SysUtils,
SimConnect;
type type
TFSXSimConnectClient = class(TOmniWorker) TFSXSimConnectClient = class(TOmniWorker)
end;
TFSXSimConnectDefinition = class(TInterfacedObject, IFSXSimConnectDefinition)
private
FSimConnect: IFSXSimConnect;
protected
property SimConnect: IFSXSimConnect read FSimConnect;
protected
{ IFSXSimConnectDefinition }
procedure AddVariable(AVariableName, AUnitsName: string; ADatumType: SIMCONNECT_DATAType; AEpsilon: Single = 0);
procedure Apply(ASimConnectHandle: THandle; ADefinitionID: Integer);
public
constructor Create(ASimConnect: IFSXSimConnect);
end;
{ TFSXSimConnectInterface }
constructor TFSXSimConnectInterface.Create;
var
worker: IOmniWorker;
begin
worker := TFSXSimConnectClient.Create;
FClient := CreateTask(worker);
end;
destructor TFSXSimConnectInterface.Destroy;
begin
FClient.Terminate;
FClient := nil;
inherited;
end;
function TFSXSimConnectInterface.CreateDefinition: IFSXSimConnectDefinition;
begin
Result := TFSXSimConnectDefinition.Create(Self);
end;
procedure TFSXSimConnectInterface.AddDefinition(ADefinition: IFSXSimConnectDefinition);
begin
// TODO
end;
{ TFSXSimConnectDefinition }
constructor TFSXSimConnectDefinition.Create(ASimConnect: IFSXSimConnect);
begin
end; end;
implementation
procedure TFSXSimConnectDefinition.AddVariable(AVariableName, AUnitsName: string; ADatumType: SIMCONNECT_DATAType; AEpsilon: Single);
begin
end;
procedure TFSXSimConnectDefinition.Apply(ASimConnectHandle: THandle; ADefinitionID: Integer);
begin
// SimConnect_AddToDataDefinition(ASimConnectHandle, ADefinitionID,
// AnsiString(AVariableName), AnsiString(AUnitsName), ADatumType, AEpsilon, 0);
end;
end. end.

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

@ -0,0 +1,37 @@
unit FSXSimConnectIntf;
interface
uses
SimConnect;
type
IFSXSimConnectDefinition = interface;
IFSXSimConnect = interface
['{B6BE3E7C-0804-43D6-84DE-8010C5728A07}']
function CreateDefinition: IFSXSimConnectDefinition;
procedure AddDefinition(ADefinition: IFSXSimConnectDefinition);
end;
IFSXSimConnectDefinition = interface
['{F1EAB3B1-0A3D-4B06-A75F-823E15C313B8}']
procedure AddVariable(AVariableName, AUnitsName: string; ADatumType: SIMCONNECT_DATAType; AEpsilon: Single = 0);
procedure Apply(ASimConnectHandle: THandle; ADefinitionID: Integer);
end;
const
FSX_UNIT_PERCENT = 'percent';
FSX_UNIT_MASK = 'mask';
FSX_UNIT_BOOL = 'bool';
FSX_UNIT_NUMBER = 'number';
implementation
end.

8
G940LEDControl/Units/LEDColorIntf.pas
View File

@ -2,7 +2,13 @@ unit LEDColorIntf;
interface interface
type type
TLEDColor = (lcOff, lcGreen, lcAmber, lcRed); TLEDColor = (lcOff, lcGreen, lcAmber, lcRed,
lcFlashingGreenFast, lcFlashingGreenNormal,
lcFlashingAmberFast, lcFlashingAmberNormal,
lcFlashingRedFast, lcFlashingRedNormal);
TStaticLEDColor = lcOff..lcRed;
ILEDColor = interface ILEDColor = interface

62
G940LEDControl/Units/LEDColorPool.pas
View File

@ -6,27 +6,14 @@ uses
type type
TLEDColorPoolEntry = (cpeStaticOff,
cpeStaticGreen,
cpeStaticAmber,
cpeStaticRed,
cpeFlashingGreenFast,
cpeFlashingGreenNormal,
cpeFlashingAmberFast,
cpeFlashingAmberNormal,
cpeFlashingRedFast,
cpeFlashingRedNormal);
TLEDColorPool = class(TObject) TLEDColorPool = class(TObject)
private private
FStates: array[TLEDColorPoolEntry] of ILEDColor; FStates: array[TLEDColor] of ILEDColor;
protected protected
class function Instance: TLEDColorPool; class function Instance: TLEDColorPool;
function DoGetColor(AEntry: TLEDColorPoolEntry): ILEDColor; function DoGetColor(AColor: TLEDColor): ILEDColor;
public public
class function GetColor(AEntry: TLEDColorPoolEntry): ILEDColor; overload;
class function GetColor(AColor: TLEDColor): ILEDColor; overload; class function GetColor(AColor: TLEDColor): ILEDColor; overload;
end; end;
@ -44,22 +31,9 @@ var
{ TLEDStatePool } { TLEDStatePool }
class function TLEDColorPool.GetColor(AEntry: TLEDColorPoolEntry): ILEDColor;
begin
Result := Instance.DoGetColor(AEntry);
end;
class function TLEDColorPool.GetColor(AColor: TLEDColor): ILEDColor; class function TLEDColorPool.GetColor(AColor: TLEDColor): ILEDColor;
begin begin
Result := nil; Result := Instance.DoGetColor(AColor);
case AColor of
lcOff: Result := GetColor(cpeStaticOff);
lcGreen: Result := GetColor(cpeStaticGreen);
lcAmber: Result := GetColor(cpeStaticAmber);
lcRed: Result := GetColor(cpeStaticRed);
end;
end; end;
@ -72,7 +46,7 @@ begin
end; end;
function TLEDColorPool.DoGetColor(AEntry: TLEDColorPoolEntry): ILEDColor; function TLEDColorPool.DoGetColor(AColor: TLEDColor): ILEDColor;
function GetFlashingCycle(AColor: TLEDColor): TLEDColorDynArray; function GetFlashingCycle(AColor: TLEDColor): TLEDColorDynArray;
begin begin
@ -85,26 +59,26 @@ var
state: ILEDColor; state: ILEDColor;
begin begin
if not Assigned(FStates[AEntry]) then if not Assigned(FStates[AColor]) then
begin begin
case AEntry of case AColor of
cpeStaticOff: state := TStaticLEDColor.Create(lcOff); lcOff: state := TStaticLEDColor.Create(lcOff);
cpeStaticGreen: state := TStaticLEDColor.Create(lcGreen); lcGreen: state := TStaticLEDColor.Create(lcGreen);
cpeStaticAmber: state := TStaticLEDColor.Create(lcAmber); lcAmber: state := TStaticLEDColor.Create(lcAmber);
cpeStaticRed: state := TStaticLEDColor.Create(lcRed); lcRed: state := TStaticLEDColor.Create(lcRed);
cpeFlashingGreenFast: state := TDynamicLEDColor.Create(GetFlashingCycle(lcGreen), TICKINTERVAL_FAST); lcFlashingGreenFast: state := TDynamicLEDColor.Create(GetFlashingCycle(lcGreen), TICKINTERVAL_FAST);
cpeFlashingGreenNormal: state := TDynamicLEDColor.Create(GetFlashingCycle(lcGreen), TICKINTERVAL_NORMAL); lcFlashingGreenNormal: state := TDynamicLEDColor.Create(GetFlashingCycle(lcGreen), TICKINTERVAL_NORMAL);
cpeFlashingAmberFast: state := TDynamicLEDColor.Create(GetFlashingCycle(lcAmber), TICKINTERVAL_FAST); lcFlashingAmberFast: state := TDynamicLEDColor.Create(GetFlashingCycle(lcAmber), TICKINTERVAL_FAST);
cpeFlashingAmberNormal: state := TDynamicLEDColor.Create(GetFlashingCycle(lcAmber), TICKINTERVAL_NORMAL); lcFlashingAmberNormal: state := TDynamicLEDColor.Create(GetFlashingCycle(lcAmber), TICKINTERVAL_NORMAL);
cpeFlashingRedFast: state := TDynamicLEDColor.Create(GetFlashingCycle(lcRed), TICKINTERVAL_FAST); lcFlashingRedFast: state := TDynamicLEDColor.Create(GetFlashingCycle(lcRed), TICKINTERVAL_FAST);
cpeFlashingRedNormal: state := TDynamicLEDColor.Create(GetFlashingCycle(lcRed), TICKINTERVAL_NORMAL); lcFlashingRedNormal: state := TDynamicLEDColor.Create(GetFlashingCycle(lcRed), TICKINTERVAL_NORMAL);
end; end;
FStates[AEntry] := state; FStates[AColor] := state;
Result := state; Result := state;
end else end else
Result := FStates[AEntry]; Result := FStates[AColor];
end; end;

154
G940LEDControl/Units/LEDFunction.pas
View File

@ -28,27 +28,14 @@ type
end; end;
TCustomLEDFunction = class(TInterfacedObject, IObservable, ILEDFunction) TCustomLEDFunction = class(TInterfacedObject, ILEDFunction)
private
FObservers: TInterfaceList;
protected protected
procedure NotifyObservers; virtual;
property Observers: TInterfaceList read FObservers;
protected
{ IObservable }
procedure Attach(AObserver: IObserver); virtual;
procedure Detach(AObserver: IObserver); virtual;
{ ILEDFunction } { ILEDFunction }
function GetCategoryName: string; virtual; abstract; function GetCategoryName: string; virtual; abstract;
function GetDisplayName: string; virtual; abstract; function GetDisplayName: string; virtual; abstract;
function GetUID: string; virtual; abstract; function GetUID: string; virtual; abstract;
function GetCurrentState: ILEDState; virtual; abstract; function CreateWorker(ASettings: ILEDFunctionWorkerSettings): ILEDFunctionWorker; virtual; abstract;
public
constructor Create;
destructor Destroy; override;
end; end;
@ -56,7 +43,6 @@ type
private private
FStates: TInterfaceList; FStates: TInterfaceList;
protected protected
// procedure SetCurrentState(AState: ILEDState); virtual;
procedure RegisterStates; virtual; abstract; procedure RegisterStates; virtual; abstract;
function RegisterState(AState: ILEDState): ILEDState; virtual; function RegisterState(AState: ILEDState): ILEDState; virtual;
protected protected
@ -68,6 +54,32 @@ type
end; end;
TCustomLEDFunctionWorker = class(TInterfacedObject, ILEDFunctionWorker)
private
FObservers: TInterfaceList;
FStates: TInterfaceList;
protected
procedure RegisterStates(AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings); virtual;
function FindState(const AUID: string): ILEDStateWorker; virtual;
procedure NotifyObservers; virtual;
property Observers: TInterfaceList read FObservers;
property States: TInterfaceList read FStates;
protected
{ IObservable }
procedure Attach(AObserver: IObserver); virtual;
procedure Detach(AObserver: IObserver); virtual;
function GetCurrentState: ILEDStateWorker; virtual; abstract;
public
constructor Create; overload;
constructor Create(AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings); overload;
destructor Destroy; override;
end;
TLEDFunctionEnumerator = class(TInterfacedObject, ILEDFunctionEnumerator) TLEDFunctionEnumerator = class(TInterfacedObject, ILEDFunctionEnumerator)
private private
FList: TInterfaceList; FList: TInterfaceList;
@ -97,36 +109,11 @@ type
implementation implementation
uses uses
SysUtils; System.SysUtils,
LEDColorIntf,
{ TCustomLEDFunction } LEDColorPool,
constructor TCustomLEDFunction.Create; LEDState;
begin
inherited Create;
FObservers := TInterfaceList.Create;
end;
destructor TCustomLEDFunction.Destroy;
begin
FreeAndNil(FObservers);
inherited Destroy;
end;
procedure TCustomLEDFunction.Attach(AObserver: IObserver);
begin
FObservers.Add(AObserver as IObserver);
end;
procedure TCustomLEDFunction.Detach(AObserver: IObserver);
begin
FObservers.Remove(AObserver as IObserver);
end;
{ TCustomMultiStateLEDFunction } { TCustomMultiStateLEDFunction }
@ -160,14 +147,79 @@ begin
end; end;
//procedure TCustomMultiStateLEDFunction.SetCurrentState(AState: ILEDState); { TCustomLEDFunctionWorker }
//begin constructor TCustomLEDFunctionWorker.Create;
// FCurrentState := AState; begin
// NotifyObservers; inherited Create;
//end;
FObservers := TInterfaceList.Create;
end;
procedure TCustomLEDFunction.NotifyObservers; constructor TCustomLEDFunctionWorker.Create(AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings);
begin
Create;
FStates := TInterfaceList.Create;
RegisterStates(AStates, ASettings);
end;
destructor TCustomLEDFunctionWorker.Destroy;
begin
FreeAndNil(FStates);
FreeAndNil(FObservers);
inherited Destroy;
end;
procedure TCustomLEDFunctionWorker.Attach(AObserver: IObserver);
begin
{ TInterfaceList is thread-safe }
Observers.Add(AObserver as IObserver);
end;
procedure TCustomLEDFunctionWorker.Detach(AObserver: IObserver);
begin
Observers.Remove(AObserver as IObserver);
end;
procedure TCustomLEDFunctionWorker.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 TCustomLEDFunctionWorker.FindState(const AUID: string): ILEDStateWorker;
var
state: IInterface;
begin
Result := nil;
for state in States do
if (state as ICustomLEDState).GetUID = AUID then
begin
Result := (state as ILEDStateWorker);
break;
end;
end;
procedure TCustomLEDFunctionWorker.NotifyObservers;
var var
observer: IInterface; observer: IInterface;

18
G940LEDControl/Units/LEDFunctionIntf.pas
View File

@ -9,6 +9,8 @@ uses
type type
ILEDFunction = interface; ILEDFunction = interface;
ILEDFunctionWorker = interface;
ILEDFunctionWorkerSettings = interface;
ILEDFunctionEnumerator = interface; ILEDFunctionEnumerator = interface;
ILEDStateEnumerator = interface; ILEDStateEnumerator = interface;
@ -22,13 +24,13 @@ type
end; end;
ILEDFunction = interface(IObservable) ILEDFunction = interface
['{7087067A-1016-4A7D-ACB1-BA1F388DAD6C}'] ['{7087067A-1016-4A7D-ACB1-BA1F388DAD6C}']
function GetCategoryName: string; function GetCategoryName: string;
function GetDisplayName: string; function GetDisplayName: string;
function GetUID: string; function GetUID: string;
function GetCurrentState: ILEDState; function CreateWorker(ASettings: ILEDFunctionWorkerSettings): ILEDFunctionWorker;
end; end;
@ -38,6 +40,18 @@ type
end; end;
ILEDFunctionWorker = interface(IObservable)
['{5EF3230D-B52F-4BD6-8AD3-F3A035F155B1}']
function GetCurrentState: ILEDStateWorker;
end;
ILEDFunctionWorkerSettings = interface
['{8FA287F6-9FE6-4A49-9C87-05C7F3F2B256}']
function GetStateColor(const AUID: string; out AColor: TLEDColor): Boolean;
end;
ILEDFunctionEnumerator = interface ILEDFunctionEnumerator = interface
['{A03E4E54-19CB-4C08-AD5F-20265817086D}'] ['{A03E4E54-19CB-4C08-AD5F-20265817086D}']
function GetCurrent: ILEDFunction; function GetCurrent: ILEDFunction;

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.

66
G940LEDControl/Units/LEDState.pas
View File

@ -7,33 +7,66 @@ uses
type type
TLEDState = class(TInterfacedObject, ILEDState) TCustomLEDState = class(TInterfacedObject, ICustomLEDState)
private
FUID: string;
protected
{ ICustomLEDState }
function GetUID: string;
public
constructor Create(const AUID: string);
end;
TLEDState = class(TCustomLEDState, ILEDState)
private private
FDisplayName: string; FDisplayName: string;
FUID: string; FDefaultColor: TLEDColor;
FColor: ILEDColor;
protected protected
{ ILEDState } { ILEDState }
function GetDisplayName: string; function GetDisplayName: string;
function GetUID: string; function GetDefaultColor: TLEDColor;
public
constructor Create(const AUID, ADisplayName: string; ADefaultColor: TLEDColor);
end;
TLEDStateWorker = class(TCustomLEDState, ILEDStateWorker)
private
FColor: ILEDColor;
protected
{ ILEDStateWorker }
function GetColor: ILEDColor; function GetColor: ILEDColor;
public public
constructor Create(const AUID, ADisplayName: string; AColor: ILEDColor); constructor Create(const AUID: string; AColor: ILEDColor);
end; end;
implementation implementation
{ TLEDState }
constructor TLEDState.Create(const AUID, ADisplayName: string; AColor: ILEDColor); { TCustomLEDState }
constructor TCustomLEDState.Create(const AUID: string);
begin begin
inherited Create; inherited Create;
FUID := AUID; FUID := AUID;
FDisplayName := ADisplayName; end;
FColor := AColor;
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; end;
@ -43,13 +76,22 @@ begin
end; end;
function TLEDState.GetUID: string; function TLEDState.GetDefaultColor: TLEDColor;
begin begin
Result := FUID; Result := FDefaultColor;
end; end;
function TLEDState.GetColor: ILEDColor; { TLEDStateWorker }
constructor TLEDStateWorker.Create(const AUID: string; AColor: ILEDColor);
begin
inherited Create(AUID);
FColor := AColor;
end;
function TLEDStateWorker.GetColor: ILEDColor;
begin begin
Result := FColor; Result := FColor;
end; end;

16
G940LEDControl/Units/LEDStateIntf.pas
View File

@ -6,11 +6,21 @@ uses
type type
ILEDState = interface ICustomLEDState = interface
['{0361CBD5-E64E-4972-A8A4-D5FE0B0DFB1C}'] ['{B5567129-74E1-4888-83F5-8A6174706671}']
function GetDisplayName: string;
function GetUID: string; 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: ILEDColor; function GetColor: ILEDColor;
end; end;

96
G940LEDControl/Units/Profile.pas
View File

@ -4,18 +4,33 @@ interface
uses uses
Generics.Collections, Generics.Collections,
X2UtPersistIntf; X2UtPersistIntf,
LEDColorIntf;
type type
TProfileButtonStateColors = TDictionary<string,TLEDColor>;
TProfileButton = class(TObject) TProfileButton = class(TObject)
private private
FProviderUID: string; FProviderUID: string;
FFunctionUID: string; FFunctionUID: string;
FStateColors: TProfileButtonStateColors;
protected protected
function Load(AReader: IX2PersistReader): Boolean; function Load(AReader: IX2PersistReader): Boolean;
procedure Save(AWriter: IX2PersistWriter); procedure Save(AWriter: IX2PersistWriter);
property StateColors: TProfileButtonStateColors read FStateColors;
public public
constructor Create;
destructor Destroy; 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 ProviderUID: string read FProviderUID write FProviderUID;
property FunctionUID: string read FFunctionUID write FFunctionUID; property FunctionUID: string read FFunctionUID write FFunctionUID;
end; end;
@ -57,29 +72,106 @@ type
implementation implementation
uses uses
Classes, Classes,
SysUtils; SysUtils,
LEDResources;
const const
SectionProfiles = 'Profiles'; SectionProfiles = 'Profiles';
SectionButton = 'Button'; SectionButton = 'Button';
SectionStates = 'States';
KeyProviderUID = 'ProviderUID'; KeyProviderUID = 'ProviderUID';
KeyFunctionUID = 'FunctionUID'; KeyFunctionUID = 'FunctionUID';
{ TProfileButton } { TProfileButton }
constructor TProfileButton.Create;
begin
inherited Create;
FStateColors := TProfileButtonStateColors.Create;
end;
destructor TProfileButton.Destroy;
begin
FreeAndNil(FStateColors);
inherited Destroy;
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; function TProfileButton.Load(AReader: IX2PersistReader): Boolean;
var
stateUIDs: TStringList;
stateUID: string;
colorUID: string;
color: TLEDColor;
begin begin
Result := AReader.ReadString(KeyProviderUID, FProviderUID) and Result := AReader.ReadString(KeyProviderUID, FProviderUID) and
AReader.ReadString(KeyFunctionUID, FFunctionUID); 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; end;
procedure TProfileButton.Save(AWriter: IX2PersistWriter); procedure TProfileButton.Save(AWriter: IX2PersistWriter);
var
stateUID: string;
begin begin
AWriter.WriteString(KeyProviderUID, FProviderUID); AWriter.WriteString(KeyProviderUID, FProviderUID);
AWriter.WriteString(KeyFunctionUID, FFunctionUID); 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; end;

38
G940LEDControl/Units/StaticLEDFunction.pas
View File

@ -3,6 +3,7 @@ unit StaticLEDFunction;
interface interface
uses uses
LEDFunction, LEDFunction,
LEDFunctionIntf,
LEDColorIntf, LEDColorIntf,
LEDStateIntf; LEDStateIntf;
@ -19,13 +20,12 @@ type
TStaticLEDFunction = class(TCustomLEDFunction) TStaticLEDFunction = class(TCustomLEDFunction)
private private
FColor: TLEDColor; FColor: TLEDColor;
FState: ILEDState;
protected protected
function GetCategoryName: string; override; function GetCategoryName: string; override;
function GetDisplayName: string; override; function GetDisplayName: string; override;
function GetUID: string; override; function GetUID: string; override;
function GetCurrentState: ILEDState; override; function CreateWorker(ASettings: ILEDFunctionWorkerSettings): ILEDFunctionWorker; override;
public public
constructor Create(AColor: TLEDColor); constructor Create(AColor: TLEDColor);
end; end;
@ -39,13 +39,24 @@ uses
StaticResources; StaticResources;
type
TStaticLEDFunctionWorker = class(TCustomLEDFunctionWorker)
private
FState: ILEDStateWorker;
protected
function GetCurrentState: ILEDStateWorker; override;
public
constructor Create(AColor: TLEDColor);
end;
{ TStaticLEDFunctionProvider } { TStaticLEDFunctionProvider }
procedure TStaticLEDFunctionProvider.RegisterFunctions; procedure TStaticLEDFunctionProvider.RegisterFunctions;
var var
color: TLEDColor; color: TLEDColor;
begin begin
for color := Low(TLEDColor) to High(TLEDColor) do for color := Low(TStaticLEDColor) to High(TStaticLEDColor) do
RegisterFunction(TStaticLEDFunction.Create(color)); RegisterFunction(TStaticLEDFunction.Create(color));
end; end;
@ -83,15 +94,26 @@ begin
end; end;
function TStaticLEDFunction.GetCurrentState: ILEDState; function TStaticLEDFunction.CreateWorker(ASettings: ILEDFunctionWorkerSettings): ILEDFunctionWorker;
begin begin
if not Assigned(FState) then Result := TStaticLEDFunctionWorker.Create(FColor);
FState := TLEDState.Create('', '', TLEDColorPool.GetColor(FColor));
Result := FState;
end; end;
{ TStaticLEDFunctionWorker }
constructor TStaticLEDFunctionWorker.Create(AColor: TLEDColor);
begin
inherited Create;
FState := TLEDStateWorker.Create('', TLEDColorPool.GetColor(AColor));
end;
function TStaticLEDFunctionWorker.GetCurrentState: ILEDStateWorker;
begin
Result := FState;
end;
initialization initialization
TLEDFunctionRegistry.Register(TStaticLEDFunctionProvider.Create); TLEDFunctionRegistry.Register(TStaticLEDFunctionProvider.Create);

4
G940LEDControl/Units/StaticResources.pas
View File

@ -7,7 +7,7 @@ uses
const const
StaticProviderUID = 'static'; StaticProviderUID = 'static';
StaticFunctionUID: array[TLEDColor] of string = StaticFunctionUID: array[TStaticLEDColor] of string =
( (
'off', 'off',
'green', 'green',
@ -17,7 +17,7 @@ const
StaticCategory = 'Static'; StaticCategory = 'Static';
StaticFunctionDisplayName: array[TLEDColor] of string = StaticFunctionDisplayName: array[TStaticLEDColor] of string =
( (
'Off', 'Off',
'Green', 'Green',