GitHub-Mirror/G940LEDControl
1
0
Fork 0
mirror of synced 2024-11-22 10:03:51 +00:00
Code Issues Projects Releases Wiki Activity

Browse Source
This commit is contained in:
Mark van Renswoude 2013-04-14 09:25:40 +00:00
parent a9b472ea9a
commit 0a9d825261
19 changed files with 1752 additions and 324 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
G940LEDControl/Forms/MainFrm.dfm
View File

@ -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

419
G940LEDControl/Forms/MainFrm.pas
View File

@ -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);

11
G940LEDControl/G940LEDControl.dpr
View File

@ -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';

199
G940LEDControl/G940LEDControl.dproj
View File

@ -82,10 +82,10 @@
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<VerInfo_Release>1</VerInfo_Release>
<VerInfo_Release>5</VerInfo_Release>
<VerInfo_MajorVer>1</VerInfo_MajorVer>
<VerInfo_MinorVer>0</VerInfo_MinorVer>
<VerInfo_Keys>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=</VerInfo_Keys>
<VerInfo_Keys>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=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
</PropertyGroup>
@ -106,11 +106,68 @@
<Manifest_File>F:\Components\X2Utils\Resources\VistaManAsInvoker.manifest</Manifest_File>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="Forms\MainFrm.pas">
<Form>MainForm</Form>
</DCCReference>
<DCCReference Include="..\Shared\LogiJoystickDLL.pas"/>
<DCCReference Include="..\Shared\SimConnect.pas"/>
<DCCReference Include="Units\G940LEDStateConsumer.pas"/>
<DCCReference Include="Units\LEDStateConsumer.pas"/>
<DCCReference Include="Units\LEDColorIntf.pas"/>
<DCCReference Include="Units\LEDColor.pas"/>
<DCCReference Include="Units\LEDFunctionIntf.pas"/>
<DCCReference Include="Units\LEDFunction.pas"/>
<DCCReference Include="Units\StaticLEDFunction.pas"/>
<DCCReference Include="Units\ConfigConversion.pas"/>
<DCCReference Include="Units\LEDFunctionRegistry.pas"/>
<DCCReference Include="Units\StaticLEDColor.pas"/>
<DCCReference Include="Units\DynamicLEDColor.pas"/>
<DCCReference Include="Units\LEDStateIntf.pas"/>
<DCCReference Include="Units\LEDState.pas"/>
<DCCReference Include="Units\Profile.pas"/>
<DCCReference Include="Units\LEDColorPool.pas"/>
<DCCReference Include="Forms\ButtonFunctionFrm.pas">
<Form>ButtonFunctionForm</Form>
</DCCReference>
<DCCReference Include="Units\FSXLEDFunctionProvider.pas"/>
<DCCReference Include="Units\StaticResources.pas"/>
<DCCReference Include="Units\FSXResources.pas"/>
<DCCReference Include="Units\FSXSimConnectClient.pas"/>
<DCCReference Include="Units\FSXSimConnectIntf.pas"/>
<DCCReference Include="Units\FSXLEDFunction.pas"/>
<DCCReference Include="Units\LEDResources.pas"/>
<DCCReference Include="Units\Settings.pas"/>
<DCCReference Include="Units\FSXLEDFunctionWorker.pas"/>
<DCCReference Include="Units\FSXSimConnectStateMonitor.pas"/>
<DCCReference Include="Units\ProfileManager.pas"/>
<DCCReference Include="Units\FSXLEDFunctionProviderIntf.pas"/>
<DCCReference Include="Units\GxDbugIntf.pas"/>
<DCCReference Include="Units\DebugLog.pas"/>
<DCCReference Include="Units\DebugLogGExperts.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">G940LEDControl.dpr</Source>
</Source>
<Parameters>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="LoadAllSymbols">True</Parameters>
@ -143,95 +200,7 @@
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"/>
</VersionInfoKeys>
<Source>
<Source Name="MainSource">G940LEDControl.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxEditorFieldLinkD16.bpl">ExpressEditors FieldLink by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxBarDBNavD16.bpl">ExpressBars DBNavigator by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxBarExtDBItemsD16.bpl">ExpressBars extended DB items by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxBarExtItemsD16.bpl">ExpressBars extended items by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxTabbedMDID16.bpl">ExpressBars Tabbed MDI by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxLayoutControlD16.bpl">ExpressLayout Control by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxTreeListD16.bpl">ExpressQuantumTreeList 5 by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxGridD16.bpl">ExpressQuantumGrid by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxVerticalGridD16.bpl">ExpressVerticalGrid by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxmdsD16.bpl">ExpressMemData by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSpellCheckerD16.bpl">ExpressSpellChecker 2 by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxSpreadSheetD16.bpl">ExpressSpreadSheet by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxDockingD16.bpl">ExpressDocking Library by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxNavBarD16.bpl">ExpressNavBar by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinBlackD16.bpl">ExpressSkins - Black Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinBlueD16.bpl">ExpressSkins - Blue Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinBlueprintD16.bpl">ExpressSkins - Blueprint Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinCaramelD16.bpl">ExpressSkins - Caramel Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinCoffeeD16.bpl">ExpressSkins - Coffee Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinDarkRoomD16.bpl">ExpressSkins - Darkroom Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinDarkSideD16.bpl">ExpressSkins - DarkSide Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinDevExpressDarkStyleD16.bpl">ExpressSkins - DevExpressDarkStyle Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinDevExpressStyleD16.bpl">ExpressSkins - DevExpressStyle Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinFoggyD16.bpl">ExpressSkins - Foggy Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinGlassOceansD16.bpl">ExpressSkins - GlassOceans Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinHighContrastD16.bpl">ExpressSkins - HighContrast Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkiniMaginaryD16.bpl">ExpressSkins - iMaginary Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinLilianD16.bpl">ExpressSkins - Lilian Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinLiquidSkyD16.bpl">ExpressSkins - LiquidSky Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinLondonLiquidSkyD16.bpl">ExpressSkins - LondonLiquidSky Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinMcSkinD16.bpl">ExpressSkins - McSkin Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinMoneyTwinsD16.bpl">ExpressSkins - MoneyTwins Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2007BlackD16.bpl">ExpressSkins - Office2007Black Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2007BlueD16.bpl">ExpressSkins - Office2007Blue Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2007GreenD16.bpl">ExpressSkins - Office2007Green Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2007PinkD16.bpl">ExpressSkins - Office2007Pink Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2007SilverD16.bpl">ExpressSkins - Office2007Silver Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2010BlackD16.bpl">ExpressSkins - Office2010Black Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2010BlueD16.bpl">ExpressSkins - Office2010Blue Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinOffice2010SilverD16.bpl">ExpressSkins - Office2010Silver Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinPumpkinD16.bpl">ExpressSkins - Pumpkin Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinSevenClassicD16.bpl">ExpressSkins - SevenClassic Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinSevenD16.bpl">ExpressSkins - Seven Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinSharpD16.bpl">ExpressSkins - Sharp Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinSharpPlusD16.bpl">ExpressSkins - SharpPlus Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinSilverD16.bpl">ExpressSkins - Silver Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinSpringTimeD16.bpl">ExpressSkins - Springtime Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinStardustD16.bpl">ExpressSkins - Stardust Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinSummer2008D16.bpl">ExpressSkins - Summer2008 Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinTheAsphaltWorldD16.bpl">ExpressSkins - TheAsphaltWorld Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinValentineD16.bpl">ExpressSkins - Valentine Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinVS2010D16.bpl">ExpressSkins - VS2010 Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinWhiteprintD16.bpl">ExpressSkins - Whiteprint Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxSkinXmas2008BlueD16.bpl">ExpressSkins - Xmas2008Blue Skin by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSLnksD16.bpl">ExpressPrinting System ReportLinks (Standard) by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dxPScxPCProdD16.bpl">ExpressPrinting System ContainerProducer for ExpressPageControl by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxdbtrD16.bpl">ExpressDBTree by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxtrmdD16.bpl">ExpressTreePrintedDataSet by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxDBOrD16.bpl">ExpressDBOrgChart by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxFlowChartD16.bpl">ExpressFlowChart by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxPageControldxBarPopupMenuD16.bpl">ExpressPageControl dxBar Popup Menu by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxBarEditItemD16.bpl">ExpressBars cxEditor item by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxSchedulerGridD16.bpl">ExpressScheduler connection to ExpressQuantumGrid by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxTreeListdxBarPopupMenuD16.bpl">ExpressQuantumTreeList 5 dxBar Built-In Menu by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSkinscxEditorsHelperD16.bpl">ExpressSkins Library Uses Clause Auto Fill Helper for ExpressEditors by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSkinscxPCPainterD16.bpl">ExpressSkins Library Uses Clause Auto Fill Helper for PageControl Painter by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSkinscxSchedulerPainterD16.bpl">ExpressSkins Library Uses Clause Auto Fill Helper for Scheduler Painter by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSkinsdxBarsPaintersD16.bpl">ExpressSkins Library Uses Clause Auto Fill Helper for Bars Painters by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSkinsdxNavBarPainterD16.bpl">ExpressSkins Library Uses Clause Auto Fill Helper for NavBar Painter by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxSkinsdxRibbonPaintersD16.bpl">ExpressSkins Library Uses Clause Auto Fill Helper for Ribbon Painters by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxCommonD16.bpl">ExpressPrinting System Cross Platform Library by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxExtCommonD16.bpl">ExpressPrinting System Extended Cross Platform Library by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxPivotGridLnkD16.bpl">ExpressPrinting System ReportLink for ExpressPivotGrid by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxSchedulerLnkD16.bpl">ExpressPrinting System ReportLink for ExpressScheduler by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxSSLnkD16.bpl">ExpressPrinting System ReportLink for ExpressSpreadSheet by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxTLLnkD16.bpl">ExpressPrinting System ReportLink for ExpressQuantumTreeList by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxVGridLnkD16.bpl">ExpressPrinting System ReportLink for ExpressVerticalGrid by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSdxDBOCLnkD16.bpl">ExpressPrinting System ReportLinks for ExpressDBOrgChart by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSdxDBTVLnkD16.bpl">ExpressPrinting System ReportLink for ExpressDBTree by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSdxFCLnkD16.bpl">ExpressPrinting System ReportLinks for ExpressFlowChart by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPScxGridLnkD16.bpl">ExpressPrinting System ReportLink for ExpressQuantumGrid by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSdxOCLnkD16.bpl">ExpressPrinting System ReportLinks for ExpressOrgChart by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSPrVwAdvD16.bpl">ExpressPrinting System Advanced Preview Window by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dcldxPSPrVwRibbonD16.bpl">ExpressPrinting System Ribbon Preview Window by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxPivotGridChartD16.bpl">ExpressPivotGrid 2 connection to ExpressQuantumGrid Chart View by Developer Express Inc.</Excluded_Packages>
<Excluded_Packages Name="D:\Program Files\Developer Express.VCL\Library\Delphi16\dclcxPivotGridOLAPD16.bpl">ExpressPivotGrid 2 OLAP by Developer Express Inc.</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
@ -243,55 +212,5 @@
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="Forms\MainFrm.pas">
<Form>MainForm</Form>
</DCCReference>
<DCCReference Include="..\Shared\LogiJoystickDLL.pas"/>
<DCCReference Include="..\Shared\SimConnect.pas"/>
<DCCReference Include="Units\G940LEDStateConsumer.pas"/>
<DCCReference Include="Units\LEDStateConsumer.pas"/>
<DCCReference Include="Units\LEDColorIntf.pas"/>
<DCCReference Include="Units\LEDColor.pas"/>
<DCCReference Include="Units\LEDFunctionIntf.pas"/>
<DCCReference Include="Units\LEDFunction.pas"/>
<DCCReference Include="Units\StaticLEDFunction.pas"/>
<DCCReference Include="Units\ConfigConversion.pas"/>
<DCCReference Include="Units\LEDFunctionRegistry.pas"/>
<DCCReference Include="Units\StaticLEDColor.pas"/>
<DCCReference Include="Units\DynamicLEDColor.pas"/>
<DCCReference Include="Units\LEDStateIntf.pas"/>
<DCCReference Include="Units\LEDState.pas"/>
<DCCReference Include="Units\Profile.pas"/>
<DCCReference Include="Units\LEDColorPool.pas"/>
<DCCReference Include="Forms\ButtonFunctionFrm.pas">
<Form>ButtonFunctionForm</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="Units\FSXLEDFunctionProvider.pas"/>
<DCCReference Include="Units\StaticResources.pas"/>
<DCCReference Include="Units\FSXResources.pas"/>
<DCCReference Include="Units\FSXSimConnectClient.pas"/>
<DCCReference Include="Units\FSXSimConnectIntf.pas"/>
<DCCReference Include="Units\FSXLEDFunction.pas"/>
<DCCReference Include="Units\LEDResources.pas"/>
<DCCReference Include="Units\Settings.pas"/>
<DCCReference Include="Units\FSXLEDFunctionWorker.pas"/>
<DCCReference Include="Units\FSXSimConnectStateMonitor.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
</Project>

BIN
G940LEDControl/G940LEDControl.res
View File

Binary file not shown.

173
G940LEDControl/Units/DebugLog.pas Normal file
View File

@ -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.

137
G940LEDControl/Units/DebugLogGExperts.pas Normal file
View File

@ -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.

28
G940LEDControl/Units/FSXLEDFunction.pas
View File

@ -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

22
G940LEDControl/Units/FSXLEDFunctionProvider.pas
View File

@ -5,6 +5,7 @@ uses
Generics.Collections,
System.SyncObjs,
FSXLEDFunctionProviderIntf,
FSXSimConnectIntf,
LEDFunction,
LEDFunctionIntf,
@ -16,10 +17,11 @@ type
TCustomFSXFunctionList = TObjectList<TCustomFSXFunction>;
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

13
G940LEDControl/Units/FSXLEDFunctionProviderIntf.pas Normal file
View File

@ -0,0 +1,13 @@
unit FSXLEDFunctionProviderIntf;
interface
type
IFSXLEDFunctionProvider = interface
['{F13C936C-32C3-4204-A5E9-3AE6604AA31C}']
procedure SetProfileMenu(AEnabled, ACascaded: Boolean);
end;
implementation
end.

25
G940LEDControl/Units/FSXLEDFunctionWorker.pas
View File

@ -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

9
G940LEDControl/Units/FSXResources.pas
View File

@ -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

307
G940LEDControl/Units/FSXSimConnectClient.pas
View File

@ -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;

14
G940LEDControl/Units/FSXSimConnectIntf.pas
View File

@ -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;

28
G940LEDControl/Units/G940LEDStateConsumer.pas
View File

@ -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;

274
G940LEDControl/Units/GxDbugIntf.pas Normal file
View File

@ -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.

77
G940LEDControl/Units/LEDStateConsumer.pas
View File

@ -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);

270
G940LEDControl/Units/ProfileManager.pas Normal file
View File

@ -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.

16
G940LEDControl/Units/Settings.pas
View File

@ -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;