diff --git a/G940LEDControl/Forms/MainFrm.dfm b/G940LEDControl/Forms/MainFrm.dfm index 85423db..24f95f5 100644 --- a/G940LEDControl/Forms/MainFrm.dfm +++ b/G940LEDControl/Forms/MainFrm.dfm @@ -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 diff --git a/G940LEDControl/Forms/MainFrm.pas b/G940LEDControl/Forms/MainFrm.pas index e07ffc1..b8f3cdb 100644 --- a/G940LEDControl/Forms/MainFrm.pas +++ b/G940LEDControl/Forms/MainFrm.pas @@ -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; diff --git a/G940LEDControl/G940LEDControl.dpr b/G940LEDControl/G940LEDControl.dpr index 6cc4657..32ffd00 100644 --- a/G940LEDControl/G940LEDControl.dpr +++ b/G940LEDControl/G940LEDControl.dpr @@ -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} diff --git a/G940LEDControl/G940LEDControl.dproj b/G940LEDControl/G940LEDControl.dproj index c4c26ff..5c37c22 100644 --- a/G940LEDControl/G940LEDControl.dproj +++ b/G940LEDControl/G940LEDControl.dproj @@ -8,7 +8,7 @@ VCL 13.4 True - Release + Debug Win32 1 Application @@ -173,14 +173,19 @@ - - + + + + + + + Cfg_2 Base diff --git a/G940LEDControl/G940LEDControl.res b/G940LEDControl/G940LEDControl.res index 6738248..d98ff0a 100644 Binary files a/G940LEDControl/G940LEDControl.res and b/G940LEDControl/G940LEDControl.res differ diff --git a/G940LEDControl/Units/ConfigConversion.pas b/G940LEDControl/Units/ConfigConversion.pas index dd97bef..a5e0b93 100644 --- a/G940LEDControl/Units/ConfigConversion.pas +++ b/G940LEDControl/Units/ConfigConversion.pas @@ -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; diff --git a/G940LEDControl/Units/DynamicLEDColor.pas b/G940LEDControl/Units/DynamicLEDColor.pas new file mode 100644 index 0000000..99754b5 --- /dev/null +++ b/G940LEDControl/Units/DynamicLEDColor.pas @@ -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. diff --git a/G940LEDControl/Units/LEDColor.pas b/G940LEDControl/Units/LEDColor.pas new file mode 100644 index 0000000..bcb3c03 --- /dev/null +++ b/G940LEDControl/Units/LEDColor.pas @@ -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. diff --git a/G940LEDControl/Units/LEDStateIntf.pas b/G940LEDControl/Units/LEDColorIntf.pas similarity index 54% rename from G940LEDControl/Units/LEDStateIntf.pas rename to G940LEDControl/Units/LEDColorIntf.pas index 8e56f5c..e283152 100644 --- a/G940LEDControl/Units/LEDStateIntf.pas +++ b/G940LEDControl/Units/LEDColorIntf.pas @@ -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. diff --git a/G940LEDControl/Units/LEDFunction.pas b/G940LEDControl/Units/LEDFunction.pas index 47f8770..74bb71d 100644 --- a/G940LEDControl/Units/LEDFunction.pas +++ b/G940LEDControl/Units/LEDFunction.pas @@ -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. diff --git a/G940LEDControl/Units/LEDFunctionIntf.pas b/G940LEDControl/Units/LEDFunctionIntf.pas index 1c56fec..1759ac5 100644 --- a/G940LEDControl/Units/LEDFunctionIntf.pas +++ b/G940LEDControl/Units/LEDFunctionIntf.pas @@ -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. diff --git a/G940LEDControl/Units/LEDFunctionRegistry.pas b/G940LEDControl/Units/LEDFunctionRegistry.pas index 1cd56bf..c328115 100644 --- a/G940LEDControl/Units/LEDFunctionRegistry.pas +++ b/G940LEDControl/Units/LEDFunctionRegistry.pas @@ -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; diff --git a/G940LEDControl/Units/LEDState.pas b/G940LEDControl/Units/LEDState.pas deleted file mode 100644 index 2241b4f..0000000 --- a/G940LEDControl/Units/LEDState.pas +++ /dev/null @@ -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. diff --git a/G940LEDControl/Units/LEDStateConsumer.pas b/G940LEDControl/Units/LEDStateConsumer.pas index e0aac12..c809a12 100644 --- a/G940LEDControl/Units/LEDStateConsumer.pas +++ b/G940LEDControl/Units/LEDStateConsumer.pas @@ -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; diff --git a/G940LEDControl/Units/Profile.pas b/G940LEDControl/Units/Profile.pas new file mode 100644 index 0000000..4aaa0bc --- /dev/null +++ b/G940LEDControl/Units/Profile.pas @@ -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); + + + 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) + 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. diff --git a/G940LEDControl/Units/StaticLEDColor.pas b/G940LEDControl/Units/StaticLEDColor.pas new file mode 100644 index 0000000..ecabd62 --- /dev/null +++ b/G940LEDControl/Units/StaticLEDColor.pas @@ -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. diff --git a/G940LEDControl/Units/StaticLEDFunction.pas b/G940LEDControl/Units/StaticLEDFunction.pas index 5bd2c39..b92195f 100644 --- a/G940LEDControl/Units/StaticLEDFunction.pas +++ b/G940LEDControl/Units/StaticLEDFunction.pas @@ -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;