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

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

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

View File

@ -4,7 +4,7 @@ object MainForm: TMainForm
BorderIcons = [biSystemMenu, biMinimize] BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle BorderStyle = bsSingle
Caption = 'G940 LED Control' Caption = 'G940 LED Control'
ClientHeight = 513 ClientHeight = 562
ClientWidth = 465 ClientWidth = 465
Color = clBtnFace Color = clBtnFace
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@ -16,14 +16,15 @@ object MainForm: TMainForm
Position = poScreenCenter Position = poScreenCenter
OnCloseQuery = FormCloseQuery OnCloseQuery = FormCloseQuery
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object pcConnections: TPageControl object PageControl: TPageControl
AlignWithMargins = True AlignWithMargins = True
Left = 8 Left = 8
Top = 80 Top = 80
Width = 449 Width = 449
Height = 425 Height = 474
Margins.Left = 8 Margins.Left = 8
Margins.Top = 8 Margins.Top = 8
Margins.Right = 8 Margins.Right = 8
@ -31,291 +32,23 @@ object MainForm: TMainForm
ActivePage = tsFSX ActivePage = tsFSX
Align = alClient Align = alClient
TabOrder = 1 TabOrder = 1
ExplicitWidth = 390
ExplicitHeight = 510
object tsFSX: TTabSheet object tsFSX: TTabSheet
Caption = 'Flight Simulator X' Caption = 'Configuration'
object gbFSXConnection: TGroupBox ExplicitWidth = 382
AlignWithMargins = True ExplicitHeight = 482
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
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
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 = ( DesignSize = (
409 441
251) 446)
object lblFSXP1: TLabel object lblP1Function: TLabel
Left = 12 Left = 64
Top = 27 Top = 89
Width = 12 Width = 364
Height = 13 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] 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 AutoSize = False
Caption = '[runtime]' Caption = '[runtime: function]'
EllipsisPosition = epEndEllipsis EllipsisPosition = epEndEllipsis
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
@ -323,125 +56,329 @@ object MainForm: TMainForm
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
ExplicitWidth = 421
end end
object cbFSXToggleZoom: TCheckBox object lblP1Category: TLabel
Left = 16 Left = 64
Top = 24 Top = 73
Width = 161 Width = 364
Height = 17 Height = 13
Caption = ' Toggle zoom level' Anchors = [akLeft, akTop, akRight]
Checked = True AutoSize = False
State = cbChecked 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 TabOrder = 0
end end
object btnFSXToggleZoom: TButton object btnP2: TButton
Left = 368 Left = 11
Top = 70 Top = 114
Width = 34 Width = 41
Height = 25 Height = 41
Caption = '...' Caption = 'P2'
TabOrder = 1 TabOrder = 1
OnClick = btnFSXToggleZoomClick
end end
object cmbFSXZoomDepressed: TComboBox object btnP3: TButton
Left = 288 Left = 11
Top = 106 Top = 161
Width = 114 Width = 41
Height = 21 Height = 41
Style = csDropDownList Caption = 'P3'
DropDownCount = 20
ItemIndex = 5
TabOrder = 2 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 end
object cmbFSXZoomPressed: TComboBox object btnP4: TButton
Left = 288 Left = 11
Top = 133 Top = 208
Width = 114 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 Height = 21
Style = csDropDownList Style = csDropDownList
DropDownCount = 20 Anchors = [akLeft, akTop, akRight]
ItemIndex = 16 TabOrder = 8
TabOrder = 3 ExplicitWidth = 270
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
object btnSaveProfile: TButton
Left = 283
Top = 16
Width = 75
Height = 21
Anchors = [akTop, akRight]
Caption = 'Save as...'
TabOrder = 9
ExplicitLeft = 340
end end
object btnDeleteProfile: TButton
Left = 364
Top = 16
Width = 64
Height = 21
Anchors = [akTop, akRight]
Caption = 'Delete'
TabOrder = 10
ExplicitLeft = 421
end end
end end
object tsAbout: TTabSheet object tsAbout: TTabSheet
Caption = 'About' Caption = 'About'
ImageIndex = 1 ImageIndex = 1
ExplicitLeft = 0 ExplicitWidth = 382
ExplicitTop = 0 ExplicitHeight = 482
ExplicitWidth = 0
ExplicitHeight = 0
object lblVersionCaption: TLabel object lblVersionCaption: TLabel
Left = 16 Left = 16
Top = 67 Top = 67
@ -456,7 +393,7 @@ object MainForm: TMainForm
Height = 13 Height = 13
Caption = 'lblVersion' Caption = 'lblVersion'
end end
object Label1: TLabel object lblProductName: TLabel
Left = 16 Left = 16
Top = 16 Top = 16
Width = 96 Width = 96
@ -469,7 +406,7 @@ object MainForm: TMainForm
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
end end
object Label2: TLabel object lblCopyright: TLabel
Left = 16 Left = 16
Top = 35 Top = 35
Width = 95 Width = 95
@ -557,6 +494,7 @@ object MainForm: TMainForm
Align = alTop Align = alTop
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 0 TabOrder = 0
ExplicitWidth = 390
DesignSize = ( DesignSize = (
449 449
64) 64)
@ -938,6 +876,7 @@ object MainForm: TMainForm
TabOrder = 0 TabOrder = 0
Visible = False Visible = False
OnClick = btnRetryClick OnClick = btnRetryClick
ExplicitLeft = 315
end end
end end
end end

View File

@ -21,7 +21,8 @@ uses
LEDFunctionMap, LEDFunctionMap,
LEDStateConsumer, LEDStateConsumer,
LEDStateProvider; LEDStateProvider,
Profile;
const const
@ -30,8 +31,15 @@ const
MSG_UPDATE = 1; MSG_UPDATE = 1;
MSG_NOUPDATE = 2; MSG_NOUPDATE = 2;
LED_COUNT = 8;
type type
TComboBoxArray = array[0..7] of TComboBoxEx; TLEDControls = record
ConfigureButton: TButton;
CategoryLabel: TLabel;
FunctionLabel: TLabel;
end;
TMainForm = class(TForm) TMainForm = class(TForm)
imgStateNotFound: TImage; imgStateNotFound: TImage;
@ -39,48 +47,13 @@ type
imgStateFound: TImage; imgStateFound: TImage;
lblG940ThrottleState: TLabel; lblG940ThrottleState: TLabel;
btnRetry: TButton; btnRetry: TButton;
pcConnections: TPageControl; PageControl: TPageControl;
pnlG940: TPanel; 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; tsAbout: TTabSheet;
lblVersionCaption: TLabel; lblVersionCaption: TLabel;
lblVersion: TLabel; lblVersion: TLabel;
Label1: TLabel; lblProductName: TLabel;
Label2: TLabel; lblCopyright: TLabel;
lblWebsiteLink: TLinkLabel; lblWebsiteLink: TLinkLabel;
lblEmailLink: TLinkLabel; lblEmailLink: TLinkLabel;
lblWebsite: TLabel; lblWebsite: TLabel;
@ -88,43 +61,76 @@ type
cbCheckUpdates: TCheckBox; cbCheckUpdates: TCheckBox;
btnCheckUpdates: TButton; btnCheckUpdates: TButton;
lblProxy: TLabel; 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 FormCreate(Sender: TObject);
procedure btnRetryClick(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 FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FunctionComboBoxChange(Sender: TObject); procedure FunctionComboBoxChange(Sender: TObject);
procedure lblLinkLinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType); procedure lblLinkLinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType);
procedure btnCheckUpdatesClick(Sender: TObject); procedure btnCheckUpdatesClick(Sender: TObject);
procedure LEDButtonClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private private
FLEDControls: array[0..LED_COUNT - 1] of TLEDControls;
FEventMonitor: TOmniEventMonitor; FEventMonitor: TOmniEventMonitor;
FStateConsumerTask: IOmniTaskControl;
FFSXComboBoxes: TComboBoxArray; FProfilesFilename: string;
FFSXToggleZoomDeviceGUID: TGUID; FProfiles: TProfileList;
FFSXToggleZoomButtonIndex: Integer; // FStateConsumerTask: IOmniTaskControl;
protected protected
procedure LoadFunctions(AProviderClass: TLEDStateProviderClass; AComboBoxes: TComboBoxArray); // procedure ReadFunctions(AReader: IX2PersistReader; AComboBoxes: TComboBoxArray);
procedure SetFunctions(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 FindLEDControls;
procedure ReadFSXExtra(AReader: IX2PersistReader); procedure LoadProfiles;
procedure ReadAutoUpdate(AReader: IX2PersistReader); procedure SaveProfiles;
procedure WriteFunctions(AWriter: IX2PersistWriter; AComboBoxes: TComboBoxArray);
procedure WriteFSXExtra(AWriter: IX2PersistWriter);
procedure WriteAutoUpdate(AWriter: IX2PersistWriter);
procedure LoadDefaultProfile; function CreateDefaultProfile: TProfile;
procedure SaveDefaultProfile;
// procedure LoadDefaultProfile;
// 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);
procedure InitializeStateProvider(AProviderClass: TLEDStateProviderClass); // procedure InitializeStateProvider(AProviderClass: TLEDStateProviderClass);
procedure FinalizeStateProvider; // procedure FinalizeStateProvider;
procedure UpdateMapping; // procedure UpdateMapping;
procedure CheckForUpdatesThread(const ATask: IOmniTask); procedure CheckForUpdatesThread(const ATask: IOmniTask);
procedure CheckForUpdates(AReportNoUpdates: Boolean); procedure CheckForUpdates(AReportNoUpdates: Boolean);
@ -140,7 +146,8 @@ type
procedure CMAskAutoUpdate(var Msg: TMessage); message CM_ASKAUTOUPDATE; procedure CMAskAutoUpdate(var Msg: TMessage); message CM_ASKAUTOUPDATE;
property EventMonitor: TOmniEventMonitor read FEventMonitor; property EventMonitor: TOmniEventMonitor read FEventMonitor;
property StateConsumerTask: IOmniTaskControl read FStateConsumerTask; property Profiles: TProfileList read FProfiles;
// property StateConsumerTask: IOmniTaskControl read FStateConsumerTask;
end; end;
@ -155,17 +162,24 @@ uses
IdHTTP, IdHTTP,
OtlCommon, OtlCommon,
X2UtApp, X2UtApp,
X2UtPersistRegistry, X2UtPersistXML,
ButtonSelectFrm, ButtonSelectFrm,
ConfigConversion,
FSXLEDStateProvider, FSXLEDStateProvider,
G940LEDStateConsumer; G940LEDStateConsumer,
LEDColorIntf,
StaticLEDFunction;
{$R *.dfm} {$R *.dfm}
const const
NameDefaultProfile = 'Default';
FILENAME_PROFILES = 'G940LEDControl\Profiles.xml';
SPECIAL_CATEGORY = -1; SPECIAL_CATEGORY = -1;
TEXT_STATE_SEARCHING = 'Searching...'; TEXT_STATE_SEARCHING = 'Searching...';
@ -197,46 +211,144 @@ type
{ TMainForm } { TMainForm }
procedure TMainForm.FormCreate(Sender: TObject); procedure TMainForm.FormCreate(Sender: TObject);
var //var
consumer: IOmniWorker; // consumer: IOmniWorker;
//
begin begin
lblVersion.Caption := App.Version.FormatVersion(False); lblVersion.Caption := App.Version.FormatVersion(False);
pcConnections.ActivePageIndex := 0; PageControl.ActivePageIndex := 0;
pcFSXOptions.ActivePageIndex := 0;
lblFSXToggleZoomButtonName.Caption := '';
FEventMonitor := TOmniEventMonitor.Create(Self); FEventMonitor := TOmniEventMonitor.Create(Self);
consumer := TG940LEDStateConsumer.Create; // consumer := TG940LEDStateConsumer.Create;
FStateConsumerTask := FEventMonitor.Monitor(CreateTask(consumer)).MsgWait; // FStateConsumerTask := FEventMonitor.Monitor(CreateTask(consumer)).MsgWait;
EventMonitor.OnTaskMessage := EventMonitorMessage; EventMonitor.OnTaskMessage := EventMonitorMessage;
EventMonitor.OnTaskTerminated := EventMonitorTerminated; EventMonitor.OnTaskTerminated := EventMonitorTerminated;
StateConsumerTask.Run; // StateConsumerTask.Run;
FFSXComboBoxes[0] := cmbFSXP1; FindLEDControls;
FFSXComboBoxes[1] := cmbFSXP2;
FFSXComboBoxes[2] := cmbFSXP3; FProfilesFilename := App.UserPath + FILENAME_PROFILES;
FFSXComboBoxes[3] := cmbFSXP4; FProfiles := TProfileList.Create(True);
FFSXComboBoxes[4] := cmbFSXP5; LoadProfiles;
FFSXComboBoxes[5] := cmbFSXP6;
FFSXComboBoxes[6] := cmbFSXP7; // LoadFunctions(TFSXLEDStateProvider, FFSXComboBoxes);
FFSXComboBoxes[7] := cmbFSXP8; // LoadDefaultProfile;
LoadFunctions(TFSXLEDStateProvider, FFSXComboBoxes);
LoadDefaultProfile;
end; end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin begin
if Assigned(StateConsumerTask) then SaveProfiles;
begin // if Assigned(StateConsumerTask) then
SaveDefaultProfile; // 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;
end; end;
@ -262,249 +374,155 @@ begin
end; end;
procedure TMainForm.SetFSXToggleZoomButton(const ADeviceGUID: TGUID; AButtonIndex: Integer; const ADisplayText: string); //procedure TMainForm.ReadFunctions(AReader: IX2PersistReader; AComboBoxes: TComboBoxArray);
begin //var
FFSXToggleZoomDeviceGUID := ADeviceGUID; // comboBox: TComboBoxEx;
FFSXToggleZoomButtonIndex := AButtonIndex; // value: Integer;
lblFSXToggleZoomButtonName.Caption := ADisplayText; // itemIndex: Integer;
end; //
//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 var
comboBox: TComboBoxEx; ledIndex: NativeInt;
begin begin
for comboBox in AComboBoxes do ledIndex := (Sender as TComponent).Tag;
begin // TODO configure led
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);
end; end;
@ -631,12 +649,12 @@ end;
procedure TMainForm.EventMonitorTerminated(const task: IOmniTaskControl); procedure TMainForm.EventMonitorTerminated(const task: IOmniTaskControl);
begin begin
if task = StateConsumerTask then // if task = StateConsumerTask then
begin // begin
FStateConsumerTask := nil; // FStateConsumerTask := nil;
Close; // Close;
end else if task.Name = 'CheckForUpdatesThread' then // end else if task.Name = 'CheckForUpdatesThread' then
btnCheckUpdates.Enabled := True; // btnCheckUpdates.Enabled := True;
end; end;
@ -680,8 +698,8 @@ var
msg: string; msg: string;
begin begin
btnFSXDisconnect.Enabled := False; // btnFSXDisconnect.Enabled := False;
btnFSXConnect.Enabled := True; // btnFSXConnect.Enabled := True;
msg := AMessage.MsgData; msg := AMessage.MsgData;
if Length(msg) > 0 then if Length(msg) > 0 then
@ -694,43 +712,11 @@ begin
CheckForUpdates(True); CheckForUpdates(True);
end; 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); procedure TMainForm.btnRetryClick(Sender: TObject);
begin begin
btnRetry.Visible := False; btnRetry.Visible := False;
StateConsumerTask.Comm.Send(MSG_FINDTHROTTLEDEVICE); // StateConsumerTask.Comm.Send(MSG_FINDTHROTTLEDEVICE);
end; end;

View File

@ -11,14 +11,19 @@ uses
LEDFunctionMap in 'Units\LEDFunctionMap.pas', LEDFunctionMap in 'Units\LEDFunctionMap.pas',
LEDStateConsumer in 'Units\LEDStateConsumer.pas', LEDStateConsumer in 'Units\LEDStateConsumer.pas',
LEDStateProvider in 'Units\LEDStateProvider.pas', LEDStateProvider in 'Units\LEDStateProvider.pas',
LEDStateIntf in 'Units\LEDStateIntf.pas', LEDColorIntf in 'Units\LEDColorIntf.pas',
LEDState in 'Units\LEDState.pas', LEDColor in 'Units\LEDColor.pas',
LEDFunctionIntf in 'Units\LEDFunctionIntf.pas', LEDFunctionIntf in 'Units\LEDFunctionIntf.pas',
ObserverIntf in 'Units\ObserverIntf.pas', ObserverIntf in 'Units\ObserverIntf.pas',
LEDFunction in 'Units\LEDFunction.pas', LEDFunction in 'Units\LEDFunction.pas',
StaticLEDFunction in 'Units\StaticLEDFunction.pas', StaticLEDFunction in 'Units\StaticLEDFunction.pas',
ConfigConversion in 'Units\ConfigConversion.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} {$R *.res}

View File

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

Binary file not shown.

View File

@ -1,15 +1,19 @@
unit ConfigConversion; unit ConfigConversion;
interface interface
uses
Profile;
{ Version 0.x: registry -> 1.x: XML } { Version 0.x: registry -> 1.x: XML }
procedure Convert0To1; function Convert0To1: TProfile;
implementation implementation
procedure Convert0To1; function Convert0To1: TProfile;
begin begin
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,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.

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.

View File

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

View File

@ -17,7 +17,7 @@ type
procedure RegisterFunction(AFunction: ILEDFunction); procedure RegisterFunction(AFunction: ILEDFunction);
protected protected
{ ILEDFunctionProvider } { ILEDFunctionProvider }
function GetUniqueName: string; virtual; abstract; function GetUID: string; virtual; abstract;
function GetEnumerator: ILEDFunctionEnumerator; virtual; function GetEnumerator: ILEDFunctionEnumerator; virtual;
public public
@ -28,10 +28,10 @@ type
TCustomLEDFunction = class(TInterfacedObject, IObservable, ILEDFunction) TCustomLEDFunction = class(TInterfacedObject, IObservable, ILEDFunction)
private private
FCurrentState: ILEDState;
FObservers: TInterfaceList; FObservers: TInterfaceList;
FStates: TInterfaceList;
protected protected
procedure SetCurrentState(AState: ILEDState); virtual; // procedure SetCurrentState(AState: ILEDState); virtual;
procedure NotifyObservers; virtual; procedure NotifyObservers; virtual;
@ -44,9 +44,10 @@ type
{ ILEDFunction } { ILEDFunction }
function GetCategoryName: string; virtual; abstract; function GetCategoryName: string; virtual; abstract;
function GetDisplayName: 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 public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
@ -66,6 +67,20 @@ type
end; 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 implementation
uses uses
SysUtils; SysUtils;
@ -77,11 +92,13 @@ begin
inherited Create; inherited Create;
FObservers := TInterfaceList.Create; FObservers := TInterfaceList.Create;
FStates := TInterfaceList.Create;
end; end;
destructor TCustomLEDFunction.Destroy; destructor TCustomLEDFunction.Destroy;
begin begin
FreeAndNil(FStates);
FreeAndNil(FObservers); FreeAndNil(FObservers);
inherited Destroy; inherited Destroy;
@ -90,27 +107,27 @@ end;
procedure TCustomLEDFunction.Attach(AObserver: IObserver); procedure TCustomLEDFunction.Attach(AObserver: IObserver);
begin begin
FObservers.Add(AObserver as IObserver);
end; end;
procedure TCustomLEDFunction.Detach(AObserver: IObserver); procedure TCustomLEDFunction.Detach(AObserver: IObserver);
begin begin
FObservers.Remove(AObserver as IObserver);
end; end;
function TCustomLEDFunction.GetCurrentState: ILEDState; function TCustomLEDFunction.GetEnumerator: ILEDStateEnumerator;
begin begin
Result := TLEDStateEnumerator.Create(FStates);
end; end;
procedure TCustomLEDFunction.SetCurrentState(AState: ILEDState); //procedure TCustomLEDFunction.SetCurrentState(AState: ILEDState);
begin //begin
FCurrentState := AState; // FCurrentState := AState;
NotifyObservers; // NotifyObservers;
end; //end;
procedure TCustomLEDFunction.NotifyObservers; procedure TCustomLEDFunction.NotifyObservers;
@ -142,9 +159,6 @@ end;
procedure TCustomLEDFunctionProvider.RegisterFunction(AFunction: ILEDFunction); procedure TCustomLEDFunctionProvider.RegisterFunction(AFunction: ILEDFunction);
begin 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); FFunctions.Add(AFunction as ILEDFunction);
end; end;
@ -178,4 +192,28 @@ begin
Inc(FIndex); Inc(FIndex);
end; 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. end.

View File

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

View File

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

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.

View File

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

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.

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.

View File

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