1
0
mirror of synced 2024-11-22 10:03:51 +00:00

Refactored: separated definition and functionality by introducing the Function Worker

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

View File

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

View File

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

View File

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

View File

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

View File

@ -5,7 +5,6 @@ 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',
@ -26,11 +25,13 @@ uses
Profile in 'Units\Profile.pas',
LEDColorPool in 'Units\LEDColorPool.pas',
ButtonFunctionFrm in 'Forms\ButtonFunctionFrm.pas' {ButtonFunctionForm},
FSXLEDFunction in 'Units\FSXLEDFunction.pas',
FSXLEDFunctionProvider in 'Units\FSXLEDFunctionProvider.pas',
StaticResources in 'Units\StaticResources.pas',
FSXResources in 'Units\FSXResources.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}

View File

@ -98,6 +98,7 @@
<DCC_UNIT_PLATFORM>False</DCC_UNIT_PLATFORM>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<DCC_DebugDCUs>true</DCC_DebugDCUs>
<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>
<Manifest_File>F:\Components\X2Utils\Resources\VistaManAsInvoker.manifest</Manifest_File>
@ -164,10 +165,6 @@
</DCCReference>
<DCCReference Include="..\Shared\LogiJoystickDLL.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\G940LEDStateConsumer.pas"/>
<DCCReference Include="Units\LEDFunctionMap.pas"/>
@ -191,11 +188,13 @@
<Form>ButtonFunctionForm</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="Units\FSXLEDFunction.pas"/>
<DCCReference Include="Units\FSXLEDFunctionProvider.pas"/>
<DCCReference Include="Units\StaticResources.pas"/>
<DCCReference Include="Units\FSXResources.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">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>

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.

View File

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

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.

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.

View File

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

View File

@ -2,13 +2,104 @@ unit FSXSimConnectClient;
interface
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
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;
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.

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.

View File

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

View File

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

View File

@ -28,27 +28,14 @@ type
end;
TCustomLEDFunction = class(TInterfacedObject, IObservable, ILEDFunction)
private
FObservers: TInterfaceList;
TCustomLEDFunction = class(TInterfacedObject, ILEDFunction)
protected
procedure NotifyObservers; virtual;
property Observers: TInterfaceList read FObservers;
protected
{ IObservable }
procedure Attach(AObserver: IObserver); virtual;
procedure Detach(AObserver: IObserver); virtual;
{ ILEDFunction }
function GetCategoryName: string; virtual; abstract;
function GetDisplayName: string; virtual; abstract;
function GetUID: string; virtual; abstract;
function GetCurrentState: ILEDState; virtual; abstract;
public
constructor Create;
destructor Destroy; override;
function CreateWorker(ASettings: ILEDFunctionWorkerSettings): ILEDFunctionWorker; virtual; abstract;
end;
@ -56,7 +43,6 @@ type
private
FStates: TInterfaceList;
protected
// procedure SetCurrentState(AState: ILEDState); virtual;
procedure RegisterStates; virtual; abstract;
function RegisterState(AState: ILEDState): ILEDState; virtual;
protected
@ -68,6 +54,32 @@ type
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)
private
FList: TInterfaceList;
@ -97,36 +109,11 @@ type
implementation
uses
SysUtils;
System.SysUtils,
{ TCustomLEDFunction }
constructor TCustomLEDFunction.Create;
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;
LEDColorIntf,
LEDColorPool,
LEDState;
{ TCustomMultiStateLEDFunction }
@ -160,14 +147,79 @@ begin
end;
//procedure TCustomMultiStateLEDFunction.SetCurrentState(AState: ILEDState);
//begin
// FCurrentState := AState;
// NotifyObservers;
//end;
{ TCustomLEDFunctionWorker }
constructor TCustomLEDFunctionWorker.Create;
begin
inherited Create;
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
observer: IInterface;

View File

@ -9,6 +9,8 @@ uses
type
ILEDFunction = interface;
ILEDFunctionWorker = interface;
ILEDFunctionWorkerSettings = interface;
ILEDFunctionEnumerator = interface;
ILEDStateEnumerator = interface;
@ -22,13 +24,13 @@ type
end;
ILEDFunction = interface(IObservable)
ILEDFunction = interface
['{7087067A-1016-4A7D-ACB1-BA1F388DAD6C}']
function GetCategoryName: string;
function GetDisplayName: string;
function GetUID: string;
function GetCurrentState: ILEDState;
function CreateWorker(ASettings: ILEDFunctionWorkerSettings): ILEDFunctionWorker;
end;
@ -38,6 +40,18 @@ type
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
['{A03E4E54-19CB-4C08-AD5F-20265817086D}']
function GetCurrent: ILEDFunction;

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.

View File

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

View File

@ -6,11 +6,21 @@ uses
type
ILEDState = interface
['{0361CBD5-E64E-4972-A8A4-D5FE0B0DFB1C}']
function GetDisplayName: string;
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: ILEDColor;
end;

View File

@ -4,18 +4,33 @@ interface
uses
Generics.Collections,
X2UtPersistIntf;
X2UtPersistIntf,
LEDColorIntf;
type
TProfileButtonStateColors = TDictionary<string,TLEDColor>;
TProfileButton = class(TObject)
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 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;
@ -57,29 +72,106 @@ type
implementation
uses
Classes,
SysUtils;
SysUtils,
LEDResources;
const
SectionProfiles = 'Profiles';
SectionButton = 'Button';
SectionStates = 'States';
KeyProviderUID = 'ProviderUID';
KeyFunctionUID = 'FunctionUID';
{ 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;
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;

View File

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

View File

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