Changeset 93


Ignore:
Timestamp:
May 18, 2024, 11:17:25 PM (7 weeks ago)
Author:
chronos
Message:
  • Modified: Better menu High DPI scaling.
Location:
trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/Engine.pas

    r92 r93  
    226226    FShowMenuStats: Boolean;
    227227    FSelectedPlayer: TPlayer;
     228    function Scale(Value: Integer): Integer;
    228229    procedure InitDigMasks;
    229230    procedure SetActive(const AValue: Boolean);
    … …  
    234235    procedure ClearBackground;
    235236    procedure DrawMenu;
    236     procedure DrawStatsPartial(PlayerIndex, YDiff: Integer);
     237    procedure DrawStatsPartial(var Y: Integer; PlayerIndex: Integer);
    237238    procedure DrawStats;
    238239    procedure DrawGamePrepare(Thread: TVirtualThread);
    … …  
    13181319  X: Integer;
    13191320  Y: Integer;
    1320 const
    1321   LineHeight = 60;
    1322 begin
     1321  LineHeight: Integer;
     1322begin
     1323  LineHeight := Scale(40);
    13231324  with Bitmap.Canvas do begin
    13241325    ClearBackground;
    … …  
    13311332    Pen.Color := clWhite;
    13321333    Font.Color := clGreen;
    1333     Font.Size := 30;
     1334    Font.Size := Scale(20);
    13341335    Text := SInformation;
    13351336    TextOut(X - TextWidth(Text) div 2, Y, Text);
    13361337    Inc(Y, 2 * LineHeight);
    13371338
    1338     X := 30;
     1339    X := Scale(30);
    13391340
    13401341    Font.Color := clYellow;
    1341     Font.Size := 20;
     1342    Font.Size := Scale(14);
    13421343    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)));
    13441345    Inc(Y, LineHeight);
    13451346
    13461347    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)));
    13481349    Inc(Y, LineHeight);
    13491350
    … …  
    13511352
    13521353    Font.Color := clGreen;
    1353     Font.Size := 30;
     1354    Font.Size := Scale(14);
    13541355    Text := SPressEsc;
    13551356    TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10 * 9, Text);
    … …  
    13621363  X: Integer;
    13631364  Y: Integer;
    1364 const
    1365   LineHeight = 60;
    1366 begin
     1365  LineHeight: Integer;
     1366begin
     1367  LineHeight := Scale(40);
    13671368  with Bitmap.Canvas do begin
    13681369    ClearBackground;
    … …  
    13751376    Pen.Color := clWhite;
    13761377    Font.Color := clTuna;
    1377     Font.Size := 30;
     1378    Font.Size := Scale(20);
    13781379    Text := SInstructions;
    13791380    TextOut(X - TextWidth(Text) div 2, Y, Text);
    13801381    Inc(Y, 2 * LineHeight);
    13811382
    1382     X := 30;
     1383    X := Scale(30);
    13831384
    13841385    Font.Color := clTeal;
    1385     Font.Size := 20;
     1386    Font.Size := Scale(14);
    13861387    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)));
    13881389    Inc(Y, LineHeight);
    13891390
    13901391    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)));
    13921393    Inc(Y, LineHeight);
    13931394
    13941395    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)));
    13961397    Inc(Y, LineHeight);
    13971398
    13981399    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)));
    14001401    Inc(Y, LineHeight);
    14011402
    14021403    X := Bitmap.Width div 2;
    14031404    Font.Color := clGreen;
    1404     Font.Size := 30;
     1405    Font.Size := Scale(14);
    14051406    Text := SPressEsc;
    14061407    TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10 * 9, Text);
    … …  
    14121413  Text: string;
    14131414  MenuWidth: Integer;
     1415  X: Integer;
    14141416begin
    14151417  with Bitmap.Canvas do begin
    … …  
    14221424    Pen.Color := clWhite;
    14231425    Font.Color := clTuna;
    1424     Font.Size := 30;
     1426    Font.Size := Scale(20);
    14251427    Text := SSettings;
    14261428    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 20, Text);
    14271429
    14281430    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));
    14321434
    14331435    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);
    14401443
    14411444    Font.Color := clDarkGreen;
    1442     Font.Size := 20;
     1445    Font.Size := Scale(14);
    14431446    Text := SPlayersCount + ': ' + IntToStr(PlayerPool.GetEnabledCount);
    14441447    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 8, Text);
    … …  
    14501453  Text: string;
    14511454  MenuWidth: Integer;
     1455  X: Integer;
    14521456  Y: Integer;
    14531457  I: Integer;
    … …  
    14621466    Pen.Color := clWhite;
    14631467    Font.Color := clTuna;
    1464     Font.Size := 30;
     1468    Font.Size := Scale(20);
    14651469    Text := SPlayersKeys;
    14661470    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 20, Text);
    14671471
    14681472    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));
    14721476
    14731477    Font.Color := clPurple;
    1474     Font.Size := 20;
    1475 
     1478    Font.Size := Scale(14);
     1479
     1480    X := MenuWidth div 2 - Scale(180);
    14761481    Y := Bitmap.Height div 10 * 4;
    14771482    for I := 0 to PlayerPool.GetEnabledCount - 1 do begin
    14781483      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);
    14811486    end;
    14821487    Font.Color := clPurple;
    1483     ShowMenuItem('ESC', SBack, MenuWidth div 2 - 180, Y, Bitmap.Canvas);
     1488    ShowMenuItem('ESC', SBack, X, Y, Bitmap.Canvas);
    14841489  end;
    14851490end;
    … …  
    14891494  Text: string;
    14901495  MenuWidth: Integer;
     1496  X: Integer;
    14911497  Y: Integer;
    14921498  I: Integer;
    … …  
    15081514    Pen.Color := clWhite;
    15091515    Font.Color := clTuna;
    1510     Font.Size := 30;
     1516    Font.Size := Scale(20);
    15111517    Text := SDefinePlayerKeys;
    15121518    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 20, Text);
    15131519
    15141520    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));
    15181524
    15191525    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);
    15281535
    15291536    if (FSelectedPlayer.Keys.Left <> 0) and
    … …  
    15331540      (FSelectedPlayer.Keys.Shoot <> 0) then begin
    15341541        Font.Color := clDarkGreen;
    1535         Font.Size := 20;
     1542        Font.Size := Scale(14);
    15361543        Text := SDone;
    15371544        TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text);
    … …  
    15531560    Pen.Color := clWhite;
    15541561    Font.Color := clTuna;
    1555     Font.Size := 30;
     1562    Font.Size := Scale(20);
    15561563    Text := SRound + ' ' + IntToStr(CurrentRound);
    15571564    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 5, Text);
    15581565
    1559 
    15601566    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));
    15641570
    15651571    Y := 0;
    … …  
    15681574      if Enabled then begin
    15691575        Font.Color := Color1;
     1576        Font.Size := Scale(14);
    15701577        Text := Name + ': ' + IntToStr(Score);
    15711578        TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 5 * 2 + Y, Text);
    1572         Inc(Y, 60);
     1579        Inc(Y, Scale(40));
    15731580      end;
    15741581    end;
    … …  
    15911598    Pen.Style := psSolid;
    15921599    Font.Color := clGreen;
    1593     Font.Size := 30;
     1600    Font.Size := Scale(20);
    15941601    Text := SPressEsc;
    15951602    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text);
    … …  
    16321639    DrawStats;
    16331640  end else Result := Bitmap.Width;
     1641end;
     1642
     1643function TEngine.Scale(Value: Integer): Integer;
     1644begin
     1645  Result := ScaleX(Value, 96);
    16341646end;
    16351647
    … …  
    18821894begin
    18831895  Canvas.TextOut(X, Y, '<' + Key + '>');
    1884   Canvas.TextOut(X + 140, Y, Text);
     1896  Canvas.TextOut(X + Scale(140), Y, Text);
    18851897end;
    18861898
    … …  
    18891901  Text: string;
    18901902  MenuWidth: Integer;
     1903  X: Integer;
    18911904begin
    18921905  with Bitmap.Canvas do begin
    … …  
    18991912    Pen.Color := clWhite;
    19001913    Font.Color := clTuna;
    1901     Font.Size := 30;
     1914    Font.Size := Scale(20);
    19021915    Text := 'TUNNELER';
    19031916    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10, Text);
    19041917
    19051918    Font.Color := clDarkOrange;
    1906     Font.Size := 20;
     1919    Font.Size := Scale(14);
    19071920    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);
    19091922
    19101923    Pen.Color := clPurple;
    19111924    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));
    19141927
    19151928    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);
    19231937
    19241938    Font.Color := clDarkGreen;
    1925     Font.Size := 20;
     1939    Font.Size := Scale(14);
    19261940    Text := '(' + SWorldReady + ')';
    19271941    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text);
    … …  
    19291943end;
    19301944
    1931 procedure TEngine.DrawStatsPartial(PlayerIndex, YDiff: Integer);
     1945procedure TEngine.DrawStatsPartial(var Y: Integer; PlayerIndex: Integer);
    19321946var
    19331947  X: Integer;
    1934   Y: Integer;
    19351948  I: Integer;
    19361949  Text: string;
    19371950  ShotsPercent: Integer;
    1938 const
    1939   LineHeight = 40;
    1940 begin
     1951  LineHeight: Integer;
     1952  TempY: Integer;
     1953begin
     1954  TempY := Y;
     1955
     1956  LineHeight := Scale(40);
    19411957  with Bitmap.Canvas do begin
    19421958    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);
    19471962    Inc(Y, LineHeight);
    19481963    Text := SShotsFired;
    … …  
    19661981    if I < Players.Count then
    19671982    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));
    19701985      Font.Color := Color1;
    19711986      Text := Name;
    1972       TextOut(X - TextWidth(Text) , Y, Text);
     1987      TextOut(X - TextWidth(Text), Y, Text);
    19731988      Inc(Y, LineHeight);
    19741989      Text := IntToStr(ShotsCount);
    … …  
    19932008    end;
    19942009
    1995     Inc(Y, 3 * LineHeight);
     2010    Inc(Y, 2 * LineHeight);
    19962011  end;
    19972012end;
    … …  
    20032018  Text: string;
    20042019  Winner: TPlayer;
    2005 begin
     2020  LineHeight: Integer;
     2021begin
     2022  LineHeight := Scale(40);
    20062023  with Bitmap.Canvas do begin
    20072024    X := Bitmap.Width div 4 * 3;
    … …  
    20152032
    20162033    Font.Color := clCyan;
    2017     Font.Size := 20;
     2034    Font.Size := Scale(14);
    20182035    Text := SStatistics;
    20192036    TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10, Text);
    20202037
    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);
    20262044    Font.Color := clOrange;
    20272045    Winner := Players.GetWinner;
    … …  
    20292047      Text := SWinnerIs;
    20302048      TextOut(X, Y, Text);
    2031       X := X + TextWidth(Text) + 20;
     2049      X := X + TextWidth(Text) + Scale(20);
    20322050      Font.Color := Winner.Color1;
    20332051      Text := Winner.Name;

  • trunk/tunneler.lpr

    r85 r93  
    3232  Application.CreateForm(TCore, Core.Core);
    3333  Application.CreateForm(TFormMain, FormMain.FormMain);
    34   {$IFDEF DEBUG}
    35   {$ENDIF}
    3634  Application.Run;
    3735end.
Note: See TracChangeset for help on using the changeset viewer.