Changeset 118 for trunk


Ignore:
Timestamp:
Oct 23, 2022, 10:55:55 PM (2 years ago)
Author:
chronos
Message:
  • Added: UCore main data module.
  • Added: Test cases support for better future testing.
Location:
trunk
Files:
11 added
10 edited

Legend:

Unmodified
Added
Removed

  • trunk/BigMetro.lpi

    r117 r118  
    8989      </Item2>
    9090    </RequiredPackages>
    91     <Units Count="12">
     91    <Units Count="16">
    9292      <Unit0>
    9393        <Filename Value="BigMetro.lpr"/>
    … …  
    144144        <IsPartOfProject Value="True"/>
    145145      </Unit11>
     146      <Unit12>
     147        <Filename Value="Forms/UFormTestCase.pas"/>
     148        <IsPartOfProject Value="True"/>
     149        <ComponentName Value="FormTestCase"/>
     150        <ResourceBaseClass Value="Form"/>
     151      </Unit12>
     152      <Unit13>
     153        <Filename Value="Forms/UFormTest.pas"/>
     154        <IsPartOfProject Value="True"/>
     155        <ComponentName Value="FormTest"/>
     156        <HasResources Value="True"/>
     157        <ResourceBaseClass Value="Form"/>
     158      </Unit13>
     159      <Unit14>
     160        <Filename Value="UCore.pas"/>
     161        <IsPartOfProject Value="True"/>
     162        <ComponentName Value="Core"/>
     163        <ResourceBaseClass Value="DataModule"/>
     164      </Unit14>
     165      <Unit15>
     166        <Filename Value="UTestCases.pas"/>
     167        <IsPartOfProject Value="True"/>
     168      </Unit15>
    146169    </Units>
    147170  </ProjectOptions>

  • trunk/BigMetro.lpr

    r93 r118  
    88  {$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, SysUtils, UFormMain, UFormImages, Common, UMenu, UControls,
    11 UMetroPassenger, UColors, UView, URiver, UCity;
     10  Forms, SysUtils, UFormMain, UFormImages, UFormTestCase, UFormTest, Common,
     11  UMenu, UControls, UMetroPassenger, UColors, UView, URiver, UCity, UCore,
     12  UTestCases;
    1213
    1314{$R *.res}
    … …  
    2829  Application.Scaled:=True;
    2930  Application.Initialize;
     31  Application.CreateForm(TCore, Core);
    3032  Application.CreateForm(TFormMain, FormMain);
    3133  Application.CreateForm(TFormImages, FormImages);

  • trunk/Forms/UFormMain.lfm

    r112 r118  
    3737    Top = 21
    3838  end
    39   object Translator1: TTranslator
    40     POFilesFolder = 'Languages'
    41     OnTranslate = Translator1Translate
    42     Left = 496
    43     Top = 358
    44   end
    4539  object ApplicationInfo1: TApplicationInfo
    4640    Identification = 1
    … …  
    6155    Top = 460
    6256  end
    63   object PersistentForm1: TPersistentForm
    64     MinVisiblePart = 50
    65     EntireVisible = False
    66     Left = 488
    67     Top = 536
    68   end
    6957end

  • trunk/Forms/UFormMain.pas

    r100 r118  
    1515    ApplicationInfo1: TApplicationInfo;
    1616    PaintBox1: TPaintBox;
    17     PersistentForm1: TPersistentForm;
    1817    Timer1: TTimer;
    19     Translator1: TTranslator;
    2018    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    2119    procedure FormCreate(Sender: TObject);
    … …  
    6058
    6159uses
    62   UFormImages, UPixelPointer;
     60  UFormImages, UPixelPointer, UCore, UFormTest, UTestCases;
    6361
    6462resourcestring
    … …  
    7977  {$IFDEF UNIX}
    8078  // If installed in UNIX system then use installation directory for po files
    81   if not DirectoryExists(Translator1.POFilesFolder) and DirectoryExists(UnixLanguagesDir) then
    82     Translator1.POFilesFolder := UnixLanguagesDir;
     79  if not DirectoryExists(Core.Translator1.POFilesFolder) and DirectoryExists(UnixLanguagesDir) then
     80    Core.Translator1.POFilesFolder := UnixLanguagesDir;
    8381  {$ENDIF}
    8482
    8583  Engine := TEngine.Create;
    8684  Engine.RegistryContext := ApplicationInfo1.GetRegistryContext;
     85  Engine.Translator := Core.Translator1;
    8786  LoadConfig;
    8887  // Load cities after language core is loaded to have city names translated
    … …  
    9594procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
    9695begin
    97   PersistentForm1.Save(Self);
     96  Core.PersistentForm1.Save(Self);
    9897end;
    9998
    … …  
    116115const
    117116  KeyF11 = 122;
     117{$IFDEF DEBUG}
     118  KeyF12 = 123;
     119{$ENDIF}
    118120begin
    119121  if Key = KeyF11 then begin
    120122    FullScreen := not FullScreen;
    121     PersistentForm1.SetFullScreen(FormMain.FullScreen);
     123    Core.PersistentForm1.SetFullScreen(FormMain.FullScreen);
    122124  end else
     125{$IFDEF DEBUG}
     126  if Key = KeyF12 then begin
     127    FormTest := TFormTest.Create(nil);
     128    try
     129      FormTest.TestCases := InitTestCases;
     130      try
     131        FormTest.ShowModal;
     132      finally
     133        FormTest.TestCases.Free;
     134      end;
     135    finally
     136      FormTest.Free;
     137    end;
     138  end else
     139{$ENDIF}
    123140    Engine.KeyUp(Key);
    124141end;
    … …  
    128145  if not Initialized then begin
    129146    Initialized := True;
    130     PersistentForm1.RegistryContext := ApplicationInfo1.GetRegistryContext;
    131     PersistentForm1.Load(Self, False, True);
    132     FullScreen := PersistentForm1.FormFullScreen;
     147    Core.PersistentForm1.RegistryContext := ApplicationInfo1.GetRegistryContext;
     148    Core.PersistentForm1.Load(Self, False, True);
     149    FullScreen := Core.PersistentForm1.FormFullScreen;
    133150    Engine.InitMenus;
    134151    Engine.OnDarkModeChange := DarkModeChange;
    … …  
    214231    if ValueExists('LanguageCode') then begin
    215232      LangCode := ReadStringWithDefault('LanguageCode', '');
    216       Translator1.Language := Translator1.Languages.SearchByCode(LangCode);
    217     end else Translator1.Language := Translator1.Languages.SearchByCode('');
     233      Core.Translator1.Language := Core.Translator1.Languages.SearchByCode(LangCode);
     234    end else Core.Translator1.Language := Core.Translator1.Languages.SearchByCode('');
    218235    Engine.LoadFromRegistry;
    219236  finally
    … …  
    228245    CurrentContext := ApplicationInfo1.GetRegistryContext;
    229246
    230     if Assigned(Translator1.Language) and (Translator1.Language.Code <> '') then
    231       WriteString('LanguageCode', Translator1.Language.Code)
     247    if Assigned(Core.Translator1.Language) and (Core.Translator1.Language.Code <> '') then
     248      WriteString('LanguageCode', Core.Translator1.Language.Code)
    232249      else DeleteValue('LanguageCode');
    233250    Engine.SaveToRegistry;

  • trunk/Languages/BigMetro.cs.po

    r117 r118  
    2525msgstr "Big Metro"
    2626
     27#: tformtest.arun.caption
     28msgctxt "tformtest.arun.caption"
     29msgid "Run"
     30msgstr "Spustit"
     31
     32#: tformtest.ashow.caption
     33msgid "Show"
     34msgstr "Ukázat"
     35
     36#: tformtest.buttonrun.caption
     37msgctxt "tformtest.buttonrun.caption"
     38msgid "Run"
     39msgstr "Spustit"
     40
     41#: tformtest.caption
     42msgid "Test"
     43msgstr "Test"
     44
     45#: tformtest.labelresult.caption
     46msgid "   "
     47msgstr "   "
     48
     49#: tformtest.listviewtestcases.columns[0].caption
     50msgid "Name"
     51msgstr "Jméno"
     52
     53#: tformtest.listviewtestcases.columns[1].caption
     54msgid "Result"
     55msgstr "Výsledek"
     56
     57#: tformtestcase.caption
     58msgid "Test case"
     59msgstr "Testový případ"
     60
    2761#: uengine.sautomatic
    2862msgctxt "uengine.sautomatic"
    … …  
    265299msgid "Zero zoom not allowed"
    266300msgstr "Nulové přiblížení není povoleno"
    267 

  • trunk/Languages/BigMetro.de.po

    r117 r118  
    2525msgstr "Big Metro"
    2626
     27#: tformtest.arun.caption
     28msgctxt "tformtest.arun.caption"
     29msgid "Run"
     30msgstr ""
     31
     32#: tformtest.ashow.caption
     33msgid "Show"
     34msgstr ""
     35
     36#: tformtest.buttonrun.caption
     37msgctxt "tformtest.buttonrun.caption"
     38msgid "Run"
     39msgstr ""
     40
     41#: tformtest.caption
     42msgid "Test"
     43msgstr ""
     44
     45#: tformtest.labelresult.caption
     46msgid "   "
     47msgstr ""
     48
     49#: tformtest.listviewtestcases.columns[0].caption
     50msgid "Name"
     51msgstr ""
     52
     53#: tformtest.listviewtestcases.columns[1].caption
     54msgid "Result"
     55msgstr ""
     56
     57#: tformtestcase.caption
     58msgid "Test case"
     59msgstr ""
     60
    2761#: uengine.sautomatic
    2862msgctxt "uengine.sautomatic"

  • trunk/Languages/BigMetro.fr.po

    r117 r118  
    2525msgstr "Big Metro"
    2626
     27#: tformtest.arun.caption
     28msgctxt "tformtest.arun.caption"
     29msgid "Run"
     30msgstr ""
     31
     32#: tformtest.ashow.caption
     33msgid "Show"
     34msgstr ""
     35
     36#: tformtest.buttonrun.caption
     37msgctxt "tformtest.buttonrun.caption"
     38msgid "Run"
     39msgstr ""
     40
     41#: tformtest.caption
     42msgid "Test"
     43msgstr ""
     44
     45#: tformtest.labelresult.caption
     46msgid "   "
     47msgstr ""
     48
     49#: tformtest.listviewtestcases.columns[0].caption
     50msgid "Name"
     51msgstr ""
     52
     53#: tformtest.listviewtestcases.columns[1].caption
     54msgid "Result"
     55msgstr ""
     56
     57#: tformtestcase.caption
     58msgid "Test case"
     59msgstr ""
     60
    2761#: uengine.sautomatic
    2862msgctxt "uengine.sautomatic"

  • trunk/Languages/BigMetro.pot

    r117 r118  
    1515msgstr ""
    1616
     17#: tformtest.arun.caption
     18msgctxt "tformtest.arun.caption"
     19msgid "Run"
     20msgstr ""
     21
     22#: tformtest.ashow.caption
     23msgid "Show"
     24msgstr ""
     25
     26#: tformtest.buttonrun.caption
     27msgctxt "tformtest.buttonrun.caption"
     28msgid "Run"
     29msgstr ""
     30
     31#: tformtest.caption
     32msgid "Test"
     33msgstr ""
     34
     35#: tformtest.labelresult.caption
     36msgid "   "
     37msgstr ""
     38
     39#: tformtest.listviewtestcases.columns[0].caption
     40msgid "Name"
     41msgstr ""
     42
     43#: tformtest.listviewtestcases.columns[1].caption
     44msgid "Result"
     45msgstr ""
     46
     47#: tformtestcase.caption
     48msgid "Test case"
     49msgstr ""
     50
    1751#: uengine.sautomatic
    1852msgctxt "uengine.sautomatic"

  • trunk/UEngine.pas

    r110 r118  
    99  Classes, SysUtils, Graphics, Controls, ExtCtrls, Math, DateUtils, Types,
    1010  URegistry, UMetaCanvas, Generics.Collections, Generics.Defaults, UMenu,
    11   UControls, UMetroPassenger, UColors, UView, URiver, UTrack, UCity, UGeometric;
     11  UControls, UMetroPassenger, UColors, UView, URiver, UTrack, UCity, UGeometric,
     12  UPersistentForm, UTranslator;
    1213
    1314type
    … …  
    164165    FOnDarkModeChange: TNotifyEvent;
    165166    FState: TGameState;
     167    FTranslator: TTranslator;
    166168    LastMousePos: TPoint;
    167169    LastFocusedStation: TMapStation;
    … …  
    246248    procedure EvaluateImprovement(Improvement: TMetroImprovement);
    247249  public
     250    // Test
     251    function GetSelectedOrUnusedMetroLine: TMetroLine;
     252  public
    248253    AvailableTerminals: Integer;
    249254    Week: Integer;
    … …  
    304309    procedure Paint(Canvas: TCanvas; CanvasSize: TPoint);
    305310    property Time: TDateTime read FTime;
    306     property DarkMode: Boolean read FDarkMode write SetDarkMode;
    307311    property State: TGameState read FState write SetState;
    308312    property ServedDaysCount: Integer read GetServedDaysCount;
     313  published
     314    property DarkMode: Boolean read FDarkMode write SetDarkMode;
     315    property Translator: TTranslator read FTranslator write FTranslator;
    309316    property OnDarkModeChange: TNotifyEvent read FOnDarkModeChange
    310317      write FOnDarkModeChange;
    … …  
    17111718      BackgroundColor := Colors.MenuItemBackground;
    17121719      BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
    1713       FormMain.Translator1.LanguageListToStrings(States);
    1714       Index := States.IndexOfObject(FormMain.Translator1.Language);
     1720      if Assigned(Translator) then begin
     1721        Translator.LanguageListToStrings(States);
     1722        Index := States.IndexOfObject(Translator.Language);
     1723      end;
    17151724      if Index = -1 then Index := 0;
    17161725    end;
    … …  
    18591868begin
    18601869  NewLanguage := TLanguage(TMenuItemComboBox(Sender).States.Objects[TMenuItemComboBox(Sender).Index]);
    1861   if FormMain.Translator1.Language <> NewLanguage then begin
    1862     FormMain.Translator1.Language := NewLanguage;
    1863     FormMain.Translator1.Translate;
     1870  if Assigned(Translator) and (Translator.Language <> NewLanguage) then begin
     1871    Translator.Language := NewLanguage;
     1872    Translator.Translate;
    18641873    InitMenus;
    18651874
    … …  
    18741883begin
    18751884  FormMain.FullScreen := TMenuItemCheckBox(Sender).Checked;
    1876   FormMain.PersistentForm1.SetFullScreen(FormMain.FullScreen);
     1885  with TPersistentForm.Create(nil) do
     1886  try
     1887    SetFullScreen(FormMain.FullScreen);
     1888  finally
     1889    Free;
     1890  end;
    18771891end;
    18781892
    … …  
    19631977    miTerminal: Inc(AvailableTerminals);
    19641978  end;
     1979end;
     1980
     1981function TEngine.GetSelectedOrUnusedMetroLine: TMetroLine;
     1982begin
     1983  if Assigned(SelectedLine) and (SelectedLine.LineStations.Count = 0) then
     1984    Result := SelectedLine
     1985    else Result := GetUnusedLine;
    19651986end;
    19661987
    … …  
    31143135      Station := GetStationOnPos(View.PointDestToSrc(Position));
    31153136      if Assigned(Station) then begin
    3116         if Assigned(SelectedLine) and (SelectedLine.LineStations.Count = 0) then NewLine := SelectedLine
    3117           else NewLine := GetUnusedLine;
     3137        NewLine := GetSelectedOrUnusedMetroLine;
    31183138        if Assigned(NewLine) then begin
    31193139          NewLine.ConnectStation(Station, nil, nil);
Note: See TracChangeset for help on using the changeset viewer.