Changeset 93
- Timestamp:
- May 18, 2024, 11:17:25 PM (6 months ago)
- Location:
- trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Engine.pas
r92 r93 226 226 FShowMenuStats: Boolean; 227 227 FSelectedPlayer: TPlayer; 228 function Scale(Value: Integer): Integer; 228 229 procedure InitDigMasks; 229 230 procedure SetActive(const AValue: Boolean); … … 234 235 procedure ClearBackground; 235 236 procedure DrawMenu; 236 procedure DrawStatsPartial( PlayerIndex, YDiff: Integer);237 procedure DrawStatsPartial(var Y: Integer; PlayerIndex: Integer); 237 238 procedure DrawStats; 238 239 procedure DrawGamePrepare(Thread: TVirtualThread); … … 1318 1319 X: Integer; 1319 1320 Y: Integer; 1320 const 1321 LineHeight = 60; 1322 begin 1321 LineHeight: Integer; 1322 begin 1323 LineHeight := Scale(40); 1323 1324 with Bitmap.Canvas do begin 1324 1325 ClearBackground; … … 1331 1332 Pen.Color := clWhite; 1332 1333 Font.Color := clGreen; 1333 Font.Size := 30;1334 Font.Size := Scale(20); 1334 1335 Text := SInformation; 1335 1336 TextOut(X - TextWidth(Text) div 2, Y, Text); 1336 1337 Inc(Y, 2 * LineHeight); 1337 1338 1338 X := 30;1339 X := Scale(30); 1339 1340 1340 1341 Font.Color := clYellow; 1341 Font.Size := 20;1342 Font.Size := Scale(14); 1342 1343 Text := SInformationDetails; 1343 Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - 60));1344 Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - Scale(60))); 1344 1345 Inc(Y, LineHeight); 1345 1346 1346 1347 Text := Format(SInformationDetails2, [HomePage]); 1347 Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - 60));1348 Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - Scale(60))); 1348 1349 Inc(Y, LineHeight); 1349 1350 … … 1351 1352 1352 1353 Font.Color := clGreen; 1353 Font.Size := 30;1354 Font.Size := Scale(14); 1354 1355 Text := SPressEsc; 1355 1356 TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10 * 9, Text); … … 1362 1363 X: Integer; 1363 1364 Y: Integer; 1364 const 1365 LineHeight = 60; 1366 begin 1365 LineHeight: Integer; 1366 begin 1367 LineHeight := Scale(40); 1367 1368 with Bitmap.Canvas do begin 1368 1369 ClearBackground; … … 1375 1376 Pen.Color := clWhite; 1376 1377 Font.Color := clTuna; 1377 Font.Size := 30;1378 Font.Size := Scale(20); 1378 1379 Text := SInstructions; 1379 1380 TextOut(X - TextWidth(Text) div 2, Y, Text); 1380 1381 Inc(Y, 2 * LineHeight); 1381 1382 1382 X := 30;1383 X := Scale(30); 1383 1384 1384 1385 Font.Color := clTeal; 1385 Font.Size := 20;1386 Font.Size := Scale(14); 1386 1387 Text := SInstructionsDetails; 1387 Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - 60));1388 Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - Scale(60))); 1388 1389 Inc(Y, LineHeight); 1389 1390 1390 1391 Text := SInstructionsDetails2; 1391 Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - 60));1392 Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - Scale(60))); 1392 1393 Inc(Y, LineHeight); 1393 1394 1394 1395 Text := SInstructionsDetails3; 1395 Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - 60));1396 Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - Scale(60))); 1396 1397 Inc(Y, LineHeight); 1397 1398 1398 1399 Text := SInstructionsDetails4; 1399 Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - 60));1400 Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - Scale(60))); 1400 1401 Inc(Y, LineHeight); 1401 1402 1402 1403 X := Bitmap.Width div 2; 1403 1404 Font.Color := clGreen; 1404 Font.Size := 30;1405 Font.Size := Scale(14); 1405 1406 Text := SPressEsc; 1406 1407 TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10 * 9, Text); … … 1412 1413 Text: string; 1413 1414 MenuWidth: Integer; 1415 X: Integer; 1414 1416 begin 1415 1417 with Bitmap.Canvas do begin … … 1422 1424 Pen.Color := clWhite; 1423 1425 Font.Color := clTuna; 1424 Font.Size := 30;1426 Font.Size := Scale(20); 1425 1427 Text := SSettings; 1426 1428 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 20, Text); 1427 1429 1428 1430 Pen.Color := clPurple; 1429 Pen.Width := 6;1430 Frame((MenuWidth - 400) div 2, Bitmap.Height div 10 * 4 - 40,1431 (MenuWidth + 500) div 2, Bitmap.Height div 10 * 4 + 200);1431 Pen.Width := Scale(6); 1432 Frame((MenuWidth - Scale(400)) div 2, Bitmap.Height div 10 * 4 - Scale(40), 1433 (MenuWidth + Scale(400)) div 2, Bitmap.Height div 10 * 4 + Scale(200)); 1432 1434 1433 1435 Font.Color := clPurple; 1434 Font.Size := 20; 1435 1436 ShowMenuItem('F1', SMorePlayers, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4, Bitmap.Canvas); 1437 ShowMenuItem('F2', SLessPlayers, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 40, Bitmap.Canvas); 1438 ShowMenuItem('F3', SPlayersKeys, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 80, Bitmap.Canvas); 1439 ShowMenuItem('ESC', SBack, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 120, Bitmap.Canvas); 1436 Font.Size := Scale(14); 1437 1438 X := MenuWidth div 2 - Scale(180); 1439 ShowMenuItem('F1', SMorePlayers, X, Bitmap.Height div 10 * 4, Bitmap.Canvas); 1440 ShowMenuItem('F2', SLessPlayers, X, Bitmap.Height div 10 * 4 + Scale(40), Bitmap.Canvas); 1441 ShowMenuItem('F3', SPlayersKeys, X, Bitmap.Height div 10 * 4 + Scale(80), Bitmap.Canvas); 1442 ShowMenuItem('ESC', SBack, X, Bitmap.Height div 10 * 4 + Scale(120), Bitmap.Canvas); 1440 1443 1441 1444 Font.Color := clDarkGreen; 1442 Font.Size := 20;1445 Font.Size := Scale(14); 1443 1446 Text := SPlayersCount + ': ' + IntToStr(PlayerPool.GetEnabledCount); 1444 1447 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 8, Text); … … 1450 1453 Text: string; 1451 1454 MenuWidth: Integer; 1455 X: Integer; 1452 1456 Y: Integer; 1453 1457 I: Integer; … … 1462 1466 Pen.Color := clWhite; 1463 1467 Font.Color := clTuna; 1464 Font.Size := 30;1468 Font.Size := Scale(20); 1465 1469 Text := SPlayersKeys; 1466 1470 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 20, Text); 1467 1471 1468 1472 Pen.Color := clPurple; 1469 Pen.Width := 6;1470 Frame((MenuWidth - 400) div 2, Bitmap.Height div 10 * 4 - 40,1471 (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 440);1473 Pen.Width := Scale(6); 1474 Frame((MenuWidth - Scale(400)) div 2, Bitmap.Height div 10 * 4 - Scale(40), 1475 (MenuWidth + Scale(400)) div 2, Bitmap.Height div 10 * 4 + Scale(400)); 1472 1476 1473 1477 Font.Color := clPurple; 1474 Font.Size := 20; 1475 1478 Font.Size := Scale(14); 1479 1480 X := MenuWidth div 2 - Scale(180); 1476 1481 Y := Bitmap.Height div 10 * 4; 1477 1482 for I := 0 to PlayerPool.GetEnabledCount - 1 do begin 1478 1483 Font.Color := PlayerPool[I].Color1; 1479 ShowMenuItem('F' + IntToStr(I + 1), PlayerPool[I].Name, MenuWidth div 2 - 180, Y, Bitmap.Canvas);1480 Y := Y + 40;1484 ShowMenuItem('F' + IntToStr(I + 1), PlayerPool[I].Name, X, Y, Bitmap.Canvas); 1485 Y := Y + Scale(40); 1481 1486 end; 1482 1487 Font.Color := clPurple; 1483 ShowMenuItem('ESC', SBack, MenuWidth div 2 - 180, Y, Bitmap.Canvas);1488 ShowMenuItem('ESC', SBack, X, Y, Bitmap.Canvas); 1484 1489 end; 1485 1490 end; … … 1489 1494 Text: string; 1490 1495 MenuWidth: Integer; 1496 X: Integer; 1491 1497 Y: Integer; 1492 1498 I: Integer; … … 1508 1514 Pen.Color := clWhite; 1509 1515 Font.Color := clTuna; 1510 Font.Size := 30;1516 Font.Size := Scale(20); 1511 1517 Text := SDefinePlayerKeys; 1512 1518 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 20, Text); 1513 1519 1514 1520 Pen.Color := clPurple; 1515 Pen.Width := 6;1516 Frame((MenuWidth - 400) div 2, Bitmap.Height div 10 * 4 - 40,1517 (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 280);1521 Pen.Width := Scale(6); 1522 Frame((MenuWidth - Scale(400)) div 2, Bitmap.Height div 10 * 4 - Scale(40), 1523 (MenuWidth + Scale(400)) div 2, Bitmap.Height div 10 * 4 + Scale(280)); 1518 1524 1519 1525 Font.Color := clPurple; 1520 Font.Size := 20; 1521 1522 ShowMenuItem(IsKeySet(FSelectedPlayer.Keys.Left), SLeft, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4, Bitmap.Canvas); 1523 ShowMenuItem(IsKeySet(FSelectedPlayer.Keys.Up), SUp, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 40, Bitmap.Canvas); 1524 ShowMenuItem(IsKeySet(FSelectedPlayer.Keys.Right), SRight, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 80, Bitmap.Canvas); 1525 ShowMenuItem(IsKeySet(FSelectedPlayer.Keys.Down), SDown, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 120, Bitmap.Canvas); 1526 ShowMenuItem(IsKeySet(FSelectedPlayer.Keys.Shoot), SShoot, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 160, Bitmap.Canvas); 1527 ShowMenuItem('ESC', SBack, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 200, Bitmap.Canvas); 1526 Font.Size := Scale(14); 1527 1528 X := MenuWidth div 2 - Scale(180); 1529 ShowMenuItem(IsKeySet(FSelectedPlayer.Keys.Left), SLeft, X, Bitmap.Height div 10 * 4, Bitmap.Canvas); 1530 ShowMenuItem(IsKeySet(FSelectedPlayer.Keys.Up), SUp, X, Bitmap.Height div 10 * 4 + Scale(40), Bitmap.Canvas); 1531 ShowMenuItem(IsKeySet(FSelectedPlayer.Keys.Right), SRight, X, Bitmap.Height div 10 * 4 + Scale(80), Bitmap.Canvas); 1532 ShowMenuItem(IsKeySet(FSelectedPlayer.Keys.Down), SDown, X, Bitmap.Height div 10 * 4 + Scale(120), Bitmap.Canvas); 1533 ShowMenuItem(IsKeySet(FSelectedPlayer.Keys.Shoot), SShoot, X, Bitmap.Height div 10 * 4 + Scale(160), Bitmap.Canvas); 1534 ShowMenuItem('ESC', SBack, X, Bitmap.Height div 10 * 4 + Scale(200), Bitmap.Canvas); 1528 1535 1529 1536 if (FSelectedPlayer.Keys.Left <> 0) and … … 1533 1540 (FSelectedPlayer.Keys.Shoot <> 0) then begin 1534 1541 Font.Color := clDarkGreen; 1535 Font.Size := 20;1542 Font.Size := Scale(14); 1536 1543 Text := SDone; 1537 1544 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text); … … 1553 1560 Pen.Color := clWhite; 1554 1561 Font.Color := clTuna; 1555 Font.Size := 30;1562 Font.Size := Scale(20); 1556 1563 Text := SRound + ' ' + IntToStr(CurrentRound); 1557 1564 TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 5, Text); 1558 1565 1559 1560 1566 Pen.Color := clPurple; 1561 Pen.Width := 6;1562 Frame((Bitmap.Width - 400) div 2, Bitmap.Height div 5 - 10,1563 (Bitmap.Width + 400) div 2, Bitmap.Height div 5 + 100);1567 Pen.Width := Scale(6); 1568 Frame((Bitmap.Width - Scale(400)) div 2, Bitmap.Height div 5 - Scale(10), 1569 (Bitmap.Width + Scale(400)) div 2, Bitmap.Height div 5 + Scale(70)); 1564 1570 1565 1571 Y := 0; … … 1568 1574 if Enabled then begin 1569 1575 Font.Color := Color1; 1576 Font.Size := Scale(14); 1570 1577 Text := Name + ': ' + IntToStr(Score); 1571 1578 TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 5 * 2 + Y, Text); 1572 Inc(Y, 60);1579 Inc(Y, Scale(40)); 1573 1580 end; 1574 1581 end; … … 1591 1598 Pen.Style := psSolid; 1592 1599 Font.Color := clGreen; 1593 Font.Size := 30;1600 Font.Size := Scale(20); 1594 1601 Text := SPressEsc; 1595 1602 TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text); … … 1632 1639 DrawStats; 1633 1640 end else Result := Bitmap.Width; 1641 end; 1642 1643 function TEngine.Scale(Value: Integer): Integer; 1644 begin 1645 Result := ScaleX(Value, 96); 1634 1646 end; 1635 1647 … … 1882 1894 begin 1883 1895 Canvas.TextOut(X, Y, '<' + Key + '>'); 1884 Canvas.TextOut(X + 140, Y, Text);1896 Canvas.TextOut(X + Scale(140), Y, Text); 1885 1897 end; 1886 1898 … … 1889 1901 Text: string; 1890 1902 MenuWidth: Integer; 1903 X: Integer; 1891 1904 begin 1892 1905 with Bitmap.Canvas do begin … … 1899 1912 Pen.Color := clWhite; 1900 1913 Font.Color := clTuna; 1901 Font.Size := 30;1914 Font.Size := Scale(20); 1902 1915 Text := 'TUNNELER'; 1903 1916 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10, Text); 1904 1917 1905 1918 Font.Color := clDarkOrange; 1906 Font.Size := 20;1919 Font.Size := Scale(14); 1907 1920 Text := 'by Chronos'; 1908 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 + 70, Text);1921 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 + Scale(60), Text); 1909 1922 1910 1923 Pen.Color := clPurple; 1911 1924 Pen.Width := 6; 1912 Frame((MenuWidth - 400) div 2, Bitmap.Height div 10 * 4 - 40,1913 (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 240);1925 Frame((MenuWidth - Scale(400)) div 2, Bitmap.Height div 10 * 4 - Scale(40), 1926 (MenuWidth + Scale(400)) div 2, Bitmap.Height div 10 * 4 + Scale(240)); 1914 1927 1915 1928 Font.Color := clPurple; 1916 Font.Size := 20; 1917 1918 ShowMenuItem('F1', SStartGame, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4, Bitmap.Canvas); 1919 ShowMenuItem('F2', SInstructions, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 40, Bitmap.Canvas); 1920 ShowMenuItem('F3', SInformation, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 80, Bitmap.Canvas); 1921 ShowMenuItem('F4', SSettings, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 120, Bitmap.Canvas); 1922 ShowMenuItem('F10', SExit, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 160, Bitmap.Canvas); 1929 Font.Size := Scale(14); 1930 1931 X := MenuWidth div 2 - Scale(180); 1932 ShowMenuItem('F1', SStartGame, X, Bitmap.Height div 10 * 4, Bitmap.Canvas); 1933 ShowMenuItem('F2', SInstructions, X, Bitmap.Height div 10 * 4 + Scale(40), Bitmap.Canvas); 1934 ShowMenuItem('F3', SInformation, X, Bitmap.Height div 10 * 4 + Scale(80), Bitmap.Canvas); 1935 ShowMenuItem('F4', SSettings, X, Bitmap.Height div 10 * 4 + Scale(120), Bitmap.Canvas); 1936 ShowMenuItem('F10', SExit, X, Bitmap.Height div 10 * 4 + Scale(160), Bitmap.Canvas); 1923 1937 1924 1938 Font.Color := clDarkGreen; 1925 Font.Size := 20;1939 Font.Size := Scale(14); 1926 1940 Text := '(' + SWorldReady + ')'; 1927 1941 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text); … … 1929 1943 end; 1930 1944 1931 procedure TEngine.DrawStatsPartial( PlayerIndex, YDiff: Integer);1945 procedure TEngine.DrawStatsPartial(var Y: Integer; PlayerIndex: Integer); 1932 1946 var 1933 1947 X: Integer; 1934 Y: Integer;1935 1948 I: Integer; 1936 1949 Text: string; 1937 1950 ShotsPercent: Integer; 1938 const 1939 LineHeight = 40; 1940 begin 1951 LineHeight: Integer; 1952 TempY: Integer; 1953 begin 1954 TempY := Y; 1955 1956 LineHeight := Scale(40); 1941 1957 with Bitmap.Canvas do begin 1942 1958 Font.Color := clOrange; 1943 Font.Size := 20; 1944 1945 Y := Bitmap.Height div 10 + 3 * LineHeight + YDiff; 1946 X := Bitmap.Width div 2 + 50; 1959 Font.Size := Scale(14); 1960 1961 X := Bitmap.Width div 2 + Scale(50); 1947 1962 Inc(Y, LineHeight); 1948 1963 Text := SShotsFired; … … 1966 1981 if I < Players.Count then 1967 1982 with Players[I] do begin 1968 Y := Bitmap.Height div 10 + 3 * LineHeight + YDiff;1969 X := Bitmap.Width div 2 + 50 + 500 + 200 * (I - PlayerIndex);1983 Y := TempY; 1984 X := Bitmap.Width div 2 + Scale(50 + 300 + 150 * (I - PlayerIndex)); 1970 1985 Font.Color := Color1; 1971 1986 Text := Name; 1972 TextOut(X - TextWidth(Text) 1987 TextOut(X - TextWidth(Text), Y, Text); 1973 1988 Inc(Y, LineHeight); 1974 1989 Text := IntToStr(ShotsCount); … … 1993 2008 end; 1994 2009 1995 Inc(Y, 3* LineHeight);2010 Inc(Y, 2 * LineHeight); 1996 2011 end; 1997 2012 end; … … 2003 2018 Text: string; 2004 2019 Winner: TPlayer; 2005 begin 2020 LineHeight: Integer; 2021 begin 2022 LineHeight := Scale(40); 2006 2023 with Bitmap.Canvas do begin 2007 2024 X := Bitmap.Width div 4 * 3; … … 2015 2032 2016 2033 Font.Color := clCyan; 2017 Font.Size := 20;2034 Font.Size := Scale(14); 2018 2035 Text := SStatistics; 2019 2036 TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10, Text); 2020 2037 2021 DrawStatsPartial(0, 0); 2022 if Players.Count > 4 then 2023 DrawStatsPartial(4, 400); 2024 2025 X := Bitmap.Width div 2 + 50; 2038 Y := Bitmap.Height div 10 + 3 * LineHeight; 2039 2040 DrawStatsPartial(Y, 0); 2041 if Players.Count > 4 then DrawStatsPartial(Y, 4); 2042 2043 X := Bitmap.Width div 2 + Scale(50); 2026 2044 Font.Color := clOrange; 2027 2045 Winner := Players.GetWinner; … … 2029 2047 Text := SWinnerIs; 2030 2048 TextOut(X, Y, Text); 2031 X := X + TextWidth(Text) + 20;2049 X := X + TextWidth(Text) + Scale(20); 2032 2050 Font.Color := Winner.Color1; 2033 2051 Text := Winner.Name; -
trunk/tunneler.lpr
r85 r93 32 32 Application.CreateForm(TCore, Core.Core); 33 33 Application.CreateForm(TFormMain, FormMain.FormMain); 34 {$IFDEF DEBUG}35 {$ENDIF}36 34 Application.Run; 37 35 end.
Note:
See TracChangeset
for help on using the changeset viewer.