Changeset 130
- Timestamp:
- May 1, 2023, 4:02:31 PM (20 months ago)
- Location:
- trunk
- Files:
-
- 3 added
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormMain.lfm
r125 r130 15 15 OnKeyUp = FormKeyUp 16 16 OnShow = FormShow 17 LCLVersion = '2.2. 4.0'17 LCLVersion = '2.2.6.0' 18 18 object PaintBox1: TPaintBox 19 19 Left = 0 -
trunk/Languages/TransLines.cs.po
r128 r130 233 233 msgstr "Tvary" 234 234 235 #: uengine.sslot 236 msgid "Slot" 237 msgstr "Pozice" 238 235 239 #: uengine.sstationnotdefined 236 240 msgid "Station have to be defined" -
trunk/Languages/TransLines.de.po
r128 r130 237 237 msgstr "" 238 238 239 #: uengine.sslot 240 msgid "Slot" 241 msgstr "" 242 239 243 #: uengine.sstationnotdefined 240 244 msgid "Station have to be defined" -
trunk/Languages/TransLines.fr.po
r128 r130 238 238 msgstr "" 239 239 240 #: uengine.sslot 241 msgid "Slot" 242 msgstr "" 243 240 244 #: uengine.sstationnotdefined 241 245 msgid "Station have to be defined" -
trunk/Languages/TransLines.pot
r128 r130 223 223 msgstr "" 224 224 225 #: uengine.sslot 226 msgid "Slot" 227 msgstr "" 228 225 229 #: uengine.sstationnotdefined 226 230 msgid "Station have to be defined" -
trunk/TransLines.lpi
r128 r130 31 31 <SearchPaths> 32 32 <IncludeFiles Value="$(ProjOutDir)"/> 33 <OtherUnitFiles Value="Forms "/>33 <OtherUnitFiles Value="Forms;Scenes"/> 34 34 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/> 35 35 </SearchPaths> … … 89 89 </Item2> 90 90 </RequiredPackages> 91 <Units Count="1 7">91 <Units Count="19"> 92 92 <Unit0> 93 93 <Filename Value="TransLines.lpr"/> … … 173 173 <IsPartOfProject Value="True"/> 174 174 </Unit16> 175 <Unit17> 176 <Filename Value="UScene.pas"/> 177 <IsPartOfProject Value="True"/> 178 </Unit17> 179 <Unit18> 180 <Filename Value="Scenes/USceneGameSlots.pas"/> 181 <IsPartOfProject Value="True"/> 182 </Unit18> 175 183 </Units> 176 184 </ProjectOptions> … … 182 190 <SearchPaths> 183 191 <IncludeFiles Value="$(ProjOutDir)"/> 184 <OtherUnitFiles Value="Forms "/>192 <OtherUnitFiles Value="Forms;Scenes"/> 185 193 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/> 186 194 </SearchPaths> -
trunk/TransLines.lpr
r128 r130 10 10 Forms, SysUtils, UFormMain, UFormImages, UFormTestCase, UFormTest, Common, 11 11 UMenu, UControls, UMetroPassenger, UColors, UView, URiver, UCity, UCore, 12 UTestCases, UItems ;12 UTestCases, UItems, UScene, USceneGameSlots; 13 13 14 14 {$R *.res} -
trunk/UCity.pas
r110 r130 28 28 29 29 TCities = class(TObjectList<TCity>) 30 function SearchBySysName(SysName: string): TCity; 30 31 function AddNew(SysName, Name: string; Population: Integer): TCity; 31 32 procedure LoadFromRegistry(Context: TRegistryContext); … … 81 82 { TCities } 82 83 84 function TCities.SearchBySysName(SysName: string): TCity; 85 var 86 I: Integer; 87 begin 88 I := 0; 89 while (I < Count) and (Items[I].SysName <> SysName) do Inc(I); 90 if I < Count then Result := Items[I] 91 else Result := nil; 92 end; 93 83 94 function TCities.AddNew(SysName, Name: string; Population: Integer): TCity; 84 95 begin -
trunk/UEngine.pas
r129 r130 10 10 URegistry, UMetaCanvas, Generics.Collections, Generics.Defaults, UMenu, 11 11 UControls, UMetroPassenger, UColors, UView, URiver, UTrack, UCity, UGeometric, 12 UTranslator, DOM, XMLRead, XMLWrite, UXMLUtils, UItems ;12 UTranslator, DOM, XMLRead, XMLWrite, UXMLUtils, UItems, FileUtil; 13 13 14 14 type … … 227 227 MenuGame: TMenu; 228 228 MenuCustomGame: TMenu; 229 MenuGameSlots: TMenu; 229 230 LastState: TGameState; 230 231 TimePerSecond: TDateTime; … … 237 238 GrabbedTrainDirection: Integer; 238 239 LastGrabbedTrain: TMetroTrain; 239 SavedGameFileName: string;240 240 function GetMetroLineThickness: Integer; 241 241 function GetServedDaysCount: Integer; … … 286 286 procedure MenuItemGameLoad(Sender: TObject); 287 287 procedure MenuItemGameSave(Sender: TObject); 288 procedure MenuItemGameSlotLoad(Sender: TObject); 289 procedure MenuItemGameSlotSave(Sender: TObject); 288 290 procedure MenuItemBack(Sender: TObject); 289 291 procedure ButtonPlay(Sender: TObject); … … 304 306 function GetImprovementBitmap(Improvement: TMetroImprovement): TBitmap; 305 307 procedure EvaluateImprovement(Improvement: TMetroImprovement); 308 procedure ReloadGameSlots(Save: Boolean); 309 function GetGameSlotFileName(Index: Integer): string; 306 310 public 307 311 // Test … … 465 469 SVisualStyle = 'Visual style'; 466 470 SStationStyle = 'Station style'; 471 SSlot = 'Slot'; 467 472 468 473 // Cities … … 2287 2292 procedure TEngine.MenuItemGameLoad(Sender: TObject); 2288 2293 begin 2289 LoadFromFile(SavedGameFileName); 2294 ReloadGameSlots(False); 2295 Menu := MenuGameSlots; 2296 end; 2297 2298 procedure TEngine.MenuItemGameSave(Sender: TObject); 2299 begin 2300 ReloadGameSlots(True); 2301 Menu := MenuGameSlots; 2302 end; 2303 2304 procedure TEngine.MenuItemGameSlotLoad(Sender: TObject); 2305 begin 2306 LoadFromFile(GetGameSlotFileName(Integer(TMenuItemButton(Sender).Ref))); 2290 2307 State := gsRunning; 2291 2308 end; 2292 2309 2293 procedure TEngine.MenuItemGameS ave(Sender: TObject);2294 begin 2295 SaveToFile( SavedGameFileName);2310 procedure TEngine.MenuItemGameSlotSave(Sender: TObject); 2311 begin 2312 SaveToFile(GetGameSlotFileName(Integer(TMenuItemButton(Sender).Ref))); 2296 2313 State := LastState; 2297 2314 end; … … 2426 2443 miTerminal: Inc(AvailableTerminals); 2427 2444 end; 2445 end; 2446 2447 procedure TEngine.ReloadGameSlots(Save: Boolean); 2448 var 2449 I: Integer; 2450 Action: TNotifyEvent; 2451 FileName: string; 2452 FileDateTime: TDateTime; 2453 ControlName: string; 2454 const 2455 GameSlotCount = 6; 2456 begin 2457 with MenuGameSlots, Items do begin 2458 Clear; 2459 Parent := Menu; 2460 if Save then Action := MenuItemGameSlotSave 2461 else Action := MenuItemGameSlotLoad; 2462 for I := 0 to GameSlotCount - 1 do begin 2463 FileName := GetGameSlotFileName(Integer(I)); 2464 ControlName := SSlot + ' ' + IntToStr(I); 2465 if FileExists(FileName) then begin 2466 FileAge(FileName, FileDateTime); 2467 ControlName := ControlName + ' (' + DateTimeToStr(FileDateTime) + ')'; 2468 end; 2469 with AddButton(ControlName, Action) do begin 2470 Ref := TObject(I); 2471 Enabled := FileExists(FileName) or Save; 2472 TextSize := 40; 2473 TextColor := Colors.MenuItemText; 2474 TextDisabledColor := Colors.MenuItemDisabledText; 2475 BackgroundColor := Colors.MenuItemBackground; 2476 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 2477 end; 2478 end; 2479 with AddButton(SExit, MenuItemBack) do begin 2480 TextSize := 40; 2481 TextColor := Colors.MenuItemText; 2482 TextDisabledColor := Colors.MenuItemDisabledText; 2483 BackgroundColor := Colors.MenuItemBackground; 2484 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 2485 end; 2486 OnExit := MenuItemBack; 2487 end; 2488 end; 2489 2490 function TEngine.GetGameSlotFileName(Index: Integer): string; 2491 begin 2492 Result := GetAppConfigDir(False) + 'Saved game ' + IntToStr(Index) + TransLinesExt; 2428 2493 end; 2429 2494 … … 2470 2535 end; 2471 2536 with AddButton(SLoad, MenuItemGameLoad) do begin 2472 Enabled := FileExists(SavedGameFileName);2473 2537 TextSize := 40; 2474 2538 TextColor := Colors.MenuItemText; … … 2527 2591 end; 2528 2592 with AddButton(SLoad, MenuItemGameLoad) do begin 2529 Enabled := FileExists(SavedGameFileName);2530 2593 TextSize := 40; 2531 2594 TextColor := Colors.MenuItemText; … … 3957 4020 FTime := ReadDateTime(Node, 'Time', 0); 3958 4021 FLastTime := FTime; 4022 City := Cities.SearchBySysName(ReadString(Node, 'CityName', '')); 3959 4023 3960 4024 NewNode := Node.FindNode(DOMString(TView.GetClassSysName)); … … 4007 4071 WriteInteger(Node, 'State', Integer(State)); 4008 4072 WriteDateTime(Node, 'Time', FTime); 4073 if Assigned(City) then WriteString(Node, 'CityName', City.SysName); 4009 4074 4010 4075 NewNode := Node.OwnerDocument.CreateElement(DOMString(TView.GetClassSysName)); … … 4078 4143 begin 4079 4144 inherited; 4080 SavedGameFileName := GetAppConfigDir(False) + 'LastGameState' + TransLinesExt;4081 4145 MovableTracks := True; 4082 4146 Colors := TColors.Create; … … 4095 4159 MenuGame := TMenu.Create; 4096 4160 MenuCustomGame := TMenu.Create; 4161 MenuGameSlots := TMenu.Create; 4097 4162 Menu := MenuMain; 4098 4163 InitMenus; … … 4159 4224 FreeAndNil(MenuCareer); 4160 4225 FreeAndNil(MenuGame); 4226 FreeAndNil(MenuGameSlots); 4161 4227 FreeAndNil(Cities); 4162 4228 FreeAndNil(ButtonBack); -
trunk/UMenu.pas
r100 r130 75 75 procedure MouseUp(Button: TMouseButton; Position: TPoint); 76 76 procedure Paint(Canvas: TCanvas; CanvasSize: TPoint); 77 constructor Create; 77 constructor Create; virtual; 78 78 destructor Destroy; override; 79 79 property OnExit: TNotifyEvent read FOnExit write FOnExit; … … 286 286 end; 287 287 288 289 288 end. 290 289
Note:
See TracChangeset
for help on using the changeset viewer.