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

Added: start of button configuration form

This commit is contained in:
Mark van Renswoude 2013-02-10 20:39:34 +00:00
parent 9da668afc1
commit 9929578ef0
14 changed files with 786 additions and 114 deletions

View File

@ -0,0 +1,196 @@
object ButtonFunctionForm: TButtonFunctionForm
Left = 0
Top = 0
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'Configure button'
ClientHeight = 401
ClientWidth = 692
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poMainFormCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object pnlButtons: TPanel
Left = 0
Top = 360
Width = 692
Height = 41
Align = alBottom
BevelOuter = bvNone
TabOrder = 0
ExplicitLeft = 168
ExplicitTop = 232
ExplicitWidth = 185
DesignSize = (
692
41)
object btnOK: TButton
Left = 528
Top = 8
Width = 75
Height = 25
Anchors = [akTop, akRight]
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 0
ExplicitLeft = 467
end
object btnCancel: TButton
Left = 609
Top = 8
Width = 75
Height = 25
Anchors = [akTop, akRight]
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
ExplicitLeft = 548
end
end
object vstFunctions: TVirtualStringTree
AlignWithMargins = True
Left = 8
Top = 8
Width = 257
Height = 352
Margins.Left = 8
Margins.Top = 8
Margins.Right = 0
Margins.Bottom = 0
Align = alLeft
Header.AutoSizeIndex = 0
Header.Font.Charset = DEFAULT_CHARSET
Header.Font.Color = clWindowText
Header.Font.Height = -11
Header.Font.Name = 'Tahoma'
Header.Font.Style = []
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]
TabOrder = 1
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowTreeLines, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect]
OnGetText = vstFunctionsGetText
Columns = <
item
Position = 0
Width = 253
WideText = 'Available functions'
end>
end
object pnlFunction: TPanel
AlignWithMargins = True
Left = 273
Top = 8
Width = 411
Height = 352
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 0
Align = alClient
BevelOuter = bvNone
TabOrder = 2
ExplicitLeft = 224
ExplicitTop = 192
ExplicitWidth = 185
ExplicitHeight = 41
object vstStates: TVirtualStringTree
Left = 0
Top = 113
Width = 411
Height = 239
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.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]
TabOrder = 0
ExplicitTop = 93
ExplicitWidth = 407
ExplicitHeight = 259
Columns = <
item
Position = 0
Width = 207
WideText = 'State'
end
item
Position = 1
Width = 200
WideText = 'Color'
end>
end
object pnlName: TPanel
Left = 0
Top = 0
Width = 411
Height = 113
Align = alTop
BevelOuter = bvNone
TabOrder = 1
ExplicitWidth = 407
DesignSize = (
411
113)
object lblFunctionName: TLabel
Left = 0
Top = 19
Width = 405
Height = 19
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = 'runtime: function'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
ExplicitWidth = 401
end
object lblCategoryName: TLabel
Left = 0
Top = 0
Width = 405
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = 'runtime: category'
ExplicitWidth = 401
end
object lblHasStates: TLabel
Left = 0
Top = 74
Width = 401
Height = 31
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.'
WordWrap = True
end
object lblNoStates: TLabel
Left = 0
Top = 55
Width = 195
Height = 13
Caption = 'This function has no configurable states.'
Visible = False
end
end
end
end

View File

@ -0,0 +1,176 @@
unit ButtonFunctionFrm;
interface
uses
System.Classes,
Vcl.Controls,
Vcl.ExtCtrls,
Vcl.Forms,
Vcl.StdCtrls,
VirtualTrees,
Profile;
type
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;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure vstFunctionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
private
FButtonIndex: Integer;
FProfile: TProfile;
protected
procedure LoadFunctions;
property ButtonIndex: Integer read FButtonIndex write FButtonIndex;
property Profile: TProfile read FProfile write FProfile;
public
class function Execute(AProfile: TProfile; AButtonIndex: Integer): Boolean;
end;
implementation
uses
System.SysUtils,
Generics.Collections,
LEDFunctionIntf,
LEDFunctionRegistry;
type
TNodeType = (ntCategory, ntFunction);
TNodeData = record
NodeType: TNodeType;
Provider: ILEDFunctionProvider;
LEDFunction: ILEDFunction;
end;
PNodeData = ^TNodeData;
{$R *.dfm}
{ TButtonFunctionForm }
class function TButtonFunctionForm.Execute(AProfile: TProfile; AButtonIndex: Integer): Boolean;
begin
with Self.Create(nil) do
try
Profile := AProfile;
ButtonIndex := AButtonIndex;
Result := (ShowModal = mrOk);
finally
Free;
end;
end;
procedure TButtonFunctionForm.FormCreate(Sender: TObject);
begin
vstFunctions.NodeDataSize := SizeOf(TNodeData);
lblNoStates.Top := lblHasStates.Top;
lblCategoryName.Caption := '';
lblFunctionName.Caption := '';
LoadFunctions;
end;
procedure TButtonFunctionForm.FormDestroy(Sender: TObject);
begin
//
end;
procedure TButtonFunctionForm.LoadFunctions;
var
categoryNodes: TDictionary<string,PVirtualNode>;
function GetCategoryNode(AProvider: ILEDFunctionProvider; AFunction: ILEDFunction): PVirtualNode;
var
category: string;
nodeData: PNodeData;
begin
category := AFunction.GetCategoryName;
if not categoryNodes.ContainsKey(category) then
begin
Result := vstFunctions.AddChild(nil);
Include(Result^.States, vsExpanded);
nodeData := vstFunctions.GetNodeData(Result);
nodeData^.NodeType := ntCategory;
nodeData^.Provider := AProvider;
nodeData^.LEDFunction := AFunction;
categoryNodes.Add(category, Result);
end else
Result := categoryNodes.Items[category];
end;
var
node: PVirtualNode;
nodeData: PNodeData;
provider: ILEDFunctionProvider;
ledFunction: ILEDFunction;
begin
vstFunctions.BeginUpdate;
try
vstFunctions.Clear;
categoryNodes := TDictionary<string, PVirtualNode>.Create;
try
for provider in TLEDFunctionRegistry.Providers do
begin
for ledFunction in provider do
begin
node := vstFunctions.AddChild(GetCategoryNode(provider, ledFunction));
nodeData := vstFunctions.GetNodeData(node);
nodeData^.NodeType := ntFunction;
nodeData^.Provider := provider;
nodeData^.LEDFunction := ledFunction;
end;
end;
finally
FreeAndNil(categoryNodes);
end;
finally
vstFunctions.EndUpdate;
end;
end;
procedure TButtonFunctionForm.vstFunctionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: string);
var
nodeData: PNodeData;
begin
nodeData := Sender.GetNodeData(Node);
case nodeData^.NodeType of
ntCategory: CellText := nodeData^.LEDFunction.GetCategoryName;
ntFunction: CellText := nodeData^.LEDFunction.GetDisplayName;
end;
end;
end.

View File

@ -43,7 +43,7 @@ object MainForm: TMainForm
446) 446)
object lblP1Function: TLabel object lblP1Function: TLabel
Left = 64 Left = 64
Top = 89 Top = 73
Width = 364 Width = 364
Height = 13 Height = 13
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
@ -56,54 +56,24 @@ object MainForm: TMainForm
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
ExplicitWidth = 421
end end
object lblP1Category: TLabel object lblP1Category: TLabel
Left = 64 Left = 64
Top = 73 Top = 89
Width = 364 Width = 364
Height = 13 Height = 13
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
AutoSize = False AutoSize = False
Caption = '[runtime: category]' Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis EllipsisPosition = epEndEllipsis
ExplicitWidth = 421
end end
object lblP2Function: TLabel object lblP2Function: TLabel
Left = 64
Top = 136
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: function]'
EllipsisPosition = epEndEllipsis
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
ExplicitWidth = 421
end
object lblP2Category: TLabel
Left = 64 Left = 64
Top = 120 Top = 120
Width = 364 Width = 364
Height = 13 Height = 13
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
AutoSize = False AutoSize = False
Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis
ExplicitWidth = 421
end
object lblP3Function: TLabel
Left = 64
Top = 183
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: function]' Caption = '[runtime: function]'
EllipsisPosition = epEndEllipsis EllipsisPosition = epEndEllipsis
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@ -112,26 +82,24 @@ object MainForm: TMainForm
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
ExplicitWidth = 421
end end
object lblP3Category: TLabel object lblP2Category: TLabel
Left = 64
Top = 136
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis
end
object lblP3Function: TLabel
Left = 64 Left = 64
Top = 167 Top = 167
Width = 364 Width = 364
Height = 13 Height = 13
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
AutoSize = False AutoSize = False
Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis
ExplicitWidth = 421
end
object lblP4Function: TLabel
Left = 64
Top = 230
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: function]' Caption = '[runtime: function]'
EllipsisPosition = epEndEllipsis EllipsisPosition = epEndEllipsis
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@ -140,26 +108,24 @@ object MainForm: TMainForm
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
ExplicitWidth = 421
end end
object lblP4Category: TLabel object lblP3Category: TLabel
Left = 64
Top = 183
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis
end
object lblP4Function: TLabel
Left = 64 Left = 64
Top = 214 Top = 214
Width = 364 Width = 364
Height = 13 Height = 13
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
AutoSize = False AutoSize = False
Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis
ExplicitWidth = 421
end
object lblP5Function: TLabel
Left = 64
Top = 277
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: function]' Caption = '[runtime: function]'
EllipsisPosition = epEndEllipsis EllipsisPosition = epEndEllipsis
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@ -168,26 +134,24 @@ object MainForm: TMainForm
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
ExplicitWidth = 421
end end
object lblP5Category: TLabel object lblP4Category: TLabel
Left = 64
Top = 230
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis
end
object lblP5Function: TLabel
Left = 64 Left = 64
Top = 261 Top = 261
Width = 364 Width = 364
Height = 13 Height = 13
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
AutoSize = False AutoSize = False
Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis
ExplicitWidth = 421
end
object lblP6Function: TLabel
Left = 64
Top = 324
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: function]' Caption = '[runtime: function]'
EllipsisPosition = epEndEllipsis EllipsisPosition = epEndEllipsis
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@ -196,26 +160,24 @@ object MainForm: TMainForm
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
ExplicitWidth = 421
end end
object lblP6Category: TLabel object lblP5Category: TLabel
Left = 64
Top = 277
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis
end
object lblP6Function: TLabel
Left = 64 Left = 64
Top = 308 Top = 308
Width = 364 Width = 364
Height = 13 Height = 13
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
AutoSize = False AutoSize = False
Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis
ExplicitWidth = 421
end
object lblP7Function: TLabel
Left = 64
Top = 371
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: function]' Caption = '[runtime: function]'
EllipsisPosition = epEndEllipsis EllipsisPosition = epEndEllipsis
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@ -224,22 +186,46 @@ object MainForm: TMainForm
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
ExplicitWidth = 421
end end
object lblP7Category: TLabel object lblP6Category: TLabel
Left = 64
Top = 324
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis
end
object lblP7Function: TLabel
Left = 64 Left = 64
Top = 355 Top = 355
Width = 364 Width = 364
Height = 13 Height = 13
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
AutoSize = False AutoSize = False
Caption = '[runtime: function]'
EllipsisPosition = epEndEllipsis
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object lblP7Category: TLabel
Left = 64
Top = 371
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: category]' Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis EllipsisPosition = epEndEllipsis
ExplicitWidth = 421
end end
object lblP8Function: TLabel object lblP8Function: TLabel
Left = 64 Left = 64
Top = 418 Top = 402
Width = 364 Width = 364
Height = 13 Height = 13
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
@ -252,18 +238,16 @@ object MainForm: TMainForm
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
ExplicitWidth = 421
end end
object lblP8Category: TLabel object lblP8Category: TLabel
Left = 64 Left = 64
Top = 402 Top = 418
Width = 364 Width = 364
Height = 13 Height = 13
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
AutoSize = False AutoSize = False
Caption = '[runtime: category]' Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis EllipsisPosition = epEndEllipsis
ExplicitWidth = 421
end end
object lblProfile: TLabel object lblProfile: TLabel
Left = 11 Left = 11
@ -350,8 +334,9 @@ object MainForm: TMainForm
Height = 21 Height = 21
Style = csDropDownList Style = csDropDownList
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
Sorted = True
TabOrder = 8 TabOrder = 8
ExplicitWidth = 270 OnClick = cmbProfilesClick
end end
object btnSaveProfile: TButton object btnSaveProfile: TButton
Left = 283 Left = 283

View File

@ -100,12 +100,15 @@ type
procedure btnCheckUpdatesClick(Sender: TObject); procedure btnCheckUpdatesClick(Sender: TObject);
procedure LEDButtonClick(Sender: TObject); procedure LEDButtonClick(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure cmbProfilesClick(Sender: TObject);
private private
FLEDControls: array[0..LED_COUNT - 1] of TLEDControls; FLEDControls: array[0..LED_COUNT - 1] of TLEDControls;
FEventMonitor: TOmniEventMonitor; FEventMonitor: TOmniEventMonitor;
FProfilesFilename: string; FProfilesFilename: string;
FProfiles: TProfileList; FProfiles: TProfileList;
FActiveProfile: TProfile;
FLoadingProfiles: Boolean;
// FStateConsumerTask: IOmniTaskControl; // FStateConsumerTask: IOmniTaskControl;
protected protected
// procedure ReadFunctions(AReader: IX2PersistReader; AComboBoxes: TComboBoxArray); // procedure ReadFunctions(AReader: IX2PersistReader; AComboBoxes: TComboBoxArray);
@ -120,9 +123,8 @@ type
procedure SaveProfiles; procedure SaveProfiles;
function CreateDefaultProfile: TProfile; function CreateDefaultProfile: TProfile;
procedure LoadActiveProfile;
// procedure LoadDefaultProfile; procedure UpdateButton(AProfile: TProfile; AButtonIndex: Integer);
// procedure SaveDefaultProfile;
procedure SetDeviceState(const AMessage: string; AFound: Boolean); procedure SetDeviceState(const AMessage: string; AFound: Boolean);
// procedure SetFSXToggleZoomButton(const ADeviceGUID: TGUID; AButtonIndex: Integer; const ADisplayText: string); // procedure SetFSXToggleZoomButton(const ADeviceGUID: TGUID; AButtonIndex: Integer; const ADisplayText: string);
@ -145,6 +147,7 @@ type
procedure CMAskAutoUpdate(var Msg: TMessage); message CM_ASKAUTOUPDATE; procedure CMAskAutoUpdate(var Msg: TMessage); message CM_ASKAUTOUPDATE;
property ActiveProfile: TProfile read FActiveProfile;
property EventMonitor: TOmniEventMonitor read FEventMonitor; property EventMonitor: TOmniEventMonitor read FEventMonitor;
property Profiles: TProfileList read FProfiles; property Profiles: TProfileList read FProfiles;
// property StateConsumerTask: IOmniTaskControl read FStateConsumerTask; // property StateConsumerTask: IOmniTaskControl read FStateConsumerTask;
@ -155,6 +158,7 @@ implementation
uses uses
ComObj, ComObj,
Dialogs, Dialogs,
Graphics,
ShellAPI, ShellAPI,
SysUtils, SysUtils,
@ -164,11 +168,13 @@ uses
X2UtApp, X2UtApp,
X2UtPersistXML, X2UtPersistXML,
ButtonSelectFrm, ButtonFunctionFrm,
ConfigConversion, ConfigConversion,
FSXLEDStateProvider, FSXLEDStateProvider,
G940LEDStateConsumer, G940LEDStateConsumer,
LEDColorIntf, LEDColorIntf,
LEDFunctionIntf,
LEDFunctionRegistry,
StaticLEDFunction; StaticLEDFunction;
@ -176,7 +182,7 @@ uses
const const
NameDefaultProfile = 'Default'; DefaultProfileName = 'Default';
FILENAME_PROFILES = 'G940LEDControl\Profiles.xml'; FILENAME_PROFILES = 'G940LEDControl\Profiles.xml';
@ -284,6 +290,7 @@ begin
FLEDControls[ledIndex].ConfigureButton.OnClick := LEDButtonClick; FLEDControls[ledIndex].ConfigureButton.OnClick := LEDButtonClick;
FLEDControls[ledIndex].CategoryLabel.Caption := ''; FLEDControls[ledIndex].CategoryLabel.Caption := '';
FLEDControls[ledIndex].CategoryLabel.Font.Color := clGrayText;
FLEDControls[ledIndex].FunctionLabel.Caption := ''; FLEDControls[ledIndex].FunctionLabel.Caption := '';
end; end;
end; end;
@ -293,6 +300,7 @@ procedure TMainForm.LoadProfiles;
var var
defaultProfile: TProfile; defaultProfile: TProfile;
persistXML: TX2UtPersistXML; persistXML: TX2UtPersistXML;
profile: TProfile;
begin begin
if not FileExists(FProfilesFilename) then if not FileExists(FProfilesFilename) then
@ -305,7 +313,7 @@ begin
if Assigned(defaultProfile) then if Assigned(defaultProfile) then
begin begin
defaultProfile.Name := NameDefaultProfile; defaultProfile.Name := DefaultProfileName;
Profiles.Add(defaultProfile); Profiles.Add(defaultProfile);
end; end;
end else end else
@ -318,6 +326,29 @@ begin
FreeAndNil(persistXML); FreeAndNil(persistXML);
end; end;
end; end;
FLoadingProfiles := True;
try
cmbProfiles.Items.BeginUpdate;
try
cmbProfiles.Items.Clear;
for profile in Profiles do
cmbProfiles.Items.AddObject(profile.Name, profile);
finally
cmbProfiles.Items.EndUpdate;
if cmbProfiles.Items.Count > 0 then
begin
cmbProfiles.ItemIndex := 0;
FActiveProfile := TProfile(cmbProfiles.Items.Objects[0]);
LoadActiveProfile;
end;
end;
finally
FLoadingProfiles := False;
end;
end; end;
@ -337,18 +368,68 @@ end;
function TMainForm.CreateDefaultProfile: TProfile; function TMainForm.CreateDefaultProfile: TProfile;
var
ledIndex: Integer;
button: TProfileButton;
begin begin
{ Default button functions are assigned during UpdateButton }
Result := TProfile.Create; Result := TProfile.Create;
end;
procedure TMainForm.LoadActiveProfile;
var
buttonIndex: Integer;
for ledIndex := 0 to Pred(LED_COUNT) do
begin begin
button := Result.Buttons[ledIndex]; if not Assigned(ActiveProfile) then
button.ProviderUID := StaticProviderUID; exit;
button.FunctionUID := StaticFunctionUID[lcGreen];
for buttonIndex := 0 to Pred(LED_COUNT) do
UpdateButton(ActiveProfile, buttonIndex);
end;
procedure TMainForm.UpdateButton(AProfile: TProfile; AButtonIndex: Integer);
var
button: TProfileButton;
providerUID: string;
functionUID: string;
provider: ILEDFunctionProvider;
buttonFunction: ILEDFunction;
begin
if AProfile.HasButton(AButtonIndex) then
begin
button := AProfile.Buttons[AButtonIndex];
providerUID := button.ProviderUID;
functionUID := button.FunctionUID;
end else
begin
providerUID := StaticProviderUID;
functionUID := StaticFunctionUID[lcGreen];
end;
buttonFunction := nil;
provider := TLEDFunctionRegistry.Find(providerUID);
if Assigned(provider) then
buttonFunction := provider.Find(functionUID);
if Assigned(buttonFunction) then
begin
FLEDControls[AButtonIndex].CategoryLabel.Caption := buttonFunction.GetCategoryName;
FLEDControls[AButtonIndex].FunctionLabel.Caption := buttonFunction.GetDisplayName;
end;
end;
procedure TMainForm.cmbProfilesClick(Sender: TObject);
begin
if not FLoadingProfiles then
begin
if cmbProfiles.ItemIndex > -1 then
FActiveProfile := TProfile(cmbProfiles.Items.Objects[cmbProfiles.ItemIndex])
else
FActiveProfile := nil;
LoadActiveProfile;
end; end;
end; end;
@ -518,11 +599,15 @@ end;
procedure TMainForm.LEDButtonClick(Sender: TObject); procedure TMainForm.LEDButtonClick(Sender: TObject);
var var
ledIndex: NativeInt; buttonIndex: NativeInt;
begin begin
ledIndex := (Sender as TComponent).Tag; if not Assigned(ActiveProfile) then
// TODO configure led exit;
buttonIndex := (Sender as TComponent).Tag;
if TButtonFunctionForm.Execute(ActiveProfile, buttonIndex) then
UpdateButton(ActiveProfile, buttonIndex);
end; end;

View File

@ -23,7 +23,9 @@ uses
DynamicLEDColor in 'Units\DynamicLEDColor.pas', DynamicLEDColor in 'Units\DynamicLEDColor.pas',
LEDStateIntf in 'Units\LEDStateIntf.pas', LEDStateIntf in 'Units\LEDStateIntf.pas',
LEDState in 'Units\LEDState.pas', LEDState in 'Units\LEDState.pas',
Profile in 'Units\Profile.pas'; Profile in 'Units\Profile.pas',
LEDColorPool in 'Units\LEDColorPool.pas',
ButtonFunctionFrm in 'Forms\ButtonFunctionFrm.pas' {ButtonFunctionForm};
{$R *.res} {$R *.res}

View File

@ -186,6 +186,11 @@
<DCCReference Include="Units\LEDStateIntf.pas"/> <DCCReference Include="Units\LEDStateIntf.pas"/>
<DCCReference Include="Units\LEDState.pas"/> <DCCReference Include="Units\LEDState.pas"/>
<DCCReference Include="Units\Profile.pas"/> <DCCReference Include="Units\Profile.pas"/>
<DCCReference Include="Units\LEDColorPool.pas"/>
<DCCReference Include="Forms\ButtonFunctionFrm.pas">
<Form>ButtonFunctionForm</Form>
<FormType>dfm</FormType>
</DCCReference>
<BuildConfiguration Include="Debug"> <BuildConfiguration Include="Debug">
<Key>Cfg_2</Key> <Key>Cfg_2</Key>
<CfgParent>Base</CfgParent> <CfgParent>Base</CfgParent>

View File

@ -14,6 +14,8 @@ function Convert0To1: TProfile;
begin begin
Result := nil; Result := nil;
// FUNCTION_NONE = 0; // FUNCTION_NONE = 0;
// FUNCTION_OFF = 1; // FUNCTION_OFF = 1;
// FUNCTION_RED = 2; // FUNCTION_RED = 2;

View File

@ -0,0 +1,101 @@
unit LEDColorPool;
interface
uses
LEDColorIntf;
type
TLEDColorPoolEntry = (cpeStaticOff,
cpeStaticGreen,
cpeStaticAmber,
cpeStaticRed,
cpeFlashingGreenFast,
cpeFlashingGreenNormal,
cpeFlashingAmberFast,
cpeFlashingAmberNormal,
cpeFlashingRedFast,
cpeFlashingRedNormal);
TLEDColorPool = class(TObject)
private
FStates: array[TLEDColorPoolEntry] of ILEDColor;
protected
class function Instance: TLEDColorPool;
function DoGetColor(AEntry: TLEDColorPoolEntry): ILEDColor;
public
class function GetColor(AEntry: TLEDColorPoolEntry): ILEDColor;
end;
implementation
uses
SysUtils,
DynamicLEDColor,
StaticLEDColor;
var
LEDColorPoolInstance: TLEDColorPool;
{ TLEDStatePool }
class function TLEDColorPool.GetColor(AEntry: TLEDColorPoolEntry): ILEDColor;
begin
Result := Instance.DoGetColor(AEntry);
end;
class function TLEDColorPool.Instance: TLEDColorPool;
begin
if not Assigned(LEDColorPoolInstance) then
LEDColorPoolInstance := TLEDColorPool.Create;
Result := LEDColorPoolInstance;
end;
function TLEDColorPool.DoGetColor(AEntry: TLEDColorPoolEntry): ILEDColor;
function GetFlashingCycle(AColor: TLEDColor): TLEDColorDynArray;
begin
SetLength(Result, 2);
Result[0] := AColor;
Result[1] := lcOff;
end;
var
state: ILEDColor;
begin
if not Assigned(FStates[AEntry]) 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);
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);
end;
FStates[AEntry] := state;
Result := state;
end else
Result := FStates[AEntry];
end;
initialization
finalization
FreeAndNil(LEDColorPoolInstance);
end.

View File

@ -18,8 +18,9 @@ type
protected protected
{ ILEDFunctionProvider } { ILEDFunctionProvider }
function GetUID: string; virtual; abstract; function GetUID: string; virtual; abstract;
function GetEnumerator: ILEDFunctionEnumerator; virtual; function GetEnumerator: ILEDFunctionEnumerator; virtual;
function Find(const AFunctionUID: string): ILEDFunction; virtual;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
@ -157,6 +158,22 @@ begin
end; end;
function TCustomLEDFunctionProvider.Find(const AFunctionUID: string): ILEDFunction;
var
ledFunction: ILEDFunction;
begin
Result := nil;
for ledFunction in (Self as ILEDFunctionProvider) do
if ledFunction.GetUID = AFunctionUID then
begin
Result := ledFunction;
break;
end;
end;
procedure TCustomLEDFunctionProvider.RegisterFunction(AFunction: ILEDFunction); procedure TCustomLEDFunctionProvider.RegisterFunction(AFunction: ILEDFunction);
begin begin
FFunctions.Add(AFunction as ILEDFunction); FFunctions.Add(AFunction as ILEDFunction);

View File

@ -8,6 +8,7 @@ uses
type type
ILEDFunction = interface;
ILEDFunctionEnumerator = interface; ILEDFunctionEnumerator = interface;
ILEDStateEnumerator = interface; ILEDStateEnumerator = interface;
@ -15,8 +16,9 @@ type
ILEDFunctionProvider = interface ILEDFunctionProvider = interface
['{B38F6F90-DC96-42CE-B8F0-21F0DD8AA537}'] ['{B38F6F90-DC96-42CE-B8F0-21F0DD8AA537}']
function GetUID: string; function GetUID: string;
function GetEnumerator: ILEDFunctionEnumerator; function GetEnumerator: ILEDFunctionEnumerator;
function Find(const AFunctionUID: string): ILEDFunction;
end; end;
@ -26,11 +28,16 @@ type
function GetDisplayName: string; function GetDisplayName: string;
function GetUID: string; function GetUID: string;
function GetEnumerator: ILEDStateEnumerator;
function GetCurrentState: ILEDState; function GetCurrentState: ILEDState;
end; end;
ILEDMultiStateFunction = interface(ILEDFunction)
['{F16ADF7E-1C1C-4676-8D4F-135B68A80B52}']
function GetEnumerator: ILEDStateEnumerator;
end;
ILEDFunctionEnumerator = interface ILEDFunctionEnumerator = interface
['{A03E4E54-19CB-4C08-AD5F-20265817086D}'] ['{A03E4E54-19CB-4C08-AD5F-20265817086D}']
function GetCurrent: ILEDFunction; function GetCurrent: ILEDFunction;

View File

@ -0,0 +1,57 @@
unit LEDState;
interface
uses
LEDColorIntf,
LEDStateIntf;
type
TLEDState = class(TInterfacedObject, ILEDState)
private
FDisplayName: string;
FUID: string;
FColor: ILEDColor;
protected
{ ILEDState }
function GetDisplayName: string;
function GetUID: string;
function GetColor: ILEDColor;
public
constructor Create(const AUID, ADisplayName: string; AColor: ILEDColor);
end;
implementation
{ TLEDState }
constructor TLEDState.Create(const AUID, ADisplayName: string; AColor: ILEDColor);
begin
inherited Create;
FUID := AUID;
FDisplayName := ADisplayName;
FColor := AColor;
end;
function TLEDState.GetDisplayName: string;
begin
Result := FDisplayName;
end;
function TLEDState.GetUID: string;
begin
Result := FUID;
end;
function TLEDState.GetColor: ILEDColor;
begin
Result := FColor;
end;
end.

View File

@ -0,0 +1,20 @@
unit LEDStateIntf;
interface
uses
LEDColorIntf;
type
ILEDState = interface
['{0361CBD5-E64E-4972-A8A4-D5FE0B0DFB1C}']
function GetDisplayName: string;
function GetUID: string;
function GetColor: ILEDColor;
end;
implementation
end.

View File

@ -38,6 +38,8 @@ type
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
function HasButton(AIndex: Integer): Boolean;
property Name: string read FName write FName; property Name: string read FName write FName;
property ButtonCount: Integer read GetButtonCount; property ButtonCount: Integer read GetButtonCount;
@ -140,6 +142,13 @@ begin
end; end;
function TProfile.HasButton(AIndex: Integer): Boolean;
begin
Result := (FButtons.Count > AIndex) and
Assigned(FButtons[AIndex]);
end;
function TProfile.GetButtonCount: Integer; function TProfile.GetButtonCount: Integer;
begin begin
Result := FButtons.Count; Result := FButtons.Count;

View File

@ -3,7 +3,8 @@ unit StaticLEDFunction;
interface interface
uses uses
LEDFunction, LEDFunction,
LEDColorIntf; LEDColorIntf,
LEDStateIntf;
type type
@ -22,6 +23,8 @@ type
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;
public public
constructor Create(AColor: TLEDColor); constructor Create(AColor: TLEDColor);
end; end;
@ -101,6 +104,13 @@ begin
end; end;
function TStaticLEDFunction.GetCurrentState: ILEDState;
begin
end;
initialization initialization
TLEDFunctionRegistry.Register(TStaticLEDFunctionProvider.Create); TLEDFunctionRegistry.Register(TStaticLEDFunctionProvider.Create);