Changeset 64 for trunk/UEngine.pas
- Timestamp:
- Nov 26, 2020, 4:58:02 PM (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/UEngine.pas
r63 r64 24 24 TTrackLink = class; 25 25 TTrackLinks = class; 26 27 TColors = record 28 Background: TColor; 29 Text: TColor; 30 MenuItemText: TColor; 31 MenuItemBackground: TColor; 32 MenuItemBackgroundSelected: TColor; 33 end; 26 34 27 35 { TMapStation } … … 265 273 TEngine = class 266 274 private 275 FDarkMode: Boolean; 267 276 LastMousePos: TPoint; 268 277 LastFocusedStation: TMapStation; … … 279 288 MenuMain: TMenu; 280 289 MenuOptions: TMenu; 290 MenuGame: TMenu; 291 ButtonBack: TMenuItemButton; 281 292 procedure ResizeView; 282 293 function GetExistStationShapes: TStationShapeSet; … … 292 303 procedure ComputeShapeDistanceStation(Station: TMapStation; 293 304 UpdatedShape: TStationShape; Distance: Integer); 305 procedure SetDarkMode(AValue: Boolean); 306 procedure InitColors; 294 307 procedure TrainMovement; 295 308 function GetUnusedLine: TMetroLine; … … 298 311 procedure MenuItemPlay(Sender: TObject); 299 312 procedure MenuItemOptions(Sender: TObject); 313 procedure MenuItemGameContinue(Sender: TObject); 314 procedure MenuItemGameExit(Sender: TObject); 315 procedure MenuItemGameRestart(Sender: TObject); 300 316 procedure MenuItemBack(Sender: TObject); 317 procedure ButtonBackClick(Sender: TObject); 301 318 procedure DarkModeChanged(Sender: TObject); 302 319 procedure LanguageChanged(Sender: TObject); 303 320 procedure FullScreenChanged(Sender: TObject); 304 procedure InitMenus;305 321 public 322 Colors: TColors; 306 323 Passengers: TMetroPassengers; 307 324 Stations: TMapStations; … … 320 337 ImagePassenger: TImage; 321 338 ImageLocomotive: TImage; 339 procedure InitMenus; 322 340 procedure MouseMove(Position: TPoint); 323 341 procedure MouseUp(Button: TMouseButton; Position: TPoint); 324 342 procedure MouseDown(Button: TMouseButton; Position: TPoint); 343 procedure KeyUp(Key: Word); 325 344 procedure MainMenu; 345 procedure Clear; 326 346 procedure NewGame; 327 347 procedure Redraw; … … 331 351 procedure Paint(TargetCanvas: TCanvas); 332 352 property Time: TDateTime read FTime; 353 property DarkMode: Boolean read FDarkMode write SetDarkMode; 333 354 end; 334 355 … … 1617 1638 end; 1618 1639 end; 1640 end; 1641 end; 1642 1643 procedure TEngine.SetDarkMode(AValue: Boolean); 1644 begin 1645 if FDarkMode = AValue then Exit; 1646 FDarkMode := AValue; 1647 InitColors; 1648 end; 1649 1650 procedure TEngine.InitColors; 1651 begin 1652 with Colors do 1653 if FDarkMode then begin 1654 Background := $2f3020; 1655 Text := clWhite; 1656 MenuItemText := $cccccc; 1657 MenuItemBackground := $b75C01; 1658 MenuItemBackgroundSelected := $070C81; 1659 end else begin 1660 Background := $eff0e0; 1661 Text := clBlack; 1662 MenuItemText := clWhite; 1663 MenuItemBackground := $e78C31; 1664 MenuItemBackgroundSelected := $f7bC61; 1619 1665 end; 1620 1666 end; … … 1872 1918 Menu := Menu.Parent; 1873 1919 Redraw; 1874 end; 1920 end else MenuItemExit(nil); 1921 end; 1922 1923 procedure TEngine.MenuItemGameContinue(Sender: TObject); 1924 begin 1925 State := gsRunning; 1926 end; 1927 1928 procedure TEngine.MenuItemGameExit(Sender: TObject); 1929 begin 1930 State := gsMenu; 1931 Clear; 1932 Menu := MenuMain; 1933 Redraw; 1934 end; 1935 1936 procedure TEngine.MenuItemGameRestart(Sender: TObject); 1937 begin 1938 NewGame; 1875 1939 end; 1876 1940 1877 1941 procedure TEngine.DarkModeChanged(Sender: TObject); 1878 1942 begin 1879 1943 DarkMode := TMenuItemCheckBox(Sender).Checked; 1944 InitMenus; 1880 1945 end; 1881 1946 … … 1900 1965 procedure TEngine.InitMenus; 1901 1966 begin 1902 with MenuMain .Items do begin1967 with MenuMain, Items do begin 1903 1968 Clear; 1904 AddButton(SPlay, MenuItemPlay); 1905 AddButton(SOptions, MenuItemOptions); 1906 AddButton(SExit, MenuItemExit); 1907 end; 1969 with AddButton(SBigMetro, nil) do begin 1970 Enabled := False; 1971 FontSize := 60; 1972 FontColor := Colors.Text; 1973 BackgroundColor := clNone; 1974 BackgroundSelectedColor := clNone; 1975 end; 1976 with AddButton(SPlay, MenuItemPlay) do begin 1977 FontSize := 40; 1978 FontColor := Colors.MenuItemText; 1979 BackgroundColor := Colors.MenuItemBackground; 1980 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 1981 end; 1982 with AddButton(SOptions, MenuItemOptions) do begin 1983 FontSize := 40; 1984 FontColor := Colors.MenuItemText; 1985 BackgroundColor := Colors.MenuItemBackground; 1986 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 1987 end; 1988 with AddButton(SExit, MenuItemExit) do begin 1989 FontSize := 40; 1990 FontColor := Colors.MenuItemText; 1991 BackgroundColor := Colors.MenuItemBackground; 1992 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 1993 end; 1994 OnExit := MenuItemExit; 1995 end; 1996 1908 1997 MenuOptions.Parent := MenuMain; 1909 with MenuOptions .Items do begin1998 with MenuOptions, Items do begin 1910 1999 Clear; 1911 2000 with AddComboBox(SLanguage, [], LanguageChanged) do begin 2001 FontSize := 40; 2002 FontColor := Colors.MenuItemText; 2003 BackgroundColor := Colors.MenuItemBackground; 2004 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 1912 2005 FormMain.Translator1.LanguageListToStrings(States); 1913 2006 Index := States.IndexOfObject(FormMain.Translator1.Language); 1914 2007 if Index = -1 then Index := 0; 1915 2008 end; 1916 AddCheckBox(SDarkMode, DarkModeChanged); 2009 with AddCheckBox(SDarkMode, DarkModeChanged) do begin 2010 FontSize := 40; 2011 FontColor := Colors.MenuItemText; 2012 BackgroundColor := Colors.MenuItemBackground; 2013 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 2014 Checked := DarkMode; 2015 end; 1917 2016 with AddCheckBox(SFullScreen, FullScreenChanged) do begin 2017 FontSize := 40; 2018 FontColor := Colors.MenuItemText; 2019 BackgroundColor := Colors.MenuItemBackground; 2020 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 1918 2021 Checked := FormMain.FullScreen; 1919 2022 end; 1920 AddButton(SBack, MenuItemBack); 1921 end; 2023 with AddButton(SBack, MenuItemBack) do begin 2024 FontSize := 40; 2025 FontColor := Colors.MenuItemText; 2026 BackgroundColor := Colors.MenuItemBackground; 2027 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 2028 end; 2029 OnExit := MenuItemBack; 2030 end; 2031 2032 with MenuGame, Items do begin 2033 Clear; 2034 with AddButton(SContinue, MenuItemGameContinue) do begin 2035 FontSize := 40; 2036 FontColor := Colors.MenuItemText; 2037 BackgroundColor := Colors.MenuItemBackground; 2038 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 2039 end; 2040 with AddButton(SRestart, MenuItemGameRestart) do begin 2041 FontSize := 40; 2042 FontColor := Colors.MenuItemText; 2043 BackgroundColor := Colors.MenuItemBackground; 2044 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 2045 end; 2046 with AddButton(SExit, MenuItemGameExit) do begin 2047 FontSize := 40; 2048 FontColor := Colors.MenuItemText; 2049 BackgroundColor := Colors.MenuItemBackground; 2050 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 2051 end; 2052 OnExit := MenuItemGameContinue; 2053 end; 2054 end; 2055 2056 procedure TEngine.ButtonBackClick(Sender: TObject); 2057 begin 2058 Menu := MenuGame; 2059 State := gsMenu; 2060 Redraw; 1922 2061 end; 1923 2062 … … 1932 2071 begin 1933 2072 Canvas.Pen.Style := psSolid; 1934 Canvas.Pen.Color := clBlack;2073 Canvas.Pen.Color := Colors.Text; 1935 2074 Canvas.Pen.Width := 2; 1936 2075 ClockCenter := Point(Canvas.Width - 30, 40); … … 2144 2283 Redraw; 2145 2284 end else begin 2146 // Place selected train if focused track 2285 // Back button 2286 if ButtonBack.Bounds.Contains(Position) then begin 2287 if Assigned(ButtonBack.OnClick) then 2288 ButtonBack.OnClick(ButtonBack); 2289 end; 2290 2291 // Place selected train if focused track 2147 2292 if Assigned(SelectedTrain) then begin 2148 2293 SelectedTrain.TargetStation := nil; … … 2200 2345 begin 2201 2346 if Button = mbLeft then begin 2347 if State <> gsMenu then begin 2202 2348 MouseHold := True; 2203 2349 LastFocusedStation := nil; … … 2254 2400 end; 2255 2401 end; 2402 end; 2403 end; 2404 end; 2405 2406 procedure TEngine.KeyUp(Key: Word); 2407 const 2408 KeyEsc = 27; 2409 begin 2410 if Key = KeyEsc then begin 2411 if State = gsMenu then begin 2412 if Assigned(Menu.OnExit) then 2413 Menu.OnExit(nil); 2414 end else begin 2415 ButtonBackClick(nil); 2416 end; 2256 2417 end; 2257 2418 end; … … 2263 2424 end; 2264 2425 2265 procedure TEngine.NewGame; 2266 var 2267 NewTrain: TMetroTrain; 2268 I: Integer; 2269 NewStation: TMapStation; 2270 InitialStationCount: Integer; 2271 begin 2426 procedure TEngine.Clear; 2427 begin 2428 Trains.Clear; 2272 2429 Passengers.Clear; 2273 2430 Lines.Clear; 2274 2431 Stations.Clear; 2275 2432 end; 2433 2434 procedure TEngine.NewGame; 2435 var 2436 NewTrain: TMetroTrain; 2437 I: Integer; 2438 NewStation: TMapStation; 2439 InitialStationCount: Integer; 2440 begin 2441 Clear; 2276 2442 ShapeCount := 3; 2277 2443 ServedPassengerCount := 0; … … 2313 2479 constructor TEngine.Create; 2314 2480 begin 2481 ButtonBack := TMenuItemButton.Create; 2482 ButtonBack.Text := '🡸'; 2483 ButtonBack.OnClick := ButtonBackClick; 2484 ButtonBack.BackgroundColor := clNone; 2315 2485 MenuMain := TMenu.Create; 2316 2486 MenuOptions := TMenu.Create; 2487 MenuGame := TMenu.Create; 2317 2488 Menu := MenuMain; 2318 2489 InitMenus; … … 2333 2504 // ImageLocomotive.Picture.LoadFromFile(ImageLocomotiveName); 2334 2505 MetaCanvas := TMetaCanvas.Create; 2506 InitColors; 2335 2507 end; 2336 2508 … … 2348 2520 FreeAndNil(MenuMain); 2349 2521 FreeAndNil(MenuOptions); 2522 FreeAndNil(MenuGame); 2523 FreeAndNil(ButtonBack); 2350 2524 inherited; 2351 2525 end; … … 2512 2686 2513 2687 // MainMenu background 2514 TargetCanvas.Brush.Color := $eff0e0;2688 TargetCanvas.Brush.Color := Colors.Background; 2515 2689 TargetCanvas.Brush.Style := bsSolid; 2516 2690 TargetCanvas.Clear; … … 2533 2707 Size := 5; 2534 2708 end; 2535 TargetCanvas.Pen.Color := clBlack;2709 TargetCanvas.Pen.Color := Colors.Text; 2536 2710 if Assigned(SelectedLine) and (SelectedLine.Color = LineColors[I]) then begin 2537 2711 TargetCanvas.Pen.Style := psSolid; … … 2550 2724 TargetCanvas.Brush.Style := bsClear; 2551 2725 TargetCanvas.Font.Size := 14; 2552 TargetCanvas.Font.Color := clBlack;2726 TargetCanvas.Font.Color := Colors.Text; 2553 2727 TargetCanvas.TextOut(TargetCanvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist - 50 - TargetCanvas.TextWidth(Text), 2554 2728 TargetCanvas.Height - LineColorsDist - TargetCanvas.TextHeight(Text) div 2, Text); … … 2559 2733 TargetCanvas.Brush.Style := bsClear; 2560 2734 TargetCanvas.Font.Size := 14; 2561 TargetCanvas.Font.Color := clBlack;2735 TargetCanvas.Font.Color := Colors.Text; 2562 2736 TargetCanvas.TextOut(TargetCanvas.Width - 70 - TargetCanvas.TextWidth(Text), TargetCanvas.Height - 55, Text); 2563 2737 2564 2738 DrawClock(TargetCanvas); 2739 2740 // Back button 2741 TargetCanvas.Font.Size := 40; 2742 TargetCanvas.Font.Color := Colors.Text; 2743 ButtonBack.Paint(TargetCanvas, Point(10, 10)); 2565 2744 end; 2566 2745 2567 2746 // Show train grabbed by mouse 2568 2747 if Assigned(SelectedTrain) then begin 2569 TargetCanvas.Brush.Color := clBlack; //SelectedTrain.Line.Color;2748 TargetCanvas.Brush.Color := Colors.Text; //SelectedTrain.Line.Color; 2570 2749 TargetCanvas.Brush.Style := bsSolid; 2571 2750 TargetCanvas.Pen.Style := psClear; … … 2585 2764 begin 2586 2765 TargetCanvas.Font.Size := 40; 2587 TargetCanvas.Font.Color := clBlack;2766 TargetCanvas.Font.Color := Colors.Text; 2588 2767 TargetCanvas.TextOut((TargetCanvas.Width - TargetCanvas.TextWidth(SGameOver)) div 2, 100, SGameOver); 2589 2768 TargetCanvas.Font.Size := 14;
Note:
See TracChangeset
for help on using the changeset viewer.