From 0a9d82526148c3bf7dd3550d272e8c8b53eb13e6 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Sun, 14 Apr 2013 09:25:40 +0000 Subject: [PATCH] --- G940LEDControl/Forms/MainFrm.dfm | 54 ++- G940LEDControl/Forms/MainFrm.pas | 419 ++++++++++++------ G940LEDControl/G940LEDControl.dpr | 11 +- G940LEDControl/G940LEDControl.dproj | 199 +++------ G940LEDControl/G940LEDControl.res | Bin 28524 -> 28524 bytes G940LEDControl/Units/DebugLog.pas | 173 ++++++++ G940LEDControl/Units/DebugLogGExperts.pas | 137 ++++++ G940LEDControl/Units/FSXLEDFunction.pas | 28 ++ .../Units/FSXLEDFunctionProvider.pas | 22 +- .../Units/FSXLEDFunctionProviderIntf.pas | 13 + G940LEDControl/Units/FSXLEDFunctionWorker.pas | 25 ++ G940LEDControl/Units/FSXResources.pas | 9 + G940LEDControl/Units/FSXSimConnectClient.pas | 307 ++++++++++++- G940LEDControl/Units/FSXSimConnectIntf.pas | 14 + G940LEDControl/Units/G940LEDStateConsumer.pas | 28 ++ G940LEDControl/Units/GxDbugIntf.pas | 274 ++++++++++++ G940LEDControl/Units/LEDStateConsumer.pas | 77 ++-- G940LEDControl/Units/ProfileManager.pas | 270 +++++++++++ G940LEDControl/Units/Settings.pas | 16 + 19 files changed, 1752 insertions(+), 324 deletions(-) create mode 100644 G940LEDControl/Units/DebugLog.pas create mode 100644 G940LEDControl/Units/DebugLogGExperts.pas create mode 100644 G940LEDControl/Units/FSXLEDFunctionProviderIntf.pas create mode 100644 G940LEDControl/Units/GxDbugIntf.pas create mode 100644 G940LEDControl/Units/ProfileManager.pas diff --git a/G940LEDControl/Forms/MainFrm.dfm b/G940LEDControl/Forms/MainFrm.dfm index e3e52ee..c2798a3 100644 --- a/G940LEDControl/Forms/MainFrm.dfm +++ b/G940LEDControl/Forms/MainFrm.dfm @@ -1,7 +1,7 @@ object MainForm: TMainForm Left = 0 Top = 0 - ActiveControl = cmbProfiles + ActiveControl = cbProfileMenu BorderIcons = [biSystemMenu, biMinimize] BorderStyle = bsSingle Caption = 'G940 LED Control' @@ -29,11 +29,11 @@ object MainForm: TMainForm Margins.Top = 8 Margins.Right = 8 Margins.Bottom = 8 - ActivePage = tsFSX + ActivePage = tsConfiguration Align = alClient TabOrder = 0 - object tsFSX: TTabSheet - Caption = 'Configuration' + object tsButtons: TTabSheet + Caption = ' Button assignment ' DesignSize = ( 442 452) @@ -271,7 +271,7 @@ object MainForm: TMainForm object bvlProfiles: TBevel Left = 11 Top = 52 - Width = 474 + Width = 418 Height = 13 Shape = bsTopLine end @@ -371,6 +371,50 @@ object MainForm: TMainForm OnClick = btnDeleteProfileClick end end + object tsConfiguration: TTabSheet + Caption = ' Configuration ' + ImageIndex = 2 + object lblProfileSwitching: TLabel + Left = 11 + Top = 19 + Width = 92 + Height = 13 + Caption = 'Profile switching' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object bvlProfileSwitching: TBevel + Left = 224 + Top = 26 + Width = 205 + Height = 13 + Shape = bsTopLine + end + object cbProfileMenu: TCheckBox + Left = 11 + Top = 44 + Width = 409 + Height = 17 + Caption = ' Add profile selection to FSX "Add-ons" menu' + Checked = True + State = cbChecked + TabOrder = 0 + OnClick = cbProfileMenuClick + end + object cbProfileMenuCascaded: TCheckBox + Left = 31 + Top = 67 + Width = 389 + Height = 17 + Caption = ' Cascaded menu (profiles in "G940 Profile" submenu)' + TabOrder = 1 + OnClick = cbProfileMenuCascadedClick + end + end object tsAbout: TTabSheet Caption = 'About' ImageIndex = 1 diff --git a/G940LEDControl/Forms/MainFrm.pas b/G940LEDControl/Forms/MainFrm.pas index b5ddb43..92b669b 100644 --- a/G940LEDControl/Forms/MainFrm.pas +++ b/G940LEDControl/Forms/MainFrm.pas @@ -1,5 +1,7 @@ unit MainFrm; +// #ToDo1 -oMvR: 3-3-2013: trigger profile update when Save As only changes the name + interface uses System.Classes, @@ -22,11 +24,13 @@ uses FSXSimConnectIntf, LEDStateConsumer, Profile, + ProfileManager, Settings; const CM_ASKAUTOUPDATE = WM_APP + 1; + CM_PROFILECHANGED = WM_APP + 2; TM_UPDATE = 1; TM_NOUPDATE = 2; @@ -48,7 +52,7 @@ type end; - TMainForm = class(TForm) + TMainForm = class(TForm, IProfileObserver) imgStateNotFound: TImage; lblG940Throttle: TLabel; imgStateFound: TImage; @@ -67,7 +71,7 @@ type cbCheckUpdates: TCheckBox; btnCheckUpdates: TButton; lblProxy: TLabel; - tsFSX: TTabSheet; + tsButtons: TTabSheet; btnP1: TButton; lblP1Function: TLabel; lblP1Category: TLabel; @@ -103,6 +107,11 @@ type lblFSX: TLabel; lblFSXState: TLabel; pnlState: TPanel; + tsConfiguration: TTabSheet; + cbProfileMenu: TCheckBox; + cbProfileMenuCascaded: TCheckBox; + lblProfileSwitching: TLabel; + bvlProfileSwitching: TBevel; procedure FormCreate(Sender: TObject); procedure lblLinkLinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType); @@ -113,13 +122,13 @@ type procedure cbCheckUpdatesClick(Sender: TObject); procedure btnSaveProfileClick(Sender: TObject); procedure btnDeleteProfileClick(Sender: TObject); + procedure cbProfileMenuClick(Sender: TObject); + procedure cbProfileMenuCascadedClick(Sender: TObject); private FLEDControls: array[0..LED_COUNT - 1] of TLEDControls; FEventMonitor: TOmniEventMonitor; FProfilesFilename: string; - FProfiles: TProfileList; - FActiveProfile: TProfile; FLockChangeProfile: Boolean; FStateConsumerTask: IOmniTaskControl; @@ -128,13 +137,17 @@ type FSettingsFileName: string; FSettings: TSettings; - - procedure SetActiveProfile(const Value: TProfile); protected procedure RegisterDeviceArrival; procedure UnregisterDeviceArrival; + { IProfileObserver } + procedure ObserveAdd(AProfile: TProfile); + procedure ObserveRemove(AProfile: TProfile); + procedure ObserveActiveChanged(AProfile: TProfile); + procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE; + procedure CMProfileChanged(var Msg: TMessage); message CM_PROFILECHANGED; protected procedure FindLEDControls; procedure LoadProfiles; @@ -151,6 +164,9 @@ type procedure UpdateProfile(AProfile: TProfile); procedure DeleteProfile(AProfile: TProfile; ASetActiveProfile: Boolean); + procedure ApplyProfileMenuSettings; + procedure FinalizeProfileMenu; + procedure SetDeviceState(const AMessage: string; AFound: Boolean); procedure SetFSXState(const AMessage: string; AConnected: Boolean); // procedure SetFSXToggleZoomButton(const ADeviceGUID: TGUID; AButtonIndex: Integer; const ADisplayText: string); @@ -166,9 +182,7 @@ type procedure CMAskAutoUpdate(var Msg: TMessage); message CM_ASKAUTOUPDATE; - property ActiveProfile: TProfile read FActiveProfile write SetActiveProfile; property EventMonitor: TOmniEventMonitor read FEventMonitor; - property Profiles: TProfileList read FProfiles; property Settings: TSettings read FSettings; property StateConsumerTask: IOmniTaskControl read FStateConsumerTask; end; @@ -190,6 +204,9 @@ uses ButtonFunctionFrm, ConfigConversion, + DebugLog, + FSXLEDFunctionProviderIntf, + FSXResources, FSXSimConnectStateMonitor, G940LEDStateConsumer, LEDColorIntf, @@ -234,6 +251,17 @@ type { TMainForm } procedure TMainForm.FormCreate(Sender: TObject); + + procedure AlignBevel(ABevel: TBevel; ACaption: TLabel); + var + bounds: TRect; + + begin + bounds := ABevel.BoundsRect; + bounds.Left := ACaption.BoundsRect.Right + 8; + ABevel.BoundsRect := bounds; + end; + var worker: IOmniWorker; @@ -241,23 +269,29 @@ begin lblVersion.Caption := App.Version.FormatVersion(False); PageControl.ActivePageIndex := 0; + AlignBevel(bvlProfileSwitching, lblProfileSwitching); FEventMonitor := TOmniEventMonitor.Create(Self); + Debug.Log('UI: Starting G940 LED state consumer thread'); worker := TG940LEDStateConsumer.Create; - FStateConsumerTask := EventMonitor.Monitor(CreateTask(worker)).MsgWait; + FStateConsumerTask := EventMonitor.Monitor(CreateTask(worker)); EventMonitor.OnTaskMessage := EventMonitorMessage; EventMonitor.OnTaskTerminated := EventMonitorTerminated; + StateConsumerTask.Run; + + Debug.Log('UI: Starting FSX state monitor thread'); worker := TFSXStateMonitorWorker.Create; EventMonitor.Monitor(CreateTask(worker)).Run; + TProfileManager.Attach(Self); + FindLEDControls; FProfilesFilename := App.UserPath + FilenameProfiles; - FProfiles := TProfileList.Create(True); LoadProfiles; FSettingsFileName := App.UserPath + FilenameSettings; @@ -269,9 +303,10 @@ end; procedure TMainForm.FormDestroy(Sender: TObject); begin - UnregisterDeviceArrival; + FinalizeProfileMenu; - FreeAndNil(FProfiles); + UnregisterDeviceArrival; + TProfileManager.Detach(Self); end; @@ -289,6 +324,8 @@ var request: TDevBroadcastDeviceInterface; begin + Debug.Log('UI: Registering for device notifications'); + ZeroMemory(@request, SizeOf(request)); request.dbcc_size := SizeOf(request); request.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE; @@ -303,6 +340,8 @@ procedure TMainForm.UnregisterDeviceArrival; begin if Assigned(FDeviceNotification) then begin + Debug.Log('UI: Unregistering for device notifications'); + UnregisterDeviceNotification(FDeviceNotification); FDeviceNotification := nil; end; @@ -316,16 +355,48 @@ begin case Msg.WParam of DBT_DEVICEARRIVAL: - if (not FG940Found) then - StateConsumerTask.Comm.Send(TM_FINDTHROTTLEDEVICE); + begin + Debug.Log('UI: Device arrived'); + + if (not FG940Found) then + StateConsumerTask.Comm.Send(TM_FINDTHROTTLEDEVICE); + end; DBT_DEVICEREMOVECOMPLETE: - if FG940Found then - StateConsumerTask.Comm.Send(TM_TESTTHROTTLEDEVICE); + begin + Debug.Log('UI: Device removed'); + + if FG940Found then + StateConsumerTask.Comm.Send(TM_TESTTHROTTLEDEVICE); + end; end; end; +procedure TMainForm.CMProfileChanged(var Msg: TMessage); +var + profile: TProfile; + +begin + profile := TProfileManager.Instance.ActiveProfile; + + if Settings.ActiveProfile <> profile.Name then + begin + Settings.ActiveProfile := profile.Name; + SaveSettings; + end; + + FLockChangeProfile := True; + try + cmbProfiles.ItemIndex := cmbProfiles.Items.IndexOfObject(profile); + finally + FLockChangeProfile := False; + end; + + LoadActiveProfile; +end; + + procedure TMainForm.FindLEDControls; function ComponentByName(const AName: string; ATag: NativeInt): TComponent; @@ -365,49 +436,63 @@ var profile: TProfile; begin - if not FileExists(FProfilesFilename) then - begin - { Check if version 0.x settings are in the registry } - defaultProfile := ConfigConversion.ConvertProfile0To1; - - if not Assigned(defaultProfile) then - defaultProfile := CreateDefaultProfile - else - begin - defaultProfile.Name := DefaultProfileName; - defaultProfile.IsTemporary := True; - end; - - if Assigned(defaultProfile) then - Profiles.Add(defaultProfile); - end else - begin - persistXML := TX2UtPersistXML.Create; - try - persistXML.FileName := FProfilesFilename; - Profiles.Load(persistXML.CreateReader); - finally - FreeAndNil(persistXML); - end; - end; - - { Make sure we always have a profile } - if Profiles.Count = 0 then - Profiles.Add(CreateDefaultProfile); - - FLockChangeProfile := True; + Debug.LogFmt('UI: Loading profiles (%s)', [FProfilesFilename]); + Debug.Indent; try - cmbProfiles.Items.BeginUpdate; - try - cmbProfiles.Items.Clear; + if not FileExists(FProfilesFilename) then + begin + Debug.Log('UI: Profiles not found, attempting conversion from 0.x profile'); - for profile in Profiles do - cmbProfiles.Items.AddObject(profile.Name, profile); + { Check if version 0.x settings are in the registry } + defaultProfile := ConfigConversion.ConvertProfile0To1; + + if not Assigned(defaultProfile) then + begin + Debug.Log('UI: 0.x profile not found, creating default profile'); + defaultProfile := CreateDefaultProfile + end else + begin + Debug.Log('UI: Succesfully converted 0.x profile'); + defaultProfile.Name := DefaultProfileName; + defaultProfile.IsTemporary := True; + end; + + if Assigned(defaultProfile) then + TProfileManager.Add(defaultProfile); + end else + begin + persistXML := TX2UtPersistXML.Create; + try + persistXML.FileName := FProfilesFilename; + TProfileManager.Load(persistXML.CreateReader); + finally + FreeAndNil(persistXML); + end; + end; + + { Make sure we always have a profile } + if TProfileManager.Instance.Count = 0 then + begin + Debug.Log('UI: No profiles found, creating default profile'); + TProfileManager.Add(CreateDefaultProfile); + end; + + FLockChangeProfile := True; + try + cmbProfiles.Items.BeginUpdate; + try + cmbProfiles.Items.Clear; + + for profile in TProfileManager.Instance do + cmbProfiles.Items.AddObject(profile.Name, profile); + finally + cmbProfiles.Items.EndUpdate; + end; finally - cmbProfiles.Items.EndUpdate; + FLockChangeProfile := False; end; finally - FLockChangeProfile := False; + Debug.UnIndent; end; end; @@ -417,10 +502,12 @@ var persistXML: TX2UtPersistXML; begin + Debug.LogFmt('UI: Saving profiles (%s)', [FProfilesFilename]); + persistXML := TX2UtPersistXML.Create; try persistXML.FileName := FProfilesFilename; - Profiles.Save(persistXML.CreateWriter); + TProfileManager.Instance.Save(persistXML.CreateWriter); finally FreeAndNil(persistXML); end; @@ -433,44 +520,62 @@ var profile: TProfile; begin - if not FileExists(FSettingsFileName) then - begin - { Check if version 0.x settings are in the registry } - FSettings := ConfigConversion.ConvertSettings0To1; + Debug.LogFmt('UI: Loading profiles (%s)', [FSettingsFilename]); + Debug.Indent; + try + if not FileExists(FSettingsFileName) then + begin + Debug.Log('UI: Settings not found, attempting conversion from 0.x settings'); - if not Assigned(FSettings) then + { Check if version 0.x settings are in the registry } + FSettings := ConfigConversion.ConvertSettings0To1; + + if not Assigned(FSettings) then + begin + Debug.Log('UI: 0.x profile not found, creating default settings'); + FSettings := TSettings.Create; + end else + Debug.Log('UI: Succesfully converted 0.x settings'); + end else + begin FSettings := TSettings.Create; - end else - begin - FSettings := TSettings.Create; - persistXML := TX2UtPersistXML.Create; - try - persistXML.FileName := FSettingsFileName; - Settings.Load(persistXML.CreateReader); - finally - FreeAndNil(persistXML); + persistXML := TX2UtPersistXML.Create; + try + persistXML.FileName := FSettingsFileName; + Settings.Load(persistXML.CreateReader); + finally + FreeAndNil(persistXML); + end; end; + + { Default profile } + profile := nil; + if Length(Settings.ActiveProfile) > 0 then + profile := TProfileManager.Instance.Find(Settings.ActiveProfile); + + { LoadProfiles ensures there's always at least 1 profile } + if (not Assigned(profile)) and (TProfileManager.Instance.Count > 0) then + profile := TProfileManager.Instance[0]; + + TProfileManager.Instance.ActiveProfile := profile; + + { Auto-update } + cbCheckUpdates.Checked := Settings.CheckUpdates; + + if not Settings.HasCheckUpdates then + PostMessage(Self.Handle, CM_ASKAUTOUPDATE, 0, 0) + else if Settings.CheckUpdates then + CheckForUpdates(False); + + + cbProfileMenu.Checked := Settings.ProfileMenu; + cbProfileMenuCascaded.Checked := Settings.ProfileMenuCascaded; + + ApplyProfileMenuSettings; + finally + Debug.UnIndent; end; - - { Default profile } - profile := nil; - if Length(Settings.ActiveProfile) > 0 then - profile := Profiles.Find(Settings.ActiveProfile); - - { LoadProfiles ensures there's always at least 1 profile } - if (not Assigned(profile)) and (Profiles.Count > 0) then - profile := Profiles[0]; - - SetActiveProfile(profile); - - { Auto-update } - cbCheckUpdates.Checked := Settings.CheckUpdates; - - if not Settings.HasCheckUpdates then - PostMessage(Self.Handle, CM_ASKAUTOUPDATE, 0, 0) - else if Settings.CheckUpdates then - CheckForUpdates(False); end; @@ -479,6 +584,8 @@ var persistXML: TX2UtPersistXML; begin + Debug.LogFmt('UI: Saving settings (%s)', [FSettingsFilename]); + persistXML := TX2UtPersistXML.Create; try persistXML.FileName := FSettingsFileName; @@ -500,17 +607,21 @@ end; procedure TMainForm.LoadActiveProfile; var + activeProfile: TProfile; buttonIndex: Integer; begin - if not Assigned(ActiveProfile) then + activeProfile := TProfileManager.Instance.ActiveProfile; + if not Assigned(activeProfile) then exit; + Debug.LogFmt('UI: Loading active profile (%s)', [activeProfile.Name]); + for buttonIndex := 0 to Pred(LED_COUNT) do - UpdateButton(ActiveProfile, buttonIndex); + UpdateButton(activeProfile, buttonIndex); if Assigned(StateConsumerTask) then - StateConsumerTask.Comm.Send(TM_LOADPROFILE, ActiveProfile); + StateConsumerTask.Comm.Send(TM_LOADPROFILE, activeProfile); end; @@ -549,9 +660,8 @@ end; procedure TMainForm.AddProfile(AProfile: TProfile); begin - Profiles.Add(AProfile); cmbProfiles.Items.AddObject(AProfile.Name, AProfile); - SetActiveProfile(AProfile); + TProfileManager.Instance.Add(AProfile, True); end; @@ -581,27 +691,24 @@ var itemIndex: Integer; begin - if AProfile = ActiveProfile then - FActiveProfile := nil; - itemIndex := cmbProfiles.Items.IndexOfObject(AProfile); if itemIndex > -1 then begin - Profiles.Remove(AProfile); + TProfileManager.Remove(AProfile); cmbProfiles.Items.Delete(itemIndex); - if Profiles.Count = 0 then + if TProfileManager.Instance.Count = 0 then AddProfile(CreateDefaultProfile); if ASetActiveProfile then begin - if itemIndex >= Profiles.Count then - itemIndex := Pred(Profiles.Count); + if itemIndex >= TProfileManager.Instance.Count then + itemIndex := Pred(TProfileManager.Instance.Count); FLockChangeProfile := True; try cmbProfiles.ItemIndex := itemIndex; - SetActiveProfile(TProfile(cmbProfiles.Items.Objects[itemIndex])); + TProfileManager.Instance.ActiveProfile := TProfile(cmbProfiles.Items.Objects[itemIndex]); finally FLockChangeProfile := False; end; @@ -615,7 +722,7 @@ begin if not FLockChangeProfile then begin if cmbProfiles.ItemIndex > -1 then - SetActiveProfile(TProfile(cmbProfiles.Items.Objects[cmbProfiles.ItemIndex])); + TProfileManager.Instance.ActiveProfile := TProfile(cmbProfiles.Items.Objects[cmbProfiles.ItemIndex]); end; end; @@ -635,35 +742,28 @@ begin end; -procedure TMainForm.SetActiveProfile(const Value: TProfile); +procedure TMainForm.ObserveActiveChanged(AProfile: TProfile); begin - if Value <> FActiveProfile then - begin - FActiveProfile := Value; + { This callback is not thread-safe } + PostMessage(Self.Handle, CM_PROFILECHANGED, 0, 0); +end; - if Assigned(ActiveProfile) then - begin - if Settings.ActiveProfile <> ActiveProfile.Name then - begin - Settings.ActiveProfile := ActiveProfile.Name; - SaveSettings; - end; - FLockChangeProfile := True; - try - cmbProfiles.ItemIndex := cmbProfiles.Items.IndexOfObject(ActiveProfile); - finally - FLockChangeProfile := False; - end; +procedure TMainForm.ObserveAdd(AProfile: TProfile); +begin + { For now we'll assume we're the only one changing the profiles } +end; - LoadActiveProfile; - end; - end; + +procedure TMainForm.ObserveRemove(AProfile: TProfile); +begin end; procedure TMainForm.SetDeviceState(const AMessage: string; AFound: Boolean); begin + Debug.LogFmt('UI: G940 Throttle state changed (found = %s, status = %s)', [BoolToStr(AFound, True), AMessage]); + lblG940ThrottleState.Caption := AMessage; lblG940ThrottleState.Update; @@ -676,6 +776,8 @@ end; procedure TMainForm.SetFSXState(const AMessage: string; AConnected: Boolean); begin + Debug.LogFmt('UI: FSX SimConnect state changed (connected = %s, status = %s)', [BoolToStr(AConnected, True), AMessage]); + lblFSXState.Caption := AMessage; lblFSXState.Update; @@ -694,7 +796,7 @@ procedure TMainForm.LEDButtonClick(Sender: TObject); Result := AName; counter := 0; - while Assigned(Profiles.Find(Result)) do + while Assigned(TProfileManager.Find(Result)) do begin Inc(counter); Result := Format('%s (%d)', [AName, counter]); @@ -703,27 +805,29 @@ procedure TMainForm.LEDButtonClick(Sender: TObject); var + activeProfile: TProfile; buttonIndex: NativeInt; profile: TProfile; newProfile: Boolean; begin - if not Assigned(ActiveProfile) then + activeProfile := TProfileManager.Instance.ActiveProfile; + if not Assigned(activeProfile) then exit; { Behaviour similar to the Windows System Sounds control panel; when a change occurs, create a temporary profile "(modified)" so the original profile can still be selected } - if not ActiveProfile.IsTemporary then + if not activeProfile.IsTemporary then begin profile := TProfile.Create; - profile.Assign(ActiveProfile); + profile.Assign(activeProfile); profile.Name := GetUniqueProfileName(profile.Name + ProfilePostfixModified); profile.IsTemporary := True; newProfile := True; end else begin - profile := ActiveProfile; + profile := activeProfile; newProfile := False; end; @@ -801,6 +905,9 @@ end; procedure TMainForm.CheckForUpdatesThread(const ATask: IOmniTask); +const + UPDATE_URL = 'http://g940.x2software.net/version'; + var httpClient: TIdHTTP; msgSent: Boolean; @@ -809,9 +916,13 @@ var begin msgSent := False; try + Debug.LogFmt('AutoUpdate: Checking for updates (%s)', [UPDATE_URL]); + httpClient := TIdHTTP.Create(nil); try - latestVersion := httpClient.Get('http://g940.x2software.net/version'); + latestVersion := httpClient.Get(UPDATE_URL); + Debug.LogFmt('AutoUpdate: Received version "%s"', [latestVersion]); + if VersionIsNewer(Format('%d.%d.%d', [App.Version.Major, App.Version.Minor, App.Version.Release]), latestVersion) then ATask.Comm.Send(TM_UPDATE, latestVersion) else @@ -844,13 +955,13 @@ var begin name := ''; - profile := ActiveProfile; + profile := TProfileManager.Instance.ActiveProfile; existingProfile := nil; repeat if InputQuery('Save profile as', 'Save this profile as:', name) then begin - existingProfile := Profiles.Find(name); + existingProfile := TProfileManager.Find(name); if existingProfile = profile then existingProfile := nil; @@ -875,7 +986,7 @@ begin existingProfile.Assign(profile); existingProfile.Name := name; UpdateProfile(existingProfile); - SetActiveProfile(existingProfile); + TProfileManager.Instance.ActiveProfile := existingProfile; if profile.IsTemporary then DeleteProfile(profile, False); @@ -900,13 +1011,17 @@ end; procedure TMainForm.btnDeleteProfileClick(Sender: TObject); +var + activeProfile: TProfile; + begin - if Assigned(ActiveProfile) then + activeProfile := TProfileManager.Instance.ActiveProfile; + if Assigned(activeProfile) then begin - if MessageBox(Self.Handle, PChar(Format('Do you want to remove the profile named "%s"?', [ActiveProfile.Name])), + if MessageBox(Self.Handle, PChar(Format('Do you want to remove the profile named "%s"?', [activeProfile.Name])), 'Remove profile', MB_ICONQUESTION or MB_YESNO) = ID_YES then begin - DeleteProfile(ActiveProfile, True); + DeleteProfile(activeProfile, True); SaveProfiles; end; end; @@ -920,6 +1035,22 @@ begin end; +procedure TMainForm.cbProfileMenuClick(Sender: TObject); +begin + Settings.ProfileMenu := cbProfileMenu.Checked; + SaveSettings; + ApplyProfileMenuSettings; +end; + + +procedure TMainForm.cbProfileMenuCascadedClick(Sender: TObject); +begin + Settings.ProfileMenuCascaded := cbProfileMenuCascaded.Checked; + SaveSettings; + ApplyProfileMenuSettings; +end; + + procedure TMainForm.CheckForUpdates(AReportNoUpdates: Boolean); begin btnCheckUpdates.Enabled := False; @@ -1001,6 +1132,26 @@ begin end; +procedure TMainForm.ApplyProfileMenuSettings; +var + fsxProvider: IFSXLEDFunctionProvider; + +begin + if Supports(TLEDFunctionRegistry.Find(FSXProviderUID), IFSXLEDFunctionProvider, fsxProvider) then + fsxProvider.SetProfileMenu(Settings.ProfileMenu, Settings.ProfileMenuCascaded); +end; + + +procedure TMainForm.FinalizeProfileMenu; +var + fsxProvider: IFSXLEDFunctionProvider; + +begin + if Supports(TLEDFunctionRegistry.Find(FSXProviderUID), IFSXLEDFunctionProvider, fsxProvider) then + fsxProvider.SetProfileMenu(False, False); +end; + + procedure TMainForm.btnCheckUpdatesClick(Sender: TObject); begin CheckForUpdates(True); diff --git a/G940LEDControl/G940LEDControl.dpr b/G940LEDControl/G940LEDControl.dpr index 87b0bc9..6b70f6e 100644 --- a/G940LEDControl/G940LEDControl.dpr +++ b/G940LEDControl/G940LEDControl.dpr @@ -2,6 +2,7 @@ program G940LEDControl; uses Forms, + SysUtils, MainFrm in 'Forms\MainFrm.pas' {MainForm}, LogiJoystickDLL in '..\Shared\LogiJoystickDLL.pas', SimConnect in '..\Shared\SimConnect.pas', @@ -30,7 +31,12 @@ uses LEDResources in 'Units\LEDResources.pas', Settings in 'Units\Settings.pas', FSXLEDFunctionWorker in 'Units\FSXLEDFunctionWorker.pas', - FSXSimConnectStateMonitor in 'Units\FSXSimConnectStateMonitor.pas'; + FSXSimConnectStateMonitor in 'Units\FSXSimConnectStateMonitor.pas', + ProfileManager in 'Units\ProfileManager.pas', + FSXLEDFunctionProviderIntf in 'Units\FSXLEDFunctionProviderIntf.pas', + GxDbugIntf in 'Units\GxDbugIntf.pas', + DebugLog in 'Units\DebugLog.pas', + DebugLogGExperts in 'Units\DebugLogGExperts.pas'; {$R *.res} @@ -39,6 +45,9 @@ var MainForm: TMainForm; begin + if FindCmdLineSwitch('log') then + SetDebugLogConsumer(TGExpertsDebugLogConsumer.Create); + Application.Initialize; Application.MainFormOnTaskbar := True; Application.Title := 'G940 LED Control'; diff --git a/G940LEDControl/G940LEDControl.dproj b/G940LEDControl/G940LEDControl.dproj index 4e9058b..c318d2e 100644 --- a/G940LEDControl/G940LEDControl.dproj +++ b/G940LEDControl/G940LEDControl.dproj @@ -82,10 +82,10 @@ RELEASE;$(DCC_Define) - 1 + 5 1 0 - CompanyName=X²Software;FileDescription=G940 LED Control;FileVersion=1.0.1.0;InternalName=;LegalCopyright=© 2011 X²Software;LegalTrademarks=;OriginalFilename=G940LEDControl.exe;ProductName=G940 LED Control;ProductVersion=1.0;Comments= + CompanyName=X²Software;FileDescription=G940 LED Control;FileVersion=1.0.5.0;InternalName=;LegalCopyright=© 2011 X²Software;LegalTrademarks=;OriginalFilename=G940LEDControl.exe;ProductName=G940 LED Control;ProductVersion=1.0;Comments= 1033 $(BDS)\bin\default_app.manifest @@ -106,11 +106,68 @@ F:\Components\X2Utils\Resources\VistaManAsInvoker.manifest 1033 + + + MainSource + + +
MainForm
+ + + + + + + + + + + + + + + + + + + +
ButtonFunctionForm
+ + + + + + + + + + + + + + + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + Delphi.Personality.12 + + G940LEDControl.dpr + False True @@ -143,95 +200,7 @@ 1.0.0.0 - - G940LEDControl.dpr - - ExpressEditors FieldLink by Developer Express Inc. - ExpressBars DBNavigator by Developer Express Inc. - ExpressBars extended DB items by Developer Express Inc. - ExpressBars extended items by Developer Express Inc. - ExpressBars Tabbed MDI by Developer Express Inc. - ExpressLayout Control by Developer Express Inc. - ExpressQuantumTreeList 5 by Developer Express Inc. - ExpressQuantumGrid by Developer Express Inc. - ExpressVerticalGrid by Developer Express Inc. - ExpressMemData by Developer Express Inc. - ExpressSpellChecker 2 by Developer Express Inc. - ExpressSpreadSheet by Developer Express Inc. - ExpressDocking Library by Developer Express Inc. - ExpressNavBar by Developer Express Inc. - ExpressSkins - Black Skin by Developer Express Inc. - ExpressSkins - Blue Skin by Developer Express Inc. - ExpressSkins - Blueprint Skin by Developer Express Inc. - ExpressSkins - Caramel Skin by Developer Express Inc. - ExpressSkins - Coffee Skin by Developer Express Inc. - ExpressSkins - Darkroom Skin by Developer Express Inc. - ExpressSkins - DarkSide Skin by Developer Express Inc. - ExpressSkins - DevExpressDarkStyle Skin by Developer Express Inc. - ExpressSkins - DevExpressStyle Skin by Developer Express Inc. - ExpressSkins - Foggy Skin by Developer Express Inc. - ExpressSkins - GlassOceans Skin by Developer Express Inc. - ExpressSkins - HighContrast Skin by Developer Express Inc. - ExpressSkins - iMaginary Skin by Developer Express Inc. - ExpressSkins - Lilian Skin by Developer Express Inc. - ExpressSkins - LiquidSky Skin by Developer Express Inc. - ExpressSkins - LondonLiquidSky Skin by Developer Express Inc. - ExpressSkins - McSkin Skin by Developer Express Inc. - ExpressSkins - MoneyTwins Skin by Developer Express Inc. - ExpressSkins - Office2007Black Skin by Developer Express Inc. - ExpressSkins - Office2007Blue Skin by Developer Express Inc. - ExpressSkins - Office2007Green Skin by Developer Express Inc. - ExpressSkins - Office2007Pink Skin by Developer Express Inc. - ExpressSkins - Office2007Silver Skin by Developer Express Inc. - ExpressSkins - Office2010Black Skin by Developer Express Inc. - ExpressSkins - Office2010Blue Skin by Developer Express Inc. - ExpressSkins - Office2010Silver Skin by Developer Express Inc. - ExpressSkins - Pumpkin Skin by Developer Express Inc. - ExpressSkins - SevenClassic Skin by Developer Express Inc. - ExpressSkins - Seven Skin by Developer Express Inc. - ExpressSkins - Sharp Skin by Developer Express Inc. - ExpressSkins - SharpPlus Skin by Developer Express Inc. - ExpressSkins - Silver Skin by Developer Express Inc. - ExpressSkins - Springtime Skin by Developer Express Inc. - ExpressSkins - Stardust Skin by Developer Express Inc. - ExpressSkins - Summer2008 Skin by Developer Express Inc. - ExpressSkins - TheAsphaltWorld Skin by Developer Express Inc. - ExpressSkins - Valentine Skin by Developer Express Inc. - ExpressSkins - VS2010 Skin by Developer Express Inc. - ExpressSkins - Whiteprint Skin by Developer Express Inc. - ExpressSkins - Xmas2008Blue Skin by Developer Express Inc. - ExpressPrinting System ReportLinks (Standard) by Developer Express Inc. - ExpressPrinting System ContainerProducer for ExpressPageControl by Developer Express Inc. - ExpressDBTree by Developer Express Inc. - ExpressTreePrintedDataSet by Developer Express Inc. - ExpressDBOrgChart by Developer Express Inc. - ExpressFlowChart by Developer Express Inc. - ExpressPageControl dxBar Popup Menu by Developer Express Inc. - ExpressBars cxEditor item by Developer Express Inc. - ExpressScheduler connection to ExpressQuantumGrid by Developer Express Inc. - ExpressQuantumTreeList 5 dxBar Built-In Menu by Developer Express Inc. - ExpressSkins Library Uses Clause Auto Fill Helper for ExpressEditors by Developer Express Inc. - ExpressSkins Library Uses Clause Auto Fill Helper for PageControl Painter by Developer Express Inc. - ExpressSkins Library Uses Clause Auto Fill Helper for Scheduler Painter by Developer Express Inc. - ExpressSkins Library Uses Clause Auto Fill Helper for Bars Painters by Developer Express Inc. - ExpressSkins Library Uses Clause Auto Fill Helper for NavBar Painter by Developer Express Inc. - ExpressSkins Library Uses Clause Auto Fill Helper for Ribbon Painters by Developer Express Inc. - ExpressPrinting System Cross Platform Library by Developer Express Inc. - ExpressPrinting System Extended Cross Platform Library by Developer Express Inc. - ExpressPrinting System ReportLink for ExpressPivotGrid by Developer Express Inc. - ExpressPrinting System ReportLink for ExpressScheduler by Developer Express Inc. - ExpressPrinting System ReportLink for ExpressSpreadSheet by Developer Express Inc. - ExpressPrinting System ReportLink for ExpressQuantumTreeList by Developer Express Inc. - ExpressPrinting System ReportLink for ExpressVerticalGrid by Developer Express Inc. - ExpressPrinting System ReportLinks for ExpressDBOrgChart by Developer Express Inc. - ExpressPrinting System ReportLink for ExpressDBTree by Developer Express Inc. - ExpressPrinting System ReportLinks for ExpressFlowChart by Developer Express Inc. - ExpressPrinting System ReportLink for ExpressQuantumGrid by Developer Express Inc. - ExpressPrinting System ReportLinks for ExpressOrgChart by Developer Express Inc. - ExpressPrinting System Advanced Preview Window by Developer Express Inc. - ExpressPrinting System Ribbon Preview Window by Developer Express Inc. - ExpressPivotGrid 2 connection to ExpressQuantumGrid Chart View by Developer Express Inc. ExpressPivotGrid 2 OLAP by Developer Express Inc. @@ -243,55 +212,5 @@ 12 - - - MainSource - - -
MainForm
- - - - - - - - - - - - - - - - - - - -
ButtonFunctionForm
- dfm - - - - - - - - - - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - diff --git a/G940LEDControl/G940LEDControl.res b/G940LEDControl/G940LEDControl.res index b7f720a8adedaeba582724d0671faca5f2ace654..906ddee2cba7b0ebdff29348afd88ed20b99346a 100644 GIT binary patch delta 21 dcmaEJkMYet#tCJNtQ*UD85vDCw=zD@1psM72%G=_ delta 21 dcmaEJkMYet#tCJNj2p{&85s>Xw=zD@1psLK2$TQ- diff --git a/G940LEDControl/Units/DebugLog.pas b/G940LEDControl/Units/DebugLog.pas new file mode 100644 index 0000000..2c50ab7 --- /dev/null +++ b/G940LEDControl/Units/DebugLog.pas @@ -0,0 +1,173 @@ +unit DebugLog; + +interface +type + TCustomDebugLogConsumer = class(TObject) + public + procedure LogValue(const AIdentifier: string; const AValue: Boolean); overload; virtual; abstract; + procedure LogValue(const AIdentifier: string; const AValue: TDateTime); overload; virtual; abstract; + procedure LogValue(const AIdentifier: string; const AValue: Integer); overload; virtual; abstract; + + procedure Log(const AMsg: string); virtual; abstract; + procedure LogFmt(const AMsg: string; const AArgs: array of const); virtual; abstract; + + procedure LogWarning(const AMsg: string); virtual; abstract; + procedure LogWarningFmt(const AMsg: string; const AArgs: array of const); virtual; abstract; + + procedure LogError(const AMsg: string); virtual; abstract; + procedure LogErrorFmt(const AMsg: string; const AArgs: array of const); virtual; abstract; + + procedure LogMethodEnter(const AMethodName: string); virtual; abstract; + procedure LogMethodExit(const AMethodName: string); virtual; abstract; + + procedure Indent; virtual; abstract; + procedure UnIndent; virtual; abstract; + procedure Separator; virtual; abstract; + end; + + + procedure SetDebugLogConsumer(AConsumer: TCustomDebugLogConsumer); + procedure ClearDebugLogConsumer; + + function Debug: TCustomDebugLogConsumer; + + +implementation +uses + SysUtils; + + +var + DebugLogConsumer: TCustomDebugLogConsumer; + + +type + TNullDebugLogConsumer = class(TCustomDebugLogConsumer) + public + procedure Log(const AMsg: string); override; + procedure LogFmt(const AMsg: string; const AArgs: array of const); override; + + procedure LogWarning(const AMsg: string); override; + procedure LogWarningFmt(const AMsg: string; const AArgs: array of const); override; + + procedure LogError(const AMsg: string); override; + procedure LogErrorFmt(const AMsg: string; const AArgs: array of const); override; + + procedure LogValue(const AIdentifier: string; const AValue: Boolean); overload; override; + procedure LogValue(const AIdentifier: string; const AValue: TDateTime); overload; override; + procedure LogValue(const AIdentifier: string; const AValue: Integer); overload; override; + + procedure LogMethodEnter(const AMethodName: string); override; + procedure LogMethodExit(const AMethodName: string); override; + + procedure Indent; override; + procedure UnIndent; override; + procedure Separator; override; + end; + + + +procedure SetDebugLogConsumer(AConsumer: TCustomDebugLogConsumer); +begin + if (not Assigned(DebugLogConsumer)) or (AConsumer <> DebugLogConsumer) then + begin + FreeAndNil(DebugLogConsumer); + + if Assigned(AConsumer) then + DebugLogConsumer := AConsumer + else + DebugLogConsumer := TNullDebugLogConsumer.Create; + end; +end; + + +procedure ClearDebugLogConsumer; +begin + SetDebugLogConsumer(nil); +end; + + +function Debug: TCustomDebugLogConsumer; +begin + Result := DebugLogConsumer; +end; + + +{ TNullDebugLogConsumer } +procedure TNullDebugLogConsumer.Log(const AMsg: string); +begin +end; + + +procedure TNullDebugLogConsumer.LogFmt(const AMsg: string; const AArgs: array of const); +begin +end; + + +procedure TNullDebugLogConsumer.LogWarning(const AMsg: string); +begin +end; + + +procedure TNullDebugLogConsumer.LogWarningFmt(const AMsg: string; const AArgs: array of const); +begin +end; + + +procedure TNullDebugLogConsumer.LogError(const AMsg: string); +begin +end; + + +procedure TNullDebugLogConsumer.LogErrorFmt(const AMsg: string; const AArgs: array of const); +begin +end; + + +procedure TNullDebugLogConsumer.LogValue(const AIdentifier: string; const AValue: Boolean); +begin +end; + + +procedure TNullDebugLogConsumer.LogValue(const AIdentifier: string; const AValue: TDateTime); +begin +end; + + +procedure TNullDebugLogConsumer.LogValue(const AIdentifier: string; const AValue: Integer); +begin +end; + + +procedure TNullDebugLogConsumer.LogMethodEnter(const AMethodName: string); +begin +end; + + +procedure TNullDebugLogConsumer.LogMethodExit(const AMethodName: string); +begin +end; + + +procedure TNullDebugLogConsumer.Indent; +begin +end; + + +procedure TNullDebugLogConsumer.UnIndent; +begin +end; + + +procedure TNullDebugLogConsumer.Separator; +begin +end; + + +initialization + ClearDebugLogConsumer; + +finalization + FreeAndNil(DebugLogConsumer); + +end. diff --git a/G940LEDControl/Units/DebugLogGExperts.pas b/G940LEDControl/Units/DebugLogGExperts.pas new file mode 100644 index 0000000..a1c2a0a --- /dev/null +++ b/G940LEDControl/Units/DebugLogGExperts.pas @@ -0,0 +1,137 @@ +unit DebugLogGExperts; + +interface +uses + DebugLog; + + +type + TGExpertsDebugLogConsumer = class(TCustomDebugLogConsumer) + public + constructor Create; + + procedure Log(const AMsg: string); override; + procedure LogFmt(const AMsg: string; const AArgs: array of const); override; + + procedure LogWarning(const AMsg: string); override; + procedure LogWarningFmt(const AMsg: string; const AArgs: array of const); override; + + procedure LogError(const AMsg: string); override; + procedure LogErrorFmt(const AMsg: string; const AArgs: array of const); override; + + procedure LogValue(const AIdentifier: string; const AValue: Boolean); overload; override; + procedure LogValue(const AIdentifier: string; const AValue: TDateTime); overload; override; + procedure LogValue(const AIdentifier: string; const AValue: Integer); overload; override; + + procedure LogMethodEnter(const AMethodName: string); override; + procedure LogMethodExit(const AMethodName: string); override; + + procedure Indent; override; + procedure UnIndent; override; + procedure Separator; override; + end; + + +implementation +uses + Dialogs, + SysUtils, + + GxDbugIntf; + + +{ TGExpertsDebugLogConsumer } +constructor TGExpertsDebugLogConsumer.Create; +begin + if StartDebugWin = 0 then + raise Exception.Create('Debug log not available; is GExpertsDebugWindow.exe present?'); + + Log('G940 LED Control log initialized'); + Separator; +end; + + +procedure TGExpertsDebugLogConsumer.Log(const AMsg: string); +begin + SendDebug(AMsg); +end; + + +procedure TGExpertsDebugLogConsumer.LogFmt(const AMsg: string; const AArgs: array of const); +begin + SendDebugFmt(AMsg, AArgs); +end; + + +procedure TGExpertsDebugLogConsumer.LogWarning(const AMsg: string); +begin + SendDebugWarning(AMsg); +end; + + +procedure TGExpertsDebugLogConsumer.LogWarningFmt(const AMsg: string; const AArgs: array of const); +begin + SendDebugFmtEx(AMsg, AArgs, mtWarning); +end; + + +procedure TGExpertsDebugLogConsumer.LogError(const AMsg: string); +begin + SendDebug(AMsg); +end; + + +procedure TGExpertsDebugLogConsumer.LogErrorFmt(const AMsg: string; const AArgs: array of const); +begin + SendDebugFmtEx(AMsg, AArgs, mtError); +end; + + +procedure TGExpertsDebugLogConsumer.LogValue(const AIdentifier: string; const AValue: Boolean); +begin + SendBoolean(AIdentifier, AValue); +end; + + +procedure TGExpertsDebugLogConsumer.LogValue(const AIdentifier: string; const AValue: TDateTime); +begin + SendDateTime(AIdentifier, AValue); +end; + + +procedure TGExpertsDebugLogConsumer.LogValue(const AIdentifier: string; const AValue: Integer); +begin + SendInteger(AIdentifier, AValue); +end; + + +procedure TGExpertsDebugLogConsumer.LogMethodEnter(const AMethodName: string); +begin + SendMethodEnter(AMethodName); +end; + + +procedure TGExpertsDebugLogConsumer.LogMethodExit(const AMethodName: string); +begin + SendMethodExit(AMethodName); +end; + + +procedure TGExpertsDebugLogConsumer.Indent; +begin + SendIndent; +end; + + +procedure TGExpertsDebugLogConsumer.UnIndent; +begin + SendUnIndent; +end; + + +procedure TGExpertsDebugLogConsumer.Separator; +begin + SendSeparator; +end; + +end. diff --git a/G940LEDControl/Units/FSXLEDFunction.pas b/G940LEDControl/Units/FSXLEDFunction.pas index 0206860..33076ee 100644 --- a/G940LEDControl/Units/FSXLEDFunction.pas +++ b/G940LEDControl/Units/FSXLEDFunction.pas @@ -145,6 +145,13 @@ type function GetLightMask: Integer; override; end; + TFSXAllLightsFunction = class(TCustomFSXFunction) + protected + procedure RegisterStates; override; + function GetCategoryName: string; override; + function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override; + end; + { Autopilot } TCustomFSXAutoPilotFunction = class(TCustomFSXFunction) @@ -483,6 +490,27 @@ begin end; +{ TFSXAllLightsFunction } +procedure TFSXAllLightsFunction.RegisterStates; +begin + RegisterState(TLEDState.Create(FSXStateUIDOn, FSXStateDisplayNameOn, lcGreen)); + RegisterState(TLEDState.Create(FSXStateUIDPartial, FSXStateDisplayNamePartial, lcAmber)); + RegisterState(TLEDState.Create(FSXStateUIDOff, FSXStateDisplayNameOff, lcRed)); +end; + + +function TFSXAllLightsFunction.GetCategoryName: string; +begin + Result := FSXCategoryLights; +end; + + +function TFSXAllLightsFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; +begin + Result := TFSXAllLightsFunctionWorker; +end; + + { TCustomFSXAutoPilotFunction } function TCustomFSXAutoPilotFunction.GetCategoryName: string; begin diff --git a/G940LEDControl/Units/FSXLEDFunctionProvider.pas b/G940LEDControl/Units/FSXLEDFunctionProvider.pas index 84ea46a..f3f8a8f 100644 --- a/G940LEDControl/Units/FSXLEDFunctionProvider.pas +++ b/G940LEDControl/Units/FSXLEDFunctionProvider.pas @@ -5,6 +5,7 @@ uses Generics.Collections, System.SyncObjs, + FSXLEDFunctionProviderIntf, FSXSimConnectIntf, LEDFunction, LEDFunctionIntf, @@ -16,10 +17,11 @@ type TCustomFSXFunctionList = TObjectList; - TFSXLEDFunctionProvider = class(TCustomLEDFunctionProvider, IFSXSimConnectObserver) + TFSXLEDFunctionProvider = class(TCustomLEDFunctionProvider, IFSXLEDFunctionProvider, IFSXSimConnectObserver) private FSimConnect: TInterfacedObject; FSimConnectLock: TCriticalSection; + FProfileMenuSimConnect: IFSXSimConnectProfileMenu; protected procedure RegisterFunctions; override; @@ -27,6 +29,9 @@ type protected { IFSXSimConnectObserver } procedure ObserveDestroy(Sender: IFSXSimConnect); + + { IFSXLEDFunctionProvider } + procedure SetProfileMenu(AEnabled: Boolean; ACascaded: Boolean); public constructor Create; destructor Destroy; override; @@ -147,6 +152,7 @@ begin RegisterFunction(TFSXRecognitionLightsFunction.Create( Self, FSXFunctionDisplayNameRecognitionLights, FSXFunctionUIDRecognitionLights)); RegisterFunction(TFSXStrobeLightsFunction.Create( Self, FSXFunctionDisplayNameStrobeLights, FSXFunctionUIDStrobeLights)); RegisterFunction(TFSXTaxiLightsFunction.Create( Self, FSXFunctionDisplayNameTaxiLights, FSXFunctionUIDTaxiLights)); + RegisterFunction(TFSXAllLightsFunction.Create( Self, FSXFunctionDisplayNameAllLights, FSXFunctionUIDAllLights)); { Autopilot } RegisterFunction(TFSXAutoPilotFunction.Create( Self, FSXFunctionDisplayNameAutoPilot, FSXFunctionUIDAutoPilot)); @@ -197,6 +203,20 @@ begin end; +procedure TFSXLEDFunctionProvider.SetProfileMenu(AEnabled: Boolean; ACascaded: Boolean); +begin + if AEnabled and (not Assigned(FProfileMenuSimConnect)) then + FProfileMenuSimConnect := (GetSimConnect as IFSXSimConnectProfileMenu); + + if Assigned(FProfileMenuSimConnect) then + FProfileMenuSimConnect.SetProfileMenu(AEnabled, ACascaded); + + if not AEnabled then + FProfileMenuSimConnect := nil; +end; + + + { TCustomFSXFunction } constructor TCustomFSXFunction.Create(AProvider: TFSXLEDFunctionProvider; const ADisplayName, AUID: string); begin diff --git a/G940LEDControl/Units/FSXLEDFunctionProviderIntf.pas b/G940LEDControl/Units/FSXLEDFunctionProviderIntf.pas new file mode 100644 index 0000000..3d96e43 --- /dev/null +++ b/G940LEDControl/Units/FSXLEDFunctionProviderIntf.pas @@ -0,0 +1,13 @@ +unit FSXLEDFunctionProviderIntf; + +interface +type + IFSXLEDFunctionProvider = interface + ['{F13C936C-32C3-4204-A5E9-3AE6604AA31C}'] + procedure SetProfileMenu(AEnabled, ACascaded: Boolean); + end; + + +implementation + +end. diff --git a/G940LEDControl/Units/FSXLEDFunctionWorker.pas b/G940LEDControl/Units/FSXLEDFunctionWorker.pas index 634145a..9d645c2 100644 --- a/G940LEDControl/Units/FSXLEDFunctionWorker.pas +++ b/G940LEDControl/Units/FSXLEDFunctionWorker.pas @@ -91,6 +91,13 @@ type end; + TFSXAllLightsFunctionWorker = class(TCustomFSXFunctionWorker) + protected + procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); override; + procedure HandleData(AData: Pointer); override; + end; + + { Autopilot } PAutoPilotData = ^TAutoPilotData; TAutoPilotData = packed record @@ -533,6 +540,24 @@ begin end; +{ TFSXAllLightsFunctionWorker } +procedure TFSXAllLightsFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition); +begin + ADefinition.AddVariable('LIGHT ON STATES', FSX_UNIT_MASK, SIMCONNECT_DATATYPE_INT32); +end; + + +procedure TFSXAllLightsFunctionWorker.HandleData(AData: Pointer); +begin + if PCardinal(AData)^ = FSX_LIGHTON_ALL then + SetCurrentState(FSXStateUIDOn) + else if PCardinal(AData)^ > 0 then + SetCurrentState(FSXStateUIDPartial) + else + SetCurrentState(FSXStateUIDOff); +end; + + { TCustomFSXAutoPilotFunctionWorker } procedure TCustomFSXAutoPilotFunctionWorker.RegisterVariables(ADefinition: IFSXSimConnectDefinition); begin diff --git a/G940LEDControl/Units/FSXResources.pas b/G940LEDControl/Units/FSXResources.pas index 04eed5d..11f3dd5 100644 --- a/G940LEDControl/Units/FSXResources.pas +++ b/G940LEDControl/Units/FSXResources.pas @@ -15,9 +15,11 @@ const FSXStateUIDOn = 'on'; FSXStateUIDOff = 'off'; + FSXStateUIDPartial = 'partial'; FSXStateDisplayNameOn = 'On'; FSXStateDisplayNameOff = 'Off'; + FSXStateDisplayNamePartial = 'Partial'; FSXFunctionUIDEngine = 'engine'; @@ -77,6 +79,9 @@ const FSXFunctionUIDRecognitionLights = 'recognitionLights'; FSXFunctionDisplayNameRecognitionLights = 'Recognition lights'; + FSXFunctionUIDAllLights = 'allLights'; + FSXFunctionDisplayNameAllLights = 'All lights'; + FSXFunctionUIDParkingBrake = 'parkingBrake'; FSXFunctionDisplayNameParkingBrake = 'Parking brake'; @@ -190,6 +195,10 @@ const + FSXMenuProfiles = 'G940 Profile'; + FSXMenuProfileFormat = 'G940: %s'; + FSXMenuProfileFormatCascaded = '%s'; + implementation diff --git a/G940LEDControl/Units/FSXSimConnectClient.pas b/G940LEDControl/Units/FSXSimConnectClient.pas index c919b38..0299f1c 100644 --- a/G940LEDControl/Units/FSXSimConnectClient.pas +++ b/G940LEDControl/Units/FSXSimConnectClient.pas @@ -1,19 +1,27 @@ unit FSXSimConnectClient; +// Determines if a Win32 event will be used to wait for new +// messages instead of the old 0.x method of polling via a timer. +{$DEFINE SCUSEEVENT} + interface uses Classes, OtlTaskControl, - FSXSimConnectIntf; + FSXSimConnectIntf, + Profile, + ProfileManager; type - TFSXSimConnectInterface = class(TInterfacedObject, IFSXSimConnect) + TFSXSimConnectInterface = class(TInterfacedObject, IFSXSimConnect, IFSXSimConnectProfileMenu, IProfileObserver) private FClient: IOmniTaskControl; FObservers: TInterfaceList; + + FObservingProfileManager: Boolean; protected property Client: IOmniTaskControl read FClient; property Observers: TInterfaceList read FObservers; @@ -25,6 +33,14 @@ type function CreateDefinition: IFSXSimConnectDefinition; function AddDefinition(ADefinition: IFSXSimConnectDefinition; ADataHandler: IFSXSimConnectDataHandler): Integer; procedure RemoveDefinition(ADefinitionID: Cardinal; ADataHandler: IFSXSimConnectDataHandler); + + { IFSXSimConnectProfileMenu } + procedure SetProfileMenu(AEnabled, ACascaded: Boolean); + + { IProfileObserver } + procedure ObserveAdd(AProfile: TProfile); + procedure ObserveRemove(AProfile: TProfile); + procedure ObserveActiveChanged(AProfile: TProfile); public constructor Create; destructor Destroy; override; @@ -43,6 +59,7 @@ uses OtlCommon, SimConnect, + DebugLog, FSXResources, FSXSimConnectStateMonitor; @@ -52,12 +69,16 @@ const TM_REMOVEDEFINITION = 3002; TM_TRYSIMCONNECT = 3003; TM_PROCESSMESSAGES = 3004; + TM_SETPROFILEMENU = 3005; + TM_UPDATEPROFILEMENU = 3006; TIMER_TRYSIMCONNECT = 201; - TIMER_PROCESSMESSAGES = 202; - INTERVAL_TRYSIMCONNECT = 5000; + + {$IFNDEF SCUSEEVENT} + TIMER_PROCESSMESSAGES = 202; INTERVAL_PROCESSMESSAGES = 50; + {$ENDIF} type @@ -71,7 +92,7 @@ type constructor Create(ADefinition: IFSXSimConnectDefinitionAccess); destructor Destroy; override; - procedure Attach(ADataHandler: IFSXSimConnectDataHandler); + function Attach(ADataHandler: IFSXSimConnectDataHandler): Integer; function Detach(ADataHandler: IFSXSimConnectDataHandler): Integer; procedure HandleData(AData: Pointer); @@ -90,14 +111,27 @@ type FDefinitions: TFSXSimConnectDefinitionMap; FLastDefinitionID: Cardinal; FSimConnectHandle: THandle; -// FSimConnectDataEvent: TEvent; + {$IFDEF SCUSEEVENT} + FSimConnectDataEvent: TEvent; + {$ENDIF} + + FProfileMenu: Boolean; + FProfileMenuCascaded: Boolean; + + FMenuProfiles: TStringList; + FMenuWasCascaded: Boolean; protected procedure TMAddDefinition(var Msg: TOmniMessage); message TM_ADDDEFINITION; procedure TMRemoveDefinition(var Msg: TOmniMessage); message TM_REMOVEDEFINITION; procedure TMTrySimConnect(var Msg: TOmniMessage); message TM_TRYSIMCONNECT; + {$IFNDEF SCUSEEVENT} procedure TMProcessMessages(var Msg: TOmniMessage); message TM_PROCESSMESSAGES; + {$ENDIF} + procedure TMSetProfileMenu(var Msg: TOmniMessage); message TM_SETPROFILEMENU; + procedure TMUpdateProfileMenu(var Msg: TOmniMessage); message TM_UPDATEPROFILEMENU; procedure HandleSimConnectDataEvent; + procedure HandleEvent(AEventID: Integer); protected function Initialize: Boolean; override; procedure Cleanup; override; @@ -111,10 +145,17 @@ type function SameDefinition(ADefinition1, ADefinition2: IFSXSimConnectDefinitionAccess): Boolean; + procedure UpdateProfileMenu; + property Definitions: TFSXSimConnectDefinitionMap read FDefinitions; property LastDefinitionID: Cardinal read FLastDefinitionID; property SimConnectHandle: THandle read FSimConnectHandle; -// property SimConnectDataEvent: TEvent read FSimConnectDataEvent; + {$IFDEF SCUSEEVENT} + property SimConnectDataEvent: TEvent read FSimConnectDataEvent; + {$ENDIF} + + property ProfileMenu: Boolean read FProfileMenu; + property ProfileMenuCascaded: Boolean read FProfileMenuCascaded; end; @@ -263,6 +304,40 @@ end; +procedure TFSXSimConnectInterface.SetProfileMenu(AEnabled, ACascaded: Boolean); +begin + Client.Comm.Send(TM_SETPROFILEMENU, [AEnabled, ACascaded]); + + if AEnabled <> FObservingProfileManager then + begin + if AEnabled then + TProfileManager.Attach(Self) + else + TProfileManager.Detach(Self); + + FObservingProfileManager := AEnabled; + end; +end; + + +procedure TFSXSimConnectInterface.ObserveAdd(AProfile: TProfile); +begin + Client.Comm.Send(TM_UPDATEPROFILEMENU); +end; + + +procedure TFSXSimConnectInterface.ObserveRemove(AProfile: TProfile); +begin + Client.Comm.Send(TM_UPDATEPROFILEMENU); +end; + + +procedure TFSXSimConnectInterface.ObserveActiveChanged(AProfile: TProfile); +begin +end; + + + { TFSXSimConnectDefinition } constructor TFSXSimConnectDefinition.Create; begin @@ -301,14 +376,19 @@ end; { TFSXSimConnectClient } function TFSXSimConnectClient.Initialize: Boolean; begin + Debug.Log('FSX SimConnect: Initializing'); + Result := inherited Initialize; if not Result then exit; FDefinitions := TFSXSimConnectDefinitionMap.Create; + FMenuProfiles := TStringList.Create; -// FSimConnectDataEvent := TEvent.Create(nil, False, False, ''); -// Task.RegisterWaitObject(SimConnectDataEvent.Handle, HandleSimConnectDataEvent); + {$IFDEF SCUSEEVENT} + FSimConnectDataEvent := TEvent.Create(nil, False, False, ''); + Task.RegisterWaitObject(SimConnectDataEvent.Handle, HandleSimConnectDataEvent); + {$ENDIF} TrySimConnect; end; @@ -316,7 +396,13 @@ end; procedure TFSXSimConnectClient.Cleanup; begin -// FreeAndNil(FSimConnectDataEvent); + Debug.Log('FSX SimConnect: Cleaning up'); + + {$IFDEF SCUSEEVENT} + FreeAndNil(FSimConnectDataEvent); + {$ENDIF} + + FreeAndNil(FMenuProfiles); FreeAndNil(FDefinitions); if SimConnectHandle <> 0 then @@ -329,41 +415,85 @@ end; procedure TFSXSimConnectClient.TrySimConnect; +var + eventHandle: THandle; + begin if SimConnectHandle <> 0 then exit; + Debug.Log('FSX SimConnect: Attempting to connect to SimConnect'); + if InitSimConnect then begin - if SimConnect_Open(FSimConnectHandle, FSXSimConnectAppName, 0, 0, 0 (*SimConnectDataEvent.Handle*), 0) = S_OK then + {$IFDEF SCUSEEVENT} + eventHandle := SimConnectDataEvent.Handle; + {$ELSE} + eventHandle := 0; + {$ENDIF} + + if SimConnect_Open(FSimConnectHandle, FSXSimConnectAppName, 0, 0, eventHandle, 0) = S_OK then begin + Debug.Log('FSX SimConnect: Succesfully connected'); TFSXSimConnectStateMonitor.SetCurrentState(scsConnected); Task.ClearTimer(TIMER_TRYSIMCONNECT); RegisterDefinitions; + UpdateProfileMenu; + {$IFNDEF SCUSEEVENT} Task.SetTimer(TIMER_PROCESSMESSAGES, INTERVAL_PROCESSMESSAGES, TM_PROCESSMESSAGES); + {$ENDIF} end; end; if SimConnectHandle = 0 then begin + Debug.LogFmt('FSX SimConnect: Connection failed, trying again in %d seconds', [INTERVAL_TRYSIMCONNECT div 1000]); TFSXSimConnectStateMonitor.SetCurrentState(scsFailed); Task.SetTimer(TIMER_TRYSIMCONNECT, INTERVAL_TRYSIMCONNECT, TM_TRYSIMCONNECT); + {$IFNDEF SCUSEEVENT} Task.ClearTimer(TIMER_PROCESSMESSAGES); + {$ENDIF} end; end; procedure TFSXSimConnectClient.HandleSimConnectDataEvent; +const + RecvMessageName: array[SIMCONNECT_RECV_ID] of string = + ( + 'Null', + 'Exception', + 'Open', + 'Quit', + 'Event', + 'Event Object Addremove', + 'Event Filename', + 'Event Frame', + 'Simobject Data', + 'Simobject Data Bytype', + 'Weather Observation', + 'Cloud State', + 'Assigned Object Id', + 'Reserved Key', + 'Custom Action', + 'System State', + 'Client Data' + ); + + var data: PSimConnectRecv; dataSize: Cardinal; simObjectData: PSimConnectRecvSimObjectData; + eventData: PSimConnectRecvEvent; definitionRef: TFSXSimConnectDefinitionRef; begin + Debug.Log('FSX SimConnect: Handling messages'); + while (SimConnectHandle <> 0) and (SimConnect_GetNextDispatch(SimConnectHandle, data, dataSize) = S_OK) do begin @@ -371,6 +501,7 @@ begin SIMCONNECT_RECV_ID_SIMOBJECT_DATA: begin simObjectData := PSimConnectRecvSimObjectData(data); + Debug.LogFmt('FSX SimConnect: Received Sim Object Data message (definition = %d)', [simObjectData^.dwDefineID]); if Definitions.ContainsKey(simObjectData^.dwDefineID) then begin @@ -379,19 +510,54 @@ begin end; end; + SIMCONNECT_RECV_ID_EVENT: + begin + eventData := PSimConnectRecvEvent(data); + Debug.LogFmt('FSX SimConnect: Received Event message (eventId = %d)', [eventData^.uEventID]); + + HandleEvent(eventData^.uEventID); + end; + SIMCONNECT_RECV_ID_QUIT: begin + Debug.Log('FSX SimConnect: Received Quit message'); + FSimConnectHandle := 0; + {$IFNDEF SCUSEEVENT} Task.ClearTimer(TIMER_PROCESSMESSAGES); + {$ENDIF} Task.SetTimer(TIMER_TRYSIMCONNECT, INTERVAL_TRYSIMCONNECT, TM_TRYSIMCONNECT); + FMenuProfiles.Clear; + TFSXSimConnectStateMonitor.SetCurrentState(scsDisconnected); end; + else + if SIMCONNECT_RECV_ID(data^.dwID) in [Low(SIMCONNECT_RECV_ID)..High(SIMCONNECT_RECV_ID)] then + Debug.LogFmt('FSX SimConnect: Received unhandled message (%s)', [RecvMessageName[SIMCONNECT_RECV_ID(data^.dwID)]]) + else + Debug.LogFmt('FSX SimConnect: Received unknown message (%d)', [data^.dwID]); end; end; end; +procedure TFSXSimConnectClient.HandleEvent(AEventID: Integer); +var + profileName: string; + profile: TProfile; + +begin + if (AEventID <= 0) or (AEventID > FMenuProfiles.Count) then + exit; + + profileName := FMenuProfiles[Pred(AEventID)]; + profile := TProfileManager.Find(profileName); + if Assigned(profile) then + TProfileManager.Instance.ActiveProfile := profile; +end; + + procedure TFSXSimConnectClient.RegisterDefinitions; var definitionID: Cardinal; @@ -400,6 +566,8 @@ begin if SimConnectHandle = 0 then exit; + UpdateProfileMenu; + for definitionID in Definitions.Keys do RegisterDefinition(definitionID, Definitions[definitionID].Definition); end; @@ -414,6 +582,8 @@ begin if SimConnectHandle = 0 then exit; + Debug.LogFmt('FSX SimConnect: Registering definition %d', [ADefinitionID]); + for variableIndex := 0 to Pred(ADefinition.GetVariableCount) do begin variable := ADefinition.GetVariable(variableIndex); @@ -446,7 +616,10 @@ end; procedure TFSXSimConnectClient.UnregisterDefinition(ADefinitionID: Cardinal); begin if SimConnectHandle <> 0 then + begin + Debug.LogFmt('FSX SimConnect: Unregistering definition: %d', [ADefinitionID]); SimConnect_ClearDataDefinition(SimConnectHandle, ADefinitionID); + end; end; @@ -482,6 +655,69 @@ begin end; +procedure TFSXSimConnectClient.UpdateProfileMenu; +var + profile: TProfile; + profileIndex: Integer; + menuIndex: Integer; + profileName: string; + +begin + if SimConnectHandle = 0 then + exit; + + Debug.Log('FSX SimConnect: Updating profile menu'); + + if FMenuWasCascaded then + begin + for menuIndex := Pred(FMenuProfiles.Count) downto 0 do + SimConnect_MenuDeleteSubItem(SimConnectHandle, 1, Cardinal(FMenuProfiles.Objects[menuIndex])); + + SimConnect_MenuDeleteItem(SimConnectHandle, 1); + end else + begin + for menuIndex := Pred(FMenuProfiles.Count) downto 0 do + SimConnect_MenuDeleteItem(SimConnectHandle, Cardinal(FMenuProfiles.Objects[menuIndex])); + end; + + FMenuProfiles.Clear; + + + if ProfileMenu then + begin + for profile in TProfileManager.Instance do + FMenuProfiles.Add(profile.Name); + + FMenuProfiles.Sort; + + + if ProfileMenuCascaded then + begin + SimConnect_MenuAddItem(SimConnectHandle, FSXMenuProfiles, 1, 0); + + for profileIndex := 0 to Pred(FMenuProfiles.Count) do + begin + profileName := Format(FSXMenuProfileFormatCascaded, [FMenuProfiles[profileIndex]]); + + SimConnect_MenuAddSubItem(SimConnectHandle, 1, PAnsiChar(AnsiString(profileName)), Succ(profileIndex), Succ(profileIndex)); + FMenuProfiles.Objects[profileIndex] := TObject(Succ(profileIndex)); + end; + end else + begin + for profileIndex := 0 to Pred(FMenuProfiles.Count) do + begin + profileName := Format(FSXMenuProfileFormat, [FMenuProfiles[profileIndex]]); + + SimConnect_MenuAddItem(SimConnectHandle, PAnsiChar(AnsiString(profileName)), Succ(profileIndex), Succ(profileIndex)); + FMenuProfiles.Objects[profileIndex] := TObject(Succ(profileIndex)); + end; + end; + + FMenuWasCascaded := ProfileMenuCascaded; + end; +end; + + procedure TFSXSimConnectClient.TMAddDefinition(var Msg: TOmniMessage); var addDefinition: TAddDefinitionValue; @@ -489,12 +725,15 @@ var definitionRef: TFSXSimConnectDefinitionRef; definitionAccess: IFSXSimConnectDefinitionAccess; hasDefinition: Boolean; + refCount: Integer; begin addDefinition := Msg.MsgData; definitionAccess := (addDefinition.Definition as IFSXSimConnectDefinitionAccess); hasDefinition := False; + Debug.Log('FSX SimConnect: Received request to add a definition'); + { Attempt to re-use existing definition to save on SimConnect traffic } for definitionID in Definitions.Keys do begin @@ -502,9 +741,12 @@ begin if SameDefinition(definitionRef.Definition, definitionAccess) then begin - definitionRef.Attach(addDefinition.DataHandler); + refCount := definitionRef.Attach(addDefinition.DataHandler); addDefinition.DefinitionID := definitionID; + Debug.LogFmt('FSX SimConnect: Definition exists, incremented reference count (definitionID = %d, refCount = %d)', [definitionID, refCount]); + + { Request an update on the definition to update the new worker } UpdateDefinition(definitionID); @@ -517,6 +759,7 @@ begin begin { Add as new definition } Inc(FLastDefinitionID); + Debug.LogFmt('FSX SimConnect: Adding as new definition (%d)', [FLastDefinitionID]); definitionRef := TFSXSimConnectDefinitionRef.Create(definitionAccess); definitionRef.Attach(addDefinition.DataHandler); @@ -534,15 +777,23 @@ procedure TFSXSimConnectClient.TMRemoveDefinition(var Msg: TOmniMessage); var removeDefinition: TRemoveDefinitionValue; definitionRef: TFSXSimConnectDefinitionRef; + refCount: Integer; begin removeDefinition := Msg.MsgData; + Debug.LogFmt('FSX SimConnect: Received request to remove a definition (%d)', [removeDefinition.DefinitionID]); if Definitions.ContainsKey(removeDefinition.DefinitionID) then begin definitionRef := Definitions[removeDefinition.DefinitionID]; - if definitionRef.Detach(removeDefinition.DataHandler) = 0 then + refCount := definitionRef.Detach(removeDefinition.DataHandler); + + Debug.LogFmt('FSX SimConnect: Definition exists, decreased reference count (refCount = %d)', [refCount]); + + if refCount = 0 then begin + Debug.Log('FSX SimConnect: Removing definition'); + { Unregister with SimConnect } UnregisterDefinition(removeDefinition.DefinitionID); @@ -560,10 +811,37 @@ begin end; +{$IFNDEF SCUSEEVENT} procedure TFSXSimConnectClient.TMProcessMessages(var Msg: TOmniMessage); begin HandleSimConnectDataEvent; end; +{$ENDIF} + + +procedure TFSXSimConnectClient.TMSetProfileMenu(var Msg: TOmniMessage); +var + newProfileMenu: Boolean; + newProfileMenuCascaded: Boolean; + +begin + newProfileMenu := Msg.MsgData[0]; + newProfileMenuCascaded := Msg.MsgData[1]; + + if (newProfileMenu <> FProfileMenu) or (newProfileMenuCascaded <> FProfileMenuCascaded) then + begin + FProfileMenu := newProfileMenu; + FProfileMenuCascaded := newProfileMenuCascaded; + + UpdateProfileMenu; + end; +end; + + +procedure TFSXSimConnectClient.TMUpdateProfileMenu(var Msg: TOmniMessage); +begin + UpdateProfileMenu; +end; { TFSXSimConnectDefinitionRef } @@ -594,9 +872,10 @@ begin end; -procedure TFSXSimConnectDefinitionRef.Attach(ADataHandler: IFSXSimConnectDataHandler); +function TFSXSimConnectDefinitionRef.Attach(ADataHandler: IFSXSimConnectDataHandler): Integer; begin DataHandlers.Add(ADataHandler as IFSXSimConnectDataHandler); + Result := DataHandlers.Count; end; diff --git a/G940LEDControl/Units/FSXSimConnectIntf.pas b/G940LEDControl/Units/FSXSimConnectIntf.pas index 5f235a9..ec4b851 100644 --- a/G940LEDControl/Units/FSXSimConnectIntf.pas +++ b/G940LEDControl/Units/FSXSimConnectIntf.pas @@ -33,6 +33,12 @@ type end; + IFSXSimConnectProfileMenu = interface + ['{362B6F7D-3E68-48A8-83BC-6078AE100334}'] + procedure SetProfileMenu(AEnabled, ACascaded: Boolean); + end; + + IFSXSimConnectDefinition = interface ['{F1EAB3B1-0A3D-4B06-A75F-823E15C313B8}'] procedure AddVariable(AVariableName, AUnitsName: string; ADataType: SIMCONNECT_DATAType; AEpsilon: Single = 0); @@ -76,8 +82,16 @@ const FSX_LIGHTON_STROBE = $0010; FSX_LIGHTON_PANEL = $0020; FSX_LIGHTON_RECOGNITION = $0040; + FSX_LIGHTON_WING = $0080; + FSX_LIGHTON_LOGO = $0100; FSX_LIGHTON_CABIN = $0200; + FSX_LIGHTON_ALL = FSX_LIGHTON_NAV or FSX_LIGHTON_BEACON or FSX_LIGHTON_LANDING or + FSX_LIGHTON_TAXI or FSX_LIGHTON_STROBE or FSX_LIGHTON_PANEL or + FSX_LIGHTON_RECOGNITION or FSX_LIGHTON_WING or FSX_LIGHTON_LOGO or + FSX_LIGHTON_CABIN; + + FSX_MAX_ENGINES = 4; diff --git a/G940LEDControl/Units/G940LEDStateConsumer.pas b/G940LEDControl/Units/G940LEDStateConsumer.pas index f668616..54f605e 100644 --- a/G940LEDControl/Units/G940LEDStateConsumer.pas +++ b/G940LEDControl/Units/G940LEDStateConsumer.pas @@ -61,6 +61,7 @@ uses OtlCommon, OtlTask, + DebugLog, LEDColorIntf, LogiJoystickDLL; @@ -99,12 +100,14 @@ begin Result := False; + Debug.Log('G940 LED State consumer: Initializing LogiJoystickDLL'); if not LogiJoystickDLLInitialized then begin Task.SetExitStatus(EXIT_ERROR_LOGIJOYSTICKDLL, 'Could not load LogiJoystickDLL.dll'); exit; end; + Debug.Log('G940 LED State consumer: Initializing DirectInput'); if DirectInput8Create(SysInit.HInstance, DIRECTINPUT_VERSION, IDirectInput8, FDirectInput, nil) <> S_OK then begin Task.SetExitStatus(EXIT_ERROR_DIRECTINPUT, 'Failed to initialize DirectInput'); @@ -121,12 +124,17 @@ begin inherited Cleanup; if Assigned(ThrottleDevice) then + begin + Debug.Log('G940 LED State consumer: Cleanup (all LEDs to Green)'); SetLEDs(ThrottleDevice, 0, $FF); + end; end; procedure TG940LEDStateConsumer.FindThrottleDevice; begin + Debug.Log('G940 LED State consumer: Searching for throttle device'); + SetDeviceState(DEVICESTATE_SEARCHING); DirectInput.EnumDevices(DI8DEVCLASS_GAMECTRL, EnumDevicesProc, @@ -164,6 +172,21 @@ procedure TG940LEDStateConsumer.Update; end; + function ByteToBin(AByte: Byte): string; + var + bit: Integer; + + begin + Result := StringOfChar('0', 8); + + for bit := 0 to 7 do + begin + if (AByte and (1 shl bit)) <> 0 then + Result[8 - bit] := '1'; + end; + end; + + var red: Byte; green: Byte; @@ -199,6 +222,7 @@ begin end; end; + Debug.LogFmt('G940 LED State consumer: Set LED colors (red = %s, green = %s)', [ByteToBin(red), ByteToBin(green)]); SetLEDs(ThrottleDevice, red, green); end; @@ -213,8 +237,12 @@ procedure TG940LEDStateConsumer.TMTestThrottleDevice(var Msg: TOmniMessage); begin if Assigned(ThrottleDevice) then begin + Debug.Log('G940 LED State consumer: Checking if throttle is still attached'); + if DirectInput.GetDeviceStatus(ThrottleDeviceGUID) = DI_NOTATTACHED then begin + Debug.Log('G940 LED State consumer: Throttle disconnect'); + FThrottleDevice := nil; SetDeviceState(DEVICESTATE_NOTFOUND); end; diff --git a/G940LEDControl/Units/GxDbugIntf.pas b/G940LEDControl/Units/GxDbugIntf.pas new file mode 100644 index 0000000..9d0e089 --- /dev/null +++ b/G940LEDControl/Units/GxDbugIntf.pas @@ -0,0 +1,274 @@ +(* + * GExperts Debug Window Interface + * http://www.gexperts.org + * + * You are free to use this code in any application to send commands to the + * GExperts debug window. This includes usage in commercial, shareware, + * freeware, public domain, and other applications. + *) + +unit GxDbugIntf; + +interface + +uses + Windows, Dialogs; // We need "Dialogs" for TMsgDlgType + +procedure SendBoolean(const Identifier: string; const Value: Boolean); +procedure SendDateTime(const Identifier: string; const Value: TDateTime); +procedure SendDebugEx(const Msg: string; MType: TMsgDlgType); +procedure SendDebug(const Msg: string); +procedure SendDebugError(const Msg: string); +procedure SendDebugWarning(const Msg: string); +procedure SendDebugClear; +procedure SendInteger(const Identifier: string; const Value: Integer); +procedure SendMethodEnter(const MethodName: string); +procedure SendMethodExit(const MethodName: string); +procedure SendIndent; +procedure SendUnIndent; +procedure SendSeparator; +procedure SendDebugFmt(const Msg: string; const Args: array of const); +procedure SendDebugFmtEx(const Msg: string; const Args: array of const; MType: TMsgDlgType); +function StartDebugWin: hWnd; +procedure SendDebugPause; +procedure SendDebugResume; + +implementation + +uses + Messages, + SysUtils, + Registry, +{$IFDEF GX_DEBUGLOG} + GX_Debug, +{$ENDIF GX_DEBUGLOG} + Forms; // We need "Forms" for the Application object + +threadvar + MsgPrefix: string; + +const + chrStringCommand: AnsiChar = {$IFDEF UNICODE} #4 {$ELSE} #1 {$ENDIF}; + chrSQLCommand: AnsiChar = #2; // Old, unused type + chrClearCommand: AnsiChar = #3; + chrNull: AnsiChar = #0; + +var + PastFailedAttemptToStartDebugWin: Boolean = False; + SendPaused: Boolean = False; + +function StartDebugWin: hWnd; +var + DebugFileName: string; + Buf: array[0..MAX_PATH + 1] of Char; + si: TStartupInfo; + pi: TProcessInformation; +begin + MsgPrefix := ''; + + Result := 0; + if PastFailedAttemptToStartDebugWin then + Exit; + + with TRegIniFile.Create('\Software\GExperts') do // Do not localize. + try + DebugFileName := ReadString('Debug', 'FilePath', ''); // Do not localize. + finally + Free; + end; + + if Trim(DebugFileName) = '' then + begin + GetModuleFileName(HINSTANCE, Buf, SizeOf(Buf)-1); + DebugFileName := ExtractFilePath(StrPas(Buf)) + 'GExpertsDebugWindow.exe'; // Do not localize. + end; + + if (Trim(DebugFileName) = '') or not FileExists(DebugFileName) then + begin + PastFailedAttemptToStartDebugWin := True; + Exit; + end; + + FillChar(si, SizeOf(si), #0); + si.cb := SizeOf(si); + si.dwFlags := STARTF_USESHOWWINDOW; + si.wShowWindow := SW_SHOW; + if not CreateProcess(PChar(DebugFileName), nil, nil, nil, + False, 0, nil, nil, si, pi) then + begin + PastFailedAttemptToStartDebugWin := True; + Exit; + end; + + try + WaitForInputIdle(pi.hProcess, 3 * 1000); // wait for 3 seconds to get idle + finally + CloseHandle(pi.hThread); + CloseHandle(pi.hProcess); + end; + + Result := FindWindow('TfmDebug', nil); +end; + +procedure SendDebugEx(const Msg: string; MType: TMsgDlgType); +var + CDS: TCopyDataStruct; + DebugWin: hWnd; + MessageString: string; + MsgBytes: array of Byte; + MsgType: AnsiChar; + ByteIndex: Integer; +{$IFDEF GX_DEBUGLOG} + {$DEFINE NEEDMTYPESTR} +{$ENDIF GX_DEBUGLOG} + + procedure AddByte(B: Byte); + begin + MsgBytes[ByteIndex] := B; + Inc(ByteIndex); + end; + + procedure AddStringBytes(Str: string); + var + BPointer: {$IFDEF UNICODE} PByte {$ELSE} PAnsiChar {$ENDIF}; + i: Integer; + begin + BPointer := Pointer(Str); + for i := 0 to ((Length(Str)) * SizeOf(Char)) - 1 do + AddByte(Byte(BPointer[i])); + end; + +{$IFDEF NEEDMTYPESTR} +const + MTypeStr: array[TMsgDlgType] of string = + ('Warning: ', 'Error: ', 'Information: ', 'Confirmation: ', 'Custom: '); +{$ENDIF NEEDMTYPESTR} +begin + if SendPaused then + Exit; + +{$IFDEF GX_DEBUGLOG} + GxAddToDebugLog(MTypeStr[MType] + Msg); +{$ENDIF GX_DEBUGLOG} +{$IFDEF MSWINDOWS} + DebugWin := FindWindow('TfmDebug', nil); + + if DebugWin = 0 then + DebugWin := StartDebugWin; + + if DebugWin <> 0 then + begin + ByteIndex := 0; + MessageString := MsgPrefix + Msg; + SetLength(MsgBytes, 1 + 1 + (Length(MessageString)* SizeOf(Char)) + 1); // Payload, type, message, null + CDS.cbData := Length(MsgBytes); + CDS.dwData := 0; + MsgType := AnsiChar(Ord(MType) + 1); + if Msg = string(chrClearCommand) then + AddByte(Byte(chrClearCommand)) + else + AddByte(Byte(chrStringCommand)); + AddByte(Byte(MsgType)); + AddStringBytes(MessageString); + AddByte(Byte(chrNull)); + CDS.lpData := Pointer(MsgBytes); + SendMessage(DebugWin, WM_COPYDATA, WPARAM(Application.Handle), LPARAM(@CDS)); + end; +{$ENDIF MSWINDOWS} +end; + +procedure SendDebug(const Msg: string); +begin + SendDebugEx(Msg, mtInformation); +end; + +procedure SendDebugError(const Msg: string); +begin + SendDebugEx(Msg, mtError); +end; + +procedure SendDebugWarning(const Msg: string); +begin + SendDebugEx(Msg, mtWarning); +end; + +procedure SendDebugFmt(const Msg: string; const Args: array of const); +begin + SendDebugEx(Format(Msg, Args), mtInformation); +end; + +procedure SendDebugFmtEx(const Msg: string; const Args: array of const; MType: TMsgDlgType); +begin + SendDebugEx(Format(Msg, Args), MType); +end; + +procedure SendDebugClear; +begin + SendDebug(string(chrClearCommand)); +end; + +const + Indentation = ' '; + +procedure SendMethodEnter(const MethodName: string); +begin + SendDebugEx('Entering ' + MethodName, mtInformation); + SendIndent; +end; + +procedure SendIndent; +begin + MsgPrefix := MsgPrefix + Indentation; +end; + +procedure SendUnIndent; +begin + Delete(MsgPrefix, 1, Length(Indentation)); +end; + +procedure SendMethodExit(const MethodName: string); +begin + SendUnindent; + SendDebugEx('Exiting ' + MethodName, mtInformation); +end; + +procedure SendSeparator; +const + SeparatorString = '------------------------------'; +begin + SendDebugEx(SeparatorString, mtInformation); +end; + +procedure SendBoolean(const Identifier: string; const Value: Boolean); +begin + // Note: We deliberately leave "True" and "False" as + // hard-coded string constants, since these are + // technical terminology which should not be localised. + if Value then + SendDebugEx(Identifier + ' = True', mtInformation) + else + SendDebugEx(Identifier + ' = False', mtInformation); +end; + +procedure SendInteger(const Identifier: string; const Value: Integer); +begin + SendDebugEx(Format('%s = %d', [Identifier, Value]), mtInformation); +end; + +procedure SendDateTime(const Identifier: string; const Value: TDateTime); +begin + SendDebugEx(Identifier + ' = ' + DateTimeToStr(Value), mtInformation); +end; + +procedure SendDebugPause; +begin + SendPaused := True; +end; + +procedure SendDebugResume; +begin + SendPaused := False; +end; + +end. + diff --git a/G940LEDControl/Units/LEDStateConsumer.pas b/G940LEDControl/Units/LEDStateConsumer.pas index d20f05b..b4d9d14 100644 --- a/G940LEDControl/Units/LEDStateConsumer.pas +++ b/G940LEDControl/Units/LEDStateConsumer.pas @@ -53,6 +53,7 @@ uses System.SysUtils, Winapi.Windows, + DebugLog, LEDFunctionRegistry, LEDStateIntf; @@ -123,46 +124,57 @@ var dynamicColor: ILEDStateDynamicColor; begin - hasDynamicColors := False; - ButtonColors.Clear; + Debug.Log('LED State consumer: Updating LED states'); + Debug.Indent; + try + hasDynamicColors := False; + ButtonColors.Clear; - for buttonIndex := 0 to Pred(ButtonWorkers.Count) do - begin - color := nil; - - if Assigned(ButtonWorkers[buttonIndex]) then + for buttonIndex := 0 to Pred(ButtonWorkers.Count) do begin - state := (ButtonWorkers[buttonIndex] as ILEDFunctionWorker).GetCurrentState; - if Assigned(state) then + color := nil; + + if Assigned(ButtonWorkers[buttonIndex]) then begin - color := state.GetColor; - if Assigned(color) then + state := (ButtonWorkers[buttonIndex] as ILEDFunctionWorker).GetCurrentState; + if Assigned(state) then begin - if (hasDynamicColors = False) and Supports(color, ILEDStateDynamicColor, dynamicColor) then + color := state.GetColor; + if Assigned(color) then begin - { If the tick timer isn't currently running, there were no - dynamic colors before. Reset each dynamic colors now. } - if not HasTickTimer then - dynamicColor.Reset; + if (hasDynamicColors = False) and Supports(color, ILEDStateDynamicColor, dynamicColor) then + begin + { If the tick timer isn't currently running, there were no + dynamic colors before. Reset each dynamic colors now. } + if not HasTickTimer then + dynamicColor.Reset; - hasDynamicColors := True; + hasDynamicColors := True; + end; + + ButtonColors.Add(color as ILEDStateColor); end; - - ButtonColors.Add(color as ILEDStateColor); end; end; + + if not Assigned(color) then + ButtonColors.Add(nil); end; - if not Assigned(color) then - ButtonColors.Add(nil); - end; - - if hasDynamicColors <> HasTickTimer then - begin - if hasDynamicColors then - Task.SetTimer(TIMER_TICK, INTERVAL_TICK, TM_TICK) - else - Task.ClearTimer(TIMER_TICK); + if hasDynamicColors <> HasTickTimer then + begin + if hasDynamicColors then + begin + Debug.Log('LED State consumer: Starting tick timer'); + Task.SetTimer(TIMER_TICK, INTERVAL_TICK, TM_TICK) + end else + begin + Debug.Log('LED State consumer: Stopping tick timer'); + Task.ClearTimer(TIMER_TICK); + end; + end; + finally + Debug.UnIndent; end; Update; @@ -197,6 +209,10 @@ var begin profile := Msg.MsgData; + if not Assigned(profile) then + exit; + + Debug.Log('LED State consumer: Loading profile'); oldStates := nil; oldWorkers := nil; @@ -267,6 +283,8 @@ var dynamicColor: ILEDStateDynamicColor; begin + Debug.Log('LED State consumer: Tick'); + // (MvR) 19-2-2013: I could pass a tick count to Tick() so that they can all use modulus to blink synchronously... think about it. for buttonIndex := 0 to Pred(ButtonColors.Count) do @@ -301,6 +319,7 @@ begin FProfileButton := AProfileButton; end; + function TProfileButtonWorkerSettings.GetStateColor(const AUID: string; out AColor: TLEDColor): Boolean; begin Result := ProfileButton.GetStateColor(AUID, AColor); diff --git a/G940LEDControl/Units/ProfileManager.pas b/G940LEDControl/Units/ProfileManager.pas new file mode 100644 index 0000000..a0bc2e4 --- /dev/null +++ b/G940LEDControl/Units/ProfileManager.pas @@ -0,0 +1,270 @@ +unit ProfileManager; + +interface +uses + System.Classes, + System.SyncObjs, + + Profile, + X2UtPersistIntf; + + +type + IProfileObserver = interface + ['{DF41398E-015B-4BF4-A6EE-D3E8679E16A9}'] + procedure ObserveAdd(AProfile: TProfile); + procedure ObserveRemove(AProfile: TProfile); + procedure ObserveActiveChanged(AProfile: TProfile); + end; + + + TProfileManager = class; + + + TProfileManagerEnumerator = class(TProfileList.TEnumerator) + private + FManager: TProfileManager; + public + constructor Create(AManager: TProfileManager); + destructor Destroy; override; + end; + + + TProfileManager = class(TObject) + private + FLock: TCriticalSection; + FProfiles: TProfileList; + FObservers: TInterfaceList; + FActiveProfile: TProfile; + + function GetActiveProfile: TProfile; + function GetCount: Integer; + function GetItem(Index: Integer): TProfile; + procedure SetActiveProfile(const Value: TProfile); + procedure SetItem(Index: Integer; const Value: TProfile); + protected + property Observers: TInterfaceList read FObservers; + property Profiles: TProfileList read FProfiles; + public + class function Instance(): TProfileManager; + + constructor Create; + destructor Destroy; override; + + procedure Lock; + procedure Unlock; + + class procedure Add(AProfile: TProfile; ASetActive: Boolean = False); + class function Find(const AName: string): TProfile; + class function Remove(const AProfile: TProfile): Integer; + + class procedure Load(AReader: IX2PersistReader); + class procedure Save(AWriter: IX2PersistWriter); + + class procedure Attach(AObserver: IProfileObserver); + class procedure Detach(AObserver: IProfileObserver); + + function GetEnumerator: TProfileManagerEnumerator; + + property ActiveProfile: TProfile read GetActiveProfile write SetActiveProfile; + property Count: Integer read GetCount; + property Items[Index: Integer]: TProfile read GetItem write SetItem; default; + end; + + + + +implementation +uses + System.SysUtils; + + +var + ProfileManagerInstance: TProfileManager; + + +{ TProfileManager } +class function TProfileManager.Instance: TProfileManager; +begin + if not Assigned(ProfileManagerInstance) then + ProfileManagerInstance := TProfileManager.Create; + + Result := ProfileManagerInstance; +end; + + +constructor TProfileManager.Create; +begin + inherited Create; + + FObservers := TInterfaceList.Create; + FProfiles := TProfileList.Create(True); + FLock := TCriticalSection.Create; +end; + + +destructor TProfileManager.Destroy; +begin + FreeAndNil(FLock); + FreeAndNil(FProfiles); + FreeAndNil(FObservers); + + inherited; +end; + + +procedure TProfileManager.Lock; +begin + +end; + + +procedure TProfileManager.Unlock; +begin + +end; + + +class procedure TProfileManager.Add(AProfile: TProfile; ASetActive: Boolean); +var + observer: IInterface; + +begin + Instance.Lock; + try + Instance.Profiles.Add(AProfile); + finally + Instance.Unlock; + end; + + for observer in Instance.Observers do + (observer as IProfileObserver).ObserveAdd(AProfile); + + if ASetActive then + Instance.SetActiveProfile(AProfile); +end; + + +class function TProfileManager.Find(const AName: string): TProfile; +begin + Result := Instance.Profiles.Find(AName); +end; + + +class function TProfileManager.Remove(const AProfile: TProfile): Integer; +var + observer: IInterface; + +begin + Instance.Lock; + try + Result := Instance.Profiles.Remove(AProfile); + finally + Instance.Unlock; + end; + + for observer in Instance.Observers do + (observer as IProfileObserver).ObserveRemove(AProfile); +end; + + +class procedure TProfileManager.Load(AReader: IX2PersistReader); +begin + Instance.Lock; + try + Instance.Profiles.Load(AReader); + finally + Instance.Unlock; + end; +end; + + +class procedure TProfileManager.Save(AWriter: IX2PersistWriter); +begin + Instance.Lock; + try + Instance.Profiles.Save(AWriter); + finally + Instance.Unlock; + end; +end; + + +class procedure TProfileManager.Attach(AObserver: IProfileObserver); +begin + Instance.Observers.Add(AObserver as IProfileObserver); +end; + + +class procedure TProfileManager.Detach(AObserver: IProfileObserver); +begin + Instance.Observers.Remove(AObserver as IProfileObserver); +end; + + +function TProfileManager.GetActiveProfile: TProfile; +begin + Result := Instance.FActiveProfile; +end; + + +function TProfileManager.GetCount: Integer; +begin + Result := Instance.Profiles.Count; +end; + + +function TProfileManager.GetEnumerator: TProfileManagerEnumerator; +begin + Result := TProfileManagerEnumerator.Create(Self); +end; + + +function TProfileManager.GetItem(Index: Integer): TProfile; +begin + Result := Profiles[Index]; +end; + + +procedure TProfileManager.SetActiveProfile(const Value: TProfile); +var + observer: IInterface; +begin + if Value <> FActiveProfile then + begin + FActiveProfile := Value; + + for observer in Observers do + (observer as IProfileObserver).ObserveActiveChanged(Value); + end; +end; + + +procedure TProfileManager.SetItem(Index: Integer; const Value: TProfile); +begin + Profiles[Index] := Value; +end; + + +{ TProfileManagerEnumerator } +constructor TProfileManagerEnumerator.Create(AManager: TProfileManager); +begin + inherited Create(AManager.Profiles); + + FManager := AManager; + FManager.Lock; +end; + + +destructor TProfileManagerEnumerator.Destroy; +begin + FManager.Unlock; + + inherited; +end; + +initialization +finalization + FreeAndNil(ProfileManagerInstance); + +end. diff --git a/G940LEDControl/Units/Settings.pas b/G940LEDControl/Units/Settings.pas index c1fd303..5ea3e13 100644 --- a/G940LEDControl/Units/Settings.pas +++ b/G940LEDControl/Units/Settings.pas @@ -10,6 +10,8 @@ type FCheckUpdates: Boolean; FHasCheckUpdates: Boolean; FActiveProfile: string; + FProfileMenu: Boolean; + FProfileMenuCascaded: Boolean; procedure SetCheckUpdates(const Value: Boolean); public @@ -20,6 +22,9 @@ type property HasCheckUpdates: Boolean read FHasCheckUpdates; property ActiveProfile: string read FActiveProfile write FActiveProfile; + + property ProfileMenu: Boolean read FProfileMenu write FProfileMenu; + property ProfileMenuCascaded: Boolean read FProfileMenuCascaded write FProfileMenuCascaded; end; @@ -30,6 +35,9 @@ const KeyCheckUpdates = 'CheckUpdates'; KeyActiveProfile = 'ActiveProfile'; + KeyProfileMenu = 'ProfileMenu'; + KeyProfileMenuCascaded = 'ProfileMenuCascaded'; + { TSettings } procedure TSettings.Load(AReader: IX2PersistReader); @@ -44,6 +52,12 @@ begin if not AReader.ReadString(KeyActiveProfile, FActiveProfile) then FActiveProfile := ''; + + if not AReader.ReadBoolean(KeyProfileMenu, FProfileMenu) then + FProfileMenu := False; + + if not AReader.ReadBoolean(KeyProfileMenuCascaded, FProfileMenuCascaded) then + FProfileMenuCascaded := False; finally AReader.EndSection; end; @@ -56,6 +70,8 @@ begin try AWriter.WriteBoolean(KeyCheckUpdates, CheckUpdates); AWriter.WriteString(KeyActiveProfile, ActiveProfile); + AWriter.WriteBoolean(KeyProfileMenu, ProfileMenu); + AWriter.WriteBoolean(KeyProfileMenuCascaded, ProfileMenuCascaded); finally AWriter.EndSection; end;