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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Cfg_2
+ Base
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
Delphi.Personality.12
+
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
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- dfm
-
-
-
-
-
-
-
-
-
-
-
-
- Cfg_2
- Base
-
-
- Base
-
-
- Cfg_1
- Base
-
-
diff --git a/G940LEDControl/G940LEDControl.res b/G940LEDControl/G940LEDControl.res
index b7f720a..906ddee 100644
Binary files a/G940LEDControl/G940LEDControl.res and b/G940LEDControl/G940LEDControl.res differ
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;