Changeset 334

Timestamp:

Mar 31, 2021, 9:12:58 PM (4 years ago)

Author:

chronos

Message:

• Fixed: Keep tile position under mouse cursor during after tile resize by mouse wheel.

Location:

trunk

Files:

• LocalPlayer/Term.pas (modified) (10 diffs)
• Protocol.pas (modified) (1 diff)

trunk/LocalPlayer/Term.pas

@@ -226 +226 @@
     procedure MovieSpeedBtnClick(Sender: TObject);
   private
-    xw: Integer;
-    yw: Integer;
+    xw: Integer; // Base map x
+    yw: Integer; // Base map y
     xwd: Integer;
     ywd: Integer;
@@ -288 +288 @@
     procedure NextUnit(NearLoc: integer; AutoTurn: boolean);
     procedure Scroll(dx, dy: integer);
+    procedure SetMapPos(Loc: integer; MapPos: TPoint);
     procedure Centre(Loc: integer);
     procedure SetTroopLoc(Loc: integer);
@@ -312 +313 @@
     procedure SetDebugMap(p: integer);
     procedure SetViewpoint(p: integer);
-    function LocationOfScreenPixel(x, y: integer): integer;
-    procedure SetTileSize(TileSize: TTileSize);
+    function LocationOfScreenPixel(x, y: integer): Integer;
+    function GetCenterLoc: Integer;
+    procedure SetTileSizeCenter(TileSize: TTileSize);
+    procedure SetTileSize(TileSize: TTileSize; Loc: Integer; MapPos: TPoint);
     procedure RectInvalidate(Left, Top, Rigth, Bottom: integer);
     procedure ShowEnemyShipChange(ShowShipChange: TShowShipChange);
@@ -3556 +3559 @@
 procedure TMainScreen.FormMouseWheel(Sender: TObject; Shift: TShiftState;
   WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
+var
+  MouseLoc: Integer;
 begin
   if sb.ProcessMouseWheel(WheelDelta) then begin
@@ -3561 +3566 @@
     Update;
   end else begin
-    if (WheelDelta > 0) and (MainMap.TileSize < High(TTileSize)) then
-      SetTileSize(Succ(MainMap.TileSize))
-    else if (WheelDelta < 0) and (MainMap.TileSize > Low(TTileSize)) then
-      SetTileSize(Pred(MainMap.TileSize));
+    if (WheelDelta > 0) and (MainMap.TileSize < High(TTileSize)) then begin
+      MouseLoc := LocationOfScreenPixel(MousePos.X, MousePos.Y);
+      SetTileSize(Succ(MainMap.TileSize), MouseLoc, Point(MousePos.X, MousePos.Y));
+    end
+    else if (WheelDelta < 0) and (MainMap.TileSize > Low(TTileSize)) then begin
+      MouseLoc := LocationOfScreenPixel(MousePos.X, MousePos.Y);
+      SetTileSize(Pred(MainMap.TileSize), MouseLoc, Point(MousePos.X, MousePos.Y));
+    end;
   end;
 end;
@@ -5071 +5080 @@
 end;
 
-procedure TMainScreen.Centre(Loc: integer);
+procedure TMainScreen.SetMapPos(Loc: integer; MapPos: TPoint);
 begin
   with MainMap do begin
@@ -5077 +5086 @@
       Update;
     // necessary because ScrollDC for form canvas is called after
-    xw := (Loc mod G.lx - (MapWidth - xxt * 2 * ((Loc div G.lx) and 1))
-      div (xxt * 4) + G.lx) mod G.lx;
-    if ywmax <= 0 then
-      yw := ywcenter
+    xw := (Loc mod G.lx) - (MapPos.X - ((xxt * 2) * ((Loc div G.lx) and 1)) div 2)
+      div (xxt * 2);
+    xw := (xw + G.lx) mod G.lx;
+    if ywmax <= 0 then yw := ywcenter
     else begin
-      yw := (Loc div G.lx - MapHeight div (yyt * 2) + 1) and not 1;
-      if yw < 0 then
-        yw := 0
-      else if yw > ywmax then
-        yw := ywmax;
-    end;
-  end;
+      yw := (Loc div G.lx - (MapPos.Y * 2) div (yyt * 2) + 1) and not 1;
+      if yw < 0 then yw := 0
+        else if yw > ywmax then yw := ywmax;
+    end;
+  end;
+end;
+
+procedure TMainScreen.Centre(Loc: integer);
+begin
+  SetMapPos(Loc, Point(MapWidth div 2, MapHeight div 2));
 end;
 
@@ -5121 +5133 @@
 end;
 
-function TMainScreen.LocationOfScreenPixel(x, y: integer): integer;
+function TMainScreen.LocationOfScreenPixel(x, y: integer): Integer;
 var
   qx, qy: integer;
@@ -5129 +5141 @@
     qy := (y * (xxt * 2) - x * (yyt * 2) - xxt * yyt * 2 + 4000 * xxt * yyt)
       div (xxt * yyt * 4) - 999;
-    result := (xw + (qx - qy + 2048) div 2 - 1024 + G.lx) mod G.lx + G.lx *
+    Result := (xw + (qx - qy + 2048) div 2 - 1024 + G.lx) mod G.lx + G.lx *
       (yw + qx + qy);
   end;
+end;
+
+function TMainScreen.GetCenterLoc: Integer;
+begin
+  Result := (xw + MapWidth div (MainMap.xxt * 4)) mod G.lx +
+    (yw + MapHeight div (MainMap.yyt * 2)) * G.lx;
 end;
 
@@ -7933 +7951 @@
 procedure TMainScreen.mSmallTilesClick(Sender: TObject);
 begin
-  SetTileSize(tsSmall);
+  SetTileSizeCenter(tsSmall);
 end;
 
 procedure TMainScreen.mNormalTilesClick(Sender: TObject);
 begin
-  SetTileSize(tsMedium);
+  SetTileSizeCenter(tsMedium);
 end;
 
 procedure TMainScreen.mBigTilesClick(Sender: TObject);
 begin
-  SetTileSize(tsBig);
-end;
-
-procedure TMainScreen.SetTileSize(TileSize: TTileSize);
+  SetTileSizeCenter(tsBig);
+end;
+
+procedure TMainScreen.SetTileSizeCenter(TileSize: TTileSize);
+begin
+  SetTileSize(TileSize, GetCenterLoc, Point(MapWidth div 2, MapHeight div 2));
+end;
+
+procedure TMainScreen.SetTileSize(TileSize: TTileSize; Loc: Integer; MapPos: TPoint);
 var
-  i, CenterLoc: integer;
-begin
-  CenterLoc := (xw + MapWidth div (MainMap.xxt * 4)) mod G.lx +
-    (yw + MapHeight div (MainMap.yyt * 2)) * G.lx;
+  i: integer;
+begin
   MainMap.TileSize := TileSize;
   NoMap.TileSize := TileSize;
   FormResize(nil);
-  Centre(CenterLoc);
+  SetMapPos(Loc, MapPos);
   PaintAllMaps;
   for i := 0 to Screen.FormCount - 1 do

trunk/Protocol.pas

@@ -1671 +1671 @@
 
   TNewGameData = record
-    lx: Integer;
-    ly: Integer;
+    lx: Integer; // Map width
+    ly: Integer; // Map height
     LandMass: Integer;
     MaxTurn: Integer;