Changeset 405 for branches/highdpi/LocalPlayer

Timestamp:

Nov 3, 2021, 11:22:02 AM (4 years ago)

Author:

chronos

Message:

• Modified: Merged changes from trunk r404.

Location:

branches/highdpi/LocalPlayer

Files:

• CityScreen.pas (modified) (1 diff)
• ClientTools.pas (modified) (2 diffs)
• IsoEngine.pas (modified) (3 diffs)
• MessgEx.pas (modified) (1 diff)
• Term.lfm (modified) (2 diffs)
• Term.pas (modified) (23 diffs)
• UKeyBindings.pas (modified) (8 diffs)
• UnitStat.pas (modified) (1 diff)

branches/highdpi/LocalPlayer/CityScreen.pas

@@ -8 +8 @@
   Protocol, ClientTools, Term, ScreenTools, IsoEngine, BaseWin,
   LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls,
-  ButtonA, ButtonC, Area, GraphType;
+  ButtonA, ButtonC, Area, GraphType, UTexture;
 
 const

branches/highdpi/LocalPlayer/ClientTools.pas

@@ -636 +636 @@
 procedure CityOptimizer_CityChange(cix: integer);
 begin
-  if (MyRO.Government <> gAnarchy) and (MyCity[cix].Flags and
+  if (MyRO.Government <> gAnarchy) and (cix <> -1) and (MyCity[cix].Flags and
     chCaptured = 0) then
   begin
@@ -756 +756 @@
 initialization
 
-  Assert(nImp < 128);
-  CalculateAdvValues;
+Assert(nImp < 128);
+CalculateAdvValues;
 
 end.

branches/highdpi/LocalPlayer/IsoEngine.pas

@@ -1007 +1007 @@
   end;
 
-  if ShowObjects then
-  begin
-    if (Tile and fCanal <> 0) or (Tile and fCity <> 0) then
-    begin // paint canal connections
+  if ShowObjects then begin
+    // Paint canal connections
+    if (Tile and fCanal <> 0) or (Tile and fCity <> 0) then begin
       Conn := Connection8(Loc, fCanal or fCity);
       if Tile and fCanal <> 0 then
         Conn := Conn or ($FF - OceanConnection(Loc));
-      if Conn = 0 then
-      begin
+      if Conn = 0 then begin
         if Tile and fCanal <> 0 then
-          TSprite(x, y, spCanal)
+          TSprite(x, y, spCanal);
       end
       else
@@ -1024 +1022 @@
             TSprite(x, y, spCanal + 1 + Dir);
     end;
+
     if Tile and (fRR or fCity) <> 0 then
       RRConn := Connection8(Loc, fRR or fCity)
     else
       RRConn := 0;
-    if Tile and (fRoad or fRR or fCity) <> 0 then
-    begin // paint road connections
+
+    // Paint road connections
+    if Tile and (fRoad or fRR or fCity) <> 0 then begin
       Conn := Connection8(Loc, fRoad or fRR or fCity) and not RRConn;
       if (Conn = 0) and (Tile and (fRR or fCity) = 0) then
@@ -1038 +1038 @@
             TSprite(x, y, spRoad + 1 + Dir);
     end;
-    // paint railroad connections
+
+    // Paint railroad connections
     if (Tile and fRR <> 0) and (RRConn = 0) then
       TSprite(x, y, spRailRoad)
-    else if RRConn > 0 then
+    else if RRConn > 0 then begin
       for Dir := 0 to 7 do
         if (1 shl Dir) and RRConn <> 0 then
           TSprite(x, y, spRailRoad + 1 + Dir);
+    end;
   end;
 end;

branches/highdpi/LocalPlayer/MessgEx.pas

@@ -543 +543 @@
 end;
 
-
-initialization
-
 end.

branches/highdpi/LocalPlayer/Term.lfm

@@ -1 +1 @@
 object MainScreen: TMainScreen
-  Left = 169
+  Left = 516
   Height = 480
-  Top = 596
+  Top = 834
   Width = 800
   HorzScrollBar.Visible = False
@@ -667 +667 @@
       OnClick = MenuClick
     end
+    object N13: TDpiMenuItem
+      Caption = '-'
+    end
+    object mPrevUnit: TDpiMenuItem
+      Tag = 100
+      ShortCut = 46
+      OnClick = MenuClick
+    end
+    object mNextUnit: TDpiMenuItem
+      Tag = 101
+      ShortCut = 45
+      OnClick = MenuClick
+    end
   end
   object StatPopup: TDpiPopupMenu

branches/highdpi/LocalPlayer/Term.pas

@@ -29 +29 @@
   TMainScreen = class(TDrawDlg)
     mBigTiles: TDpiMenuItem;
+    mNextUnit: TDpiMenuItem;
+    N13: TDpiMenuItem;
+    mPrevUnit: TDpiMenuItem;
     Timer1: TTimer;
     GamePopup: TDpiPopupMenu;
@@ -286 +289 @@
     procedure CopyMiniToPanel;
     procedure PanelPaint;
-    procedure NextUnit(NearLoc: integer; AutoTurn: boolean);
+    procedure FocusNextUnit(Dir: Integer = 1);
+    procedure NextUnit(NearLoc: Integer; AutoTurn: Boolean);
     procedure Scroll(dx, dy: integer);
     procedure SetMapPos(Loc: integer; MapPos: TPoint);
@@ -2433 +2437 @@
   begin
     SetTroopLoc(-1);
-    PaintAll
+    PaintAll;
   end { supervisor }
   { else if (ClientMode=cTurn) and (MyRO.Turn=0) then
@@ -2455 +2459 @@
           FocusOnLoc(G.lx * G.ly div 2);
       SetTroopLoc(-1);
-      PanelPaint
+      PanelPaint;
     end;
     if ShowCityList then
@@ -3446 +3450 @@
   NoMapPanel := TIsoMap.Create;
 
-  KeyBindings.LoadFromRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings');
   UpdateKeyShortcuts;
 
@@ -3545 +3548 @@
   I: Integer;
 begin
-  KeyBindings.SaveToRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings');
   MainFormKeyDown := nil;
   FreeAndNil(sb);
@@ -4904 +4906 @@
 end;
 
+procedure TMainScreen.FocusNextUnit(Dir: Integer);
+var
+  i, uix, NewFocus: Integer;
+begin
+  if ClientMode >= scContact then
+    Exit;
+  DestinationMarkON := False;
+  PaintDestination;
+  NewFocus := -1;
+  for i := 1 to MyRO.nUn do begin
+    uix := (UnFocus + i * Dir + MyRO.nUn) mod MyRO.nUn;
+    if (MyUn[uix].Loc >= 0) and (MyUn[uix].Status and usStay = 0) then begin
+      NewFocus := uix;
+      Break;
+    end;
+  end;
+  if NewFocus >= 0 then begin
+    SetUnFocus(NewFocus);
+    SetTroopLoc(MyUn[NewFocus].Loc);
+    FocusOnLoc(TroopLoc, flRepaintPanel);
+  end;
+end;
+
 procedure TMainScreen.FocusOnLoc(Loc: integer; Options: integer = 0);
 var
@@ -4930 +4955 @@
 end;
 
-procedure TMainScreen.NextUnit(NearLoc: integer; AutoTurn: boolean);
+procedure TMainScreen.NextUnit(NearLoc: Integer; AutoTurn: Boolean);
 var
-  Dist, TestDist: single;
-  i, uix, NewFocus: integer;
-  GotoOnly: boolean;
+  Dist, TestDist: Single;
+  i, uix, NewFocus: Integer;
+  GotoOnly: Boolean;
 begin
   Dist := 0;
   if ClientMode >= scContact then
-    exit;
-  DestinationMarkON := false;
+    Exit;
+  DestinationMarkON := False;
   PaintDestination;
-  for GotoOnly := GoOnPhase downto false do
-  begin
+  for GotoOnly := GoOnPhase downto False do begin
     NewFocus := -1;
-    for i := 1 to MyRO.nUn do
-    begin
+    for i := 1 to MyRO.nUn do begin
       uix := (UnFocus + i) mod MyRO.nUn;
       if (MyUn[uix].Loc >= 0) and (MyUn[uix].Job = jNone) and
         (MyUn[uix].Status and (usStay or usRecover or usWaiting) = usWaiting)
         and (not GotoOnly or (MyUn[uix].Status and usGoto <> 0)) then
-        if NearLoc < 0 then
-        begin
+        if NearLoc < 0 then begin
           NewFocus := uix;
           Break;
-        end
-        else
-        begin
+        end else begin
           TestDist := Distance(NearLoc, MyUn[uix].Loc);
-          if (NewFocus < 0) or (TestDist < Dist) then
-          begin
+          if (NewFocus < 0) or (TestDist < Dist) then begin
             NewFocus := uix;
             Dist := TestDist;
@@ -4966 +4985 @@
     end;
     if GotoOnly then
-      if NewFocus < 0 then
-        GoOnPhase := false
-      else
-        Break;
-  end;
-  if NewFocus >= 0 then
-  begin
+      if NewFocus < 0 then GoOnPhase := False
+        else Break;
+  end;
+  if NewFocus >= 0 then begin
     SetUnFocus(NewFocus);
     SetTroopLoc(MyUn[NewFocus].Loc);
-    FocusOnLoc(TroopLoc, flRepaintPanel)
-  end
-  else if AutoTurn and not mWaitTurn.Checked then
-  begin
-    TurnComplete := true;
+    FocusOnLoc(TroopLoc, flRepaintPanel);
+  end else
+  if AutoTurn and not mWaitTurn.Checked then begin
+    TurnComplete := True;
     SetUnFocus(-1);
     SetTroopLoc(-1);
-    PostMessage(Handle, WM_EOT, 0, 0)
-  end
-  else
-  begin
+    PostMessage(Handle, WM_EOT, 0, 0);
+  end else begin
     if { (UnFocus>=0) and } not TurnComplete and EOT.Visible then
       Play('TURNEND');
-    TurnComplete := true;
+    TurnComplete := True;
     SetUnFocus(-1);
     SetTroopLoc(-1);
@@ -5962 +5975 @@
         end
         else
-          NextUnit(UnStartLoc, true)
+          NextUnit(UnStartLoc, true);
     end
     else if (UnFocus < 0) and (Options and muAutoNext <> 0) then
@@ -6167 +6180 @@
         begin
           MyUn[uix].Status := MyUn[uix].Status and not usWaiting;
-          NextUnit(UnStartLoc, true)
+          NextUnit(UnStartLoc, true);
         end;
       end;
@@ -6328 +6341 @@
               trixFocus := TrCnt;
             inc(TrCnt);
-          end
+          end;
     end
     else // count enemy units here
@@ -6443 +6456 @@
   mStay.ShortCut := BStay.ShortCut;
   mNoOrders.ShortCut := BNoOrders.ShortCut;
+  mPrevUnit.ShortCut := BPrevUnit.ShortCut;
+  mNextUnit.ShortCut := BNextUnit.ShortCut;
   mCancel.ShortCut := BCancel.ShortCut;
   mPillage.ShortCut := BPillage.ShortCut;
@@ -6636 +6651 @@
     else if BStay.Test(ShortCut) then MenuClick(mStay)
     else if BNoOrders.Test(ShortCut) then MenuClick(mNoOrders)
+    else if BPrevUnit.Test(ShortCut) then MenuClick(mPrevUnit)
+    else if BNextUnit.Test(ShortCut) then MenuClick(mNextUnit)
     else if BCancel.Test(ShortCut) then MenuClick_Check(UnitPopup, mCancel)
     else if BPillage.Test(ShortCut) then MenuClick_Check(UnitPopup, mPillage)
@@ -6718 +6735 @@
           end
           else
-            PanelPaint
+            PanelPaint;
         end
         else
           NextUnit(UnStartLoc, true);
-      end
+      end;
     end;
     case result of
@@ -6735 +6752 @@
       if result < rExecuted then
         Play('INVALID')
-    end
+    end;
   end;
 
@@ -6914 +6931 @@
   end
   else if UnFocus >= 0 then
-    with MyUn[UnFocus] do
+    with TUn(MyUn[UnFocus]) do
       if Sender = mGoOn then
       begin
@@ -6945 +6962 @@
       begin
         Centre(Loc);
-        PaintAllMaps
+        PaintAllMaps;
       end
       else if Sender = mCity then
@@ -6957 +6974 @@
             PaintAll;
             ZoomToCity(Loc0, true, chFounded);
-          end
+          end;
         end
         else
@@ -7018 +7035 @@
         if Job > jNone then
           Server(sStartJob + jNone shl 4, me, UnFocus, nil^);
-        NextUnit(UnStartLoc, true)
+        NextUnit(UnStartLoc, true);
       end
       else if Sender = mRecover then
@@ -7027 +7044 @@
         if Job > jNone then
           Server(sStartJob + jNone shl 4, me, UnFocus, nil^);
-        NextUnit(UnStartLoc, true)
+        NextUnit(UnStartLoc, true);
       end
       else if Sender = mNoOrders then
       begin
         Status := Status and not usWaiting;
-        NextUnit(UnStartLoc, true)
+        NextUnit(UnStartLoc, true);
+      end
+      else if Sender = mPrevUnit then
+      begin
+        Status := Status and not usWaiting;
+        FocusNextUnit(-1);
+      end
+      else if Sender = mNextUnit then
+      begin
+        Status := Status and not usWaiting;
+        FocusNextUnit(1);
       end
       else if Sender = mCancel then
@@ -7113 +7140 @@
               NextUnit(Loc, true)
             else
-              PanelPaint
+              PanelPaint;
           end
           else if i = eNoTime_Load then
@@ -8035 +8062 @@
 end;
 
-initialization
-
 end.
 

branches/highdpi/LocalPlayer/UKeyBindings.pas

@@ -17 +17 @@
     ShortCut: TShortCut;
     ShortCut2: TShortCut;
+    DefaultShortCut: TShortCut;
+    DefaultShortCut2: TShortCut;
     function Test(AShortCut: TShortCut): Boolean;
+    procedure Assign(Source: TKeyBinding);
+    procedure SetDefault;
   end;
 
@@ -23 +27 @@
 
   TKeyBindings = class(TFPGObjectList<TKeyBinding>)
+  private
   public
     function AddItem(const ShortName, FullName: string; ShortCut: TShortCut; ShortCut2: TShortCut = 0): TKeyBinding; overload;
@@ -29 +34 @@
     procedure LoadFromRegistry(RootKey: HKEY; Key: string);
     procedure SaveToRegistry(RootKey: HKEY; Key: string);
+    procedure LoadToStrings(Strings: TStrings);
+    procedure Assign(Source: TKeyBindings);
+    procedure ResetToDefault;
+    procedure RemoveShortCut(ShortCut: TShortCut);
   end;
 
@@ -52 +61 @@
   BStay: TKeyBinding;
   BNoOrders: TKeyBinding;
+  BPrevUnit: TKeyBinding;
+  BNextUnit: TKeyBinding;
   BCancel: TKeyBinding;
   BPillage: TKeyBinding;
@@ -123 +134 @@
 end;
 
+procedure TKeyBinding.Assign(Source: TKeyBinding);
+begin
+  ShortName := Source.ShortName;
+  FullName := Source.FullName;
+  ShortCut := Source.ShortCut;
+  ShortCut2 := Source.ShortCut2;
+  DefaultShortCut := Source.DefaultShortCut;
+  DefaultShortCut2 := Source.DefaultShortCut2;
+end;
+
+procedure TKeyBinding.SetDefault;
+begin
+  ShortCut := DefaultShortCut;
+  ShortCut2 := DefaultShortCut2;
+end;
+
 { TKeyBindings }
 
@@ -133 +160 @@
   Result.ShortCut := ShortCut;
   Result.ShortCut2 := ShortCut2;
+  Result.DefaultShortCut := ShortCut;
+  Result.DefaultShortCut2 := ShortCut2;
   Add(Result);
 end;
@@ -207 +236 @@
 end;
 
+procedure TKeyBindings.LoadToStrings(Strings: TStrings);
+var
+  I: Integer;
+  Text: string;
+begin
+  Strings.Clear;
+  for I := 0 to Count - 1 do begin
+    Text:= '';
+    if Items[I].ShortCut <> 0 then
+      Text:= Text + ShortCutToText(Items[I].ShortCut);
+    if Items[I].ShortCut2 <> 0 then begin
+      if Text <> '' then Text := Text + ', ';
+      Text:= Text + ShortCutToText(Items[I].ShortCut2);
+    end;
+    if Text <> '' then Text := Items[I].FullName + ' (' + Text + ')'
+      else Text := Items[I].FullName;
+    Strings.Add(Text);
+  end;
+end;
+
+procedure TKeyBindings.Assign(Source: TKeyBindings);
+var
+  I: Integer;
+begin
+  while Count < Source.Count do
+    Add(TKeyBinding.Create);
+  while Count > Source.Count do
+    Delete(Count - 1);
+  for I := 0 to Count - 1 do
+    Items[I].Assign(Source.Items[I]);
+end;
+
+procedure TKeyBindings.ResetToDefault;
+var
+  I: Integer;
+begin
+  for I := 0 to Count - 1 do
+    Items[I].SetDefault;
+end;
+
+procedure TKeyBindings.RemoveShortCut(ShortCut: TShortCut);
+var
+  I: Integer;
+begin
+  for I := 0 to Count - 1 do begin
+    if Items[I].ShortCut = ShortCut then Items[I].ShortCut := 0;
+    if Items[I].ShortCut2 = ShortCut then Items[I].ShortCut2 := 0;
+  end;
+end;
+
 
 initialization
@@ -231 +310 @@
   BStay := AddItem('Stay', 'Stay', 'S');
   BNoOrders := AddItem('NoOrders', 'No orders', 'Space');
+  BPrevUnit := AddItem('PrevUnit', 'Previous unit', 'Del');
+  BNextUnit := AddItem('NextUnit', 'Next unit', 'Ins');
   BCancel := AddItem('Cancel', 'Cancel', 'Ctrl+C');
   BPillage := AddItem('Pillage', 'Pillage', 'Ctrl+P');

branches/highdpi/LocalPlayer/UnitStat.pas

@@ -52 +52 @@
 
 uses
-  Tribes, Help, Directories;
+  Tribes, Help, Directories, UTexture;
 
 {$R *.lfm}