GitHub-Mirror/G940LEDControl
1
0
Fork 0
mirror of synced 2024-11-05 02:59:16 +00:00
Code Issues Projects Releases Wiki Activity

Changed logging to X2Log

Browse Source 
Implemented tray icon functionality
This commit is contained in:
Mark van Renswoude 2015-04-18 10:28:53 +00:00
parent f2bcf3401d
commit 20350cfdd7
16 changed files with 946 additions and 774 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

133
G940LEDControl/Forms/MainFrm.dfm
View File

@ -1,7 +1,7 @@
object MainForm: TMainForm
Left = 0
Top = 0
ActiveControl = cmbProfiles
ActiveControl = cbTrayIcon
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'G940 LED Control'
@ -29,7 +29,7 @@ object MainForm: TMainForm
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
ActivePage = tsButtons
ActivePage = tsConfiguration
Align = alClient
TabOrder = 0
object tsButtons: TTabSheet
@ -374,9 +374,12 @@ object MainForm: TMainForm
object tsConfiguration: TTabSheet
Caption = ' Configuration '
ImageIndex = 2
DesignSize = (
442
452)
object lblProfileSwitching: TLabel
Left = 11
Top = 19
Top = 187
Width = 92
Height = 13
Caption = 'Profile switching'
@ -388,40 +391,130 @@ object MainForm: TMainForm
ParentFont = False
end
object bvlProfileSwitching: TBevel
Left = 224
Top = 26
Width = 205
Left = 124
Top = 194
Width = 305
Height = 13
Anchors = [akLeft, akTop, akRight]
Shape = bsTopLine
end
object lblLaunch: TLabel
Left = 11
Top = 122
Width = 40
Height = 13
Caption = 'Launch'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object bvlLaunch: TBevel
Left = 80
Top = 129
Width = 353
Height = 13
Anchors = [akLeft, akTop, akRight]
Shape = bsTopLine
end
object lblGeneral: TLabel
Left = 11
Top = 11
Width = 44
Height = 13
Caption = 'General'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object bvlGeneral: TBevel
Left = 80
Top = 18
Width = 353
Height = 13
Anchors = [akLeft, akTop, akRight]
Shape = bsTopLine
end
object cbProfileMenu: TCheckBox
Left = 11
Top = 44
Top = 212
Width = 409
Height = 17
Caption = ' Add profile selection to FSX "Add-ons" menu'
Caption = ' Add profile selection to FSX/Prepar3D "Add-ons" menu'
Checked = True
State = cbChecked
TabOrder = 0
TabOrder = 4
OnClick = cbProfileMenuClick
end
object cbProfileMenuCascaded: TCheckBox
Left = 31
Top = 67
Top = 235
Width = 389
Height = 17
Caption = ' Cascaded menu (profiles in "G940 Profile" submenu)'
TabOrder = 1
TabOrder = 5
OnClick = cbProfileMenuCascadedClick
end
object cbFSXAutoLaunch: TCheckBox
Left = 11
Top = 147
Width = 409
Height = 17
Caption = ' Automatically start G940 LED Control when FSX launches'
Checked = True
State = cbChecked
TabOrder = 3
OnClick = cbFSXAutoLaunchClick
end
object cbLaunchMinimized: TCheckBox
Left = 31
Top = 82
Width = 381
Height = 17
Caption = ' Start minimized'
TabOrder = 2
OnClick = cbLaunchMinimizedClick
end
object cbMinimizeToTray: TCheckBox
Left = 31
Top = 59
Width = 389
Height = 17
Caption = ' Minimize to the notification area'
Checked = True
State = cbChecked
TabOrder = 1
OnClick = cbMinimizeToTrayClick
end
object cbTrayIcon: TCheckBox
Left = 11
Top = 36
Width = 409
Height = 17
Caption = ' Show icon in the notification area'
Checked = True
State = cbChecked
TabOrder = 0
OnClick = cbTrayIconClick
end
object btnLog: TButton
Left = 11
Top = 412
Width = 102
Height = 25
Caption = 'Application log...'
TabOrder = 6
OnClick = btnLogClick
end
end
object tsAbout: TTabSheet
Caption = 'About'
ImageIndex = 1
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
object lblVersionCaption: TLabel
Left = 16
Top = 67
@ -1058,4 +1151,14 @@ object MainForm: TMainForm
end
end
end
object TrayIcon: TTrayIcon
OnClick = TrayIconClick
Left = 384
Top = 436
end
object ApplicationEvents: TApplicationEvents
OnMinimize = ApplicationEventsMinimize
Left = 300
Top = 436
end
end

281
G940LEDControl/Forms/MainFrm.pas
View File

@ -16,16 +16,17 @@ uses
OtlComm,
OtlEventMonitor,
OtlTaskControl,
OtlTask,
OtlTaskControl,
pngimage,
X2Log.Intf,
X2UtPersistIntf,
FSXSimConnectIntf,
LEDStateConsumer,
Profile,
ProfileManager,
Settings;
Settings, Vcl.AppEvnts;
const
@ -112,6 +113,17 @@ type
cbProfileMenuCascaded: TCheckBox;
lblProfileSwitching: TLabel;
bvlProfileSwitching: TBevel;
lblLaunch: TLabel;
cbFSXAutoLaunch: TCheckBox;
cbLaunchMinimized: TCheckBox;
bvlLaunch: TBevel;
lblGeneral: TLabel;
bvlGeneral: TBevel;
cbMinimizeToTray: TCheckBox;
cbTrayIcon: TCheckBox;
btnLog: TButton;
TrayIcon: TTrayIcon;
ApplicationEvents: TApplicationEvents;
procedure FormCreate(Sender: TObject);
procedure lblLinkLinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType);
@ -124,7 +136,15 @@ type
procedure btnDeleteProfileClick(Sender: TObject);
procedure cbProfileMenuClick(Sender: TObject);
procedure cbProfileMenuCascadedClick(Sender: TObject);
procedure cbTrayIconClick(Sender: TObject);
procedure cbMinimizeToTrayClick(Sender: TObject);
procedure cbFSXAutoLaunchClick(Sender: TObject);
procedure cbLaunchMinimizedClick(Sender: TObject);
procedure btnLogClick(Sender: TObject);
procedure ApplicationEventsMinimize(Sender: TObject);
procedure TrayIconClick(Sender: TObject);
private
FLog: IX2Log;
FLEDControls: array[0..LED_COUNT - 1] of TLEDControls;
FEventMonitor: TOmniEventMonitor;
@ -137,6 +157,7 @@ type
FSettingsFileName: string;
FSettings: TSettings;
FLoadingSettings: Boolean;
protected
procedure RegisterDeviceArrival;
procedure UnregisterDeviceArrival;
@ -167,6 +188,8 @@ type
procedure ApplyProfileMenuSettings;
procedure FinalizeProfileMenu;
procedure ApplyTrayIconSettings;
procedure SetDeviceState(const AMessage: string; AFound: Boolean);
procedure SetFSXState(const AMessage: string; AConnected: Boolean);
// procedure SetFSXToggleZoomButton(const ADeviceGUID: TGUID; AButtonIndex: Integer; const ADisplayText: string);
@ -185,6 +208,8 @@ type
property EventMonitor: TOmniEventMonitor read FEventMonitor;
property Settings: TSettings read FSettings;
property StateConsumerTask: IOmniTaskControl read FStateConsumerTask;
property Log: IX2Log read FLog;
end;
@ -199,12 +224,13 @@ uses
IdException,
IdHTTP,
OtlCommon,
X2Log.Global,
X2Log.Observer.MonitorForm,
X2UtApp,
X2UtPersistXML,
ButtonFunctionFrm,
ConfigConversion,
DebugLog,
FSXLEDFunctionProviderIntf,
FSXResources,
FSXSimConnectStateMonitor,
@ -267,15 +293,20 @@ var
worker: IOmniWorker;
begin
FLog := TX2GlobalLog.Category('UI');
TX2LogObserverMonitorForm.LockInstance(TX2GlobalLog.Instance);
lblVersion.Caption := App.Version.FormatVersion(False);
TrayIcon.Icon.Assign(Application.Icon);
PageControl.ActivePageIndex := 0;
AlignBevel(bvlProfileSwitching, lblProfileSwitching);
FEventMonitor := TOmniEventMonitor.Create(Self);
Debug.Log('UI: Starting G940 LED state consumer thread');
worker := TG940LEDStateConsumer.Create;
Log.Info('Starting G940 LED state consumer thread');
worker := TG940LEDStateConsumer.Create(TX2GlobalLog.Category('G940 LED state consumer'));
FStateConsumerTask := EventMonitor.Monitor(CreateTask(worker));
EventMonitor.OnTaskMessage := EventMonitorMessage;
@ -284,7 +315,7 @@ begin
StateConsumerTask.Run;
Debug.Log('UI: Starting FSX state monitor thread');
Log.Info('Starting FSX state monitor thread');
worker := TFSXStateMonitorWorker.Create;
EventMonitor.Monitor(CreateTask(worker)).Run;
@ -300,6 +331,9 @@ begin
FSettingsFileName := App.UserPath + FilenameSettings;
LoadSettings;
if Settings.TrayIcon and Settings.MinimizeToTray and Settings.LaunchMinimized then
Application.ShowMainForm := False;
RegisterDeviceArrival;
end;
@ -310,6 +344,8 @@ begin
UnregisterDeviceArrival;
TProfileManager.Detach(Self);
TX2LogObserverMonitorForm.UnlockInstance(TX2GlobalLog.Instance);
end;
@ -327,7 +363,7 @@ var
request: TDevBroadcastDeviceInterface;
begin
Debug.Log('UI: Registering for device notifications');
Log.Verbose('Registering for device notifications');
ZeroMemory(@request, SizeOf(request));
request.dbcc_size := SizeOf(request);
@ -343,7 +379,7 @@ procedure TMainForm.UnregisterDeviceArrival;
begin
if Assigned(FDeviceNotification) then
begin
Debug.Log('UI: Unregistering for device notifications');
Log.Verbose('Unregistering for device notifications');
UnregisterDeviceNotification(FDeviceNotification);
FDeviceNotification := nil;
@ -359,7 +395,7 @@ begin
case Msg.WParam of
DBT_DEVICEARRIVAL:
begin
Debug.Log('UI: Device arrived');
Log.Verbose('Device arrived');
if (not FG940Found) then
StateConsumerTask.Comm.Send(TM_FINDTHROTTLEDEVICE);
@ -367,7 +403,7 @@ begin
DBT_DEVICEREMOVECOMPLETE:
begin
Debug.Log('UI: Device removed');
Log.Verbose('Device removed');
if FG940Found then
StateConsumerTask.Comm.Send(TM_TESTTHROTTLEDEVICE);
@ -439,63 +475,59 @@ var
profile: TProfile;
begin
Debug.LogFmt('UI: Loading profiles (%s)', [FProfilesFilename]);
Debug.Indent;
try
if not FileExists(FProfilesFilename) then
Log.Info(Format('Loading profiles (%s)', [FProfilesFilename]));
if not FileExists(FProfilesFilename) then
begin
Log.Info('Profiles not found, attempting conversion from 0.x profile');
{ Check if version 0.x settings are in the registry }
defaultProfile := ConfigConversion.ConvertProfile0To1;
if not Assigned(defaultProfile) then
begin
Debug.Log('UI: Profiles not found, attempting conversion from 0.x 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);
Log.Info('0.x profile not found, creating default profile');
defaultProfile := CreateDefaultProfile
end else
begin
persistXML := TX2UtPersistXML.Create;
try
persistXML.FileName := FProfilesFilename;
TProfileManager.Load(persistXML.CreateReader);
finally
FreeAndNil(persistXML);
end;
Log.Info('Succesfully converted 0.x profile');
defaultProfile.Name := DefaultProfileName;
defaultProfile.IsTemporary := True;
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;
if Assigned(defaultProfile) then
TProfileManager.Add(defaultProfile);
end else
begin
persistXML := TX2UtPersistXML.Create;
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;
persistXML.FileName := FProfilesFilename;
TProfileManager.Load(persistXML.CreateReader);
finally
FLockChangeProfile := False;
FreeAndNil(persistXML);
end;
end;
{ Make sure we always have a profile }
if TProfileManager.Instance.Count = 0 then
begin
Log.Info('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
Debug.UnIndent;
FLockChangeProfile := False;
end;
end;
@ -505,7 +537,7 @@ var
persistXML: TX2UtPersistXML;
begin
Debug.LogFmt('UI: Saving profiles (%s)', [FProfilesFilename]);
Log.Info(Format('Saving profiles (%s)', [FProfilesFilename]));
persistXML := TX2UtPersistXML.Create;
try
@ -523,35 +555,36 @@ var
profile: TProfile;
begin
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');
Log.Info(Format('Loading profiles (%s)', [FSettingsFilename]));
{ Check if version 0.x settings are in the registry }
FSettings := ConfigConversion.ConvertSettings0To1;
if not FileExists(FSettingsFileName) then
begin
Log.Info('Settings not found, attempting conversion from 0.x settings');
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
{ Check if version 0.x settings are in the registry }
FSettings := ConfigConversion.ConvertSettings0To1;
if not Assigned(FSettings) then
begin
Log.Info('0.x profile not found, creating default settings');
FSettings := TSettings.Create;
end else
Log.Info('Succesfully converted 0.x settings');
end else
begin
FSettings := TSettings.Create;
persistXML := TX2UtPersistXML.Create;
try
persistXML.FileName := FSettingsFileName;
Settings.Load(persistXML.CreateReader);
finally
FreeAndNil(persistXML);
end;
persistXML := TX2UtPersistXML.Create;
try
persistXML.FileName := FSettingsFileName;
Settings.Load(persistXML.CreateReader);
finally
FreeAndNil(persistXML);
end;
end;
FLoadingSettings := True;
try
{ Default profile }
profile := nil;
if Length(Settings.ActiveProfile) > 0 then
@ -572,13 +605,19 @@ begin
CheckForUpdates(False);
cbTrayIcon.Checked := Settings.TrayIcon;
cbMinimizeToTray.Checked := Settings.MinimizeToTray;
cbLaunchMinimized.Checked := Settings.LaunchMinimized;
cbProfileMenu.Checked := Settings.ProfileMenu;
cbProfileMenuCascaded.Checked := Settings.ProfileMenuCascaded;
ApplyProfileMenuSettings;
finally
Debug.UnIndent;
FLoadingSettings := False;
end;
ApplyProfileMenuSettings;
ApplyTrayIconSettings;
end;
@ -587,7 +626,10 @@ var
persistXML: TX2UtPersistXML;
begin
Debug.LogFmt('UI: Saving settings (%s)', [FSettingsFilename]);
if FLoadingSettings then
exit;
Log.Info(Format('Saving settings (%s)', [FSettingsFilename]));
persistXML := TX2UtPersistXML.Create;
try
@ -618,7 +660,7 @@ begin
if not Assigned(activeProfile) then
exit;
Debug.LogFmt('UI: Loading active profile (%s)', [activeProfile.Name]);
Log.Info(Format('Loading active profile (%s)', [activeProfile.Name]));
for buttonIndex := 0 to Pred(LED_COUNT) do
UpdateButton(activeProfile, buttonIndex);
@ -765,7 +807,7 @@ 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]);
Log.Verbose(Format('G940 Throttle state changed (found = %s, status = %s)', [BoolToStr(AFound, True), AMessage]));
lblG940ThrottleState.Caption := AMessage;
lblG940ThrottleState.Update;
@ -779,7 +821,7 @@ 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]);
Log.Verbose(Format('FSX SimConnect state changed (connected = %s, status = %s)', [BoolToStr(AConnected, True), AMessage]));
lblFSXState.Caption := AMessage;
lblFSXState.Update;
@ -919,12 +961,12 @@ var
begin
msgSent := False;
try
Debug.LogFmt('AutoUpdate: Checking for updates (%s)', [UPDATE_URL]);
Log.Info(Format('AutoUpdate: Checking for updates (%s)', [UPDATE_URL]));
httpClient := TIdHTTP.Create(nil);
try
latestVersion := httpClient.Get(UPDATE_URL);
Debug.LogFmt('AutoUpdate: Received version "%s"', [latestVersion]);
Log.Verbose(Format('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)
@ -1031,6 +1073,12 @@ begin
end;
procedure TMainForm.btnLogClick(Sender: TObject);
begin
TX2LogObserverMonitorForm.ShowInstance(TX2GlobalLog.Instance);
end;
procedure TMainForm.cbCheckUpdatesClick(Sender: TObject);
begin
Settings.CheckUpdates := cbCheckUpdates.Checked;
@ -1038,6 +1086,35 @@ begin
end;
procedure TMainForm.cbTrayIconClick(Sender: TObject);
begin
Settings.TrayIcon := cbTrayIcon.Checked;
SaveSettings;
ApplyTrayIconSettings;
end;
procedure TMainForm.cbMinimizeToTrayClick(Sender: TObject);
begin
Settings.MinimizeToTray := cbMinimizeToTray.Checked;
SaveSettings;
ApplyTrayIconSettings;
end;
procedure TMainForm.cbFSXAutoLaunchClick(Sender: TObject);
begin
//
end;
procedure TMainForm.cbLaunchMinimizedClick(Sender: TObject);
begin
Settings.LaunchMinimized := cbLaunchMinimized.Checked;
SaveSettings;
end;
procedure TMainForm.cbProfileMenuClick(Sender: TObject);
begin
Settings.ProfileMenu := cbProfileMenu.Checked;
@ -1135,6 +1212,24 @@ begin
end;
procedure TMainForm.TrayIconClick(Sender: TObject);
begin
Show();
WindowState := wsNormal;
Application.BringToFront();
end;
procedure TMainForm.ApplicationEventsMinimize(Sender: TObject);
begin
if Settings.TrayIcon and Settings.MinimizeToTray then
begin
Hide();
WindowState := wsMinimized;
end;
end;
procedure TMainForm.ApplyProfileMenuSettings;
var
fsxProvider: IFSXLEDFunctionProvider;
@ -1155,6 +1250,12 @@ begin
end;
procedure TMainForm.ApplyTrayIconSettings;
begin
TrayIcon.Visible := Settings.TrayIcon;
end;
procedure TMainForm.btnCheckUpdatesClick(Sender: TObject);
begin
CheckForUpdates(True);

7
G940LEDControl/G940LEDControl.dpr
View File

@ -34,9 +34,7 @@ uses
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';
SimBaseDocumentXMLBinding in 'Units\SimBaseDocumentXMLBinding.pas';
{$R *.res}
@ -45,9 +43,6 @@ var
MainForm: TMainForm;
begin
if FindCmdLineSwitch('log') then
SetDebugLogConsumer(TGExpertsDebugLogConsumer.Create);
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.Title := 'G940 LED Control';

6
G940LEDControl/G940LEDControl.dproj
View File

@ -8,7 +8,7 @@
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>13.4</ProjectVersion>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Release</Config>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
@ -137,9 +137,7 @@
<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"/>
<DCCReference Include="Units\SimBaseDocumentXMLBinding.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>

BIN
G940LEDControl/G940LEDControl.res
View File

Binary file not shown.

173
G940LEDControl/Units/DebugLog.pas
View File

@ -1,173 +0,0 @@
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
View File

@ -1,137 +0,0 @@
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.

6
G940LEDControl/Units/FSXLEDFunctionProvider.pas
View File

@ -5,6 +5,8 @@ uses
Generics.Collections,
System.SyncObjs,
X2Log.Intf,
FSXLEDFunctionProviderIntf,
FSXSimConnectIntf,
LEDFunction,
@ -86,6 +88,8 @@ implementation
uses
System.SysUtils,
X2Log.Global,
FSXLEDFunction,
FSXResources,
FSXSimConnectClient,
@ -203,7 +207,7 @@ begin
begin
{ Keep an object reference so we don't increment the reference count.
We'll know when it's gone through the ObserveDestroy. }
FSimConnect := TFSXSimConnectInterface.Create;
FSimConnect := TFSXSimConnectInterface.Create(TX2GlobalLog.Category('FSX SimConnect'));
(FSimConnect as IFSXSimConnect).Attach(Self);
end;

60
G940LEDControl/Units/FSXSimConnectClient.pas
View File

@ -9,6 +9,7 @@ uses
Classes,
OtlTaskControl,
X2Log.Intf,
FSXSimConnectIntf,
Profile,
@ -42,7 +43,7 @@ type
procedure ObserveRemove(AProfile: TProfile);
procedure ObserveActiveChanged(AProfile: TProfile);
public
constructor Create;
constructor Create(ALog: IX2Log);
destructor Destroy; override;
end;
@ -59,7 +60,6 @@ uses
OtlCommon,
SimConnect,
DebugLog,
FSXResources,
FSXSimConnectStateMonitor;
@ -120,6 +120,7 @@ type
FMenuProfiles: TStringList;
FMenuWasCascaded: Boolean;
FLog: IX2Log;
protected
procedure TMAddDefinition(var Msg: TOmniMessage); message TM_ADDDEFINITION;
procedure TMRemoveDefinition(var Msg: TOmniMessage); message TM_REMOVEDEFINITION;
@ -154,8 +155,11 @@ type
property SimConnectDataEvent: TEvent read FSimConnectDataEvent;
{$ENDIF}
property Log: IX2Log read FLog;
property ProfileMenu: Boolean read FProfileMenu;
property ProfileMenuCascaded: Boolean read FProfileMenuCascaded;
public
constructor Create(ALog: IX2Log);
end;
@ -229,7 +233,7 @@ type
{ TFSXSimConnectInterface }
constructor TFSXSimConnectInterface.Create;
constructor TFSXSimConnectInterface.Create(ALog: IX2Log);
var
worker: IOmniWorker;
@ -238,7 +242,7 @@ begin
FObservers := TInterfaceList.Create;
worker := TFSXSimConnectClient.Create;
worker := TFSXSimConnectClient.Create(ALog);
FClient := CreateTask(worker).Run;
end;
@ -374,9 +378,17 @@ end;
{ TFSXSimConnectClient }
constructor TFSXSimConnectClient.Create(ALog: IX2Log);
begin
inherited Create;
FLog := ALog;
end;
function TFSXSimConnectClient.Initialize: Boolean;
begin
Debug.Log('FSX SimConnect: Initializing');
Log.Info('Initializing');
Result := inherited Initialize;
if not Result then
@ -396,7 +408,7 @@ end;
procedure TFSXSimConnectClient.Cleanup;
begin
Debug.Log('FSX SimConnect: Cleaning up');
Log.Info('Cleaning up');
{$IFDEF SCUSEEVENT}
FreeAndNil(FSimConnectDataEvent);
@ -422,7 +434,7 @@ begin
if SimConnectHandle <> 0 then
exit;
Debug.Log('FSX SimConnect: Attempting to connect to SimConnect');
Log.Info('Attempting to connect to SimConnect');
if InitSimConnect then
begin
@ -434,7 +446,7 @@ begin
if SimConnect_Open(FSimConnectHandle, FSXSimConnectAppName, 0, 0, eventHandle, 0) = S_OK then
begin
Debug.Log('FSX SimConnect: Succesfully connected');
Log.Info('Succesfully connected');
TFSXSimConnectStateMonitor.SetCurrentState(scsConnected);
Task.ClearTimer(TIMER_TRYSIMCONNECT);
@ -449,7 +461,7 @@ begin
if SimConnectHandle = 0 then
begin
Debug.LogFmt('FSX SimConnect: Connection failed, trying again in %d seconds', [INTERVAL_TRYSIMCONNECT div 1000]);
Log.Info(Format('FSX SimConnect: Connection failed, trying again in %d seconds', [INTERVAL_TRYSIMCONNECT div 1000]));
TFSXSimConnectStateMonitor.SetCurrentState(scsFailed);
Task.SetTimer(TIMER_TRYSIMCONNECT, INTERVAL_TRYSIMCONNECT, TM_TRYSIMCONNECT);
@ -492,7 +504,7 @@ var
definitionRef: TFSXSimConnectDefinitionRef;
begin
Debug.Log('FSX SimConnect: Handling messages');
Log.Verbose('Handling messages');
while (SimConnectHandle <> 0) and
(SimConnect_GetNextDispatch(SimConnectHandle, data, dataSize) = S_OK) do
@ -501,7 +513,7 @@ begin
SIMCONNECT_RECV_ID_SIMOBJECT_DATA:
begin
simObjectData := PSimConnectRecvSimObjectData(data);
Debug.LogFmt('FSX SimConnect: Received Sim Object Data message (definition = %d)', [simObjectData^.dwDefineID]);
Log.Verbose(Format('Received Sim Object Data message (definition = %d)', [simObjectData^.dwDefineID]));
if Definitions.ContainsKey(simObjectData^.dwDefineID) then
begin
@ -513,14 +525,14 @@ begin
SIMCONNECT_RECV_ID_EVENT:
begin
eventData := PSimConnectRecvEvent(data);
Debug.LogFmt('FSX SimConnect: Received Event message (eventId = %d)', [eventData^.uEventID]);
Log.Verbose(Format('Received Event message (eventId = %d)', [eventData^.uEventID]));
HandleEvent(eventData^.uEventID);
end;
SIMCONNECT_RECV_ID_QUIT:
begin
Debug.Log('FSX SimConnect: Received Quit message');
Log.Verbose('Received Quit message');
FSimConnectHandle := 0;
{$IFNDEF SCUSEEVENT}
@ -534,9 +546,9 @@ begin
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)]])
Log.Verbose(Format('Received unhandled message (%s)', [RecvMessageName[SIMCONNECT_RECV_ID(data^.dwID)]]))
else
Debug.LogFmt('FSX SimConnect: Received unknown message (%d)', [data^.dwID]);
Log.Verbose(Format('Received unknown message (%d)', [data^.dwID]));
end;
end;
end;
@ -582,7 +594,7 @@ begin
if SimConnectHandle = 0 then
exit;
Debug.LogFmt('FSX SimConnect: Registering definition %d', [ADefinitionID]);
Log.Verbose(Format('Registering definition %d', [ADefinitionID]));
for variableIndex := 0 to Pred(ADefinition.GetVariableCount) do
begin
@ -617,7 +629,7 @@ procedure TFSXSimConnectClient.UnregisterDefinition(ADefinitionID: Cardinal);
begin
if SimConnectHandle <> 0 then
begin
Debug.LogFmt('FSX SimConnect: Unregistering definition: %d', [ADefinitionID]);
Log.Verbose(Format('Unregistering definition: %d', [ADefinitionID]));
SimConnect_ClearDataDefinition(SimConnectHandle, ADefinitionID);
end;
end;
@ -666,7 +678,7 @@ begin
if SimConnectHandle = 0 then
exit;
Debug.Log('FSX SimConnect: Updating profile menu');
Log.Info('Updating profile menu');
if FMenuWasCascaded then
begin
@ -732,7 +744,7 @@ begin
definitionAccess := (addDefinition.Definition as IFSXSimConnectDefinitionAccess);
hasDefinition := False;
Debug.Log('FSX SimConnect: Received request to add a definition');
Log.Verbose('Received request to add a definition');
{ Attempt to re-use existing definition to save on SimConnect traffic }
for definitionID in Definitions.Keys do
@ -744,7 +756,7 @@ begin
refCount := definitionRef.Attach(addDefinition.DataHandler);
addDefinition.DefinitionID := definitionID;
Debug.LogFmt('FSX SimConnect: Definition exists, incremented reference count (definitionID = %d, refCount = %d)', [definitionID, refCount]);
Log.Verbose(Format('Definition exists, incremented reference count (definitionID = %d, refCount = %d)', [definitionID, refCount]));
{ Request an update on the definition to update the new worker }
@ -759,7 +771,7 @@ begin
begin
{ Add as new definition }
Inc(FLastDefinitionID);
Debug.LogFmt('FSX SimConnect: Adding as new definition (%d)', [FLastDefinitionID]);
Log.Verbose(Format('Adding as new definition (%d)', [FLastDefinitionID]));
definitionRef := TFSXSimConnectDefinitionRef.Create(definitionAccess);
definitionRef.Attach(addDefinition.DataHandler);
@ -781,18 +793,18 @@ var
begin
removeDefinition := Msg.MsgData;
Debug.LogFmt('FSX SimConnect: Received request to remove a definition (%d)', [removeDefinition.DefinitionID]);
Log.Verbose(Format('Received request to remove a definition (%d)', [removeDefinition.DefinitionID]));
if Definitions.ContainsKey(removeDefinition.DefinitionID) then
begin
definitionRef := Definitions[removeDefinition.DefinitionID];
refCount := definitionRef.Detach(removeDefinition.DataHandler);
Debug.LogFmt('FSX SimConnect: Definition exists, decreased reference count (refCount = %d)', [refCount]);
Log.Verbose(Format('Definition exists, decreased reference count (refCount = %d)', [refCount]));
if refCount = 0 then
begin
Debug.Log('FSX SimConnect: Removing definition');
Log.Verbose('Removing definition');
{ Unregister with SimConnect }
UnregisterDefinition(removeDefinition.DefinitionID);

20
G940LEDControl/Units/G940LEDStateConsumer.pas
View File

@ -60,8 +60,8 @@ uses
OtlCommon,
OtlTask,
X2Log.Global,
DebugLog,
LEDColorIntf,
LogiJoystickDLL;
@ -100,16 +100,18 @@ begin
Result := False;
Debug.Log('G940 LED State consumer: Initializing LogiJoystickDLL');
Log.Info('Initializing LogiJoystickDLL');
if not LogiJoystickDLLInitialized then
begin
Log.Error('Could not load LogiJoystickDLL.dll');
Task.SetExitStatus(EXIT_ERROR_LOGIJOYSTICKDLL, 'Could not load LogiJoystickDLL.dll');
exit;
end;
Debug.Log('G940 LED State consumer: Initializing DirectInput');
Log.Info('G940 LED State consumer: Initializing DirectInput');
if DirectInput8Create(SysInit.HInstance, DIRECTINPUT_VERSION, IDirectInput8, FDirectInput, nil) <> S_OK then
begin
Log.Error('Failed to initialize DirectInput');
Task.SetExitStatus(EXIT_ERROR_DIRECTINPUT, 'Failed to initialize DirectInput');
exit;
end;
@ -125,7 +127,7 @@ begin
if Assigned(ThrottleDevice) then
begin
Debug.Log('G940 LED State consumer: Cleanup (all LEDs to Green)');
Log.Info('Cleanup (all LEDs to Green)');
SetLEDs(ThrottleDevice, 0, $FF);
end;
end;
@ -133,7 +135,7 @@ end;
procedure TG940LEDStateConsumer.FindThrottleDevice;
begin
Debug.Log('G940 LED State consumer: Searching for throttle device');
Log.Info('Searching for throttle device');
SetDeviceState(DEVICESTATE_SEARCHING);
DirectInput.EnumDevices(DI8DEVCLASS_GAMECTRL,
@ -152,7 +154,7 @@ procedure TG940LEDStateConsumer.FoundThrottleDevice(ADeviceGUID: TGUID);
begin
if DirectInput.CreateDevice(ADeviceGUID, FThrottleDevice, nil) = S_OK then
begin
FTHrottleDeviceGUID := ADeviceGUID;
FThrottleDeviceGUID := ADeviceGUID;
SetDeviceState(DEVICESTATE_FOUND);
end;
end;
@ -222,7 +224,7 @@ begin
end;
end;
Debug.LogFmt('G940 LED State consumer: Set LED colors (red = %s, green = %s)', [ByteToBin(red), ByteToBin(green)]);
Log.Verbose(Format('Set LED colors (red = %s, green = %s)', [ByteToBin(red), ByteToBin(green)]));
SetLEDs(ThrottleDevice, red, green);
end;
@ -237,11 +239,11 @@ procedure TG940LEDStateConsumer.TMTestThrottleDevice(var Msg: TOmniMessage);
begin
if Assigned(ThrottleDevice) then
begin
Debug.Log('G940 LED State consumer: Checking if throttle is still attached');
Log.Info('Checking if throttle is still attached');
if DirectInput.GetDeviceStatus(ThrottleDeviceGUID) = DI_NOTATTACHED then
begin
Debug.Log('G940 LED State consumer: Throttle disconnect');
Log.Info('Throttle disconnect');
FThrottleDevice := nil;
SetDeviceState(DEVICESTATE_NOTFOUND);

274
G940LEDControl/Units/GxDbugIntf.pas
View File

@ -1,274 +0,0 @@
(*
* 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.

91
G940LEDControl/Units/LEDStateConsumer.pas
View File

@ -7,6 +7,7 @@ uses
OtlComm,
OtlCommon,
OtlTaskControl,
X2Log.Intf,
LEDColorIntf,
LEDFunctionIntf,
@ -26,6 +27,7 @@ type
FButtonWorkers: TInterfaceList;
FButtonColors: TInterfaceList;
FHasTickTimer: Boolean;
FLog: IX2Log;
protected
function Initialize: Boolean; override;
procedure Cleanup; override;
@ -41,9 +43,13 @@ type
procedure Changed; virtual;
procedure Update; virtual; abstract;
property Log: IX2Log read FLog;
protected
procedure TMLoadProfile(var Msg: TOmniMessage); message TM_LOADPROFILE;
procedure TMTick(var Msg: TOmniMessage); message TM_TICK;
public
constructor Create(ALog: IX2Log);
end;
@ -53,7 +59,6 @@ uses
System.SysUtils,
Winapi.Windows,
DebugLog,
LEDFunctionRegistry,
LEDStateIntf;
@ -77,6 +82,14 @@ type
{ TLEDStateConsumer }
constructor TLEDStateConsumer.Create(ALog: IX2Log);
begin
inherited Create;
FLog := ALog;
end;
function TLEDStateConsumer.Initialize: Boolean;
begin
Result := inherited Initialize;
@ -124,57 +137,53 @@ var
dynamicColor: ILEDStateDynamicColor;
begin
Debug.Log('LED State consumer: Updating LED states');
Debug.Indent;
try
hasDynamicColors := False;
ButtonColors.Clear;
Log.Info('Updating LED states');
for buttonIndex := 0 to Pred(ButtonWorkers.Count) do
hasDynamicColors := False;
ButtonColors.Clear;
for buttonIndex := 0 to Pred(ButtonWorkers.Count) do
begin
color := nil;
if Assigned(ButtonWorkers[buttonIndex]) then
begin
color := nil;
if Assigned(ButtonWorkers[buttonIndex]) then
state := (ButtonWorkers[buttonIndex] as ILEDFunctionWorker).GetCurrentState;
if Assigned(state) then
begin
state := (ButtonWorkers[buttonIndex] as ILEDFunctionWorker).GetCurrentState;
if Assigned(state) then
color := state.GetColor;
if Assigned(color) then
begin
color := state.GetColor;
if Assigned(color) then
if (hasDynamicColors = False) and Supports(color, ILEDStateDynamicColor, dynamicColor) then
begin
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;
{ 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;
end;
ButtonColors.Add(color as ILEDStateColor);
hasDynamicColors := True;
end;
ButtonColors.Add(color as ILEDStateColor);
end;
end;
if not Assigned(color) then
ButtonColors.Add(nil);
end;
if hasDynamicColors <> HasTickTimer then
if not Assigned(color) then
ButtonColors.Add(nil);
end;
if hasDynamicColors <> HasTickTimer then
begin
if hasDynamicColors 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;
Log.Verbose('Starting tick timer');
Task.SetTimer(TIMER_TICK, INTERVAL_TICK, TM_TICK)
end else
begin
Log.Verbose('Stopping tick timer');
Task.ClearTimer(TIMER_TICK);
end;
finally
Debug.UnIndent;
end;
Update;
@ -212,7 +221,7 @@ begin
if not Assigned(profile) then
exit;
Debug.Log('LED State consumer: Loading profile');
Log.Info('Loading profile');
oldStates := nil;
oldWorkers := nil;
@ -283,7 +292,7 @@ var
dynamicColor: ILEDStateDynamicColor;
begin
Debug.Log('LED State consumer: Tick');
Log.Verbose('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.

23
G940LEDControl/Units/Settings.pas
View File

@ -12,6 +12,9 @@ type
FActiveProfile: string;
FProfileMenu: Boolean;
FProfileMenuCascaded: Boolean;
FTrayIcon: Boolean;
FMinimizeToTray: Boolean;
FLaunchMinimized: Boolean;
procedure SetCheckUpdates(const Value: Boolean);
public
@ -25,6 +28,10 @@ type
property ProfileMenu: Boolean read FProfileMenu write FProfileMenu;
property ProfileMenuCascaded: Boolean read FProfileMenuCascaded write FProfileMenuCascaded;
property TrayIcon: Boolean read FTrayIcon write FTrayIcon;
property MinimizeToTray: Boolean read FMinimizeToTray write FMinimizeToTray;
property LaunchMinimized: Boolean read FLaunchMinimized write FLaunchMinimized;
end;
@ -38,6 +45,10 @@ const
KeyProfileMenu = 'ProfileMenu';
KeyProfileMenuCascaded = 'ProfileMenuCascaded';
KeyTrayIcon = 'TrayIcon';
KeyMinimizeToTray = 'MinimizeToTray';
KeyLaunchMinimized = 'LaunchMinimized';
{ TSettings }
procedure TSettings.Load(AReader: IX2PersistReader);
@ -58,6 +69,15 @@ begin
if not AReader.ReadBoolean(KeyProfileMenuCascaded, FProfileMenuCascaded) then
FProfileMenuCascaded := False;
if not AReader.ReadBoolean(KeyTrayIcon, FTrayIcon) then
FTrayIcon := False;
if not AReader.ReadBoolean(KeyMinimizeToTray, FMinimizeToTray) then
FMinimizeToTray := False;
if not AReader.ReadBoolean(KeyLaunchMinimized, FLaunchMinimized) then
FLaunchMinimized := False;
finally
AReader.EndSection;
end;
@ -72,6 +92,9 @@ begin
AWriter.WriteString(KeyActiveProfile, ActiveProfile);
AWriter.WriteBoolean(KeyProfileMenu, ProfileMenu);
AWriter.WriteBoolean(KeyProfileMenuCascaded, ProfileMenuCascaded);
AWriter.WriteBoolean(KeyTrayIcon, TrayIcon);
AWriter.WriteBoolean(KeyMinimizeToTray, MinimizeToTray);
AWriter.WriteBoolean(KeyLaunchMinimized, LaunchMinimized);
finally
AWriter.EndSection;
end;

451
G940LEDControl/Units/SimBaseDocumentXMLBinding.pas Normal file
View File

@ -0,0 +1,451 @@
{
X2Software XML Data Binding
Generated on: 18-4-2015 11:27:09
Generated from: F:\Development\G940\G940LEDControl\XSD\SimBaseDocument.xsd
}
unit SimBaseDocumentXMLBinding;
interface
uses
Classes,
SysUtils,
XMLDoc,
XMLIntf,
XMLDataBindingUtils;
type
{ Forward declarations for SimBaseDocument }
IXMLSimBaseDocument = interface;
IXMLLaunchAddon = interface;
TXMLSimBaseBoolean = (SimBaseBoolean_False,
SimBaseBoolean_True);
{ Interfaces for SimBaseDocument }
IXMLSimBaseDocumentEnumerator = interface
['{42B9B24E-C414-4C60-A01A-601E829465C1}']
function GetCurrent: IXMLLaunchAddon;
function MoveNext: Boolean;
property Current: IXMLLaunchAddon read GetCurrent;
end;
IXMLSimBaseDocument = interface(IXMLNodeCollection)
['{7C4F45A9-16CB-413E-9C62-D682F5E5AE0C}']
procedure XSDValidateDocument;
procedure XSDValidate;
function GetEnumerator: IXMLSimBaseDocumentEnumerator;
function Get_LaunchAddon(Index: Integer): IXMLLaunchAddon;
function Add: IXMLLaunchAddon;
function Insert(Index: Integer): IXMLLaunchAddon;
property LaunchAddon[Index: Integer]: IXMLLaunchAddon read Get_LaunchAddon; default;
function GetDescr: WideString;
function GetFilename: WideString;
function GetDisabledText: WideString;
function GetDisabled: TXMLSimBaseBoolean;
function GetLaunchManualLoadText: WideString;
function GetLaunchManualLoad: TXMLSimBaseBoolean;
function Get_Type: WideString;
function Getversion: WideString;
procedure SetDescr(const Value: WideString);
procedure SetFilename(const Value: WideString);
procedure SetDisabledText(const Value: WideString);
procedure SetDisabled(const Value: TXMLSimBaseBoolean);
procedure SetLaunchManualLoadText(const Value: WideString);
procedure SetLaunchManualLoad(const Value: TXMLSimBaseBoolean);
procedure Set_Type(const Value: WideString);
procedure Setversion(const Value: WideString);
property Descr: WideString read GetDescr write SetDescr;
property Filename: WideString read GetFilename write SetFilename;
property DisabledText: WideString read GetDisabledText write SetDisabledText;
property Disabled: TXMLSimBaseBoolean read GetDisabled write SetDisabled;
property LaunchManualLoadText: WideString read GetLaunchManualLoadText write SetLaunchManualLoadText;
property LaunchManualLoad: TXMLSimBaseBoolean read GetLaunchManualLoad write SetLaunchManualLoad;
property _Type: WideString read Get_Type write Set_Type;
property version: WideString read Getversion write Setversion;
end;
IXMLLaunchAddon = interface(IXMLNode)
['{31A8182C-75CC-4735-B68E-4EBDCDEFB1E3}']
procedure XSDValidate;
function GetName: WideString;
function GetDisabledText: WideString;
function GetDisabled: TXMLSimBaseBoolean;
function GetManualLoadText: WideString;
function GetManualLoad: TXMLSimBaseBoolean;
function GetPath: WideString;
procedure SetName(const Value: WideString);
procedure SetDisabledText(const Value: WideString);
procedure SetDisabled(const Value: TXMLSimBaseBoolean);
procedure SetManualLoadText(const Value: WideString);
procedure SetManualLoad(const Value: TXMLSimBaseBoolean);
procedure SetPath(const Value: WideString);
property Name: WideString read GetName write SetName;
property DisabledText: WideString read GetDisabledText write SetDisabledText;
property Disabled: TXMLSimBaseBoolean read GetDisabled write SetDisabled;
property ManualLoadText: WideString read GetManualLoadText write SetManualLoadText;
property ManualLoad: TXMLSimBaseBoolean read GetManualLoad write SetManualLoad;
property Path: WideString read GetPath write SetPath;
end;
{ Classes for SimBaseDocument }
TXMLSimBaseDocumentEnumerator = class(TXMLNodeCollectionEnumerator, IXMLSimBaseDocumentEnumerator)
protected
function GetCurrent: IXMLLaunchAddon;
end;
TXMLSimBaseDocument = class(TX2XMLNodeCollection, IXSDValidate, IXMLSimBaseDocument)
public
procedure AfterConstruction; override;
protected
procedure XSDValidateDocument;
procedure XSDValidate;
function GetEnumerator: IXMLSimBaseDocumentEnumerator;
function Get_LaunchAddon(Index: Integer): IXMLLaunchAddon;
function Add: IXMLLaunchAddon;
function Insert(Index: Integer): IXMLLaunchAddon;
function GetDescr: WideString;
function GetFilename: WideString;
function GetDisabledText: WideString;
function GetDisabled: TXMLSimBaseBoolean;
function GetLaunchManualLoadText: WideString;
function GetLaunchManualLoad: TXMLSimBaseBoolean;
function Get_Type: WideString;
function Getversion: WideString;
procedure SetDescr(const Value: WideString);
procedure SetFilename(const Value: WideString);
procedure SetDisabledText(const Value: WideString);
procedure SetDisabled(const Value: TXMLSimBaseBoolean);
procedure SetLaunchManualLoadText(const Value: WideString);
procedure SetLaunchManualLoad(const Value: TXMLSimBaseBoolean);
procedure Set_Type(const Value: WideString);
procedure Setversion(const Value: WideString);
end;
TXMLLaunchAddon = class(TX2XMLNode, IXSDValidate, IXMLLaunchAddon)
protected
procedure XSDValidate;
function GetName: WideString;
function GetDisabledText: WideString;
function GetDisabled: TXMLSimBaseBoolean;
function GetManualLoadText: WideString;
function GetManualLoad: TXMLSimBaseBoolean;
function GetPath: WideString;
procedure SetName(const Value: WideString);
procedure SetDisabledText(const Value: WideString);
procedure SetDisabled(const Value: TXMLSimBaseBoolean);
procedure SetManualLoadText(const Value: WideString);
procedure SetManualLoad(const Value: TXMLSimBaseBoolean);
procedure SetPath(const Value: WideString);
end;
{ Document functions }
function GetSimBaseDocument(ADocument: XMLIntf.IXMLDocument): IXMLSimBaseDocument;
function LoadSimBaseDocument(const AFileName: String): IXMLSimBaseDocument;
function LoadSimBaseDocumentFromStream(AStream: TStream): IXMLSimBaseDocument;
function LoadSimBaseDocumentFromString(const AString: String{$IF CompilerVersion >= 20}; AEncoding: TEncoding = nil; AOwnsEncoding: Boolean = True{$IFEND}): IXMLSimBaseDocument;
function NewSimBaseDocument: IXMLSimBaseDocument;
const
TargetNamespace = '';
const
SimBaseBooleanValues: array[TXMLSimBaseBoolean] of WideString =
(
'False',
'True'
);
{ Enumeration conversion helpers }
function StringToSimBaseBoolean(const AValue: WideString): TXMLSimBaseBoolean;
implementation
uses
Variants;
{ Document functions }
function GetSimBaseDocument(ADocument: XMLIntf.IXMLDocument): IXMLSimBaseDocument;
begin
Result := ADocument.GetDocBinding('SimBase.Document', TXMLSimBaseDocument, TargetNamespace) as IXMLSimBaseDocument
end;
function LoadSimBaseDocument(const AFileName: String): IXMLSimBaseDocument;
begin
Result := LoadXMLDocument(AFileName).GetDocBinding('SimBase.Document', TXMLSimBaseDocument, TargetNamespace) as IXMLSimBaseDocument
end;
function LoadSimBaseDocumentFromStream(AStream: TStream): IXMLSimBaseDocument;
var
doc: XMLIntf.IXMLDocument;
begin
doc := NewXMLDocument;
doc.LoadFromStream(AStream);
Result := GetSimBaseDocument(doc);
end;
function LoadSimBaseDocumentFromString(const AString: String{$IF CompilerVersion >= 20}; AEncoding: TEncoding; AOwnsEncoding: Boolean{$IFEND}): IXMLSimBaseDocument;
var
stream: TStringStream;
begin
stream := TStringStream.Create(AString{$IF CompilerVersion >= 20}, AEncoding, AOwnsEncoding{$IFEND});
try
Result := LoadSimBaseDocumentFromStream(stream);
finally
FreeAndNil(stream);
end;
end;
function NewSimBaseDocument: IXMLSimBaseDocument;
begin
Result := NewXMLDocument.GetDocBinding('SimBase.Document', TXMLSimBaseDocument, TargetNamespace) as IXMLSimBaseDocument
end;
{ Enumeration conversion helpers }
function StringToSimBaseBoolean(const AValue: WideString): TXMLSimBaseBoolean;
var
enumValue: TXMLSimBaseBoolean;
begin
Result := TXMLSimBaseBoolean(-1);
for enumValue := Low(TXMLSimBaseBoolean) to High(TXMLSimBaseBoolean) do
if SimBaseBooleanValues[enumValue] = AValue then
begin
Result := enumValue;
break;
end;
end;
{ Implementation for SimBaseDocument }
function TXMLSimBaseDocumentEnumerator.GetCurrent: IXMLLaunchAddon;
begin
Result := (inherited GetCurrent as IXMLLaunchAddon);
end;
procedure TXMLSimBaseDocument.AfterConstruction;
begin
RegisterChildNode('Launch.Addon', TXMLLaunchAddon);
ItemTag := 'Launch.Addon';
ItemInterface := IXMLLaunchAddon;
inherited;
end;
procedure TXMLSimBaseDocument.XSDValidateDocument;
begin
XMLDataBindingUtils.XSDValidate(Self);
end;
procedure TXMLSimBaseDocument.XSDValidate;
begin
GetDisabled;
GetLaunchManualLoad;
CreateRequiredElements(Self, ['Descr', 'Filename']);
CreateRequiredAttributes(Self, ['Type', 'version']);
SortChildNodes(Self, ['Descr', 'Filename', 'Disabled', 'Launch.ManualLoad', 'Launch.Addon']);
end;
function TXMLSimBaseDocument.GetEnumerator: IXMLSimBaseDocumentEnumerator;
begin
Result := TXMLSimBaseDocumentEnumerator.Create(Self);
end;
function TXMLSimBaseDocument.Get_LaunchAddon(Index: Integer): IXMLLaunchAddon;
begin
Result := (List[Index] as IXMLLaunchAddon);
end;
function TXMLSimBaseDocument.Add: IXMLLaunchAddon;
begin
Result := (AddItem(-1) as IXMLLaunchAddon);
end;
function TXMLSimBaseDocument.Insert(Index: Integer): IXMLLaunchAddon;
begin
Result := (AddItem(Index) as IXMLLaunchAddon);
end;
function TXMLSimBaseDocument.GetDescr: WideString;
begin
Result := ChildNodes['Descr'].Text;
end;
function TXMLSimBaseDocument.GetFilename: WideString;
begin
Result := ChildNodes['Filename'].Text;
end;
function TXMLSimBaseDocument.GetDisabledText: WideString;
begin
Result := ChildNodes['Disabled'].Text;
end;
function TXMLSimBaseDocument.GetDisabled: TXMLSimBaseBoolean;
begin
Result := StringToSimBaseBoolean(GetDisabledText);
end;
function TXMLSimBaseDocument.GetLaunchManualLoadText: WideString;
begin
Result := ChildNodes['Launch.ManualLoad'].Text;
end;
function TXMLSimBaseDocument.GetLaunchManualLoad: TXMLSimBaseBoolean;
begin
Result := StringToSimBaseBoolean(GetLaunchManualLoadText);
end;
function TXMLSimBaseDocument.Get_Type: WideString;
begin
Result := AttributeNodes['Type'].Text;
end;
function TXMLSimBaseDocument.Getversion: WideString;
begin
Result := AttributeNodes['version'].Text;
end;
procedure TXMLSimBaseDocument.SetDescr(const Value: WideString);
begin
ChildNodes['Descr'].NodeValue := GetValidXMLText(Value);
end;
procedure TXMLSimBaseDocument.SetFilename(const Value: WideString);
begin
ChildNodes['Filename'].NodeValue := GetValidXMLText(Value);
end;
procedure TXMLSimBaseDocument.SetDisabledText(const Value: WideString);
begin
ChildNodes['Disabled'].NodeValue := Value;
end;
procedure TXMLSimBaseDocument.SetDisabled(const Value: TXMLSimBaseBoolean);
begin
ChildNodes['Disabled'].NodeValue := SimBaseBooleanValues[Value];
end;
procedure TXMLSimBaseDocument.SetLaunchManualLoadText(const Value: WideString);
begin
ChildNodes['Launch.ManualLoad'].NodeValue := Value;
end;
procedure TXMLSimBaseDocument.SetLaunchManualLoad(const Value: TXMLSimBaseBoolean);
begin
ChildNodes['Launch.ManualLoad'].NodeValue := SimBaseBooleanValues[Value];
end;
procedure TXMLSimBaseDocument.Set_Type(const Value: WideString);
begin
SetAttribute('Type', GetValidXMLText(Value));
end;
procedure TXMLSimBaseDocument.Setversion(const Value: WideString);
begin
SetAttribute('version', GetValidXMLText(Value));
end;
procedure TXMLLaunchAddon.XSDValidate;
begin
GetDisabled;
GetManualLoad;
CreateRequiredElements(Self, ['Name', 'Path']);
SortChildNodes(Self, ['Name', 'Disabled', 'ManualLoad', 'Path']);
end;
function TXMLLaunchAddon.GetName: WideString;
begin
Result := ChildNodes['Name'].Text;
end;
function TXMLLaunchAddon.GetDisabledText: WideString;
begin
Result := ChildNodes['Disabled'].Text;
end;
function TXMLLaunchAddon.GetDisabled: TXMLSimBaseBoolean;
begin
Result := StringToSimBaseBoolean(GetDisabledText);
end;
function TXMLLaunchAddon.GetManualLoadText: WideString;
begin
Result := ChildNodes['ManualLoad'].Text;
end;
function TXMLLaunchAddon.GetManualLoad: TXMLSimBaseBoolean;
begin
Result := StringToSimBaseBoolean(GetManualLoadText);
end;
function TXMLLaunchAddon.GetPath: WideString;
begin
Result := ChildNodes['Path'].Text;
end;
procedure TXMLLaunchAddon.SetName(const Value: WideString);
begin
ChildNodes['Name'].NodeValue := GetValidXMLText(Value);
end;
procedure TXMLLaunchAddon.SetDisabledText(const Value: WideString);
begin
ChildNodes['Disabled'].NodeValue := Value;
end;
procedure TXMLLaunchAddon.SetDisabled(const Value: TXMLSimBaseBoolean);
begin
ChildNodes['Disabled'].NodeValue := SimBaseBooleanValues[Value];
end;
procedure TXMLLaunchAddon.SetManualLoadText(const Value: WideString);
begin
ChildNodes['ManualLoad'].NodeValue := Value;
end;
procedure TXMLLaunchAddon.SetManualLoad(const Value: TXMLSimBaseBoolean);
begin
ChildNodes['ManualLoad'].NodeValue := SimBaseBooleanValues[Value];
end;
procedure TXMLLaunchAddon.SetPath(const Value: WideString);
begin
ChildNodes['Path'].NodeValue := GetValidXMLText(Value);
end;
end.

2
G940LEDControl/XSD/SimBaseDocument.settings.xml Normal file
View File

@ -0,0 +1,2 @@
<?xml version="1.0"?>
<DataBindingSettings xmlns="http://www.x2software.net/xsd/databinding/DataBindingSettings.xsd"><Output><OutputType>Single</OutputType><OutputSingle><FileName>F:\Development\G940\G940LEDControl\Units\SimBaseDocumentXMLBinding.pas</FileName></OutputSingle></Output></DataBindingSettings>

56
G940LEDControl/XSD/SimBaseDocument.xsd Normal file
View File

@ -0,0 +1,56 @@
<?xml version="1.0" encoding="UTF-8"?>
<!-- edited with XMLSpy v2015 rel. 3 (x64) (http://www.altova.com) by Mark van Renswoude (UnameIT we build IT B.V.) -->
<!-- W3C Schema generated by XMLSpy v2015 rel. 3 (x64) (http://www.altova.com) -->
<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema">
<xs:element name="SimBase.Document">
<xs:complexType>
<xs:sequence>
<xs:element name="Descr" type="xs:string">
<xs:annotation>
<xs:documentation>Example: Launch</xs:documentation>
</xs:annotation>
</xs:element>
<xs:element name="Filename" type="xs:string">
<xs:annotation>
<xs:documentation>Example: dll.xml</xs:documentation>
</xs:annotation>
</xs:element>
<xs:element name="Disabled" type="SimBaseBoolean">
<xs:annotation>
<xs:documentation>Example: False</xs:documentation>
</xs:annotation>
</xs:element>
<xs:element name="Launch.ManualLoad" type="SimBaseBoolean">
<xs:annotation>
<xs:documentation>Example: False</xs:documentation>
</xs:annotation>
</xs:element>
<xs:element name="Launch.Addon" type="LaunchAddon" minOccurs="0" maxOccurs="unbounded"/>
</xs:sequence>
<xs:attribute name="Type" type="xs:string" use="required"/>
<xs:attribute name="version" type="xs:string" use="required"/>
</xs:complexType>
</xs:element>
<xs:complexType name="LaunchAddon">
<xs:sequence>
<xs:element name="Name" type="xs:string"/>
<xs:element name="Disabled" type="SimBaseBoolean">
<xs:annotation>
<xs:documentation>Example: False</xs:documentation>
</xs:annotation>
</xs:element>
<xs:element name="ManualLoad" type="SimBaseBoolean">
<xs:annotation>
<xs:documentation>Example: False</xs:documentation>
</xs:annotation>
</xs:element>
<xs:element name="Path" type="xs:string"/>
</xs:sequence>
</xs:complexType>
<xs:simpleType name="SimBaseBoolean">
<xs:restriction base="xs:string">
<xs:enumeration value="False"/>
<xs:enumeration value="True"/>
</xs:restriction>
</xs:simpleType>
</xs:schema>