Changeset 36


Ignore:
Timestamp:
Jan 1, 2018, 8:57:03 PM (7 years ago)
Author:
chronos
Message:
  • Added: Remember players configuration in XML config file between application runs.
Location:
trunk
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UMainForm.lfm

    r34 r36  
    55  Width = 514
    66  Caption = 'Tunneler'
    7   ClientHeight = 383
     7  ClientHeight = 378
    88  ClientWidth = 514
    99  Menu = MainMenu1
    … …  
    1515  OnKeyUp = FormKeyUp
    1616  OnShow = FormShow
    17   LCLVersion = '1.5'
     17  LCLVersion = '1.8.0.4'
    1818  object StatusBar1: TStatusBar
    1919    Left = 0
    20     Height = 29
    21     Top = 354
     20    Height = 30
     21    Top = 348
    2222    Width = 514
    2323    Panels = <   
    … …  
    4747  object Image1: TImage
    4848    Left = 0
    49     Height = 354
     49    Height = 348
    5050    Top = 0
    5151    Width = 514
    … …  
    135135    VersionMinor = 0
    136136    VersionBugFix = 0
     137    VersionSuffix = 'alfa'
    137138    CompanyName = 'Chronosoft'
    138139    HomePage = 'http://svn.zdechov.net/trac/Tunneler/'
    … …  
    140141    EmailContact = 'robie@centrum.cz'
    141142    AppName = 'Tunneler'
    142     ReleaseDate = 41160
     143    ReleaseDate = 43064
    143144    RegistryKey = '\Software\Chronosoft\Tunneler'
    144145    RegistryRoot = rrKeyCurrentUser
     146    License = 'CC0'
    145147    left = 99
    146148    top = 176
    147149  end
     150  object XMLConfig1: TXMLConfig
     151    StartEmpty = False
     152    RootName = 'CONFIG'
     153    ReadOnly = False
     154    left = 99
     155    top = 240
     156  end
    148157end

  • trunk/Forms/UMainForm.pas

    r34 r36  
    66
    77uses
    8   Registry, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
    9   ComCtrls, Menus, ActnList, UCore, UPlatform, Math, DateUtils, GraphType,
    10   UPersistentForm, UApplicationInfo, UCoolTranslator, LCLType, URegistry;
     8  Registry, XMLConf, Classes, SysUtils, FileUtil, Forms, Controls, Graphics,
     9  Dialogs, ExtCtrls, ComCtrls, Menus, ActnList, UCore, UPlatform, Math,
     10  DateUtils, GraphType, UPersistentForm, UApplicationInfo, UCoolTranslator,
     11  LCLType, URegistry;
    1112
    1213type
    … …  
    3738    TimerDraw: TTimer;
    3839    TimerEngineTick: TTimer;
     40    XMLConfig1: TXMLConfig;
    3941    procedure AExitExecute(Sender: TObject);
    4042    procedure AFullScreenExecute(Sender: TObject);
    … …  
    6062    DrawDuration: TDateTime;
    6163    Drawing: Boolean;
     64    procedure LoadConfig;
     65    procedure SaveConfig;
    6266  public
    6367    PersistentForm: TPersistentForm;
    … …  
    110114end;
    111115
     116procedure TMainForm.LoadConfig;
     117begin
     118  if not FileExists(XMLConfig1.Filename) then Exit;
     119  if Assigned(Engine) then Engine.LoadConfig(XMLConfig1, '');
     120end;
     121
     122procedure TMainForm.SaveConfig;
     123begin
     124  if Assigned(Engine) then Engine.SaveConfig(XMLConfig1, '');
     125  XMLConfig1.Flush;
     126end;
     127
    112128procedure TMainForm.EraseBackground(DC: HDC);
    113129begin
    … …  
    117133procedure TMainForm.FormCreate(Sender: TObject);
    118134begin
     135  XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml';
     136
    119137  PersistentForm := TPersistentForm.Create(nil);
    120138  PersistentForm.RegistryContext := RegContext(HKEY(ApplicationInfo1.RegistryRoot),
    … …  
    126144  Engine := TEngine.Create;
    127145  Engine.Bitmap := Image1.Picture.Bitmap;
     146  LoadConfig;
    128147  Engine.NewGame;
    129148  Engine.Active := True;
    … …  
    193212begin
    194213  PersistentForm.Save(Self);
     214  SaveConfig;
    195215end;
    196216

  • trunk/Forms/UNewGameForm.lfm

    r34 r36  
    120120    end
    121121    object EditDown: TEdit
    122       Left = 88
     122      Left = 86
    123123      Height = 36
    124124      Top = 32
    … …  
    186186    Width = 176
    187187    OnChange = EditNameChange
    188     OnKeyDown = EditUpKeyDown
    189188    TabOrder = 4
    190189  end

  • trunk/UCore.pas

    r34 r36  
    88  Dialogs, Classes, SysUtils, Graphics, SpecializedMatrix, SpecializedList,
    99  IntfGraphics, FPImage, LCLType, SpecializedBitmap, GraphType, Math, URectangle,
    10   Syncobjs, UThreading, Forms, DateUtils, UAudioSystem, UAudioSystemMPlayer;
     10  Syncobjs, UThreading, Forms, DateUtils, UAudioSystem, UAudioSystemMPlayer,
     11  XMLConf, DOM;
    1112
    1213const
    … …  
    6364    Image: TMatrixByte;
    6465    Mask: TMatrixByte;
     66    procedure Assign(Source: TTank);
    6567    constructor Create;
    6668    destructor Destroy; override;
     69  end;
     70
     71  { TTanks }
     72
     73  TTanks = class(TListObject)
     74    procedure Assign(Source: TTanks);
    6775  end;
    6876
    … …  
    109117    Name: string;
    110118    Keys: TPlayerKeys;
    111     Tanks: TListObject; // TListObject<TTank>
     119    Tanks: TTanks;
    112120    Bullets: TListObject; // TListObject<TBullet>
    113121    LastShootTime: TDateTime;
    … …  
    133141    destructor Destroy; override;
    134142    procedure Assign(Source: TPlayer);
     143    procedure LoadConfig(Config: TXMLConfig; Path: string);
     144    procedure SaveConfig(Config: TXMLConfig; Path: string);
    135145    property Exploded: Boolean read FExploded write SetExploded;
    136146  end;
    … …  
    139149
    140150  TPlayers = class(TListObject)
     151    Engine: TEngine;
    141152    procedure Assign(Players: TPlayers);
     153    procedure LoadConfig(Config: TXMLConfig; Path: string);
     154    procedure SaveConfig(Config: TXMLConfig; Path: string);
    142155  end;
    143156
    … …  
    212225    procedure DoDrawToBitmap;
    213226    procedure InitPlayerPool;
     227    procedure InitPlayers;
    214228  public
    215229    Keyboard: TKeyboard;
    … …  
    232246    procedure NewGame;
    233247    procedure NewRound;
     248    procedure LoadConfig(Config: TXMLConfig; Path: string);
     249    procedure SaveConfig(Config: TXMLConfig; Path: string);
    234250    property Bitmap: TBitmap read FBitmap write SetBitmap;
    235251    property Active: Boolean read FActive write SetActive;
    … …  
    267283end;
    268284
     285{ TTanks }
     286
     287procedure TTanks.Assign(Source: TTanks);
     288var
     289  I: Integer;
     290begin
     291  Clear;
     292  Count := Source.Count;
     293  for I := 0 to Count - 1 do begin
     294    Items[I] := TTank.Create;
     295    TTank(Items[I]).Assign(TTank(Source.Items[I]));
     296  end;
     297end;
     298
    269299{ TPlayers }
    270300
    … …  
    279309end;
    280310
     311procedure TPlayers.SaveConfig(Config: TXMLConfig; Path: string);
     312var
     313  I: Integer;
     314begin
     315  Config.SetValue(DOMString(Path + '/Count'), Count);
     316  for I := 0 to Count - 1 do
     317    TPlayer(Items[I]).SaveConfig(Config, Path + '/Player' + IntToStr(I));
     318end;
     319
     320procedure TPlayers.LoadConfig(Config: TXMLConfig; Path: string);
     321var
     322  I: Integer;
     323begin
     324  Clear;
     325  Count := Config.GetValue(DOMString(Path + '/Count'), 0);
     326  for I := 0 to Count - 1 do begin
     327    Items[I] := TPlayer.Create;
     328    TPlayer(Items[I]).Engine := Engine;
     329    TPlayer(Items[I]).Id := I;
     330    TPlayer(Items[I]).LoadConfig(Config, Path + '/Player' + IntToStr(I));
     331  end;
     332end;
     333
    281334{ TSystemThread }
    282335
    … …  
    319372{ TTank }
    320373
     374procedure TTank.Assign(Source: TTank);
     375begin
     376  Image.Assign(Source.Image);
     377  Mask.Assign(Source.Mask);
     378end;
     379
    321380constructor TTank.Create;
    322381begin
    … …  
    327386destructor TTank.Destroy;
    328387begin
    329   Mask.Free;
    330   Image.Free;
     388  FreeAndNil(Mask);
     389  FreeAndNil(Image);
    331390  inherited Destroy;
    332391end;
    … …  
    694753destructor TWorld.Destroy;
    695754begin
    696   Surface.Free;
    697   Matter.Free;
     755  FreeAndNil(Surface);
     756  FreeAndNil(Matter);
    698757  inherited Destroy;
    699758end;
    … …  
    11861245constructor TPlayer.Create;
    11871246begin
    1188   Tanks := TListObject.Create;
     1247  Tanks := TTanks.Create;
    11891248  Bullets := TListObject.Create;
    11901249  House := TRectangle.Create;
    … …  
    11941253destructor TPlayer.Destroy;
    11951254begin
    1196   ScreenFrame.Free;
    1197   House.Free;
    1198   Bullets.Free;
    1199   Tanks.Free;
     1255  FreeAndNil(ScreenFrame);
     1256  FreeAndNil(House);
     1257  FreeAndNil(Bullets);
     1258  FreeAndNil(Tanks);
    12001259  inherited Destroy;
    12011260end;
    … …  
    12031262procedure TPlayer.Assign(Source: TPlayer);
    12041263begin
     1264  Engine := Source.Engine;
     1265  Id := Source.Id;
    12051266  Keys := Source.Keys;
    12061267  Color := Source.Color;
    … …  
    12111272  Position := Source.Position;
    12121273  Score := Source.Score;
     1274  Tanks.Assign(Source.Tanks);
     1275end;
     1276
     1277procedure TPlayer.LoadConfig(Config: TXMLConfig; Path: string);
     1278begin
     1279  with Config do begin
     1280    Self.Name := GetValue(DOMString(Path + '/Name'), '');
     1281    Color := GetValue(DOMString(Path + '/Color'), 0);
     1282    Enabled := GetValue(DOMString(Path + '/Enabled'), False);
     1283    Keys.Left := GetValue(DOMString(Path + '/Keys/Left'), 0);
     1284    Keys.Right := GetValue(DOMString(Path + '/Keys/Right'), 0);
     1285    Keys.Down := GetValue(DOMString(Path + '/Keys/Down'), 0);
     1286    Keys.Up := GetValue(DOMString(Path + '/Keys/Up'), 0);
     1287    Keys.Shoot := GetValue(DOMString(Path + '/Keys/Shoot'), 0);
     1288  end;
     1289  InitTanks;
     1290end;
     1291
     1292procedure TPlayer.SaveConfig(Config: TXMLConfig; Path: string);
     1293begin
     1294  with Config do begin
     1295    SetValue(DOMString(Path + '/Name'), Self.Name);
     1296    SetValue(DOMString(Path + '/Color'), Color);
     1297    SetValue(DOMString(Path + '/Enabled'), Enabled);
     1298    SetValue(DOMString(Path + '/Keys/Left'), Keys.Left);
     1299    SetValue(DOMString(Path + '/Keys/Right'), Keys.Right);
     1300    SetValue(DOMString(Path + '/Keys/Down'), Keys.Down);
     1301    SetValue(DOMString(Path + '/Keys/Up'), Keys.Up);
     1302    SetValue(DOMString(Path + '/Keys/Shoot'), Keys.Shoot);
     1303  end;
    12131304end;
    12141305
    … …  
    15171608end;
    15181609
     1610procedure TEngine.InitPlayers;
     1611var
     1612  I: Integer;
     1613  NewPlayer: TPlayer;
     1614begin
     1615  Players.Clear;
     1616  for I := 0 to PlayerPool.Count - 1 do
     1617  with TPlayer(PlayerPool[I]) do
     1618  if Enabled then begin
     1619    NewPlayer := TPlayer.Create;
     1620    NewPlayer.Assign(TPlayer(PlayerPool[I]));
     1621    Players.Add(NewPlayer);
     1622    Score := 0;
     1623  end;
     1624end;
     1625
    15191626procedure TEngine.CheckGameEnd;
    15201627var
    … …  
    15731680  IntfImage := TLazIntfImage.Create(1, 1);
    15741681  PlayerPool := TPlayers.Create;
     1682  PlayerPool.Engine := Self;
    15751683  Players := TPlayers.Create;
    1576   Players.OwnsObjects := False;
     1684  Players.Engine := Self;
    15771685  Keyboard := TKeyboard.Create;
    15781686  World := TWorld.Create;
    … …  
    16511759begin
    16521760  Active := False;
    1653   Players.Clear;
    1654   for I := 0 to PlayerPool.Count - 1 do
    1655   with TPlayer(PlayerPool[I]) do
    1656   if Enabled then begin
    1657     Players.Add(PlayerPool[I]);
    1658     Score := 0;
    1659   end;
     1761  InitPlayers;
    16601762  ResizePlayerFrames;
    16611763  CurrentRound := 0;
    … …  
    16811783end;
    16821784
     1785procedure TEngine.LoadConfig(Config: TXMLConfig; Path: string);
     1786begin
     1787  PlayerPool.LoadConfig(Config, Path + '/Players');
     1788end;
     1789
     1790procedure TEngine.SaveConfig(Config: TXMLConfig; Path: string);
     1791begin
     1792  PlayerPool.SaveConfig(Config, Path + '/Players');
     1793end;
     1794
    16831795end.
    16841796

  • trunk/tunneler.lpi

    r35 r36  
    7171      </local>
    7272    </RunParams>
    73     <RequiredPackages Count="5">
     73    <RequiredPackages Count="6">
    7474      <Item1>
     75        <PackageName Value="FCL"/>
     76      </Item1>
     77      <Item2>
    7578        <PackageName Value="CoolAudio"/>
    7679        <DefaultFilename Value="Components/CoolAudio/CoolAudio.lpk" Prefer="True"/>
    77       </Item1>
    78       <Item2>
     80      </Item2>
     81      <Item3>
    7982        <PackageName Value="Common"/>
    8083        <DefaultFilename Value="Components/Common/Common.lpk" Prefer="True"/>
    81       </Item2>
    82       <Item3>
     84      </Item3>
     85      <Item4>
    8386        <PackageName Value="CoolTranslator"/>
    8487        <DefaultFilename Value="Components/CoolTranslator/CoolTranslator.lpk" Prefer="True"/>
    85       </Item3>
    86       <Item4>
     88      </Item4>
     89      <Item5>
    8790        <PackageName Value="TemplateGenerics"/>
    8891        <DefaultFilename Value="Components/TemplateGenerics/TemplateGenerics.lpk" Prefer="True"/>
    89       </Item4>
    90       <Item5>
     92      </Item5>
     93      <Item6>
    9194        <PackageName Value="LCL"/>
    92       </Item5>
     95      </Item6>
    9396    </RequiredPackages>
    9497    <Units Count="9">
Note: See TracChangeset for help on using the changeset viewer.