Changeset 303 for branches/highdpi/LocalPlayer/Term.pas
- Timestamp:
- Mar 9, 2021, 9:19:49 AM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/LocalPlayer/Term.pas
r265 r303 235 235 Closable, RepaintOnResize, Tracking, TurnComplete, Edited, GoOnPhase, 236 236 HaveStrategyAdvice, FirstMovieTurn: boolean; 237 PrevWindowState: TWindowState; 238 CurrentWindowState: TWindowState; 237 239 function ChooseUnusedTribe: integer; 238 240 procedure GetTribeList; … … 283 285 procedure OnEOT(var Msg: TMessage); message WM_EOT; 284 286 procedure SoundPreload(Check: integer); 287 procedure UpdateKeyShortcuts; 288 procedure SetFullScreen(Active: Boolean); 285 289 public 286 290 UsedOffscreenWidth, UsedOffscreenHeight: integer; … … 307 311 FileName: ShortString; 308 312 end; 309 310 313 TCityNameInfo = record 311 314 ID: integer; 312 NewName: ShortString end; 313 TModelNameInfo = record mix: integer; 314 NewName: ShortString end; 315 TPriceSet = Set of $00 .. $FF; 315 NewName: ShortString; 316 end; 317 TModelNameInfo = record 318 mix: integer; 319 NewName: ShortString; 320 end; 321 TPriceSet = Set of $00 .. $FF; 316 322 317 323 const … … 481 487 Directories, IsoEngine, CityScreen, Draft, MessgEx, Select, CityType, Help, 482 488 UnitStat, Log, Diagram, NatStat, Wonders, Enhance, Nego, UPixelPointer, Sound, 483 Battle, Rates, TechTree, Registry, Global ;489 Battle, Rates, TechTree, Registry, Global, UKeyBindings; 484 490 485 491 {$R *.lfm} … … 531 537 SmallScreen, GameOK, MapValid, skipped, idle: boolean; 532 538 533 SaveOption: array [0 ..nSaveOption - 1] of integer;534 MiniColors: array [0 .. $1f, 0 ..1] of TColor;539 SaveOption: array [0..nSaveOption - 1] of integer; 540 MiniColors: array [0..11, 0..1] of TColor; 535 541 MainMap: TIsoMap; 536 542 CurrentMoveInfo: record AfterMovePaintRadius, AfterAttackExpeller: integer; … … 551 557 procedure InitSmallImp; 552 558 const 553 cut = 4;559 Cut = 4; 554 560 Sharpen = 80; 555 561 type … … 742 748 ChooseModelPicture(Owner, mix, ModelCode(MyRO.EnemyModel[emix]), 743 749 ModelHash(MyRO.EnemyModel[emix]), MyRO.Turn, false, true); 744 result := true 750 result := true; 745 751 end; 746 752 … … 786 792 function CreateTribe(p: integer; FileName: string; Original: boolean): boolean; 787 793 begin 788 if not FileExists(LocalizedFilePath('Tribes' + DirectorySeparator + FileName + 789 '.tribe.txt')) then 790 begin 791 result := false; 792 exit 794 FileName := LocalizedFilePath('Tribes' + DirectorySeparator + FileName + 795 CevoTribeExt); 796 if not FileExists(FileName) then 797 begin 798 Result := False; 799 Exit; 793 800 end; 794 801 … … 879 886 MyModel[mix].Status := MyModel[mix].Status or msObsolete; 880 887 end; 881 inc(MyData.ToldModels) 888 inc(MyData.ToldModels); 882 889 end; 883 890 end; … … 1123 1130 if UnitStatDlg.Visible then 1124 1131 UnitStatDlg.Close; 1125 end 1126 end 1132 end; 1133 end; 1127 1134 end; 1128 1135 … … 1151 1158 if UnitStatDlg.Visible then 1152 1159 UnitStatDlg.Close; 1153 end 1154 end 1160 end; 1161 end; 1155 1162 end; 1156 1163 … … 1175 1182 UnFocus := -1; 1176 1183 PaintLoc(Loc0); 1177 end 1184 end; 1178 1185 end; 1179 1186 UnFocus := uix; … … 1220 1227 MovieSpeed3Btn.Visible := false; 1221 1228 MovieSpeed4Btn.Visible := false; 1222 end 1229 end; 1223 1230 end; 1224 1231 … … 1248 1255 if AILogo[p] <> nil then 1249 1256 begin 1250 AILogo[p].free; 1251 AILogo[p] := nil 1252 end 1257 FreeAndNil(AILogo[p]); 1258 end; 1253 1259 end 1254 1260 else … … 1256 1262 if AILogo[p] = nil then 1257 1263 AILogo[p] := TDpiBitmap.Create; 1258 if not LoadGraphicFile(AILogo[p], HomeDir + Name + '.png', gfNoError) then 1259 begin 1260 AILogo[p].free; 1261 AILogo[p] := nil 1262 end 1263 end 1264 if not LoadGraphicFile(AILogo[p], HomeDir + Name + '.png', [gfNoError]) then 1265 begin 1266 FreeAndNil(AILogo[p]); 1267 end; 1268 end; 1264 1269 end; 1265 1270 … … 1296 1301 MapValid := false; 1297 1302 PaintAllMaps; 1298 end 1299 end 1303 end; 1304 end; 1300 1305 end; 1301 1306 … … 1415 1420 begin 1416 1421 UnusedTribeFiles.Clear; 1417 ok := FindFirst(LocalizedFilePath('Tribes') + DirectorySeparator + '* .tribe.txt',1422 ok := FindFirst(LocalizedFilePath('Tribes') + DirectorySeparator + '*' + CevoTribeExt, 1418 1423 faArchive + faReadOnly, SearchRec) = 0; 1419 1424 if not ok then 1420 1425 begin 1421 1426 FindClose(SearchRec); 1422 ok := FindFirst(LocalizedFilePath('Tribes' + DirectorySeparator + '* .tribe.txt'),1427 ok := FindFirst(LocalizedFilePath('Tribes' + DirectorySeparator + '*' + CevoTribeExt), 1423 1428 faArchive + faReadOnly, SearchRec) = 0; 1424 1429 end; 1425 1430 if ok then 1426 1431 repeat 1427 SearchRec.Name := Copy(SearchRec.Name, 1, Length(SearchRec.Name) - 10);1432 SearchRec.Name := Copy(SearchRec.Name, 1, Length(SearchRec.Name) - Length(CevoTribeExt)); 1428 1433 if GetTribeInfo(SearchRec.Name, Name, Color) then 1429 1434 UnusedTribeFiles.AddObject(SearchRec.Name, TObject(Color)); … … 1434 1439 function TMainScreen.ChooseUnusedTribe: integer; 1435 1440 var 1436 i, j, ColorDistance, BestColorDistance, TestColorDistance, 1437 CountBest: integer; 1441 i: Integer; 1442 j: Integer; 1443 ColorDistance: Integer; 1444 BestColorDistance: Integer; 1445 TestColorDistance: Integer; 1446 CountBest: Integer; 1438 1447 begin 1439 1448 assert(UnusedTribeFiles.Count > 0); … … 1465 1474 if DelphiRandom(CountBest) = 0 then 1466 1475 result := j 1467 end 1476 end; 1468 1477 end; 1469 1478 end; … … 1523 1532 IconKind := mikShip; 1524 1533 IconIndex := Ship2Owner; 1525 end 1534 end; 1526 1535 end; 1527 1536 … … 1536 1545 MostCost := TestCost; 1537 1546 IconIndex := imShipComp + i 1538 end 1547 end; 1539 1548 end; 1540 1549 end; … … 1619 1628 sb := TPVScrollbar.Create(Self); 1620 1629 sb.OnUpdate := ScrollBarUpdate; 1621 end; { InitModule }1630 end; 1622 1631 1623 1632 procedure TMainScreen.InitTurn(NewPlayer: integer); … … 2237 2246 Flags and CityRepMask); 2238 2247 UpdatePanel := true; 2239 end 2248 end; 2240 2249 end 2241 2250 else { if mRepList.Checked then } … … 2243 2252 if Flags and CityRepMask <> 0 then 2244 2253 ShowCityList := true 2245 end 2246 end 2254 end; 2255 end; 2247 2256 end; { city loop } 2248 2257 end; // ClientMode=cTurn … … 2263 2272 Play('REVOLUTION'); 2264 2273 Server(sRevolution, me, 0, nil^); 2265 end 2274 end; 2266 2275 end; 2267 2276 end; // ClientMode=cTurn … … 2382 2391 else 2383 2392 Status := Status and not usWaiting; 2384 end 2393 end; 2385 2394 end; 2386 2395 end; // ClientMode=cTurn … … 2480 2489 opAllModel: 2481 2490 s := s + 'All models'; 2482 end 2491 end; 2483 2492 end; 2484 2493 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(s)); … … 2488 2497 s := s + '--- ACCEPTED! ---'; 2489 2498 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(s)); 2490 end 2499 end; 2491 2500 end; 2492 2501 … … 2502 2511 cReleaseModule: 2503 2512 begin 2504 SmallImp.free;2505 UnusedTribeFiles.free;2506 TribeNames.free;2507 MainMap.free;2513 FreeAndNil(SmallImp); 2514 FreeAndNil(UnusedTribeFiles); 2515 FreeAndNil(TribeNames); 2516 FreeAndNil(MainMap); 2508 2517 IsoEngine.Done; 2509 2518 // AdvisorDlg.DeInit; … … 2703 2712 for p1 := 0 to nPl - 1 do 2704 2713 if Tribe[p1] <> nil then 2705 Tribe[p1].free;2714 FreeAndNil(Tribe[p1]); 2706 2715 Tribes.Done; 2707 2716 RepaintOnResize := false; … … 2844 2853 // this break will ensure speed of fast forward does not depend on cpu speed 2845 2854 DpiApplication.ProcessMessages; 2846 end 2855 end; 2847 2856 end; 2848 2857 … … 2923 2932 DipCall(scReject); 2924 2933 EndNego 2925 end 2926 end 2934 end; 2935 end; 2927 2936 end; 2928 2937 end; … … 3410 3419 i, j: integer; 3411 3420 begin 3421 KeyBindings.LoadFromRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings'); 3422 UpdateKeyShortcuts; 3423 3412 3424 MainFormKeyDown := FormKeyDown; 3413 3425 BaseWin.CreateOffscreen(Offscreen); … … 3512 3524 I: Integer; 3513 3525 begin 3526 KeyBindings.SaveToRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings'); 3514 3527 MainFormKeyDown := nil; 3515 3528 FreeAndNil(sb); … … 3615 3628 RectInvalidate(0, TopBarHeight, ClientWidth, TopBarHeight + MapHeight); 3616 3629 MapValid := false; 3617 PaintAll 3618 end 3630 PaintAll; 3631 end; 3619 3632 end; 3620 3633 … … 3623 3636 CanClose := Closable; 3624 3637 if not Closable and idle and (me = 0) and (ClientMode < scContact) then 3625 MenuClick(mResign) 3638 MenuClick(mResign); 3626 3639 end; 3627 3640 … … 4061 4074 var 4062 4075 uix, cix, x, y, Loc, i, hw, xm, cm, cmPolOcean, cmPolNone: integer; 4063 PrevMiniPixel, MiniPixel: TPixelPointer; 4076 PrevMiniPixel: TPixelPointer; 4077 MiniPixel: TPixelPointer; 4078 TerrainTile: Cardinal; 4064 4079 begin 4065 4080 cmPolOcean := GrExt[HGrSystem].Data.Canvas.Pixels[101, 67]; … … 4085 4100 ScaleToNative(G.lx) * 5) mod (ScaleToNative(G.lx) * 2); 4086 4101 MiniPixel.SetXY(xm, y); 4087 cm := MiniColors[MyMap[Loc] and fTerrain, i]; 4102 TerrainTile := MyMap[Loc] and fTerrain; 4103 if TerrainTile > 11 then TerrainTile := 0; 4104 cm := MiniColors[TerrainTile, i]; 4088 4105 if ClientMode = cEditMap then 4089 4106 begin … … 6422 6439 MapValid := false; 6423 6440 PaintAllMaps; 6424 end 6441 end; 6442 end; 6443 6444 procedure TMainScreen.UpdateKeyShortcuts; 6445 begin 6446 mHelp.ShortCut := BHelp.ShortCut; 6447 mUnitStat.ShortCut := BUnitStat.ShortCut; 6448 mCityStat.ShortCut := BCityStat.ShortCut; 6449 mScienceStat.ShortCut := BScienceStat.ShortCut; 6450 mEUnitStat.ShortCut := BEUnitStat.ShortCut;; 6451 mDiagram.ShortCut := BDiagram.ShortCut; 6452 mWonders.ShortCut := BWonders.ShortCut; 6453 mShips.ShortCut := BShips.ShortCut; 6454 mNations.ShortCut := BNations.ShortCut; 6455 mEmpire.ShortCut := BEmpire.ShortCut; 6456 mResign.ShortCut := BResign.ShortCut; 6457 mRandomMap.ShortCut := BRandomMap.ShortCut; 6458 mDisband.ShortCut := BDisbandUnit.ShortCut; 6459 mFort.ShortCut := BFortify.ShortCut; 6460 mCentre.ShortCut := BCenterUnit.ShortCut; 6461 mStay.ShortCut := BStay.ShortCut; 6462 mNoOrders.ShortCut := BNoOrders.ShortCut; 6463 mCancel.ShortCut := BCancel.ShortCut; 6464 mPillage.ShortCut := BPillage.ShortCut; 6465 mTechTree.ShortCut := BTechTree.ShortCut; 6466 mWait.ShortCut := BWait.ShortCut; 6467 mJump.ShortCut := BJump.ShortCut;; 6468 mDebugMap.ShortCut := BDebugMap.ShortCut; 6469 mLocCodes.ShortCut := BLocCodes.ShortCut; 6470 mNames.ShortCut := BNames.ShortCut; 6471 mRun.ShortCut := BRun.ShortCut; 6472 mAirBase.ShortCut := BAirBase.ShortCut; 6473 mCity.ShortCut := BBuildCity.ShortCut; 6474 mEnhance.ShortCut := BEnhance.ShortCut; 6475 mGoOn.ShortCut := BGoOn.ShortCut; 6476 mHome.ShortCut := BHome.ShortCut; 6477 mFarm.ShortCut := BFarmClearIrrigation.ShortCut; 6478 mClear.ShortCut := BFarmClearIrrigation.ShortCut; 6479 mIrrigation.ShortCut := BFarmClearIrrigation.ShortCut; 6480 mLoad.ShortCut := BLoad.ShortCut; 6481 mAfforest.ShortCut := BAfforestMine.ShortCut; 6482 mMine.ShortCut := BAfforestMine.ShortCut; 6483 mCanal.ShortCut := BCanal.ShortCut; 6484 MTrans.ShortCut := BTrans.ShortCut; 6485 mPollution.ShortCut := BPollution.ShortCut; 6486 mRR.ShortCut := BRailRoad.ShortCut; 6487 mRoad.ShortCut := BRailRoad.ShortCut; 6488 mUnload.ShortCut := BUnload.ShortCut; 6489 mRecover.ShortCut := BRecover.ShortCut; 6490 mUtilize.ShortCut := BUtilize.ShortCut; 6491 end; 6492 6493 procedure TMainScreen.SetFullScreen(Active: Boolean); 6494 begin 6495 if Active and (CurrentWindowState <> wsFullScreen) then begin 6496 PrevWindowState := WindowState; 6497 CurrentWindowState := wsFullScreen; 6498 WindowState := CurrentWindowState; 6499 {$IFDEF WINDOWS} 6500 BorderStyle := bsNone; 6501 {$ENDIF} 6502 BorderIcons := []; 6503 end else 6504 if not Active and (CurrentWindowState = wsFullScreen) then begin 6505 if PrevWindowState = wsMaximized then begin 6506 CurrentWindowState := wsMaximized; 6507 WindowState := CurrentWindowState; 6508 end else begin 6509 CurrentWindowState := wsNormal; 6510 WindowState := CurrentWindowState; 6511 WindowState := wsFullScreen; 6512 WindowState := CurrentWindowState; 6513 end; 6514 {$IFDEF WINDOWS} 6515 BorderStyle := bsSizeable; 6516 {$ENDIF} 6517 BorderIcons := [biSystemMenu, biMinimize, biMaximize]; 6518 end; 6425 6519 end; 6426 6520 … … 6435 6529 end; 6436 6530 6531 procedure SetViewpointMe(p: Integer); 6532 begin 6533 if p = me then SetViewpoint(p) 6534 else SetViewpoint(p); 6535 end; 6536 6537 procedure DoMoveUnit(X, Y: Integer); 6538 begin 6539 DestinationMarkON := False; 6540 PaintDestination; 6541 MyUn[UnFocus].Status := MyUn[UnFocus].Status and 6542 ($FFFF - usStay - usRecover - usGoto - usEnhance) or usWaiting; 6543 MoveUnit(X, Y, muAutoNext); 6544 end; 6545 6437 6546 var 6438 dx, dy: integer; 6439 time0, time1: TDateTime; 6440 begin 6441 if GameMode = cMovie then 6442 begin 6443 case Key of 6444 VK_F4: 6445 MenuClick_Check(StatPopup, mScienceStat); 6446 VK_F6: 6447 MenuClick_Check(StatPopup, mDiagram); 6448 VK_F7: 6449 MenuClick_Check(StatPopup, mWonders); 6450 VK_F8: 6451 MenuClick_Check(StatPopup, mShips); 6452 end; 6453 exit; 6454 end; 6455 6456 if not idle then 6457 exit; 6458 6459 if ClientMode = cEditMap then 6460 begin 6461 if Shift = [ssCtrl] then 6547 Time0, Time1: TDateTime; 6548 ShortCut: TShortCut; 6549 begin 6550 ShortCut := KeyToShortCut(Key, Shift); 6551 6552 if GameMode = cMovie then begin 6553 if BScienceStat.Test(ShortCut) then MenuClick_Check(StatPopup, mScienceStat) 6554 else if BDiagram.Test(ShortCut) then MenuClick_Check(StatPopup, mDiagram) 6555 else if BWonders.Test(ShortCut) then MenuClick_Check(StatPopup, mWonders) 6556 else if BShips.Test(ShortCut) then MenuClick_Check(StatPopup, mShips); 6557 Exit; 6558 end; 6559 6560 if not Idle then Exit; 6561 6562 if ClientMode = cEditMap then begin 6563 if BResign.Test(ShortCut) then MenuClick(mResign) 6564 else if BRandomMap.Test(ShortCut) then MenuClick(mRandomMap) 6565 else if BHelp.Test(ShortCut) then MenuClick(mHelp); 6566 (*if Shift = [ssCtrl] then 6462 6567 case char(Key) of 6463 (*'A':6568 'A': 6464 6569 begin // auto symmetry 6465 6570 Server($7F0,me,0,nil^); … … 6473 6578 if MyMap[dx] and fTerrain>=fGrass then inc(dy); 6474 6579 dy:=dy 6475 end; *) 6476 'Q': 6477 MenuClick(mResign); 6478 'R': 6479 MenuClick(mRandomMap); 6480 end 6481 else if Shift = [] then 6482 case char(Key) of 6483 char(VK_F1): 6484 MenuClick(mHelp); 6580 end; 6485 6581 end; 6486 exit; 6487 end; 6488 6489 if Shift = [ssAlt] then 6490 case char(Key) of 6491 '0': 6492 SetDebugMap(-1); 6493 '1' .. '9': 6494 SetDebugMap(ord(Key) - 48); 6582 *) 6583 Exit; 6584 end; 6585 6586 if BEndTurn.Test(ShortCut) then EndTurn 6587 else if BFullScreen.Test(ShortCut) then begin 6588 FullScreen := not FullScreen; 6589 SetFullScreen(FullScreen); 6590 end 6591 else if BHelp.Test(ShortCut) then MenuClick(mHelp) 6592 else if BUnitStat.Test(ShortCut) then MenuClick_Check(StatPopup, mUnitStat) 6593 else if BCityStat.Test(ShortCut) then MenuClick_Check(StatPopup, mCityStat) 6594 else if BScienceStat.Test(ShortCut) then MenuClick_Check(StatPopup, mScienceStat) 6595 else if BEUnitStat.Test(ShortCut) then MenuClick_Check(StatPopup, mEUnitStat) 6596 else if BDiagram.Test(ShortCut) then MenuClick_Check(StatPopup, mDiagram) 6597 else if BWonders.Test(ShortCut) then MenuClick_Check(StatPopup, mWonders) 6598 else if BShips.Test(ShortCut) then MenuClick_Check(StatPopup, mShips) 6599 else if BNations.Test(ShortCut) then MenuClick_Check(StatPopup, mNations) 6600 else if BEmpire.Test(ShortCut) then MenuClick_Check(StatPopup, mEmpire) 6601 6602 else if BSetDebugMap0.Test(ShortCut) then SetDebugMap(-1) 6603 else if BSetDebugMap1.Test(ShortCut) then SetDebugMap(1) 6604 else if BSetDebugMap2.Test(ShortCut) then SetDebugMap(2) 6605 else if BSetDebugMap3.Test(ShortCut) then SetDebugMap(3) 6606 else if BSetDebugMap4.Test(ShortCut) then SetDebugMap(4) 6607 else if BSetDebugMap5.Test(ShortCut) then SetDebugMap(5) 6608 else if BSetDebugMap6.Test(ShortCut) then SetDebugMap(6) 6609 else if BSetDebugMap7.Test(ShortCut) then SetDebugMap(7) 6610 else if BSetDebugMap8.Test(ShortCut) then SetDebugMap(8) 6611 else if BSetDebugMap9.Test(ShortCut) then SetDebugMap(9) 6612 6613 else if BJump.Test(ShortCut) then MenuClick(mJump) 6614 else if BDebugMap.Test(ShortCut) then mShowClick(mDebugMap) 6615 else if BLocCodes.Test(ShortCut) then mShowClick(mLocCodes) 6616 else if BLogDlg.Test(ShortCut) then begin 6617 if LogDlg.Visible then LogDlg.Close 6618 else LogDlg.Show; 6619 end 6620 else if BNames.Test(ShortCut) then mNamesClick(mNames) 6621 else if BResign.Test(ShortCut) then MenuClick_Check(GamePopup, mResign) 6622 else if BRun.Test(ShortCut) then MenuClick(mRun) 6623 else if BTestMapRepaint.Test(ShortCut) then begin // test map repaint time 6624 Time0 := NowPrecise; 6625 MapValid := False; 6626 MainOffscreenPaint; 6627 Time1 := NowPrecise; 6628 SimpleMessage(Format('Map repaint time: %.3f ms', 6629 [(Time1 - Time0) / OneMillisecond])); 6630 end 6631 else if BSetViewpoint0.Test(ShortCut) then SetViewpointMe(0) 6632 else if BSetViewpoint1.Test(ShortCut) then SetViewpointMe(1) 6633 else if BSetViewpoint2.Test(ShortCut) then SetViewpointMe(2) 6634 else if BSetViewpoint3.Test(ShortCut) then SetViewpointMe(3) 6635 else if BSetViewpoint4.Test(ShortCut) then SetViewpointMe(4) 6636 else if BSetViewpoint5.Test(ShortCut) then SetViewpointMe(5) 6637 else if BSetViewpoint6.Test(ShortCut) then SetViewpointMe(6) 6638 else if BSetViewpoint7.Test(ShortCut) then SetViewpointMe(7) 6639 else if BSetViewpoint8.Test(ShortCut) then SetViewpointMe(8) 6640 else if BSetViewpoint9.Test(ShortCut) then SetViewpointMe(9) 6641 6642 else if BMapBtn0.Test(ShortCut) then MapBtnClick(MapBtn0) 6643 else if BMapBtn1.Test(ShortCut) then MapBtnClick(MapBtn1) 6644 else if BMapBtn4.Test(ShortCut) then MapBtnClick(MapBtn4) 6645 else if BMapBtn5.Test(ShortCut) then MapBtnClick(MapBtn5) 6646 else if BMapBtn6.Test(ShortCut) then MapBtnClick(MapBtn6) 6647 else if BTechTree.Test(ShortCut) then MenuClick(mTechTree) 6648 else if BWait.Test(ShortCut) then MenuClick(mWait); 6649 6650 if UnFocus >= 0 then begin 6651 if BDisbandUnit.Test(ShortCut) then MenuClick(mDisband) 6652 else if BFortify.Test(ShortCut) then MenuClick_Check(TerrainPopup, mFort) 6653 else if BCenterUnit.Test(ShortCut) then MenuClick(mCentre) 6654 else if BStay.Test(ShortCut) then MenuClick(mStay) 6655 else if BNoOrders.Test(ShortCut) then MenuClick(mNoOrders) 6656 else if BCancel.Test(ShortCut) then MenuClick_Check(UnitPopup, mCancel) 6657 else if BPillage.Test(ShortCut) then MenuClick_Check(UnitPopup, mPillage) 6658 else if BSelectTransport.Test(ShortCut) then MenuClick_Check(UnitPopup, mSelectTransport) 6659 else if BAirBase.Test(ShortCut) then MenuClick_Check(TerrainPopup, mAirBase) 6660 else if BBuildCity.Test(ShortCut) then MenuClick_Check(UnitPopup, mCity) 6661 else if BEnhance.Test(ShortCut) then begin 6662 InitPopup(TerrainPopup); 6663 if mEnhance.Visible and mEnhance.Enabled then MenuClick(mEnhance) 6664 else MenuClick(mEnhanceDef) 6495 6665 end 6496 else if Shift = [ssCtrl] then 6497 case char(Key) of 6498 'J': 6499 MenuClick(mJump); 6500 'K': 6501 mShowClick(mDebugMap); 6502 'L': 6503 mShowClick(mLocCodes); 6504 'M': 6505 if LogDlg.Visible then 6506 LogDlg.Close 6507 else 6508 LogDlg.Show; 6509 'N': 6510 mNamesClick(mNames); 6511 'Q': 6512 MenuClick_Check(GamePopup, mResign); 6513 'R': 6514 MenuClick(mRun); 6515 '0' .. '9': 6516 begin 6517 if ord(Key) - 48 = me then 6518 SetViewpoint(0) 6519 else 6520 SetViewpoint(ord(Key) - 48); 6521 end; 6522 ' ': 6523 begin // test map repaint time 6524 time0 := NowPrecise; 6525 MapValid := false; 6526 MainOffscreenPaint; 6527 time1 := NowPrecise; 6528 SimpleMessage(Format('Map repaint time: %.3f ms', 6529 [(time1 - time0) / OneMillisecond])); 6530 end 6666 else if BGoOn.Test(ShortCut) then MenuClick_Check(UnitPopup, mGoOn) 6667 else if BHome.Test(ShortCut) then MenuClick_Check(UnitPopup, mHome) 6668 else if BFarmClearIrrigation.Test(ShortCut) then begin 6669 if JobTest(UnFocus, jFarm, [eTreaty]) then 6670 MenuClick(mFarm) 6671 else if JobTest(UnFocus, jClear, [eTreaty]) then 6672 MenuClick(mClear) 6673 else MenuClick_Check(TerrainPopup, mIrrigation); 6531 6674 end 6532 else if Shift = [] then 6533 case char(Key) of 6534 char(VK_F1): 6535 MenuClick(mHelp); 6536 char(VK_F2): 6537 MenuClick_Check(StatPopup, mUnitStat); 6538 char(VK_F3): 6539 MenuClick_Check(StatPopup, mCityStat); 6540 char(VK_F4): 6541 MenuClick_Check(StatPopup, mScienceStat); 6542 char(VK_F5): 6543 MenuClick_Check(StatPopup, mEUnitStat); 6544 char(VK_F6): 6545 MenuClick_Check(StatPopup, mDiagram); 6546 char(VK_F7): 6547 MenuClick_Check(StatPopup, mWonders); 6548 char(VK_F8): 6549 MenuClick_Check(StatPopup, mShips); 6550 char(VK_F9): 6551 MenuClick_Check(StatPopup, mNations); 6552 char(VK_F10): 6553 MenuClick_Check(StatPopup, mEmpire); 6554 char(VK_ADD): 6555 EndTurn; 6556 '1': 6557 MapBtnClick(MapBtn0); 6558 '2': 6559 MapBtnClick(MapBtn1); 6560 '3': 6561 MapBtnClick(MapBtn4); 6562 '4': 6563 MapBtnClick(MapBtn5); 6564 '5': 6565 MapBtnClick(MapBtn6); 6566 'T': 6567 MenuClick(mTechTree); 6568 'W': 6569 MenuClick(mWait); 6570 end; 6571 6572 if UnFocus >= 0 then 6573 if Shift = [ssCtrl] then 6574 case char(Key) of 6575 'C': 6576 MenuClick_Check(UnitPopup, mCancel); 6577 'D': 6578 MenuClick(mDisband); 6579 'P': 6580 MenuClick_Check(UnitPopup, mPillage); 6581 'T': 6582 MenuClick_Check(UnitPopup, mSelectTransport); 6583 end 6584 else if Shift = [] then 6585 case char(Key) of 6586 ' ': 6587 MenuClick(mNoOrders); 6588 'A': 6589 MenuClick_Check(TerrainPopup, mAirBase); 6590 'B': 6591 MenuClick_Check(UnitPopup, mCity); 6592 'C': 6593 MenuClick(mCentre); 6594 'E': 6595 begin 6596 InitPopup(TerrainPopup); 6597 if mEnhance.Visible and mEnhance.Enabled then 6598 MenuClick(mEnhance) 6599 else 6600 MenuClick(mEnhanceDef) 6601 end; 6602 'F': 6603 MenuClick_Check(TerrainPopup, mFort); 6604 'G': 6605 MenuClick_Check(UnitPopup, mGoOn); 6606 'H': 6607 MenuClick_Check(UnitPopup, mHome); 6608 'I': 6609 if JobTest(UnFocus, jFarm, [eTreaty]) then 6610 MenuClick(mFarm) 6611 else if JobTest(UnFocus, jClear, [eTreaty]) then 6612 MenuClick(mClear) 6613 else 6614 MenuClick_Check(TerrainPopup, mIrrigation); 6615 'L': 6616 MenuClick_Check(UnitPopup, mLoad); 6617 'M': 6618 if JobTest(UnFocus, jAfforest, [eTreaty]) then 6619 MenuClick(mAfforest) 6620 else 6621 MenuClick_Check(TerrainPopup, mMine); 6622 'N': 6623 MenuClick_Check(TerrainPopup, mCanal); 6624 'O': 6625 MenuClick_Check(TerrainPopup, MTrans); 6626 'P': 6627 MenuClick_Check(TerrainPopup, mPollution); 6628 'R': 6629 if JobTest(UnFocus, jRR, [eTreaty]) then 6630 MenuClick(mRR) 6631 else 6632 MenuClick_Check(TerrainPopup, mRoad); 6633 'S': 6634 MenuClick(mStay); 6635 'U': 6636 MenuClick_Check(UnitPopup, mUnload); 6637 'V': 6638 MenuClick_Check(UnitPopup, mRecover); 6639 'Z': 6640 MenuClick_Check(UnitPopup, mUtilize); 6641 #33 .. #40, #97 .. #100, #102 .. #105: 6642 begin { arrow keys } 6643 DestinationMarkON := false; 6644 PaintDestination; 6645 MyUn[UnFocus].Status := MyUn[UnFocus].Status and 6646 ($FFFF - usStay - usRecover - usGoto - usEnhance) or usWaiting; 6647 case Key of 6648 VK_NUMPAD1, VK_END: 6649 begin 6650 dx := -1; 6651 dy := 1 6652 end; 6653 VK_NUMPAD2, VK_DOWN: 6654 begin 6655 dx := 0; 6656 dy := 2 6657 end; 6658 VK_NUMPAD3, VK_NEXT: 6659 begin 6660 dx := 1; 6661 dy := 1 6662 end; 6663 VK_NUMPAD4, VK_LEFT: 6664 begin 6665 dx := -2; 6666 dy := 0 6667 end; 6668 VK_NUMPAD6, VK_RIGHT: 6669 begin 6670 dx := 2; 6671 dy := 0 6672 end; 6673 VK_NUMPAD7, VK_HOME: 6674 begin 6675 dx := -1; 6676 dy := -1 6677 end; 6678 VK_NUMPAD8, VK_UP: 6679 begin 6680 dx := 0; 6681 dy := -2 6682 end; 6683 VK_NUMPAD9, VK_PRIOR: 6684 begin 6685 dx := 1; 6686 dy := -1 6687 end; 6688 end; 6689 MoveUnit(dx, dy, muAutoNext) 6690 end; 6691 end 6675 else if BLoad.Test(ShortCut) then MenuClick_Check(UnitPopup, mLoad) 6676 else if BAfforestMine.Test(ShortCut) then begin 6677 if JobTest(UnFocus, jAfforest, [eTreaty]) then MenuClick(mAfforest) 6678 else MenuClick_Check(TerrainPopup, mMine); 6679 end 6680 else if BCanal.Test(ShortCut) then MenuClick_Check(TerrainPopup, mCanal) 6681 else if BTrans.Test(ShortCut) then MenuClick_Check(TerrainPopup, MTrans) 6682 else if BPollution.Test(ShortCut) then MenuClick_Check(TerrainPopup, mPollution) 6683 else if BRailRoad.Test(ShortCut) then begin 6684 if JobTest(UnFocus, jRR, [eTreaty]) then MenuClick(mRR) 6685 else MenuClick_Check(TerrainPopup, mRoad); 6686 end 6687 else if BUnload.Test(ShortCut) then MenuClick_Check(UnitPopup, mUnload) 6688 else if BRecover.Test(ShortCut) then MenuClick_Check(UnitPopup, mRecover) 6689 else if BUtilize.Test(ShortCut) then MenuClick_Check(UnitPopup, mUtilize) 6690 else if BMoveLeftDown.Test(ShortCut) then DoMoveUnit(-1, 1) 6691 else if BMoveDown.Test(ShortCut) then DoMoveUnit(0, 2) 6692 else if BMoveRightDown.Test(ShortCut) then DoMoveUnit(1, 1) 6693 else if BMoveLeft.Test(ShortCut) then DoMoveUnit(-2, 0) 6694 else if BMoveRight.Test(ShortCut) then DoMoveUnit(2, 0) 6695 else if BMoveLeftUp.Test(ShortCut) then DoMoveUnit(-1, -1) 6696 else if BMoveUp.Test(ShortCut) then DoMoveUnit(0, -2) 6697 else if BMoveRightUp.Test(ShortCut) then DoMoveUnit(1, -1); 6698 end; 6692 6699 end; 6693 6700 … … 7152 7159 SetTroopLoc(Loc); 7153 7160 PanelPaint 7154 end 7161 end; 7155 7162 end 7156 7163 else if Sender = mSelectTransport then … … 7171 7178 begin 7172 7179 HaveCities := true; 7173 Break 7180 Break; 7174 7181 end; 7175 7182 if Popup = GamePopup then … … 7271 7278 m.Checked := true; 7272 7279 mDebugMap.Add(m); 7273 end 7280 end; 7274 7281 end; 7275 7282 mSmallTiles.Checked := xxt = 33; … … 7455 7462 begin 7456 7463 SetTroopLoc(-1); 7457 PanelPaint 7464 PanelPaint; 7458 7465 end 7459 7466 else … … 7474 7481 SetTroopLoc(-1); 7475 7482 PanelPaint 7476 end 7477 end 7483 end; 7484 end; 7478 7485 end; 7479 7486 … … 7523 7530 2 + G.ly); 7524 7531 Update; 7525 end 7532 end; 7526 7533 end 7527 7534 else … … 7539 7546 MiniPaint; 7540 7547 PanelPaint; 7541 end 7548 end; 7542 7549 end; 7543 7550 … … 7591 7598 begin 7592 7599 result := (y >= TopBarHeight + MapHeight) or (y >= ClientHeight - PanelHeight) 7593 and ((x < xMidPanel) or (x >= xRightPanel)) 7600 and ((x < xMidPanel) or (x >= xRightPanel)); 7594 7601 end; 7595 7602 … … 7608 7615 GamePopup.Popup(Left + 4, Top + DpiGetSystemMetrics(SM_CYCAPTION) + 4 + 7609 7616 TopBarHeight - 1); 7610 end 7617 end; 7611 7618 end 7612 7619 else if IsPanelPixel(x, y) then … … 7771 7778 CityRepMask := CityRepMask or (1 shl (Tag shr 8)) 7772 7779 else 7773 CityRepMask := CityRepMask and not(1 shl (Tag shr 8)) 7774 end 7780 CityRepMask := CityRepMask and not(1 shl (Tag shr 8)); 7781 end; 7775 7782 end; 7776 7783 … … 7782 7789 procedure TMainScreen.FormShow(Sender: TObject); 7783 7790 begin 7784 if FullScreen then begin 7785 WindowState := wsFullScreen; 7786 BorderStyle := bsNone; 7787 BorderIcons := []; 7788 end else begin 7789 WindowState := wsMaximized; 7790 BorderStyle := bsSizeable; 7791 BorderIcons := [biSystemMenu, biMinimize, biMaximize]; 7792 end; 7791 SetFullScreen(FullScreen); 7793 7792 Timer1.Enabled := True; 7794 7793 end; … … 7827 7826 else if Flag = tfAllTechs then 7828 7827 TellNewModels 7829 end 7830 end 7828 end; 7829 end; 7831 7830 end; 7832 7831 … … 7898 7897 GamePopup.Popup(Left + 4, Top + DpiGetSystemMetrics(SM_CYCAPTION) + 4 + 7899 7898 TopBarHeight - 1); 7900 exit 7901 end // windows menu button calls game menu7899 exit; 7900 end; // windows menu button calls game menu 7902 7901 end; 7903 7902
Note:
See TracChangeset
for help on using the changeset viewer.