GitHub-Mirror/G940LEDControl
1
0
Fork 0
mirror of synced 2024-11-05 02:59:16 +00:00
Code Issues Projects Releases Wiki Activity

Added: State abstraction layer; provides the ability for the user to select a color for each state a function supports

Browse Source 
Added: loading/saving profiles
This commit is contained in:
Mark van Renswoude 2013-02-10 16:39:00 +00:00
parent 688b859f66
commit 9da668afc1
17 changed files with 1200 additions and 887 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

755
G940LEDControl/Forms/MainFrm.dfm
View File

@ -4,7 +4,7 @@ object MainForm: TMainForm
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'G940 LED Control'
ClientHeight = 513
ClientHeight = 562
ClientWidth = 465
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
@ -16,14 +16,15 @@ object MainForm: TMainForm
Position = poScreenCenter
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object pcConnections: TPageControl
object PageControl: TPageControl
AlignWithMargins = True
Left = 8
Top = 80
Width = 449
Height = 425
Height = 474
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
@ -31,417 +32,353 @@ object MainForm: TMainForm
ActivePage = tsFSX
Align = alClient
TabOrder = 1
ExplicitWidth = 390
ExplicitHeight = 510
object tsFSX: TTabSheet
Caption = 'Flight Simulator X'
object gbFSXConnection: TGroupBox
AlignWithMargins = True
Left = 6
Top = 6
Width = 429
Height = 63
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 0
Align = alTop
Caption = ' Connection '
TabOrder = 0
object lblFSXLocal: TLabel
Left = 12
Top = 29
Width = 24
Height = 13
Caption = 'Local'
end
object btnFSXConnect: TButton
Left = 69
Top = 24
Width = 75
Height = 25
Caption = '&Connect'
TabOrder = 0
OnClick = btnFSXConnectClick
end
object btnFSXDisconnect: TButton
Left = 150
Top = 24
Width = 75
Height = 25
Caption = '&Disconnect'
Enabled = False
TabOrder = 1
OnClick = btnFSXDisconnectClick
end
Caption = 'Configuration'
ExplicitWidth = 382
ExplicitHeight = 482
DesignSize = (
441
446)
object lblP1Function: TLabel
Left = 64
Top = 89
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 pcFSXOptions: TPageControl
AlignWithMargins = True
Left = 6
Top = 75
Width = 429
Height = 316
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
ActivePage = tsFSXLEDButtons
Align = alClient
object lblP1Category: TLabel
Left = 64
Top = 73
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis
ExplicitWidth = 421
end
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
Top = 120
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
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]'
EllipsisPosition = epEndEllipsis
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
ExplicitWidth = 421
end
object lblP3Category: TLabel
Left = 64
Top = 167
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
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]'
EllipsisPosition = epEndEllipsis
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
ExplicitWidth = 421
end
object lblP4Category: TLabel
Left = 64
Top = 214
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
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]'
EllipsisPosition = epEndEllipsis
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
ExplicitWidth = 421
end
object lblP5Category: TLabel
Left = 64
Top = 261
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
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]'
EllipsisPosition = epEndEllipsis
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
ExplicitWidth = 421
end
object lblP6Category: TLabel
Left = 64
Top = 308
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
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]'
EllipsisPosition = epEndEllipsis
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
ExplicitWidth = 421
end
object lblP7Category: TLabel
Left = 64
Top = 355
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis
ExplicitWidth = 421
end
object lblP8Function: TLabel
Left = 64
Top = 418
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 lblP8Category: TLabel
Left = 64
Top = 402
Width = 364
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = '[runtime: category]'
EllipsisPosition = epEndEllipsis
ExplicitWidth = 421
end
object lblProfile: TLabel
Left = 11
Top = 19
Width = 30
Height = 13
Caption = 'Profile'
end
object bvlProfiles: TBevel
Left = 11
Top = 52
Width = 474
Height = 13
Shape = bsTopLine
end
object btnP1: TButton
Left = 11
Top = 67
Width = 41
Height = 41
Caption = 'P1'
TabOrder = 0
end
object btnP2: TButton
Left = 11
Top = 114
Width = 41
Height = 41
Caption = 'P2'
TabOrder = 1
object tsFSXLEDButtons: TTabSheet
Caption = 'LED Buttons'
object gbFSXButtons: TGroupBox
AlignWithMargins = True
Left = 6
Top = 6
Width = 409
Height = 251
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
Align = alTop
Caption = ' Button configuration '
TabOrder = 0
DesignSize = (
409
251)
object lblFSXP1: TLabel
Left = 12
Top = 27
Width = 12
Height = 13
Caption = 'P1'
end
object lblFSXP2: TLabel
Left = 12
Top = 54
Width = 12
Height = 13
Caption = 'P2'
end
object lblFSXP3: TLabel
Left = 12
Top = 81
Width = 12
Height = 13
Caption = 'P3'
end
object lblFSXP4: TLabel
Left = 12
Top = 108
Width = 12
Height = 13
Caption = 'P4'
end
object lblFSXP5: TLabel
Left = 12
Top = 135
Width = 12
Height = 13
Caption = 'P5'
end
object lblFSXP6: TLabel
Left = 12
Top = 162
Width = 12
Height = 13
Caption = 'P6'
end
object lblFSXP7: TLabel
Left = 12
Top = 189
Width = 12
Height = 13
Caption = 'P7'
end
object lblFSXP8: TLabel
Left = 12
Top = 216
Width = 12
Height = 13
Caption = 'P8'
end
object cmbFSXP1: TComboBoxEx
Left = 69
Top = 24
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 0
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP2: TComboBoxEx
Tag = 1
Left = 69
Top = 50
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 1
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP3: TComboBoxEx
Tag = 2
Left = 69
Top = 78
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 2
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP4: TComboBoxEx
Tag = 3
Left = 69
Top = 105
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 3
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP5: TComboBoxEx
Tag = 4
Left = 69
Top = 131
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 4
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP6: TComboBoxEx
Tag = 5
Left = 69
Top = 159
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 5
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP7: TComboBoxEx
Tag = 6
Left = 69
Top = 186
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 6
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
object cmbFSXP8: TComboBoxEx
Tag = 7
Left = 69
Top = 213
Width = 328
Height = 22
ItemsEx = <>
Style = csExDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 7
OnChange = FunctionComboBoxChange
DropDownCount = 20
end
end
end
object tsFSXExtra: TTabSheet
Caption = 'Extra'
ImageIndex = 1
TabVisible = False
object GroupBox1: TGroupBox
AlignWithMargins = True
Left = 6
Top = 6
Width = 409
Height = 171
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 0
Align = alTop
Caption = ' Zoom '
TabOrder = 0
object lblFSXToggleZoomButton: TLabel
Left = 57
Top = 56
Width = 77
Height = 13
Caption = 'Joystick button:'
end
object lblFSXZoomDepressed: TLabel
Left = 59
Top = 111
Width = 151
Height = 13
Caption = 'Zoom level (button depressed):'
end
object lblFSXZoomPressed: TLabel
Left = 59
Top = 142
Width = 139
Height = 13
Caption = 'Zoom level (button pressed):'
end
object lblFSXToggleZoomButtonName: TLabel
Left = 57
Top = 75
Width = 305
Height = 13
AutoSize = False
Caption = '[runtime]'
EllipsisPosition = epEndEllipsis
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object cbFSXToggleZoom: TCheckBox
Left = 16
Top = 24
Width = 161
Height = 17
Caption = ' Toggle zoom level'
Checked = True
State = cbChecked
TabOrder = 0
end
object btnFSXToggleZoom: TButton
Left = 368
Top = 70
Width = 34
Height = 25
Caption = '...'
TabOrder = 1
OnClick = btnFSXToggleZoomClick
end
object cmbFSXZoomDepressed: TComboBox
Left = 288
Top = 106
Width = 114
Height = 21
Style = csDropDownList
DropDownCount = 20
ItemIndex = 5
TabOrder = 2
Text = '80%'
Items.Strings = (
'30%'
'40%'
'50%'
'60%'
'70%'
'80%'
'90%'
'100%'
'110%'
'120%'
'130%'
'140%'
'150%'
'175%'
'200%'
'250%'
'300%'
'400%')
end
object cmbFSXZoomPressed: TComboBox
Left = 288
Top = 133
Width = 114
Height = 21
Style = csDropDownList
DropDownCount = 20
ItemIndex = 16
TabOrder = 3
Text = '300%'
Items.Strings = (
'30%'
'40%'
'50%'
'60%'
'70%'
'80%'
'90%'
'100%'
'110%'
'120%'
'130%'
'140%'
'150%'
'175%'
'200%'
'250%'
'300%'
'400%')
end
end
object GroupBox2: TGroupBox
AlignWithMargins = True
Left = 6
Top = 183
Width = 409
Height = 98
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 0
Align = alTop
Caption = ' Engine thrust match '
TabOrder = 1
object TLabel
Left = 104
Top = 40
Width = 201
Height = 13
Caption = 'Sorry, configuration not implemented yet!'
end
object TLabel
Left = 120
Top = 59
Width = 160
Height = 13
Caption = 'Engine 1 links to 4, engine 2 to 3.'
end
end
end
end
object btnP3: TButton
Left = 11
Top = 161
Width = 41
Height = 41
Caption = 'P3'
TabOrder = 2
end
object btnP4: TButton
Left = 11
Top = 208
Width = 41
Height = 41
Caption = 'P4'
TabOrder = 3
end
object btnP5: TButton
Left = 11
Top = 255
Width = 41
Height = 41
Caption = 'P5'
TabOrder = 4
end
object btnP6: TButton
Left = 11
Top = 302
Width = 41
Height = 41
Caption = 'P6'
TabOrder = 5
end
object btnP7: TButton
Left = 11
Top = 349
Width = 41
Height = 41
Caption = 'P7'
TabOrder = 6
end
object btnP8: TButton
Left = 11
Top = 396
Width = 41
Height = 41
Caption = 'P8'
TabOrder = 7
end
object cmbProfiles: TComboBox
Left = 64
Top = 16
Width = 213
Height = 21
Style = csDropDownList
Anchors = [akLeft, akTop, akRight]
TabOrder = 8
ExplicitWidth = 270
end
object btnSaveProfile: TButton
Left = 283
Top = 16
Width = 75
Height = 21
Anchors = [akTop, akRight]
Caption = 'Save as...'
TabOrder = 9
ExplicitLeft = 340
end
object btnDeleteProfile: TButton
Left = 364
Top = 16
Width = 64
Height = 21
Anchors = [akTop, akRight]
Caption = 'Delete'
TabOrder = 10
ExplicitLeft = 421
end
end
object tsAbout: TTabSheet
Caption = 'About'
ImageIndex = 1
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
ExplicitWidth = 382
ExplicitHeight = 482
object lblVersionCaption: TLabel
Left = 16
Top = 67
@ -456,7 +393,7 @@ object MainForm: TMainForm
Height = 13
Caption = 'lblVersion'
end
object Label1: TLabel
object lblProductName: TLabel
Left = 16
Top = 16
Width = 96
@ -469,7 +406,7 @@ object MainForm: TMainForm
Font.Style = [fsBold]
ParentFont = False
end
object Label2: TLabel
object lblCopyright: TLabel
Left = 16
Top = 35
Width = 95
@ -557,6 +494,7 @@ object MainForm: TMainForm
Align = alTop
BevelOuter = bvNone
TabOrder = 0
ExplicitWidth = 390
DesignSize = (
449
64)
@ -938,6 +876,7 @@ object MainForm: TMainForm
TabOrder = 0
Visible = False
OnClick = btnRetryClick
ExplicitLeft = 315
end
end
end

720
G940LEDControl/Forms/MainFrm.pas
View File

@ -21,7 +21,8 @@ uses
LEDFunctionMap,
LEDStateConsumer,
LEDStateProvider;
LEDStateProvider,
Profile;
const
@ -30,8 +31,15 @@ const
MSG_UPDATE = 1;
MSG_NOUPDATE = 2;
LED_COUNT = 8;
type
TComboBoxArray = array[0..7] of TComboBoxEx;
TLEDControls = record
ConfigureButton: TButton;
CategoryLabel: TLabel;
FunctionLabel: TLabel;
end;
TMainForm = class(TForm)
imgStateNotFound: TImage;
@ -39,48 +47,13 @@ type
imgStateFound: TImage;
lblG940ThrottleState: TLabel;
btnRetry: TButton;
pcConnections: TPageControl;
PageControl: TPageControl;
pnlG940: TPanel;
tsFSX: TTabSheet;
gbFSXButtons: TGroupBox;
lblFSXP1: TLabel;
cmbFSXP1: TComboBoxEx;
cmbFSXP2: TComboBoxEx;
lblFSXP2: TLabel;
cmbFSXP3: TComboBoxEx;
lblFSXP3: TLabel;
cmbFSXP4: TComboBoxEx;
lblFSXP4: TLabel;
cmbFSXP5: TComboBoxEx;
lblFSXP5: TLabel;
cmbFSXP6: TComboBoxEx;
lblFSXP6: TLabel;
cmbFSXP7: TComboBoxEx;
lblFSXP7: TLabel;
cmbFSXP8: TComboBoxEx;
lblFSXP8: TLabel;
gbFSXConnection: TGroupBox;
btnFSXConnect: TButton;
btnFSXDisconnect: TButton;
lblFSXLocal: TLabel;
pcFSXOptions: TPageControl;
tsFSXLEDButtons: TTabSheet;
tsFSXExtra: TTabSheet;
GroupBox1: TGroupBox;
cbFSXToggleZoom: TCheckBox;
lblFSXToggleZoomButton: TLabel;
lblFSXZoomDepressed: TLabel;
lblFSXZoomPressed: TLabel;
lblFSXToggleZoomButtonName: TLabel;
btnFSXToggleZoom: TButton;
cmbFSXZoomDepressed: TComboBox;
cmbFSXZoomPressed: TComboBox;
GroupBox2: TGroupBox;
tsAbout: TTabSheet;
lblVersionCaption: TLabel;
lblVersion: TLabel;
Label1: TLabel;
Label2: TLabel;
lblProductName: TLabel;
lblCopyright: TLabel;
lblWebsiteLink: TLinkLabel;
lblEmailLink: TLinkLabel;
lblWebsite: TLabel;
@ -88,43 +61,76 @@ type
cbCheckUpdates: TCheckBox;
btnCheckUpdates: TButton;
lblProxy: TLabel;
tsFSX: TTabSheet;
btnP1: TButton;
lblP1Function: TLabel;
lblP1Category: TLabel;
btnP2: TButton;
lblP2Function: TLabel;
lblP2Category: TLabel;
btnP3: TButton;
lblP3Function: TLabel;
lblP3Category: TLabel;
btnP4: TButton;
lblP4Function: TLabel;
lblP4Category: TLabel;
btnP5: TButton;
lblP5Function: TLabel;
lblP5Category: TLabel;
btnP6: TButton;
lblP6Function: TLabel;
lblP6Category: TLabel;
btnP7: TButton;
lblP7Function: TLabel;
lblP7Category: TLabel;
btnP8: TButton;
lblP8Function: TLabel;
lblP8Category: TLabel;
lblProfile: TLabel;
cmbProfiles: TComboBox;
btnSaveProfile: TButton;
btnDeleteProfile: TButton;
bvlProfiles: TBevel;
procedure FormCreate(Sender: TObject);
procedure btnRetryClick(Sender: TObject);
procedure btnFSXConnectClick(Sender: TObject);
procedure btnFSXDisconnectClick(Sender: TObject);
procedure btnFSXToggleZoomClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FunctionComboBoxChange(Sender: TObject);
procedure lblLinkLinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType);
procedure btnCheckUpdatesClick(Sender: TObject);
procedure LEDButtonClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FLEDControls: array[0..LED_COUNT - 1] of TLEDControls;
FEventMonitor: TOmniEventMonitor;
FStateConsumerTask: IOmniTaskControl;
FFSXComboBoxes: TComboBoxArray;
FFSXToggleZoomDeviceGUID: TGUID;
FFSXToggleZoomButtonIndex: Integer;
FProfilesFilename: string;
FProfiles: TProfileList;
// FStateConsumerTask: IOmniTaskControl;
protected
procedure LoadFunctions(AProviderClass: TLEDStateProviderClass; AComboBoxes: TComboBoxArray);
procedure SetFunctions(AComboBoxes: TComboBoxArray);
// procedure ReadFunctions(AReader: IX2PersistReader; AComboBoxes: TComboBoxArray);
// procedure ReadFSXExtra(AReader: IX2PersistReader);
// procedure ReadAutoUpdate(AReader: IX2PersistReader);
// procedure WriteFunctions(AWriter: IX2PersistWriter; AComboBoxes: TComboBoxArray);
// procedure WriteFSXExtra(AWriter: IX2PersistWriter);
// procedure WriteAutoUpdate(AWriter: IX2PersistWriter);
procedure ReadFunctions(AReader: IX2PersistReader; AComboBoxes: TComboBoxArray);
procedure ReadFSXExtra(AReader: IX2PersistReader);
procedure ReadAutoUpdate(AReader: IX2PersistReader);
procedure WriteFunctions(AWriter: IX2PersistWriter; AComboBoxes: TComboBoxArray);
procedure WriteFSXExtra(AWriter: IX2PersistWriter);
procedure WriteAutoUpdate(AWriter: IX2PersistWriter);
procedure FindLEDControls;
procedure LoadProfiles;
procedure SaveProfiles;
procedure LoadDefaultProfile;
procedure SaveDefaultProfile;
function CreateDefaultProfile: TProfile;
// procedure LoadDefaultProfile;
// procedure SaveDefaultProfile;
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);
procedure InitializeStateProvider(AProviderClass: TLEDStateProviderClass);
procedure FinalizeStateProvider;
// procedure InitializeStateProvider(AProviderClass: TLEDStateProviderClass);
// procedure FinalizeStateProvider;
procedure UpdateMapping;
// procedure UpdateMapping;
procedure CheckForUpdatesThread(const ATask: IOmniTask);
procedure CheckForUpdates(AReportNoUpdates: Boolean);
@ -140,7 +146,8 @@ type
procedure CMAskAutoUpdate(var Msg: TMessage); message CM_ASKAUTOUPDATE;
property EventMonitor: TOmniEventMonitor read FEventMonitor;
property StateConsumerTask: IOmniTaskControl read FStateConsumerTask;
property Profiles: TProfileList read FProfiles;
// property StateConsumerTask: IOmniTaskControl read FStateConsumerTask;
end;
@ -155,17 +162,24 @@ uses
IdHTTP,
OtlCommon,
X2UtApp,
X2UtPersistRegistry,
X2UtPersistXML,
ButtonSelectFrm,
ConfigConversion,
FSXLEDStateProvider,
G940LEDStateConsumer;
G940LEDStateConsumer,
LEDColorIntf,
StaticLEDFunction;
{$R *.dfm}
const
NameDefaultProfile = 'Default';
FILENAME_PROFILES = 'G940LEDControl\Profiles.xml';
SPECIAL_CATEGORY = -1;
TEXT_STATE_SEARCHING = 'Searching...';
@ -197,46 +211,144 @@ type
{ TMainForm }
procedure TMainForm.FormCreate(Sender: TObject);
var
consumer: IOmniWorker;
//var
// consumer: IOmniWorker;
//
begin
lblVersion.Caption := App.Version.FormatVersion(False);
pcConnections.ActivePageIndex := 0;
pcFSXOptions.ActivePageIndex := 0;
lblFSXToggleZoomButtonName.Caption := '';
PageControl.ActivePageIndex := 0;
FEventMonitor := TOmniEventMonitor.Create(Self);
consumer := TG940LEDStateConsumer.Create;
FStateConsumerTask := FEventMonitor.Monitor(CreateTask(consumer)).MsgWait;
// consumer := TG940LEDStateConsumer.Create;
// FStateConsumerTask := FEventMonitor.Monitor(CreateTask(consumer)).MsgWait;
EventMonitor.OnTaskMessage := EventMonitorMessage;
EventMonitor.OnTaskTerminated := EventMonitorTerminated;
StateConsumerTask.Run;
// StateConsumerTask.Run;
FFSXComboBoxes[0] := cmbFSXP1;
FFSXComboBoxes[1] := cmbFSXP2;
FFSXComboBoxes[2] := cmbFSXP3;
FFSXComboBoxes[3] := cmbFSXP4;
FFSXComboBoxes[4] := cmbFSXP5;
FFSXComboBoxes[5] := cmbFSXP6;
FFSXComboBoxes[6] := cmbFSXP7;
FFSXComboBoxes[7] := cmbFSXP8;
LoadFunctions(TFSXLEDStateProvider, FFSXComboBoxes);
LoadDefaultProfile;
FindLEDControls;
FProfilesFilename := App.UserPath + FILENAME_PROFILES;
FProfiles := TProfileList.Create(True);
LoadProfiles;
// LoadFunctions(TFSXLEDStateProvider, FFSXComboBoxes);
// LoadDefaultProfile;
end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if Assigned(StateConsumerTask) then
begin
SaveDefaultProfile;
SaveProfiles;
// if Assigned(StateConsumerTask) then
// begin
// SaveDefaultProfile;
//
// LEDStateConsumer.Finalize(StateConsumerTask);
// CanClose := False;
// end;
end;
LEDStateConsumer.Finalize(StateConsumerTask);
CanClose := False;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
FreeAndNil(FProfiles);
end;
procedure TMainForm.FindLEDControls;
function ComponentByName(const AName: string; ATag: NativeInt): TComponent;
begin
Result := FindComponent(AName);
if not Assigned(Result) then
raise EArgumentException.CreateFmt('"%s" is not a valid component', [AName]);
Result.Tag := ATag;
end;
var
ledIndex: Integer;
ledNumber: string;
begin
for ledIndex := 0 to Pred(LED_COUNT) do
begin
ledNumber := IntToStr(Succ(ledIndex));
FLEDControls[ledIndex].ConfigureButton := (ComponentByName('btnP' + ledNumber, ledIndex) as TButton);
FLEDControls[ledIndex].CategoryLabel := (ComponentByName('lblP' + ledNumber + 'Category', ledIndex) as TLabel);
FLEDControls[ledIndex].FunctionLabel := (ComponentByName('lblP' + ledNumber + 'Function', ledIndex) as TLabel);
FLEDControls[ledIndex].ConfigureButton.OnClick := LEDButtonClick;
FLEDControls[ledIndex].CategoryLabel.Caption := '';
FLEDControls[ledIndex].FunctionLabel.Caption := '';
end;
end;
procedure TMainForm.LoadProfiles;
var
defaultProfile: TProfile;
persistXML: TX2UtPersistXML;
begin
if not FileExists(FProfilesFilename) then
begin
{ Check if version 0.x settings are in the registry }
defaultProfile := ConfigConversion.Convert0To1;
if not Assigned(defaultProfile) then
defaultProfile := CreateDefaultProfile;
if Assigned(defaultProfile) then
begin
defaultProfile.Name := NameDefaultProfile;
Profiles.Add(defaultProfile);
end;
end else
begin
persistXML := TX2UtPersistXML.Create;
try
persistXML.FileName := FProfilesFilename;
Profiles.Load(persistXML.CreateReader);
finally
FreeAndNil(persistXML);
end;
end;
end;
procedure TMainForm.SaveProfiles;
var
persistXML: TX2UtPersistXML;
begin
persistXML := TX2UtPersistXML.Create;
try
persistXML.FileName := FProfilesFilename;
Profiles.Save(persistXML.CreateWriter);
finally
FreeAndNil(persistXML);
end;
end;
function TMainForm.CreateDefaultProfile: TProfile;
var
ledIndex: Integer;
button: TProfileButton;
begin
Result := TProfile.Create;
for ledIndex := 0 to Pred(LED_COUNT) do
begin
button := Result.Buttons[ledIndex];
button.ProviderUID := StaticProviderUID;
button.FunctionUID := StaticFunctionUID[lcGreen];
end;
end;
@ -262,249 +374,155 @@ begin
end;
procedure TMainForm.SetFSXToggleZoomButton(const ADeviceGUID: TGUID; AButtonIndex: Integer; const ADisplayText: string);
begin
FFSXToggleZoomDeviceGUID := ADeviceGUID;
FFSXToggleZoomButtonIndex := AButtonIndex;
lblFSXToggleZoomButtonName.Caption := ADisplayText;
end;
//procedure TMainForm.ReadFunctions(AReader: IX2PersistReader; AComboBoxes: TComboBoxArray);
//var
// comboBox: TComboBoxEx;
// value: Integer;
// itemIndex: Integer;
//
//begin
// if AReader.BeginSection(SECTION_FSX) then
// try
// for comboBox in AComboBoxes do
// begin
// if AReader.ReadInteger('Function' + IntToStr(comboBox.Tag), value) then
// begin
// for itemIndex := 0 to Pred(comboBox.ItemsEx.Count) do
// if Integer(comboBox.ItemsEx[itemIndex].Data) = value then
// begin
// comboBox.ItemIndex := itemIndex;
// break;
// end;
// end;
// end;
// finally
// AReader.EndSection;
// end;
//end;
procedure TMainForm.LoadFunctions(AProviderClass: TLEDStateProviderClass; AComboBoxes: TComboBoxArray);
//procedure TMainForm.ReadAutoUpdate(AReader: IX2PersistReader);
//var
// checkUpdates: Boolean;
// askAutoUpdate: Boolean;
//
//begin
// askAutoUpdate := True;
//
// if AReader.BeginSection(SECTION_SETTINGS) then
// try
// if AReader.ReadBoolean('CheckUpdates', checkUpdates) then
// begin
// cbCheckUpdates.Checked := checkUpdates;
// askAutoUpdate := False;
// end;
// finally
// AReader.EndSection;
// end;
//
// if askAutoUpdate then
// PostMessage(Self.Handle, CM_ASKAUTOUPDATE, 0, 0)
// else if cbCheckUpdates.Checked then
// CheckForUpdates(False);
//end;
//procedure TMainForm.WriteAutoUpdate(AWriter: IX2PersistWriter);
//begin
// if AWriter.BeginSection(SECTION_SETTINGS) then
// try
// AWriter.WriteBoolean('CheckUpdates', cbCheckUpdates.Checked);
// finally
// AWriter.EndSection;
// end;
//end;
//procedure TMainForm.LoadDefaultProfile;
//var
// registryReader: TX2UtPersistRegistry;
// reader: IX2PersistReader;
//
//begin
// registryReader := TX2UtPersistRegistry.Create;
// try
// registryReader.RootKey := HKEY_CURRENT_USER;
// registryReader.Key := KEY_SETTINGS;
//
// reader := registryReader.CreateReader;
//
// if reader.BeginSection(SECTION_DEFAULTPROFILE) then
// try
// ReadFunctions(reader, FFSXComboBoxes);
// ReadFSXExtra(reader);
// finally
// reader.EndSection;
// end;
//
// ReadAutoUpdate(reader);
// finally
// FreeAndNil(registryReader);
// end;
//end;
//
//
//procedure TMainForm.SaveDefaultProfile;
//var
// registryWriter: TX2UtPersistRegistry;
// writer: IX2PersistWriter;
//
//begin
// registryWriter := TX2UtPersistRegistry.Create;
// try
// registryWriter.RootKey := HKEY_CURRENT_USER;
// registryWriter.Key := KEY_SETTINGS;
//
// writer := registryWriter.CreateWriter;
// if writer.BeginSection(SECTION_DEFAULTPROFILE) then
// try
// WriteFunctions(writer, FFSXComboBoxes);
// WriteFSXExtra(writer);
// finally
// writer.EndSection;
// end;
//
// WriteAutoUpdate(writer);
// finally
// FreeAndNil(registryWriter);
// end;
//end;
//procedure TMainForm.InitializeStateProvider(AProviderClass: TLEDStateProviderClass);
//begin
// UpdateMapping;
// LEDStateConsumer.InitializeStateProvider(StateConsumerTask, AProviderClass);
//end;
//
//
//procedure TMainForm.FinalizeStateProvider;
//begin
// LEDStateConsumer.FinalizeStateProvider(StateConsumerTask);
//end;
//procedure TMainForm.UpdateMapping;
//begin
// if not Assigned(StateConsumerTask) then
// Exit;
//
// LEDStateConsumer.ClearFunctions(StateConsumerTask);
// SetFunctions(FFSXComboBoxes);
//end;
procedure TMainForm.LEDButtonClick(Sender: TObject);
var
comboBox: TComboBoxEx;
ledIndex: NativeInt;
begin
for comboBox in AComboBoxes do
begin
comboBox.Items.BeginUpdate;
try
comboBox.Items.Clear;
AProviderClass.EnumFunctions(TComboBoxFunctionConsumer.Create(comboBox));
comboBox.ItemIndex := 0;
if Assigned(comboBox.OnChange) then
comboBox.OnChange(comboBox);
finally
comboBox.Items.EndUpdate;
end;
end;
end;
procedure TMainForm.SetFunctions(AComboBoxes: TComboBoxArray);
var
comboBox: TComboBoxEx;
begin
for comboBox in AComboBoxes do
begin
if comboBox.ItemIndex > -1 then
LEDStateConsumer.SetFunction(StateConsumerTask, comboBox.Tag, Integer(comboBox.ItemsEx[comboBox.ItemIndex].Data));
end;
end;
procedure TMainForm.ReadFunctions(AReader: IX2PersistReader; AComboBoxes: TComboBoxArray);
var
comboBox: TComboBoxEx;
value: Integer;
itemIndex: Integer;
begin
if AReader.BeginSection(SECTION_FSX) then
try
for comboBox in AComboBoxes do
begin
if AReader.ReadInteger('Function' + IntToStr(comboBox.Tag), value) then
begin
for itemIndex := 0 to Pred(comboBox.ItemsEx.Count) do
if Integer(comboBox.ItemsEx[itemIndex].Data) = value then
begin
comboBox.ItemIndex := itemIndex;
break;
end;
end;
end;
finally
AReader.EndSection;
end;
end;
procedure TMainForm.ReadFSXExtra(AReader: IX2PersistReader);
var
deviceGUID: string;
buttonIndex: Integer;
displayText: string;
begin
if AReader.BeginSection(SECTION_FSX) then
try
if AReader.ReadString('ToggleZoomDeviceGUID', deviceGUID) and
AReader.ReadInteger('ToggleZoomButtonIndex', buttonIndex) and
AReader.ReadString('ToggleZoomDisplayText', displayText) then
begin
try
SetFSXToggleZoomButton(StringToGUID(deviceGUID), buttonIndex, displayText);
except
on E:EConvertError do;
end;
end;
finally
AReader.EndSection;
end;
end;
procedure TMainForm.ReadAutoUpdate(AReader: IX2PersistReader);
var
checkUpdates: Boolean;
askAutoUpdate: Boolean;
begin
askAutoUpdate := True;
if AReader.BeginSection(SECTION_SETTINGS) then
try
if AReader.ReadBoolean('CheckUpdates', checkUpdates) then
begin
cbCheckUpdates.Checked := checkUpdates;
askAutoUpdate := False;
end;
finally
AReader.EndSection;
end;
if askAutoUpdate then
PostMessage(Self.Handle, CM_ASKAUTOUPDATE, 0, 0)
else if cbCheckUpdates.Checked then
CheckForUpdates(False);
end;
procedure TMainForm.WriteFunctions(AWriter: IX2PersistWriter; AComboBoxes: TComboBoxArray);
var
comboBox: TComboBoxEx;
value: Integer;
begin
if AWriter.BeginSection(SECTION_FSX) then
try
for comboBox in AComboBoxes do
begin
value := -1;
if comboBox.ItemIndex > -1 then
value := Integer(comboBox.ItemsEx[comboBox.ItemIndex].Data);
AWriter.WriteInteger('Function' + IntToStr(comboBox.Tag), value);
end;
finally
AWriter.EndSection;
end;
end;
procedure TMainForm.WriteFSXExtra(AWriter: IX2PersistWriter);
begin
if AWriter.BeginSection(SECTION_FSX) then
try
AWriter.WriteString('ToggleZoomDeviceGUID', GUIDToString(FFSXToggleZoomDeviceGUID));
AWriter.WriteInteger('ToggleZoomButtonIndex', FFSXToggleZoomButtonIndex);
AWriter.WriteString('ToggleZoomDisplayText', lblFSXToggleZoomButtonName.Caption);
// ToDo pressed / depressed levels
finally
AWriter.EndSection;
end;
end;
procedure TMainForm.WriteAutoUpdate(AWriter: IX2PersistWriter);
begin
if AWriter.BeginSection(SECTION_SETTINGS) then
try
AWriter.WriteBoolean('CheckUpdates', cbCheckUpdates.Checked);
finally
AWriter.EndSection;
end;
end;
procedure TMainForm.LoadDefaultProfile;
var
registryReader: TX2UtPersistRegistry;
reader: IX2PersistReader;
begin
registryReader := TX2UtPersistRegistry.Create;
try
registryReader.RootKey := HKEY_CURRENT_USER;
registryReader.Key := KEY_SETTINGS;
reader := registryReader.CreateReader;
if reader.BeginSection(SECTION_DEFAULTPROFILE) then
try
ReadFunctions(reader, FFSXComboBoxes);
ReadFSXExtra(reader);
finally
reader.EndSection;
end;
ReadAutoUpdate(reader);
finally
FreeAndNil(registryReader);
end;
end;
procedure TMainForm.SaveDefaultProfile;
var
registryWriter: TX2UtPersistRegistry;
writer: IX2PersistWriter;
begin
registryWriter := TX2UtPersistRegistry.Create;
try
registryWriter.RootKey := HKEY_CURRENT_USER;
registryWriter.Key := KEY_SETTINGS;
writer := registryWriter.CreateWriter;
if writer.BeginSection(SECTION_DEFAULTPROFILE) then
try
WriteFunctions(writer, FFSXComboBoxes);
WriteFSXExtra(writer);
finally
writer.EndSection;
end;
WriteAutoUpdate(writer);
finally
FreeAndNil(registryWriter);
end;
end;
procedure TMainForm.InitializeStateProvider(AProviderClass: TLEDStateProviderClass);
begin
UpdateMapping;
LEDStateConsumer.InitializeStateProvider(StateConsumerTask, AProviderClass);
end;
procedure TMainForm.FinalizeStateProvider;
begin
LEDStateConsumer.FinalizeStateProvider(StateConsumerTask);
end;
procedure TMainForm.UpdateMapping;
begin
if not Assigned(StateConsumerTask) then
Exit;
LEDStateConsumer.ClearFunctions(StateConsumerTask);
SetFunctions(FFSXComboBoxes);
ledIndex := (Sender as TComponent).Tag;
// TODO configure led
end;
@ -631,12 +649,12 @@ end;
procedure TMainForm.EventMonitorTerminated(const task: IOmniTaskControl);
begin
if task = StateConsumerTask then
begin
FStateConsumerTask := nil;
Close;
end else if task.Name = 'CheckForUpdatesThread' then
btnCheckUpdates.Enabled := True;
// if task = StateConsumerTask then
// begin
// FStateConsumerTask := nil;
// Close;
// end else if task.Name = 'CheckForUpdatesThread' then
// btnCheckUpdates.Enabled := True;
end;
@ -680,8 +698,8 @@ var
msg: string;
begin
btnFSXDisconnect.Enabled := False;
btnFSXConnect.Enabled := True;
// btnFSXDisconnect.Enabled := False;
// btnFSXConnect.Enabled := True;
msg := AMessage.MsgData;
if Length(msg) > 0 then
@ -694,43 +712,11 @@ begin
CheckForUpdates(True);
end;
procedure TMainForm.btnFSXConnectClick(Sender: TObject);
begin
SaveDefaultProfile;
InitializeStateProvider(TFSXLEDStateProvider);
btnFSXDisconnect.Enabled := True;
btnFSXConnect.Enabled := False;
end;
procedure TMainForm.btnFSXDisconnectClick(Sender: TObject);
begin
FinalizeStateProvider;
btnFSXDisconnect.Enabled := False;
btnFSXConnect.Enabled := True;
end;
procedure TMainForm.btnFSXToggleZoomClick(Sender: TObject);
var
deviceGUID: TGUID;
button: Integer;
displayText: string;
begin
FillChar(deviceGUID, SizeOf(deviceGUID), 0);
button := -1;
if TButtonSelectForm.Execute(deviceGUID, button, displayText) then
SetFSXToggleZoomButton(deviceGUID, button, displayText);
end;
procedure TMainForm.btnRetryClick(Sender: TObject);
begin
btnRetry.Visible := False;
StateConsumerTask.Comm.Send(MSG_FINDTHROTTLEDEVICE);
// StateConsumerTask.Comm.Send(MSG_FINDTHROTTLEDEVICE);
end;

11
G940LEDControl/G940LEDControl.dpr
View File

@ -11,14 +11,19 @@ uses
LEDFunctionMap in 'Units\LEDFunctionMap.pas',
LEDStateConsumer in 'Units\LEDStateConsumer.pas',
LEDStateProvider in 'Units\LEDStateProvider.pas',
LEDStateIntf in 'Units\LEDStateIntf.pas',
LEDState in 'Units\LEDState.pas',
LEDColorIntf in 'Units\LEDColorIntf.pas',
LEDColor in 'Units\LEDColor.pas',
LEDFunctionIntf in 'Units\LEDFunctionIntf.pas',
ObserverIntf in 'Units\ObserverIntf.pas',
LEDFunction in 'Units\LEDFunction.pas',
StaticLEDFunction in 'Units\StaticLEDFunction.pas',
ConfigConversion in 'Units\ConfigConversion.pas',
LEDFunctionRegistry in 'Units\LEDFunctionRegistry.pas';
LEDFunctionRegistry in 'Units\LEDFunctionRegistry.pas',
StaticLEDColor in 'Units\StaticLEDColor.pas',
DynamicLEDColor in 'Units\DynamicLEDColor.pas',
LEDStateIntf in 'Units\LEDStateIntf.pas',
LEDState in 'Units\LEDState.pas',
Profile in 'Units\Profile.pas';
{$R *.res}

11
G940LEDControl/G940LEDControl.dproj
View File

@ -8,7 +8,7 @@
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>13.4</ProjectVersion>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Release</Config>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
@ -173,14 +173,19 @@
<DCCReference Include="Units\LEDFunctionMap.pas"/>
<DCCReference Include="Units\LEDStateConsumer.pas"/>
<DCCReference Include="Units\LEDStateProvider.pas"/>
<DCCReference Include="Units\LEDStateIntf.pas"/>
<DCCReference Include="Units\LEDState.pas"/>
<DCCReference Include="Units\LEDColorIntf.pas"/>
<DCCReference Include="Units\LEDColor.pas"/>
<DCCReference Include="Units\LEDFunctionIntf.pas"/>
<DCCReference Include="Units\ObserverIntf.pas"/>
<DCCReference Include="Units\LEDFunction.pas"/>
<DCCReference Include="Units\StaticLEDFunction.pas"/>
<DCCReference Include="Units\ConfigConversion.pas"/>
<DCCReference Include="Units\LEDFunctionRegistry.pas"/>
<DCCReference Include="Units\StaticLEDColor.pas"/>
<DCCReference Include="Units\DynamicLEDColor.pas"/>
<DCCReference Include="Units\LEDStateIntf.pas"/>
<DCCReference Include="Units\LEDState.pas"/>
<DCCReference Include="Units\Profile.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>

BIN
G940LEDControl/G940LEDControl.res
View File

Binary file not shown.

8
G940LEDControl/Units/ConfigConversion.pas
View File

@ -1,15 +1,19 @@
unit ConfigConversion;
interface
uses
Profile;
{ Version 0.x: registry -> 1.x: XML }
procedure Convert0To1;
function Convert0To1: TProfile;
implementation
procedure Convert0To1;
function Convert0To1: TProfile;
begin
Result := nil;
// FUNCTION_NONE = 0;
// FUNCTION_OFF = 1;
// FUNCTION_RED = 2;

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

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

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

@ -0,0 +1,27 @@
unit LEDColor;
interface
uses
SysUtils,
LEDColorIntf;
type
TCustomLEDColor = class(TInterfacedObject, ILEDColor)
protected
{ ILEDState }
function GetColor: TLEDColor; virtual; abstract;
end;
TCustomDynamicLEDColor = class(TCustomLEDColor, IDynamicLEDColor)
protected
{ ITickLEDState }
procedure Tick; virtual; abstract;
end;
implementation
end.

13
G940LEDControl/Units/LEDStateIntf.pas → G940LEDControl/Units/LEDColorIntf.pas
View File

@ -1,17 +1,22 @@
unit LEDStateIntf;
unit LEDColorIntf;
interface
type
TLEDColor = (lcOff, lcGreen, lcAmber, lcRed);
ILEDState = interface
['{B40DF462-B660-4002-A6B9-DD30AC69E8DB}']
procedure Tick;
ILEDColor = interface
['{B40DF462-B660-4002-A6B9-DD30AC69E8DB}']
function GetColor: TLEDColor;
end;
IDynamicLEDColor = interface(ILEDColor)
['{9770E851-580D-4803-9979-0C608CB108A0}']
procedure Tick;
end;
implementation
end.

72
G940LEDControl/Units/LEDFunction.pas
View File

@ -17,7 +17,7 @@ type
procedure RegisterFunction(AFunction: ILEDFunction);
protected
{ ILEDFunctionProvider }
function GetUniqueName: string; virtual; abstract;
function GetUID: string; virtual; abstract;
function GetEnumerator: ILEDFunctionEnumerator; virtual;
public
@ -28,10 +28,10 @@ type
TCustomLEDFunction = class(TInterfacedObject, IObservable, ILEDFunction)
private
FCurrentState: ILEDState;
FObservers: TInterfaceList;
FStates: TInterfaceList;
protected
procedure SetCurrentState(AState: ILEDState); virtual;
// procedure SetCurrentState(AState: ILEDState); virtual;
procedure NotifyObservers; virtual;
@ -44,9 +44,10 @@ type
{ ILEDFunction }
function GetCategoryName: string; virtual; abstract;
function GetDisplayName: string; virtual; abstract;
function GetUniqueName: string; virtual; abstract;
function GetUID: string; virtual; abstract;
function GetCurrentState: ILEDState; virtual;
function GetEnumerator: ILEDStateEnumerator; virtual;
function GetCurrentState: ILEDState; virtual; abstract;
public
constructor Create;
destructor Destroy; override;
@ -66,6 +67,20 @@ type
end;
TLEDStateEnumerator = class(TInterfacedObject, ILEDStateEnumerator)
private
FList: TInterfaceList;
FIndex: Integer;
protected
{ ILEDStateEnumerator }
function GetCurrent: ILEDState; virtual;
function MoveNext: Boolean; virtual;
public
constructor Create(AList: TInterfaceList);
end;
implementation
uses
SysUtils;
@ -77,11 +92,13 @@ begin
inherited Create;
FObservers := TInterfaceList.Create;
FStates := TInterfaceList.Create;
end;
destructor TCustomLEDFunction.Destroy;
begin
FreeAndNil(FStates);
FreeAndNil(FObservers);
inherited Destroy;
@ -90,27 +107,27 @@ 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;
function TCustomLEDFunction.GetCurrentState: ILEDState;
function TCustomLEDFunction.GetEnumerator: ILEDStateEnumerator;
begin
Result := TLEDStateEnumerator.Create(FStates);
end;
procedure TCustomLEDFunction.SetCurrentState(AState: ILEDState);
begin
FCurrentState := AState;
NotifyObservers;
end;
//procedure TCustomLEDFunction.SetCurrentState(AState: ILEDState);
//begin
// FCurrentState := AState;
// NotifyObservers;
//end;
procedure TCustomLEDFunction.NotifyObservers;
@ -142,9 +159,6 @@ end;
procedure TCustomLEDFunctionProvider.RegisterFunction(AFunction: ILEDFunction);
begin
{ Make sure to explicitly request the ILEDFunction interface; I've experienced
incomparable pointers otherwise if we ever need to write an UnregisterFunction.
My best, but unverified, guess is that it works kinda like a VMT. }
FFunctions.Add(AFunction as ILEDFunction);
end;
@ -178,4 +192,28 @@ begin
Inc(FIndex);
end;
{ TLEDStateEnumerator }
constructor TLEDStateEnumerator.Create(AList: TInterfaceList);
begin
inherited Create;
FList := AList;
FIndex := -1;
end;
function TLEDStateEnumerator.GetCurrent: ILEDState;
begin
Result := (FList[FIndex] as ILEDState);
end;
function TLEDStateEnumerator.MoveNext: Boolean;
begin
Result := (FIndex < Pred(FList.Count));
if Result then
Inc(FIndex);
end;
end.

17
G940LEDControl/Units/LEDFunctionIntf.pas
View File

@ -2,18 +2,19 @@ unit LEDFunctionIntf;
interface
uses
LEDColorIntf,
LEDStateIntf,
ObserverIntf;
type
ILEDFunction = interface;
ILEDFunctionEnumerator = interface;
ILEDStateEnumerator = interface;
ILEDFunctionProvider = interface
['{B38F6F90-DC96-42CE-B8F0-21F0DD8AA537}']
function GetUniqueName: string;
function GetUID: string;
function GetEnumerator: ILEDFunctionEnumerator;
end;
@ -23,8 +24,9 @@ type
['{7087067A-1016-4A7D-ACB1-BA1F388DAD6C}']
function GetCategoryName: string;
function GetDisplayName: string;
function GetUniqueName: string;
function GetUID: string;
function GetEnumerator: ILEDStateEnumerator;
function GetCurrentState: ILEDState;
end;
@ -38,6 +40,15 @@ type
end;
ILEDStateEnumerator = interface
['{045E8466-831A-4704-ABBB-31E85789F314}']
function GetCurrent: ILEDState;
function MoveNext: Boolean;
property Current: ILEDState read GetCurrent;
end;
implementation
end.

18
G940LEDControl/Units/LEDFunctionRegistry.pas
View File

@ -18,7 +18,7 @@ type
procedure DoRegister(AProvider: ILEDFunctionProvider);
procedure DoUnregister(AProvider: ILEDFunctionProvider);
function DoFind(const AUniqueName: string): ILEDFunctionProvider;
function DoFind(const AUID: string): ILEDFunctionProvider;
function GetProviders: TLEDFunctionProviderList;
public
@ -28,7 +28,7 @@ type
class procedure Register(AProvider: ILEDFunctionProvider);
class procedure Unregister(AProvider: ILEDFunctionProvider);
class function Find(const AUniqueName: string): ILEDFunctionProvider;
class function Find(const AUID: string): ILEDFunctionProvider;
class function Providers: TLEDFunctionProviderList;
end;
@ -46,7 +46,7 @@ type
constructor Create;
destructor Destroy; override;
function Find(const AUniqueName: string): ILEDFunctionProvider;
function Find(const AUID: string): ILEDFunctionProvider;
function GetEnumerator: TLEDFunctionProviderListEnumerator;
end;
@ -81,9 +81,9 @@ begin
end;
class function TLEDFunctionRegistry.Find(const AUniqueName: string): ILEDFunctionProvider;
class function TLEDFunctionRegistry.Find(const AUID: string): ILEDFunctionProvider;
begin
Result := Instance.DoFind(AUniqueName);
Result := Instance.DoFind(AUID);
end;
@ -130,9 +130,9 @@ begin
end;
function TLEDFunctionRegistry.DoFind(const AUniqueName: string): ILEDFunctionProvider;
function TLEDFunctionRegistry.DoFind(const AUID: string): ILEDFunctionProvider;
begin
Result := FProviders.Find(AUniqueName);
Result := FProviders.Find(AUID);
end;
@ -159,7 +159,7 @@ begin
end;
function TLEDFunctionProviderList.Find(const AUniqueName: string): ILEDFunctionProvider;
function TLEDFunctionProviderList.Find(const AUID: string): ILEDFunctionProvider;
var
provider: ILEDFunctionProvider;
@ -167,7 +167,7 @@ begin
Result := nil;
for provider in Self do
if provider.GetUniqueName = AUniqueName then
if provider.GetUID = AUID then
begin
Result := provider;
break;

52
G940LEDControl/Units/LEDState.pas
View File

@ -1,52 +0,0 @@
unit LEDState;
interface
uses
SysUtils,
LEDStateIntf;
type
TCustomLEDState = class(TInterfacedObject, ILEDState)
protected
{ ILEDState }
procedure Tick; virtual;
function GetColor: TLEDColor; virtual; abstract;
end;
TStaticLEDState = class(TCustomLEDState)
private
FColor: TLEDColor;
protected
function GetColor: TLEDColor; override;
public
constructor Create(AColor: TLEDColor);
end;
implementation
{ TCustomLEDState }
procedure TCustomLEDState.Tick;
begin
end;
{ TStaticLEDState }
constructor TStaticLEDState.Create(AColor: TLEDColor);
begin
inherited Create;
FColor := AColor;
end;
function TStaticLEDState.GetColor: TLEDColor;
begin
Result := FColor;
end;
end.

1
G940LEDControl/Units/LEDStateConsumer.pas
View File

@ -28,7 +28,6 @@ const
type
{ This interface name made me giggle. Because it's true. }
IRunInMainThread = interface(IOmniWaitableValue)
['{68B8F2F7-ED40-4078-9D99-503D7AFA068B}']
procedure Execute;

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

@ -0,0 +1,232 @@
unit Profile;
interface
uses
Generics.Collections,
X2UtPersistIntf;
type
TProfileButton = class(TObject)
private
FProviderUID: string;
FFunctionUID: string;
protected
function Load(AReader: IX2PersistReader): Boolean;
procedure Save(AWriter: IX2PersistWriter);
public
property ProviderUID: string read FProviderUID write FProviderUID;
property FunctionUID: string read FFunctionUID write FFunctionUID;
end;
TProfileButtonList = class(TObjectList<TProfileButton>);
TProfile = class(TObject)
private
FName: string;
FButtons: TProfileButtonList;
function GetButton(Index: Integer): TProfileButton;
function GetButtonCount: Integer;
protected
function Load(AReader: IX2PersistReader): Boolean;
procedure Save(AWriter: IX2PersistWriter);
public
constructor Create;
destructor Destroy; override;
property Name: string read FName write FName;
property ButtonCount: Integer read GetButtonCount;
property Buttons[Index: Integer]: TProfileButton read GetButton;
end;
TProfileList = class(TObjectList<TProfile>)
public
procedure Load(AReader: IX2PersistReader);
procedure Save(AWriter: IX2PersistWriter);
end;
implementation
uses
Classes,
SysUtils;
const
SectionProfiles = 'Profiles';
SectionButton = 'Button';
KeyProviderUID = 'ProviderUID';
KeyFunctionUID = 'FunctionUID';
{ TProfileButton }
function TProfileButton.Load(AReader: IX2PersistReader): Boolean;
begin
Result := AReader.ReadString(KeyProviderUID, FProviderUID) and
AReader.ReadString(KeyFunctionUID, FFunctionUID);
end;
procedure TProfileButton.Save(AWriter: IX2PersistWriter);
begin
AWriter.WriteString(KeyProviderUID, FProviderUID);
AWriter.WriteString(KeyFunctionUID, FFunctionUID);
end;
{ TProfile }
constructor TProfile.Create;
begin
inherited Create;
FButtons := TProfileButtonList.Create(True);
end;
destructor TProfile.Destroy;
begin
FreeAndNil(FButtons);
inherited;
end;
function TProfile.Load(AReader: IX2PersistReader): Boolean;
var
buttonIndex: Integer;
button: TProfileButton;
begin
Result := False;
buttonIndex := 0;
while AReader.BeginSection(SectionButton + IntToStr(buttonIndex)) do
try
button := TProfileButton.Create;
if button.Load(AReader) then
begin
FButtons.Add(button);
Result := True;
end else
FreeAndNil(button);
finally
AReader.EndSection;
Inc(buttonIndex);
end;
end;
procedure TProfile.Save(AWriter: IX2PersistWriter);
var
buttonIndex: Integer;
begin
for buttonIndex := 0 to Pred(FButtons.Count) do
begin
if AWriter.BeginSection(SectionButton + IntToStr(buttonIndex)) then
try
FButtons[buttonIndex].Save(AWriter);
finally
AWriter.EndSection;
end;
end;
end;
function TProfile.GetButtonCount: Integer;
begin
Result := FButtons.Count;
end;
function TProfile.GetButton(Index: Integer): TProfileButton;
var
oldCount: Integer;
buttonIndex: Integer;
begin
oldCount := FButtons.Count;
if Index >= oldCount then
begin
FButtons.Count := Succ(Index);
for buttonIndex := oldCount to Pred(FButtons.Count) do
FButtons[buttonIndex] := nil;
end;
Result := FButtons[Index];
if not Assigned(Result) then
begin
Result := TProfileButton.Create;
FButtons[Index] := Result;
end;
end;
{ TProfileList }
procedure TProfileList.Load(AReader: IX2PersistReader);
var
profiles: TStringList;
profileName: string;
profile: TProfile;
begin
if AReader.BeginSection(SectionProfiles) then
try
profiles := TStringList.Create;
try
AReader.GetSections(profiles);
for profileName in profiles do
begin
if AReader.BeginSection(profileName) then
try
profile := TProfile.Create;
profile.Name := profileName;
if profile.Load(AReader) then
Add(profile)
else
FreeAndNil(profile);
finally
AReader.EndSection;
end;
end;
finally
FreeAndNil(profiles);
end;
finally
AReader.EndSection;
end;
end;
procedure TProfileList.Save(AWriter: IX2PersistWriter);
var
profile: TProfile;
begin
if AWriter.BeginSection(SectionProfiles) then
try
for profile in Self do
begin
if AWriter.BeginSection(profile.Name) then
try
profile.Save(AWriter);
finally
AWriter.EndSection;
end;
end;
finally
AWriter.EndSection;
end;
end;
end.

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

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

36
G940LEDControl/Units/StaticLEDFunction.pas
View File

@ -3,13 +3,13 @@ unit StaticLEDFunction;
interface
uses
LEDFunction,
LEDStateIntf;
LEDColorIntf;
type
TStaticLEDFunctionProvider = class(TCustomLEDFunctionProvider)
protected
function GetUniqueName: string; override;
function GetUID: string; override;
public
constructor Create;
end;
@ -21,12 +21,23 @@ type
protected
function GetCategoryName: string; override;
function GetDisplayName: string; override;
function GetUniqueName: string; override;
function GetUID: string; override;
public
constructor Create(AColor: TLEDColor);
end;
const
StaticProviderUID = 'static';
StaticFunctionUID: array[TLEDColor] of string =
(
'off',
'green',
'amber',
'red'
);
implementation
uses
LEDFunctionRegistry;
@ -34,17 +45,6 @@ uses
const
CategoryStatic = 'Static';
ProviderUniqueName = 'static';
FunctionUniqueName: array[TLEDColor] of string =
(
'off',
'green',
'amber',
'red'
);
FunctionDisplayName: array[TLEDColor] of string =
(
'Off',
@ -68,9 +68,9 @@ begin
end;
function TStaticLEDFunctionProvider.GetUniqueName: string;
function TStaticLEDFunctionProvider.GetUID: string;
begin
Result := ProviderUniqueName;
Result := StaticProviderUID;
end;
@ -95,9 +95,9 @@ begin
end;
function TStaticLEDFunction.GetUniqueName: string;
function TStaticLEDFunction.GetUID: string;
begin
Result := FunctionUniqueName[FColor];
Result := StaticFunctionUID[FColor];
end;