Changeset 62
- Timestamp:
- Nov 25, 2020, 4:25:09 PM (4 years ago)
- Location:
- trunk
- Files:
-
- 1 added
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/BigMetro.lpi
r61 r62 87 87 </Item2> 88 88 </RequiredPackages> 89 <Units Count=" 5">89 <Units Count="6"> 90 90 <Unit0> 91 91 <Filename Value="BigMetro.lpr"/> … … 114 114 <ResourceBaseClass Value="Form"/> 115 115 </Unit4> 116 <Unit5> 117 <Filename Value="UMenu.pas"/> 118 <IsPartOfProject Value="True"/> 119 </Unit5> 116 120 </Units> 117 121 </ProjectOptions> -
trunk/BigMetro.lpr
r55 r62 8 8 {$ENDIF} 9 9 Interfaces, // this includes the LCL widgetset 10 Forms, SysUtils, UFormMain, UFormImages, Common ;10 Forms, SysUtils, UFormMain, UFormImages, Common, UMenu; 11 11 12 12 {$R *.res} 13 13 14 {$ IFDEF DEBUG}14 {$if declared(UseHeapTrace)} 15 15 const 16 16 HeapTraceLog = 'heaptrclog.trc'; … … 18 18 19 19 begin 20 Application.Scaled:=True; 21 {$IFDEF DEBUG} 20 {$if declared(UseHeapTrace)} 22 21 // Heap trace 23 22 DeleteFile(ExtractFilePath(ParamStr(0)) + HeapTraceLog); … … 26 25 27 26 RequireDerivedFormResource := True; 27 Application.Scaled:=True; 28 28 Application.Initialize; 29 29 Application.CreateForm(TFormMain, FormMain); -
trunk/Forms/UFormMain.lfm
r61 r62 35 35 Top = 21 36 36 end 37 object Translator1: TTranslator 38 POFilesFolder = 'Languages' 39 Left = 496 40 Top = 358 41 end 42 object ApplicationInfo1: TApplicationInfo 43 Identification = 1 44 VersionMajor = 1 45 VersionMinor = 1 46 VersionBugFix = 0 47 HomePage = 'https://app.zdechov.net/BigMetro' 48 AuthorsName = 'Chronosoft' 49 EmailContact = 'robie@centrum.cz' 50 AppName = 'Big Metro' 51 Description = 'Enjoyable real-time metro building game.' 52 ReleaseDate = 44160 53 RegistryKey = '\Software\Chronosoft\BigMetro' 54 RegistryRoot = rrKeyCurrentUser 55 License = 'CC0' 56 Left = 484 57 Top = 460 58 end 37 59 end -
trunk/Forms/UFormMain.pas
r51 r62 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus, 9 ExtCtrls, UEngine, LCLType, types ;9 ExtCtrls, UEngine, LCLType, types, UTranslator, UApplicationInfo, URegistry; 10 10 11 11 type … … 14 14 15 15 TFormMain = class(TForm) 16 ApplicationInfo1: TApplicationInfo; 16 17 PaintBox1: TPaintBox; 17 18 Timer1: TTimer; 19 Translator1: TTranslator; 18 20 procedure FormCreate(Sender: TObject); 19 21 procedure FormDestroy(Sender: TObject); … … 33 35 procedure PaintBox1Resize(Sender: TObject); 34 36 procedure Timer1Timer(Sender: TObject); 37 private 38 procedure LoadConfig; 39 procedure SaveConfig; 35 40 public 36 41 Engine: TEngine; … … 52 57 procedure TFormMain.FormCreate(Sender: TObject); 53 58 begin 59 LoadConfig; 54 60 Engine := TEngine.Create; 55 61 //PaintBox1.ControlStyle := [csOpaque]; 62 Randomize; 56 63 end; 57 64 … … 59 66 begin 60 67 Engine.Free; 68 SaveConfig; 61 69 end; 62 70 … … 76 84 Engine.Map.Size := Point(PaintBox1.Width, PaintBox1.Height); 77 85 Engine.View.DestRect := Rect(0, 0, PaintBox1.Width, PaintBox1.Height); 78 Engine. Reset;86 Engine.MainMenu; 79 87 end; 80 88 … … 132 140 end; 133 141 142 procedure TFormMain.LoadConfig; 143 var 144 LangCode: string; 145 begin 146 with TRegistryEx.Create do 147 try 148 CurrentContext := ApplicationInfo1.GetRegistryContext; 149 150 if ValueExists('LanguageCode') then begin 151 LangCode := ReadStringWithDefault('LanguageCode', ''); 152 Translator1.Language := Translator1.Languages.SearchByCode(LangCode); 153 end else Translator1.Language := Translator1.Languages.SearchByCode(''); 154 //ThemeManager1.Theme := ThemeManager1.Themes.FindByName(ReadStringWithDefault('Theme', 'System')); 155 finally 156 Free; 157 end; 158 end; 159 160 procedure TFormMain.SaveConfig; 161 begin 162 with TRegistryEx.Create do 163 try 164 CurrentContext := ApplicationInfo1.GetRegistryContext; 165 166 if Assigned(Translator1.Language) and (Translator1.Language.Code <> '') then 167 WriteString('LanguageCode', Translator1.Language.Code) 168 else DeleteValue('LanguageCode'); 169 //WriteString('Theme', ThemeManager1.Theme.Name); 170 finally 171 Free; 172 end; 173 end; 174 175 134 176 end. 135 177 -
trunk/Languages
-
Property svn:ignore
set to
*.mo
-
Property svn:ignore
set to
-
trunk/Languages/BigMetro.cs.po
r61 r62 13 13 14 14 #: tformmain.caption 15 msgctxt "tformmain.caption" 15 16 msgid "Big Metro" 16 17 msgstr "Big Metro" … … 39 40 msgid "Zero zoom not allowed" 40 41 msgstr "Nulové přiblížení není povoleno" 42 43 #: umenu.sback 44 msgid "Back" 45 msgstr "Zpět" 46 47 #: umenu.sbigmetro 48 msgctxt "umenu.sbigmetro" 49 msgid "Big Metro" 50 msgstr "Big Metro" 51 52 #: umenu.sczech 53 msgid "Czech" 54 msgstr "Čeština" 55 56 #: umenu.sdarkmode 57 msgid "Dark mode" 58 msgstr "Temný režim" 59 60 #: umenu.senglish 61 msgid "English" 62 msgstr "Angličtina" 63 64 #: umenu.sexit 65 msgctxt "umenu.sexit" 66 msgid "Exit" 67 msgstr "Odejít" 68 69 #: umenu.slanguage 70 #, fuzzy 71 #| msgid "Jazyk" 72 msgid "Language" 73 msgstr "Jazyk" 74 75 #: umenu.soptions 76 msgctxt "umenu.soptions" 77 msgid "Options" 78 msgstr "Volby" 79 80 #: umenu.splay 81 msgctxt "umenu.splay" 82 msgid "Play" 83 msgstr "Hrát" 84 -
trunk/Languages/BigMetro.po
r61 r62 3 3 4 4 #: tformmain.caption 5 msgctxt "tformmain.caption" 5 6 msgid "Big Metro" 6 7 msgstr "" … … 30 31 msgstr "" 31 32 33 #: umenu.sback 34 msgid "Back" 35 msgstr "" 36 37 #: umenu.sbigmetro 38 msgctxt "umenu.sbigmetro" 39 msgid "Big Metro" 40 msgstr "" 41 42 #: umenu.sczech 43 msgid "Czech" 44 msgstr "" 45 46 #: umenu.sdarkmode 47 msgid "Dark mode" 48 msgstr "" 49 50 #: umenu.senglish 51 msgid "English" 52 msgstr "" 53 54 #: umenu.sexit 55 msgctxt "umenu.sexit" 56 msgid "Exit" 57 msgstr "" 58 59 #: umenu.slanguage 60 msgid "Language" 61 msgstr "" 62 63 #: umenu.soptions 64 msgctxt "umenu.soptions" 65 msgid "Options" 66 msgstr "" 67 68 #: umenu.splay 69 msgctxt "umenu.splay" 70 msgid "Play" 71 msgstr "" 72 -
trunk/Packages/Common/UMetaCanvas.pas
r60 r62 6 6 7 7 uses 8 Classes, SysUtils, Graphics, Contnrs, Types ;8 Classes, SysUtils, Graphics, Contnrs, Types, fgl; 9 9 10 10 type … … 17 17 procedure Zoom(Factor: Double); virtual; 18 18 procedure Move(Delta: TPoint); virtual; 19 end; 20 21 TCanvasObjects = class(TFPGObjectList<TCanvasObject>) 19 22 end; 20 23 … … 133 136 procedure DoLineTo(X, Y: Integer); override; 134 137 public 135 Objects: T ObjectList;138 Objects: TCanvasObjects; 136 139 procedure FillRect(const ARect: TRect); overload; override; 137 140 procedure FillRect(X1,Y1,X2,Y2: Integer); overload; … … 154 157 end; 155 158 159 156 160 implementation 157 161 … … 198 202 Pen.Free; 199 203 Brush.Free; 200 inherited Destroy;204 inherited; 201 205 end; 202 206 … … 228 232 destructor TCanvasStretchDraw.Destroy; 229 233 begin 230 inherited Destroy;234 inherited; 231 235 end; 232 236 … … 264 268 Pen.Free; 265 269 Brush.Free; 266 inherited Destroy;270 inherited; 267 271 end; 268 272 … … 304 308 Brush.Free; 305 309 Pen.Free; 306 inherited Destroy;310 inherited; 307 311 end; 308 312 … … 336 340 begin 337 341 Pen.Free; 338 inherited Destroy;342 inherited; 339 343 end; 340 344 … … 375 379 Pen.Free; 376 380 Brush.Free; 377 inherited Destroy;381 inherited; 378 382 end; 379 383 … … 408 412 Brush.Free; 409 413 Font.Free; 410 inherited Destroy;414 inherited; 411 415 end; 412 416 … … 633 637 begin 634 638 for I := 0 to Objects.Count - 1 do 635 TCanvasObject(Objects[I]).Paint(Canvas);639 Objects[I].Paint(Canvas); 636 640 end; 637 641 … … 641 645 begin 642 646 for I := 0 to Objects.Count - 1 do 643 TCanvasObject(Objects[I]).Zoom(Factor);647 Objects[I].Zoom(Factor); 644 648 end; 645 649 … … 649 653 begin 650 654 for I := 0 to Objects.Count - 1 do 651 TCanvasObject(Objects[I]).Move(Delta);655 Objects[I].Move(Delta); 652 656 end; 653 657 … … 656 660 inherited; 657 661 FPenPos := Point(0, 0); 658 Objects := T ObjectList.Create;662 Objects := TCanvasObjects.Create; 659 663 end; 660 664 … … 662 666 begin 663 667 Objects.Free; 664 inherited Destroy;668 inherited; 665 669 end; 666 670 -
trunk/UEngine.pas
r61 r62 7 7 uses 8 8 Classes, SysUtils, Graphics, Controls, ExtCtrls, Math, DateUtils, 9 UMetaCanvas, fgl ;9 UMetaCanvas, fgl, UMenu; 10 10 11 11 type … … 259 259 end; 260 260 261 TGameState = (gsNotStarted, gsRunning, gsPaused, gsGameOver );261 TGameState = (gsNotStarted, gsRunning, gsPaused, gsGameOver, gsMenu); 262 262 263 263 { TEngine } … … 276 276 FLastTime: TDateTime; 277 277 MetaCanvas: TMetaCanvas; 278 Menu: TMenu; 279 MenuMain: TMenu; 280 MenuOptions: TMenu; 278 281 procedure ResizeView; 279 282 function GetExistStationShapes: TStationShapeSet; … … 292 295 function GetUnusedLine: TMetroLine; 293 296 procedure ShiftTrackPoints; 297 procedure MenuItemExit(Sender: TObject); 298 procedure MenuItemPlay(Sender: TObject); 299 procedure MenuItemOptions(Sender: TObject); 300 procedure MenuItemBack(Sender: TObject); 301 procedure DarkModeChanged(Sender: TObject); 302 procedure LanguageChanged(Sender: TObject); 303 procedure InitMenus; 294 304 public 295 305 Passengers: TMetroPassengers; … … 312 322 procedure MouseUp(Button: TMouseButton; Position: TPoint); 313 323 procedure MouseDown(Button: TMouseButton; Position: TPoint); 314 procedure Reset; 324 procedure MainMenu; 325 procedure NewGame; 315 326 procedure Redraw; 316 327 constructor Create; … … 345 356 EndStationLength = 50; 346 357 ShowDistances = False; 347 //TimePerSecond = (60 * OneMinute); 348 TimePerSecond = (60 * OneMinute); 358 TimePerSecond = 60 * OneMinute; 349 359 NewStationPeriod = 1; 350 360 NewShapePeriod = 10; … … 354 364 VisiblePassengersPerLine = 6; 355 365 366 356 367 implementation 357 368 358 369 uses 359 UGeometric ;370 UGeometric, UFormMain, ULanguages; 360 371 361 372 resourcestring … … 375 386 I := 0; 376 387 while (I < 0) and 377 ((Items[I].Points.First <> Point1) or (Items[I].Points.Last <> Point2))378 and((Items[I].Points.First <> Point2) or (Items[I].Points.Last <> Point1)) do388 ((Items[I].Points.First <> Point1) or (Items[I].Points.Last <> Point2)) and 389 ((Items[I].Points.First <> Point2) or (Items[I].Points.Last <> Point1)) do 379 390 Inc(I); 380 391 if I < 0 then Result := Items[I] … … 1536 1547 Station: TMapStation; 1537 1548 begin 1538 // Resetall distances1549 // NewGame all distances 1539 1550 for Station in Stations do 1540 1551 with Station do begin … … 1578 1589 end else begin 1579 1590 // If circular then trains might go in single direction so passengers 1580 // waiting for op osite directions are wrong1591 // waiting for opposite directions are wrong 1581 1592 DirectionUp := False; 1582 1593 DirectionDown := False; … … 1781 1792 MapStation: TMapStation; 1782 1793 begin 1783 // Resetall trackpoints position shift1794 // NewGame all trackpoints position shift 1784 1795 for MetroLine in Lines do 1785 1796 for TrackPoint in MetroLine.Track.Points do … … 1839 1850 end; 1840 1851 1852 procedure TEngine.MenuItemExit(Sender: TObject); 1853 begin 1854 FormMain.Close; 1855 end; 1856 1857 procedure TEngine.MenuItemPlay(Sender: TObject); 1858 begin 1859 NewGame; 1860 end; 1861 1862 procedure TEngine.MenuItemOptions(Sender: TObject); 1863 begin 1864 Menu := MenuOptions; 1865 Redraw; 1866 end; 1867 1868 procedure TEngine.MenuItemBack(Sender: TObject); 1869 begin 1870 if Assigned(Menu.Parent) then begin 1871 Menu := Menu.Parent; 1872 Redraw; 1873 end; 1874 end; 1875 1876 procedure TEngine.DarkModeChanged(Sender: TObject); 1877 begin 1878 1879 end; 1880 1881 procedure TEngine.LanguageChanged(Sender: TObject); 1882 var 1883 NewLanguage: TLanguage; 1884 begin 1885 NewLanguage := TLanguage(TMenuItemComboBox(MenuOptions.Items[0]).States.Objects[TMenuItemComboBox(MenuOptions.Items[0]).Index]); 1886 if FormMain.Translator1.Language <> NewLanguage then begin 1887 FormMain.Translator1.Language := NewLanguage; 1888 FormMain.Translator1.Translate; 1889 InitMenus; 1890 end; 1891 end; 1892 1893 procedure TEngine.InitMenus; 1894 begin 1895 with MenuMain.Items do begin 1896 Clear; 1897 AddButton(SPlay, MenuItemPlay); 1898 AddButton(SOptions, MenuItemOptions); 1899 AddButton(SExit, MenuItemExit); 1900 end; 1901 MenuOptions.Parent := MenuMain; 1902 with MenuOptions.Items do begin 1903 Clear; 1904 with AddComboBox(SLanguage, [], LanguageChanged) do begin 1905 FormMain.Translator1.LanguageListToStrings(States); 1906 Index := States.IndexOfObject(FormMain.Translator1.Language); 1907 if Index = -1 then Index := 0; 1908 end; 1909 AddCheckBox(SDarkMode, DarkModeChanged); 1910 AddButton(SBack, MenuItemBack); 1911 end; 1912 end; 1913 1841 1914 procedure TEngine.DrawClock(Canvas: TCanvas); 1842 1915 var … … 1878 1951 Passenger: TMetroPassenger; 1879 1952 begin 1880 // Draw trains1881 1953 for Train in Trains do 1882 1954 with Train do begin … … 1999 2071 LineStationUp: TLineStation; 2000 2072 CurrentTrackPoint: TTrackPoint; 2001 begin 2073 I: Integer; 2074 begin 2075 if State = gsMenu then begin 2076 Menu.MouseMove(Position); 2077 Redraw; 2078 end; 2079 2002 2080 LastMousePos := Position; 2003 2081 if MouseHold then begin … … 2052 2130 begin 2053 2131 if Button = mbLeft then begin 2054 // Place selected train if focused track 2055 if Assigned(SelectedTrain) then begin 2056 SelectedTrain.TargetStation := nil; 2057 SelectedTrain.BaseTrackPoint := nil; 2058 if Assigned(SelectedTrain.Line) then begin 2059 SelectedTrain.Line.Trains.Remove(SelectedTrain); 2060 SelectedTrain.Line := nil; 2061 end; 2062 FocusedTrack := GetTrackOnPos(View.PointDestToSrc(Position)); 2063 if Assigned(FocusedTrack.Points[0]) then begin 2064 SelectedTrain.Line := FocusedTrack.Points[0].Track.Line; 2065 SelectedTrain.Line.Trains.Add(SelectedTrain); 2066 SelectedTrain.BaseTrackPoint := FocusedTrack.Points[0]; 2067 end else 2068 if Assigned(FocusedTrack.Points[1]) then begin 2069 SelectedTrain.Line := FocusedTrack.Points[1].Track.Line; 2070 SelectedTrain.Line.Trains.Add(SelectedTrain); 2071 SelectedTrain.BaseTrackPoint := FocusedTrack.Points[1]; 2072 end; 2073 FocusedTrack.Free; 2074 end; 2075 2076 // Line color selection 2077 for I := 0 to Lines.Count - 1 do 2078 if Distance(Point(View.DestRect.Right div 2 - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist, 2079 View.DestRect.Bottom - LineColorsDist), Position) < 20 then begin 2080 SelectedLine := Lines[I]; 2081 Exit; 2132 if State = gsMenu then begin 2133 Menu.MouseUp(Button, Position); 2134 Redraw; 2135 end else begin 2136 // Place selected train if focused track 2137 if Assigned(SelectedTrain) then begin 2138 SelectedTrain.TargetStation := nil; 2139 SelectedTrain.BaseTrackPoint := nil; 2140 if Assigned(SelectedTrain.Line) then begin 2141 SelectedTrain.Line.Trains.Remove(SelectedTrain); 2142 SelectedTrain.Line := nil; 2082 2143 end; 2083 2084 // Remove single line station on line 2085 if Assigned(TrackStationDown) and (TrackStationDown.Track.Line.LineStations.Count = 1) then begin 2086 TrackStationDown.Track.Line.DisconnectStation(TrackStationDown.Track.Line.LineStations.First); 2087 end; 2088 if Assigned(TrackStationUp) and (TrackStationUp.Track.Line.LineStations.Count = 1) then begin 2089 TrackStationUp.Track.Line.DisconnectStation(TrackStationUp.Track.Line.LineStations.First); 2144 FocusedTrack := GetTrackOnPos(View.PointDestToSrc(Position)); 2145 if Assigned(FocusedTrack.Points[0]) then begin 2146 SelectedTrain.Line := FocusedTrack.Points[0].Track.Line; 2147 SelectedTrain.Line.Trains.Add(SelectedTrain); 2148 SelectedTrain.BaseTrackPoint := FocusedTrack.Points[0]; 2149 end else 2150 if Assigned(FocusedTrack.Points[1]) then begin 2151 SelectedTrain.Line := FocusedTrack.Points[1].Track.Line; 2152 SelectedTrain.Line.Trains.Add(SelectedTrain); 2153 SelectedTrain.BaseTrackPoint := FocusedTrack.Points[1]; 2154 end; 2155 FocusedTrack.Free; 2156 end; 2157 2158 // Line color selection 2159 for I := 0 to Lines.Count - 1 do 2160 if Distance(Point(View.DestRect.Right div 2 - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist, 2161 View.DestRect.Bottom - LineColorsDist), Position) < 20 then begin 2162 SelectedLine := Lines[I]; 2163 Exit; 2164 end; 2165 2166 // Remove single line station on line 2167 if Assigned(TrackStationDown) and (TrackStationDown.Track.Line.LineStations.Count = 1) then begin 2168 TrackStationDown.Track.Line.DisconnectStation(TrackStationDown.Track.Line.LineStations.First); 2169 end; 2170 if Assigned(TrackStationUp) and (TrackStationUp.Track.Line.LineStations.Count = 1) then begin 2171 TrackStationUp.Track.Line.DisconnectStation(TrackStationUp.Track.Line.LineStations.First); 2172 end; 2090 2173 end; 2091 2174 end else … … 2164 2247 end; 2165 2248 2166 procedure TEngine.Reset; 2249 procedure TEngine.MainMenu; 2250 begin 2251 State := gsMenu; 2252 Redraw; 2253 end; 2254 2255 procedure TEngine.NewGame; 2167 2256 var 2168 2257 NewTrain: TMetroTrain; … … 2214 2303 constructor TEngine.Create; 2215 2304 begin 2305 MenuMain := TMenu.Create; 2306 MenuOptions := TMenu.Create; 2307 Menu := MenuMain; 2308 InitMenus; 2216 2309 Stations := TMapStations.Create; 2217 2310 Stations.Engine := Self; … … 2243 2336 FreeAndNil(Stations); 2244 2337 FreeAndNil(Lines); 2338 FreeAndNil(MenuMain); 2339 FreeAndNil(MenuOptions); 2245 2340 inherited; 2246 2341 end; … … 2342 2437 *) 2343 2438 end; 2439 2344 2440 // Draw design time lines 2345 2441 if Assigned(TrackStationDown) and Assigned(TrackStationDown.LineStation) then begin … … 2405 2501 end; 2406 2502 2407 // Clearbackground2503 // MainMenu background 2408 2504 TargetCanvas.Brush.Color := $eff0e0; 2409 2505 TargetCanvas.Brush.Style := bsSolid; … … 2416 2512 MetaCanvas.DrawTo(TargetCanvas); 2417 2513 2418 // Line selection 2419 TargetCanvas.Pen.Width := 4; 2420 for I := 0 to High(LineColors) do begin 2421 if Assigned(Lines.SearchByColor(LineColors[I])) then begin 2422 TargetCanvas.Brush.Color := LineColors[I]; 2423 Size := 15; 2424 end else begin 2425 TargetCanvas.Brush.Color := clSilver; 2426 Size := 5; 2427 end; 2428 TargetCanvas.Pen.Color := clBlack; 2429 if Assigned(SelectedLine) and (SelectedLine.Color = LineColors[I]) then begin 2430 TargetCanvas.Pen.Style := psSolid; 2431 end else begin 2432 TargetCanvas.Pen.Style := psClear; 2433 end; 2434 2435 TargetCanvas.EllipseC(TargetCanvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist, 2436 TargetCanvas.Height - LineColorsDist, Size, Size); 2437 end; 2438 2439 // Draw unused trains 2440 Text := IntToStr(Trains.GetUnusedCount); 2441 TargetCanvas.Draw(Canvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist - 100, 2442 TargetCanvas.Height - LineColorsDist - ImageLocomotive.Picture.Bitmap.Height div 2, ImageLocomotive.Picture.Bitmap); 2443 TargetCanvas.Brush.Style := bsClear; 2444 TargetCanvas.Font.Size := 14; 2445 TargetCanvas.Font.Color := clBlack; 2446 TargetCanvas.TextOut(TargetCanvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist - 50 - TargetCanvas.TextWidth(Text), 2447 TargetCanvas.Height - LineColorsDist - TargetCanvas.TextHeight(Text) div 2, Text); 2448 2449 // Status interface 2450 Text := IntToStr(ServedPassengerCount); 2451 TargetCanvas.Draw(TargetCanvas.Width - 50, TargetCanvas.Height - 60, ImagePassenger.Picture.Bitmap); 2452 TargetCanvas.Brush.Style := bsClear; 2453 TargetCanvas.Font.Size := 14; 2454 TargetCanvas.Font.Color := clBlack; 2455 TargetCanvas.TextOut(TargetCanvas.Width - 70 - TargetCanvas.TextWidth(Text), TargetCanvas.Height - 55, Text); 2456 2457 DrawClock(TargetCanvas); 2458 2459 // Show grabbed train by mouse 2514 if State <> gsMenu then begin 2515 // Line selection 2516 TargetCanvas.Pen.Width := 4; 2517 for I := 0 to High(LineColors) do begin 2518 if Assigned(Lines.SearchByColor(LineColors[I])) then begin 2519 TargetCanvas.Brush.Color := LineColors[I]; 2520 Size := 15; 2521 end else begin 2522 TargetCanvas.Brush.Color := clSilver; 2523 Size := 5; 2524 end; 2525 TargetCanvas.Pen.Color := clBlack; 2526 if Assigned(SelectedLine) and (SelectedLine.Color = LineColors[I]) then begin 2527 TargetCanvas.Pen.Style := psSolid; 2528 end else begin 2529 TargetCanvas.Pen.Style := psClear; 2530 end; 2531 2532 TargetCanvas.EllipseC(TargetCanvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist, 2533 TargetCanvas.Height - LineColorsDist, Size, Size); 2534 end; 2535 2536 // Draw unused trains 2537 Text := IntToStr(Trains.GetUnusedCount); 2538 TargetCanvas.Draw(Canvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist - 100, 2539 TargetCanvas.Height - LineColorsDist - ImageLocomotive.Picture.Bitmap.Height div 2, ImageLocomotive.Picture.Bitmap); 2540 TargetCanvas.Brush.Style := bsClear; 2541 TargetCanvas.Font.Size := 14; 2542 TargetCanvas.Font.Color := clBlack; 2543 TargetCanvas.TextOut(TargetCanvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist - 50 - TargetCanvas.TextWidth(Text), 2544 TargetCanvas.Height - LineColorsDist - TargetCanvas.TextHeight(Text) div 2, Text); 2545 2546 // Status interface 2547 Text := IntToStr(ServedPassengerCount); 2548 TargetCanvas.Draw(TargetCanvas.Width - 50, TargetCanvas.Height - 60, ImagePassenger.Picture.Bitmap); 2549 TargetCanvas.Brush.Style := bsClear; 2550 TargetCanvas.Font.Size := 14; 2551 TargetCanvas.Font.Color := clBlack; 2552 TargetCanvas.TextOut(TargetCanvas.Width - 70 - TargetCanvas.TextWidth(Text), TargetCanvas.Height - 55, Text); 2553 2554 DrawClock(TargetCanvas); 2555 end; 2556 2557 // Show train grabbed by mouse 2460 2558 if Assigned(SelectedTrain) then begin 2461 2559 TargetCanvas.Brush.Color := clBlack; //SelectedTrain.Line.Color; … … 2483 2581 Text := Format(SGameOverStatistic, [ServedPassengerCount, Trunc(Time)]); 2484 2582 TargetCanvas.TextOut((TargetCanvas.Width - TargetCanvas.TextWidth(Text)) div 2, 180, Text); 2485 end; 2583 end else 2584 if State = gsMenu then begin 2585 Menu.Paint(TargetCanvas); 2586 end; 2587 2486 2588 RedrawPending := False; 2487 2589 end;
Note:
See TracChangeset
for help on using the changeset viewer.