Changeset 64
- Timestamp:
- Jan 7, 2023, 12:10:51 AM (23 months ago)
- Location:
- trunk
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormMain.lfm
r63 r64 133 133 end 134 134 end 135 object XMLConfig1: TXMLConfig136 StartEmpty = False137 RootName = 'CONFIG'138 ReadOnly = False139 Left = 149140 Top = 361141 end142 135 object AboutDialog1: TAboutDialog 143 136 Translator = Core.Translator1 -
trunk/Forms/UFormMain.pas
r63 r64 36 36 TimerDraw: TTimer; 37 37 TimerEngineTick: TTimer; 38 XMLConfig1: TXMLConfig;39 38 procedure AAboutExecute(Sender: TObject); 40 39 procedure AExitExecute(Sender: TObject); … … 83 82 procedure TFormMain.TimerDrawTimer(Sender: TObject); 84 83 begin 85 Application.ProcessMessages;86 84 if not Drawing then 87 85 try … … 112 110 113 111 procedure TFormMain.LoadConfig; 114 begin 115 if not FileExists(XMLConfig1.Filename) then Exit; 116 117 with XMLConfig1 do begin 118 FullScreenEnabled := GetValue(DOMString('LanguageCode'), FullScreenEnabled); 119 end; 120 121 if Assigned(Engine) then Engine.LoadConfig(XMLConfig1, ''); 112 var 113 LangCode: string; 114 begin 115 with TRegistryEx.Create do 116 try 117 CurrentContext := Core.ApplicationInfo.GetRegistryContext; 118 119 if ValueExists('LanguageCode') then begin 120 LangCode := ReadStringWithDefault('LanguageCode', ''); 121 Core.Translator1.Language := Core.Translator1.Languages.SearchByCode(LangCode); 122 end else Core.Translator1.Language := Core.Translator1.Languages.SearchByCode(''); 123 Engine.LoadFromRegistry(CurrentContext); 124 finally 125 Free; 126 end; 122 127 end; 123 128 124 129 procedure TFormMain.SaveConfig; 125 130 begin 126 with XMLConfig1 do begin 127 SetValue(DOMString('LanguageCode'), FullScreenEnabled); 128 end; 129 if Assigned(Engine) then Engine.SaveConfig(XMLConfig1, ''); 130 ForceDirectories(ExtractFileDir(XMLConfig1.Filename)); 131 XMLConfig1.Flush; 131 with TRegistryEx.Create do 132 try 133 CurrentContext := Core.ApplicationInfo.GetRegistryContext; 134 135 if Assigned(Core.Translator1.Language) and (Core.Translator1.Language.Code <> '') then 136 WriteString('LanguageCode', Core.Translator1.Language.Code) 137 else DeleteValue('LanguageCode'); 138 Engine.SaveToRegistry(CurrentContext); 139 finally 140 Free; 141 end; 132 142 end; 133 143 … … 150 160 151 161 procedure TFormMain.FormCreate(Sender: TObject); 152 begin 153 XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml'; 162 const 163 UnixLanguagesDir = '/usr/share/Tunneler/Languages'; 164 begin 165 {$IFDEF UNIX} 166 // If installed in UNIX system then use installation directory for po files 167 if not DirectoryExists(Core.Translator1.POFilesFolder) and DirectoryExists(UnixLanguagesDir) then 168 Core.Translator1.POFilesFolder := UnixLanguagesDir; 169 {$ENDIF} 170 171 Image1.ControlStyle := Image1.ControlStyle + [csOpaque]; 154 172 FullScreenEnabled := True; 155 173 … … 162 180 DoubleBuffered := False; 163 181 Engine := TEngine.Create(nil); 182 LoadConfig; 183 Engine.InitPlayerPool; 164 184 Engine.Bitmap := Image1.Picture.Bitmap; 165 Core.Translator1.Language := Core.Translator1.Languages.SearchByCode('cs');166 LoadConfig;167 185 Engine.NewGame; 186 Image1Resize(Self); 168 187 Engine.Active := True; 169 Image1Resize(Self);170 Image1.ControlStyle := Image1.ControlStyle + [csOpaque];171 188 end; 172 189 … … 178 195 procedure TFormMain.FormDestroy(Sender: TObject); 179 196 begin 197 SaveConfig; 180 198 TimerDraw.Enabled := False; 181 199 FreeAndNil(PersistentForm); … … 218 236 begin 219 237 PersistentForm.Save(Self); 220 SaveConfig;221 238 end; 222 239 … … 249 266 PersistentForm.Load(Self, False, True); 250 267 FullScreenEnabled := PersistentForm.FormFullScreen; 251 PersistentForm.SetFullScreen(FullScreenEnabled);268 //PersistentForm.SetFullScreen(FullScreenEnabled); 252 269 UpdateInterface; 253 270 end; -
trunk/UCore.lfm
r54 r64 1 1 object Core: TCore 2 2 OldCreateOrder = False 3 Height = 6764 HorizontalOffset = 5645 VerticalOffset = 2 266 Width = 9067 PPI = 1 253 Height = 779 4 HorizontalOffset = 650 5 VerticalOffset = 260 6 Width = 1044 7 PPI = 144 8 8 object ThemeManager1: TThemeManager 9 Left = 2 2410 Top = 2 319 Left = 258 10 Top = 266 11 11 end 12 12 object ApplicationInfo: TApplicationInfo … … 541 541 0000000000000000000000000000000000000000000000000000 542 542 } 543 Left = 2 29544 Top = 375543 Left = 264 544 Top = 432 545 545 end 546 546 object Translator1: TTranslator 547 547 POFilesFolder = 'Languages' 548 Left = 573549 Top = 2 31548 Left = 660 549 Top = 266 550 550 end 551 551 end -
trunk/UEngine.pas
r62 r64 4 4 5 5 uses 6 Dialogs, Classes, SysUtils, Graphics, SpecializedMatrix, 6 Dialogs, Classes, SysUtils, Graphics, SpecializedMatrix, URegistry, 7 7 IntfGraphics, FPImage, LCLType, SpecializedBitmap, GraphType, Math, URectangle, 8 8 Syncobjs, UThreading, Forms, DateUtils, UAudioSystem, XMLConf, DOM, … … 143 143 destructor Destroy; override; 144 144 procedure Assign(Source: TPlayer); 145 procedure Load Config(Config: TXMLConfig; Path: string);146 procedure Save Config(Config: TXMLConfig; Path: string);145 procedure LoadFromRegistry(Context: TRegistryContext); 146 procedure SaveToRegistry(Context: TRegistryContext); 147 147 property Exploded: Boolean read FExploded write SetExploded; 148 148 end; … … 154 154 function AddNew: TPlayer; 155 155 procedure Assign(Players: TPlayers); 156 procedure Load Config(Config: TXMLConfig; Path: string);157 procedure Save Config(Config: TXMLConfig; Path: string);156 procedure LoadFromRegistry(Context: TRegistryContext); 157 procedure SaveToRegistry(Context: TRegistryContext); 158 158 function GetAliveCount: Integer; 159 159 function GetWinner: TPlayer; … … 210 210 procedure Redraw; 211 211 function IsInsideHouses(Pos: TPoint): Boolean; 212 procedure InitPlayerPool;213 212 procedure InitPlayers; 214 213 procedure CheckGameEnd; … … 243 242 procedure NewGame; 244 243 procedure NewRound; 245 procedure LoadConfig(Config: TXMLConfig; Path: string);246 procedure SaveConfig(Config: TXMLConfig; Path: string);247 244 procedure KeyUp(Key: Word); 248 245 procedure KeyDown(Key: Word); 246 procedure LoadFromRegistry(Context: TRegistryContext); 247 procedure SaveToRegistry(Context: TRegistryContext); 248 procedure InitPlayerPool; 249 249 property Bitmap: TBitmap read FBitmap write SetBitmap; 250 250 property Active: Boolean read FActive write SetActive; … … 317 317 end; 318 318 319 procedure TPlayers.SaveConfig(Config: TXMLConfig; Path: string); 320 var 321 I: Integer; 322 begin 323 Config.SetValue(DOMString(Path + '/Count'), Count); 324 for I := 0 to Count - 1 do 325 Items[I].SaveConfig(Config, Path + '/Player' + IntToStr(I)); 319 procedure TPlayers.LoadFromRegistry(Context: TRegistryContext); 320 var 321 Player: TPlayer; 322 begin 323 for Player in Self do begin 324 Player.LoadFromRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\' + IntToStr(Player.Id))); 325 end; 326 end; 327 328 procedure TPlayers.SaveToRegistry(Context: TRegistryContext); 329 var 330 Player: TPlayer; 331 begin 332 for Player in Self do begin 333 Player.SaveToRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\' + IntToStr(Player.Id))); 334 end; 326 335 end; 327 336 … … 348 357 TopScore := Score; 349 358 Result := Items[I]; 350 end;351 end;352 353 procedure TPlayers.LoadConfig(Config: TXMLConfig; Path: string);354 var355 I: Integer;356 NewCount: Integer;357 begin358 NewCount := Config.GetValue(DOMString(Path + '/Count'), 0);359 while Count > NewCount do Delete(Count - 1);360 while Count < NewCount do Add(TPlayer.Create);361 for I := 0 to Count - 1 do begin362 Items[I].Engine := Engine;363 Items[I].Id := I;364 Items[I].LoadConfig(Config, Path + '/Player' + IntToStr(I));365 359 end; 366 360 end; … … 965 959 end; 966 960 967 procedure TPlayer.LoadConfig(Config: TXMLConfig; Path: string); 968 begin 969 with Config do begin 970 Self.Name := string(GetValue(DOMString(Path + '/Name'), UnicodeString(Name))); 971 Color1 := GetValue(DOMString(Path + '/Color1'), Color1); 972 Color2 := GetValue(DOMString(Path + '/Color2'), Color2); 973 Enabled := GetValue(DOMString(Path + '/Enabled'), Enabled); 974 Keys.Left := GetValue(DOMString(Path + '/Keys/Left'), Keys.Left); 975 Keys.Right := GetValue(DOMString(Path + '/Keys/Right'), Keys.Right); 976 Keys.Down := GetValue(DOMString(Path + '/Keys/Down'), Keys.Down); 977 Keys.Up := GetValue(DOMString(Path + '/Keys/Up'), Keys.Up); 978 Keys.Shoot := GetValue(DOMString(Path + '/Keys/Shoot'), Keys.Shoot); 979 end; 980 InitTanks; 981 end; 982 983 procedure TPlayer.SaveConfig(Config: TXMLConfig; Path: string); 984 begin 985 with Config do begin 986 SetValue(DOMString(Path + '/Name'), DOMString(Self.Name)); 987 SetValue(DOMString(Path + '/Color1'), Color1); 988 SetValue(DOMString(Path + '/Color2'), Color2); 989 SetValue(DOMString(Path + '/Enabled'), Enabled); 990 SetValue(DOMString(Path + '/Keys/Left'), Keys.Left); 991 SetValue(DOMString(Path + '/Keys/Right'), Keys.Right); 992 SetValue(DOMString(Path + '/Keys/Down'), Keys.Down); 993 SetValue(DOMString(Path + '/Keys/Up'), Keys.Up); 994 SetValue(DOMString(Path + '/Keys/Shoot'), Keys.Shoot); 961 procedure TPlayer.LoadFromRegistry(Context: TRegistryContext); 962 begin 963 with TRegistryEx.Create do 964 try 965 CurrentContext := Context; 966 Name := ReadStringWithDefault('Name', Name); 967 Color1 := ReadIntegerWithDefault('Color1', Color1); 968 Color2 := ReadIntegerWithDefault('Color2', Color2); 969 Enabled := ReadBoolWithDefault('Enabled', Enabled); 970 Keys.Left := ReadIntegerWithDefault('KeysLeft', Keys.Left); 971 Keys.Right := ReadIntegerWithDefault('KeyRight', Keys.Right); 972 Keys.Down := ReadIntegerWithDefault('KeyDown', Keys.Down); 973 Keys.Up := ReadIntegerWithDefault('KeyUp', Keys.Up); 974 Keys.Shoot := ReadIntegerWithDefault('KeyShoot', Keys.Shoot); 975 finally 976 Free; 977 end; 978 end; 979 980 procedure TPlayer.SaveToRegistry(Context: TRegistryContext); 981 begin 982 with TRegistryEx.Create do 983 try 984 CurrentContext := Context; 985 WriteString('Name', Name); 986 WriteInteger('Color1', Color1); 987 WriteInteger('Color2', Color2); 988 WriteBool('Enabled', Enabled); 989 WriteInteger('KeysLeft', Keys.Left); 990 WriteInteger('KeyRight', Keys.Right); 991 WriteInteger('KeyDown', Keys.Down); 992 WriteInteger('KeyUp', Keys.Up); 993 WriteInteger('KeyShoot', Keys.Shoot); 994 finally 995 Free; 995 996 end; 996 997 end; … … 1728 1729 end; 1729 1730 1730 procedure TEngine.LoadConfig(Config: TXMLConfig; Path: string); 1731 begin 1732 PlayerPool.LoadConfig(Config, Path + '/Players'); 1733 end; 1734 1735 procedure TEngine.SaveConfig(Config: TXMLConfig; Path: string); 1736 begin 1737 PlayerPool.SaveConfig(Config, Path + '/Players'); 1731 procedure TEngine.LoadFromRegistry(Context: TRegistryContext); 1732 begin 1733 with TRegistryEx.Create do 1734 try 1735 CurrentContext := Context; 1736 PlayerPool.LoadFromRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\Players')); 1737 finally 1738 Free; 1739 end; 1740 end; 1741 1742 procedure TEngine.SaveToRegistry(Context: TRegistryContext); 1743 begin 1744 with TRegistryEx.Create do 1745 try 1746 CurrentContext := Context; 1747 1748 PlayerPool.SaveToRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\Players')); 1749 finally 1750 Free; 1751 end; 1738 1752 end; 1739 1753
Note:
See TracChangeset
for help on using the changeset viewer.