Changeset 64 for trunk

Timestamp:

Jan 7, 2023, 12:10:51 AM (23 months ago)

Author:

chronos

Message:

• Modified: Store app settings in registry.
• Fixed: Full screen initialization.
• Fixed: Automatic language detection.

Location:

trunk

Files:

• Forms/UFormMain.lfm (modified) (1 diff)
• Forms/UFormMain.pas (modified) (8 diffs)
• UCore.lfm (modified) (2 diffs)
• UEngine.pas (modified) (9 diffs)

trunk/Forms/UFormMain.lfm

@@ -133 +133 @@
     end
   end
-  object XMLConfig1: TXMLConfig
-    StartEmpty = False
-    RootName = 'CONFIG'
-    ReadOnly = False
-    Left = 149
-    Top = 361
-  end
   object AboutDialog1: TAboutDialog
     Translator = Core.Translator1

trunk/Forms/UFormMain.pas

@@ -36 +36 @@
     TimerDraw: TTimer;
     TimerEngineTick: TTimer;
-    XMLConfig1: TXMLConfig;
     procedure AAboutExecute(Sender: TObject);
     procedure AExitExecute(Sender: TObject);
@@ -83 +82 @@
 procedure TFormMain.TimerDrawTimer(Sender: TObject);
 begin
-  Application.ProcessMessages;
   if not Drawing then
   try
@@ -112 +110 @@
 
 procedure TFormMain.LoadConfig;
-begin
-  if not FileExists(XMLConfig1.Filename) then Exit;
-
-  with XMLConfig1 do begin
-    FullScreenEnabled := GetValue(DOMString('LanguageCode'), FullScreenEnabled);
-  end;
-
-  if Assigned(Engine) then Engine.LoadConfig(XMLConfig1, '');
+var
+  LangCode: string;
+begin
+  with TRegistryEx.Create do
+  try
+    CurrentContext := Core.ApplicationInfo.GetRegistryContext;
+
+    if ValueExists('LanguageCode') then begin
+      LangCode := ReadStringWithDefault('LanguageCode', '');
+      Core.Translator1.Language := Core.Translator1.Languages.SearchByCode(LangCode);
+    end else Core.Translator1.Language := Core.Translator1.Languages.SearchByCode('');
+    Engine.LoadFromRegistry(CurrentContext);
+  finally
+    Free;
+  end;
 end;
 
 procedure TFormMain.SaveConfig;
 begin
-  with XMLConfig1 do begin
-    SetValue(DOMString('LanguageCode'), FullScreenEnabled);
-  end;
-  if Assigned(Engine) then Engine.SaveConfig(XMLConfig1, '');
-  ForceDirectories(ExtractFileDir(XMLConfig1.Filename));
-  XMLConfig1.Flush;
+  with TRegistryEx.Create do
+  try
+    CurrentContext := Core.ApplicationInfo.GetRegistryContext;
+
+    if Assigned(Core.Translator1.Language) and (Core.Translator1.Language.Code <> '') then
+      WriteString('LanguageCode', Core.Translator1.Language.Code)
+      else DeleteValue('LanguageCode');
+    Engine.SaveToRegistry(CurrentContext);
+  finally
+    Free;
+  end;
 end;
 
@@ -150 +160 @@
 
 procedure TFormMain.FormCreate(Sender: TObject);
-begin
-  XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml';
+const
+  UnixLanguagesDir = '/usr/share/Tunneler/Languages';
+begin
+  {$IFDEF UNIX}
+  // If installed in UNIX system then use installation directory for po files
+  if not DirectoryExists(Core.Translator1.POFilesFolder) and DirectoryExists(UnixLanguagesDir) then
+    Core.Translator1.POFilesFolder := UnixLanguagesDir;
+  {$ENDIF}
+
+  Image1.ControlStyle := Image1.ControlStyle + [csOpaque];
   FullScreenEnabled := True;
 
@@ -162 +180 @@
   DoubleBuffered := False;
   Engine := TEngine.Create(nil);
+  LoadConfig;
+  Engine.InitPlayerPool;
   Engine.Bitmap := Image1.Picture.Bitmap;
-  Core.Translator1.Language := Core.Translator1.Languages.SearchByCode('cs');
-  LoadConfig;
   Engine.NewGame;
+  Image1Resize(Self);
   Engine.Active := True;
-  Image1Resize(Self);
-  Image1.ControlStyle := Image1.ControlStyle + [csOpaque];
 end;
 
@@ -178 +195 @@
 procedure TFormMain.FormDestroy(Sender: TObject);
 begin
+  SaveConfig;
   TimerDraw.Enabled := False;
   FreeAndNil(PersistentForm);
@@ -218 +236 @@
 begin
   PersistentForm.Save(Self);
-  SaveConfig;
 end;
 
@@ -249 +266 @@
   PersistentForm.Load(Self, False, True);
   FullScreenEnabled := PersistentForm.FormFullScreen;
-  PersistentForm.SetFullScreen(FullScreenEnabled);
+  //PersistentForm.SetFullScreen(FullScreenEnabled);
   UpdateInterface;
 end;

trunk/UCore.lfm

@@ -1 +1 @@
 object Core: TCore
   OldCreateOrder = False
-  Height = 676
-  HorizontalOffset = 564
-  VerticalOffset = 226
-  Width = 906
-  PPI = 125
+  Height = 779
+  HorizontalOffset = 650
+  VerticalOffset = 260
+  Width = 1044
+  PPI = 144
   object ThemeManager1: TThemeManager
-    Left = 224
-    Top = 231
+    Left = 258
+    Top = 266
   end
   object ApplicationInfo: TApplicationInfo
@@ -541 +541 @@
       0000000000000000000000000000000000000000000000000000
     }
-    Left = 229
-    Top = 375
+    Left = 264
+    Top = 432
   end
   object Translator1: TTranslator
     POFilesFolder = 'Languages'
-    Left = 573
-    Top = 231
+    Left = 660
+    Top = 266
   end
 end

trunk/UEngine.pas

@@ -4 +4 @@
 
 uses
-  Dialogs, Classes, SysUtils, Graphics, SpecializedMatrix,
+  Dialogs, Classes, SysUtils, Graphics, SpecializedMatrix, URegistry,
   IntfGraphics, FPImage, LCLType, SpecializedBitmap, GraphType, Math, URectangle,
   Syncobjs, UThreading, Forms, DateUtils, UAudioSystem, XMLConf, DOM,
@@ -143 +143 @@
     destructor Destroy; override;
     procedure Assign(Source: TPlayer);
-    procedure LoadConfig(Config: TXMLConfig; Path: string);
-    procedure SaveConfig(Config: TXMLConfig; Path: string);
+    procedure LoadFromRegistry(Context: TRegistryContext);
+    procedure SaveToRegistry(Context: TRegistryContext);
     property Exploded: Boolean read FExploded write SetExploded;
   end;
@@ -154 +154 @@
     function AddNew: TPlayer;
     procedure Assign(Players: TPlayers);
-    procedure LoadConfig(Config: TXMLConfig; Path: string);
-    procedure SaveConfig(Config: TXMLConfig; Path: string);
+    procedure LoadFromRegistry(Context: TRegistryContext);
+    procedure SaveToRegistry(Context: TRegistryContext);
     function GetAliveCount: Integer;
     function GetWinner: TPlayer;
@@ -210 +210 @@
     procedure Redraw;
     function IsInsideHouses(Pos: TPoint): Boolean;
-    procedure InitPlayerPool;
     procedure InitPlayers;
     procedure CheckGameEnd;
@@ -243 +242 @@
     procedure NewGame;
     procedure NewRound;
-    procedure LoadConfig(Config: TXMLConfig; Path: string);
-    procedure SaveConfig(Config: TXMLConfig; Path: string);
     procedure KeyUp(Key: Word);
     procedure KeyDown(Key: Word);
+    procedure LoadFromRegistry(Context: TRegistryContext);
+    procedure SaveToRegistry(Context: TRegistryContext);
+    procedure InitPlayerPool;
     property Bitmap: TBitmap read FBitmap write SetBitmap;
     property Active: Boolean read FActive write SetActive;
@@ -317 +317 @@
 end;
 
-procedure TPlayers.SaveConfig(Config: TXMLConfig; Path: string);
-var
-  I: Integer;
-begin
-  Config.SetValue(DOMString(Path + '/Count'), Count);
-  for I := 0 to Count - 1 do
-    Items[I].SaveConfig(Config, Path + '/Player' + IntToStr(I));
+procedure TPlayers.LoadFromRegistry(Context: TRegistryContext);
+var
+  Player: TPlayer;
+begin
+  for Player in Self do begin
+    Player.LoadFromRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\' + IntToStr(Player.Id)));
+  end;
+end;
+
+procedure TPlayers.SaveToRegistry(Context: TRegistryContext);
+var
+  Player: TPlayer;
+begin
+  for Player in Self do begin
+    Player.SaveToRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\' + IntToStr(Player.Id)));
+  end;
 end;
 
@@ -348 +357 @@
     TopScore := Score;
     Result := Items[I];
-  end;
-end;
-
-procedure TPlayers.LoadConfig(Config: TXMLConfig; Path: string);
-var
-  I: Integer;
-  NewCount: Integer;
-begin
-  NewCount := Config.GetValue(DOMString(Path + '/Count'), 0);
-  while Count > NewCount do Delete(Count - 1);
-  while Count < NewCount do Add(TPlayer.Create);
-  for I := 0 to Count - 1 do begin
-    Items[I].Engine := Engine;
-    Items[I].Id := I;
-    Items[I].LoadConfig(Config, Path + '/Player' + IntToStr(I));
   end;
 end;
@@ -965 +959 @@
 end;
 
-procedure TPlayer.LoadConfig(Config: TXMLConfig; Path: string);
-begin
-  with Config do begin
-    Self.Name := string(GetValue(DOMString(Path + '/Name'), UnicodeString(Name)));
-    Color1 := GetValue(DOMString(Path + '/Color1'), Color1);
-    Color2 := GetValue(DOMString(Path + '/Color2'), Color2);
-    Enabled := GetValue(DOMString(Path + '/Enabled'), Enabled);
-    Keys.Left := GetValue(DOMString(Path + '/Keys/Left'), Keys.Left);
-    Keys.Right := GetValue(DOMString(Path + '/Keys/Right'), Keys.Right);
-    Keys.Down := GetValue(DOMString(Path + '/Keys/Down'), Keys.Down);
-    Keys.Up := GetValue(DOMString(Path + '/Keys/Up'), Keys.Up);
-    Keys.Shoot := GetValue(DOMString(Path + '/Keys/Shoot'), Keys.Shoot);
-  end;
-  InitTanks;
-end;
-
-procedure TPlayer.SaveConfig(Config: TXMLConfig; Path: string);
-begin
-  with Config do begin
-    SetValue(DOMString(Path + '/Name'), DOMString(Self.Name));
-    SetValue(DOMString(Path + '/Color1'), Color1);
-    SetValue(DOMString(Path + '/Color2'), Color2);
-    SetValue(DOMString(Path + '/Enabled'), Enabled);
-    SetValue(DOMString(Path + '/Keys/Left'), Keys.Left);
-    SetValue(DOMString(Path + '/Keys/Right'), Keys.Right);
-    SetValue(DOMString(Path + '/Keys/Down'), Keys.Down);
-    SetValue(DOMString(Path + '/Keys/Up'), Keys.Up);
-    SetValue(DOMString(Path + '/Keys/Shoot'), Keys.Shoot);
+procedure TPlayer.LoadFromRegistry(Context: TRegistryContext);
+begin
+  with TRegistryEx.Create do
+  try
+    CurrentContext := Context;
+    Name := ReadStringWithDefault('Name', Name);
+    Color1 := ReadIntegerWithDefault('Color1', Color1);
+    Color2 := ReadIntegerWithDefault('Color2', Color2);
+    Enabled := ReadBoolWithDefault('Enabled', Enabled);
+    Keys.Left := ReadIntegerWithDefault('KeysLeft', Keys.Left);
+    Keys.Right := ReadIntegerWithDefault('KeyRight', Keys.Right);
+    Keys.Down := ReadIntegerWithDefault('KeyDown', Keys.Down);
+    Keys.Up := ReadIntegerWithDefault('KeyUp', Keys.Up);
+    Keys.Shoot := ReadIntegerWithDefault('KeyShoot', Keys.Shoot);
+  finally
+    Free;
+  end;
+end;
+
+procedure TPlayer.SaveToRegistry(Context: TRegistryContext);
+begin
+  with TRegistryEx.Create do
+  try
+    CurrentContext := Context;
+    WriteString('Name', Name);
+    WriteInteger('Color1', Color1);
+    WriteInteger('Color2', Color2);
+    WriteBool('Enabled', Enabled);
+    WriteInteger('KeysLeft', Keys.Left);
+    WriteInteger('KeyRight', Keys.Right);
+    WriteInteger('KeyDown', Keys.Down);
+    WriteInteger('KeyUp', Keys.Up);
+    WriteInteger('KeyShoot', Keys.Shoot);
+  finally
+    Free;
   end;
 end;
@@ -1728 +1729 @@
 end;
 
-procedure TEngine.LoadConfig(Config: TXMLConfig; Path: string);
-begin
-  PlayerPool.LoadConfig(Config, Path + '/Players');
-end;
-
-procedure TEngine.SaveConfig(Config: TXMLConfig; Path: string);
-begin
-  PlayerPool.SaveConfig(Config, Path + '/Players');
+procedure TEngine.LoadFromRegistry(Context: TRegistryContext);
+begin
+  with TRegistryEx.Create do
+  try
+    CurrentContext := Context;
+    PlayerPool.LoadFromRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\Players'));
+  finally
+    Free;
+  end;
+end;
+
+procedure TEngine.SaveToRegistry(Context: TRegistryContext);
+begin
+  with TRegistryEx.Create do
+  try
+    CurrentContext := Context;
+
+    PlayerPool.SaveToRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\Players'));
+  finally
+    Free;
+  end;
 end;