Changeset 405 for branches/highdpi/LocalPlayer/Term.pas
- Timestamp:
- Nov 3, 2021, 11:22:02 AM (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/LocalPlayer/Term.pas
r378 r405 29 29 TMainScreen = class(TDrawDlg) 30 30 mBigTiles: TDpiMenuItem; 31 mNextUnit: TDpiMenuItem; 32 N13: TDpiMenuItem; 33 mPrevUnit: TDpiMenuItem; 31 34 Timer1: TTimer; 32 35 GamePopup: TDpiPopupMenu; … … 286 289 procedure CopyMiniToPanel; 287 290 procedure PanelPaint; 288 procedure NextUnit(NearLoc: integer; AutoTurn: boolean); 291 procedure FocusNextUnit(Dir: Integer = 1); 292 procedure NextUnit(NearLoc: Integer; AutoTurn: Boolean); 289 293 procedure Scroll(dx, dy: integer); 290 294 procedure SetMapPos(Loc: integer; MapPos: TPoint); … … 2433 2437 begin 2434 2438 SetTroopLoc(-1); 2435 PaintAll 2439 PaintAll; 2436 2440 end { supervisor } 2437 2441 { else if (ClientMode=cTurn) and (MyRO.Turn=0) then … … 2455 2459 FocusOnLoc(G.lx * G.ly div 2); 2456 2460 SetTroopLoc(-1); 2457 PanelPaint 2461 PanelPaint; 2458 2462 end; 2459 2463 if ShowCityList then … … 3446 3450 NoMapPanel := TIsoMap.Create; 3447 3451 3448 KeyBindings.LoadFromRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings');3449 3452 UpdateKeyShortcuts; 3450 3453 … … 3545 3548 I: Integer; 3546 3549 begin 3547 KeyBindings.SaveToRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings');3548 3550 MainFormKeyDown := nil; 3549 3551 FreeAndNil(sb); … … 4904 4906 end; 4905 4907 4908 procedure TMainScreen.FocusNextUnit(Dir: Integer); 4909 var 4910 i, uix, NewFocus: Integer; 4911 begin 4912 if ClientMode >= scContact then 4913 Exit; 4914 DestinationMarkON := False; 4915 PaintDestination; 4916 NewFocus := -1; 4917 for i := 1 to MyRO.nUn do begin 4918 uix := (UnFocus + i * Dir + MyRO.nUn) mod MyRO.nUn; 4919 if (MyUn[uix].Loc >= 0) and (MyUn[uix].Status and usStay = 0) then begin 4920 NewFocus := uix; 4921 Break; 4922 end; 4923 end; 4924 if NewFocus >= 0 then begin 4925 SetUnFocus(NewFocus); 4926 SetTroopLoc(MyUn[NewFocus].Loc); 4927 FocusOnLoc(TroopLoc, flRepaintPanel); 4928 end; 4929 end; 4930 4906 4931 procedure TMainScreen.FocusOnLoc(Loc: integer; Options: integer = 0); 4907 4932 var … … 4930 4955 end; 4931 4956 4932 procedure TMainScreen.NextUnit(NearLoc: integer; AutoTurn: boolean);4957 procedure TMainScreen.NextUnit(NearLoc: Integer; AutoTurn: Boolean); 4933 4958 var 4934 Dist, TestDist: single;4935 i, uix, NewFocus: integer;4936 GotoOnly: boolean;4959 Dist, TestDist: Single; 4960 i, uix, NewFocus: Integer; 4961 GotoOnly: Boolean; 4937 4962 begin 4938 4963 Dist := 0; 4939 4964 if ClientMode >= scContact then 4940 exit;4941 DestinationMarkON := false;4965 Exit; 4966 DestinationMarkON := False; 4942 4967 PaintDestination; 4943 for GotoOnly := GoOnPhase downto false do 4944 begin 4968 for GotoOnly := GoOnPhase downto False do begin 4945 4969 NewFocus := -1; 4946 for i := 1 to MyRO.nUn do 4947 begin 4970 for i := 1 to MyRO.nUn do begin 4948 4971 uix := (UnFocus + i) mod MyRO.nUn; 4949 4972 if (MyUn[uix].Loc >= 0) and (MyUn[uix].Job = jNone) and 4950 4973 (MyUn[uix].Status and (usStay or usRecover or usWaiting) = usWaiting) 4951 4974 and (not GotoOnly or (MyUn[uix].Status and usGoto <> 0)) then 4952 if NearLoc < 0 then 4953 begin 4975 if NearLoc < 0 then begin 4954 4976 NewFocus := uix; 4955 4977 Break; 4956 end 4957 else 4958 begin 4978 end else begin 4959 4979 TestDist := Distance(NearLoc, MyUn[uix].Loc); 4960 if (NewFocus < 0) or (TestDist < Dist) then 4961 begin 4980 if (NewFocus < 0) or (TestDist < Dist) then begin 4962 4981 NewFocus := uix; 4963 4982 Dist := TestDist; … … 4966 4985 end; 4967 4986 if GotoOnly then 4968 if NewFocus < 0 then 4969 GoOnPhase := false 4970 else 4971 Break; 4972 end; 4973 if NewFocus >= 0 then 4974 begin 4987 if NewFocus < 0 then GoOnPhase := False 4988 else Break; 4989 end; 4990 if NewFocus >= 0 then begin 4975 4991 SetUnFocus(NewFocus); 4976 4992 SetTroopLoc(MyUn[NewFocus].Loc); 4977 FocusOnLoc(TroopLoc, flRepaintPanel) 4978 end 4979 else if AutoTurn and not mWaitTurn.Checked then 4980 begin 4981 TurnComplete := true; 4993 FocusOnLoc(TroopLoc, flRepaintPanel); 4994 end else 4995 if AutoTurn and not mWaitTurn.Checked then begin 4996 TurnComplete := True; 4982 4997 SetUnFocus(-1); 4983 4998 SetTroopLoc(-1); 4984 PostMessage(Handle, WM_EOT, 0, 0) 4985 end 4986 else 4987 begin 4999 PostMessage(Handle, WM_EOT, 0, 0); 5000 end else begin 4988 5001 if { (UnFocus>=0) and } not TurnComplete and EOT.Visible then 4989 5002 Play('TURNEND'); 4990 TurnComplete := true;5003 TurnComplete := True; 4991 5004 SetUnFocus(-1); 4992 5005 SetTroopLoc(-1); … … 5962 5975 end 5963 5976 else 5964 NextUnit(UnStartLoc, true) 5977 NextUnit(UnStartLoc, true); 5965 5978 end 5966 5979 else if (UnFocus < 0) and (Options and muAutoNext <> 0) then … … 6167 6180 begin 6168 6181 MyUn[uix].Status := MyUn[uix].Status and not usWaiting; 6169 NextUnit(UnStartLoc, true) 6182 NextUnit(UnStartLoc, true); 6170 6183 end; 6171 6184 end; … … 6328 6341 trixFocus := TrCnt; 6329 6342 inc(TrCnt); 6330 end 6343 end; 6331 6344 end 6332 6345 else // count enemy units here … … 6443 6456 mStay.ShortCut := BStay.ShortCut; 6444 6457 mNoOrders.ShortCut := BNoOrders.ShortCut; 6458 mPrevUnit.ShortCut := BPrevUnit.ShortCut; 6459 mNextUnit.ShortCut := BNextUnit.ShortCut; 6445 6460 mCancel.ShortCut := BCancel.ShortCut; 6446 6461 mPillage.ShortCut := BPillage.ShortCut; … … 6636 6651 else if BStay.Test(ShortCut) then MenuClick(mStay) 6637 6652 else if BNoOrders.Test(ShortCut) then MenuClick(mNoOrders) 6653 else if BPrevUnit.Test(ShortCut) then MenuClick(mPrevUnit) 6654 else if BNextUnit.Test(ShortCut) then MenuClick(mNextUnit) 6638 6655 else if BCancel.Test(ShortCut) then MenuClick_Check(UnitPopup, mCancel) 6639 6656 else if BPillage.Test(ShortCut) then MenuClick_Check(UnitPopup, mPillage) … … 6718 6735 end 6719 6736 else 6720 PanelPaint 6737 PanelPaint; 6721 6738 end 6722 6739 else 6723 6740 NextUnit(UnStartLoc, true); 6724 end 6741 end; 6725 6742 end; 6726 6743 case result of … … 6735 6752 if result < rExecuted then 6736 6753 Play('INVALID') 6737 end 6754 end; 6738 6755 end; 6739 6756 … … 6914 6931 end 6915 6932 else if UnFocus >= 0 then 6916 with MyUn[UnFocus]do6933 with TUn(MyUn[UnFocus]) do 6917 6934 if Sender = mGoOn then 6918 6935 begin … … 6945 6962 begin 6946 6963 Centre(Loc); 6947 PaintAllMaps 6964 PaintAllMaps; 6948 6965 end 6949 6966 else if Sender = mCity then … … 6957 6974 PaintAll; 6958 6975 ZoomToCity(Loc0, true, chFounded); 6959 end 6976 end; 6960 6977 end 6961 6978 else … … 7018 7035 if Job > jNone then 7019 7036 Server(sStartJob + jNone shl 4, me, UnFocus, nil^); 7020 NextUnit(UnStartLoc, true) 7037 NextUnit(UnStartLoc, true); 7021 7038 end 7022 7039 else if Sender = mRecover then … … 7027 7044 if Job > jNone then 7028 7045 Server(sStartJob + jNone shl 4, me, UnFocus, nil^); 7029 NextUnit(UnStartLoc, true) 7046 NextUnit(UnStartLoc, true); 7030 7047 end 7031 7048 else if Sender = mNoOrders then 7032 7049 begin 7033 7050 Status := Status and not usWaiting; 7034 NextUnit(UnStartLoc, true) 7051 NextUnit(UnStartLoc, true); 7052 end 7053 else if Sender = mPrevUnit then 7054 begin 7055 Status := Status and not usWaiting; 7056 FocusNextUnit(-1); 7057 end 7058 else if Sender = mNextUnit then 7059 begin 7060 Status := Status and not usWaiting; 7061 FocusNextUnit(1); 7035 7062 end 7036 7063 else if Sender = mCancel then … … 7113 7140 NextUnit(Loc, true) 7114 7141 else 7115 PanelPaint 7142 PanelPaint; 7116 7143 end 7117 7144 else if i = eNoTime_Load then … … 8035 8062 end; 8036 8063 8037 initialization8038 8039 8064 end. 8040 8065
Note:
See TracChangeset
for help on using the changeset viewer.