- Timestamp:
- Apr 24, 2024, 10:28:34 AM (8 months ago)
- Location:
- trunk
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LocalPlayer/IsoEngine.pas
r551 r552 76 76 procedure PaintShore(X, Y, Loc: Integer); 77 77 procedure PaintTileExtraTerrain(X, Y, Loc: Integer); 78 procedure PaintTileObjects(X, Y, Loc, CityLoc, CityOwner: Integer; 78 procedure PaintTileObjects(nx, ny, X, Y, Loc, CityLoc, CityOwner: Integer; 79 UseBlink: Boolean); 80 procedure PaintTileObjectsRadius(nx, ny, X, Y, Loc, CityLoc, CityOwner: Integer; 81 UseBlink: Boolean; Radius: Integer; Inside: Boolean); 82 procedure PaintTileObjects1(X, Y, Loc, CityLoc, CityOwner: Integer; 83 UseBlink: Boolean); 84 procedure PaintTileObjects2(X, Y, Loc, CityLoc, CityOwner: Integer; 85 UseBlink: Boolean); 86 procedure PaintTileObjects3(X, Y, Loc, CityLoc, CityOwner: Integer; 79 87 UseBlink: Boolean); 80 88 procedure PaintGrid(X, Y, nx, ny: Integer); … … 82 90 procedure TextOut(X, Y, Color: Integer; const S: string); 83 91 procedure Sprite(HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: Integer); 84 procedure TerrainSprite(xDst, yDst, grix: Integer; PureBlack: Boolean = False); 92 procedure TerrainSprite(xDst, yDst, grix: Integer; PureBlack: Boolean = False; 93 Precise: Boolean = False); 85 94 procedure ApplyTileSize(ATileSize: TTileSize); 86 95 public … … 102 111 procedure PaintCity(X, Y: Integer; const CityInfo: TCityInfo; 103 112 Accessory: Boolean = True); 104 procedure BitBltBitmapOutput(Src: TBitmap; X, Y, Width, Height, xSrc, ySrc ,105 Rop: Integer );113 procedure BitBltBitmapOutput(Src: TBitmap; X, Y, Width, Height, xSrc, ySrc: Integer; 114 Rop: Integer = SRCCOPY; Precise: Boolean = False); 106 115 procedure AttackBegin(const ShowMove: TShowMove); 107 116 procedure AttackEffect(const ShowMove: TShowMove); … … 366 375 BitBltBitmap(DitherMask, 0, 0, xxt * 2, yyt * 2, 367 376 HGrTerrain.Mask, 1 + 7 * (xxt * 2 + 1), 368 1 + yyt + 15 * (yyt * 3 + 1), SRCAND );377 1 + yyt + 15 * (yyt * 3 + 1), SRCAND, True); 369 378 370 379 for X := -1 to 6 do begin … … 382 391 for Y := -1 to 6 do 383 392 BitBltBitmap(LandPatch, (X + 2) * (xxt * 2), (Y + 2) * yyt, 384 xxt * 2, yyt, HGrTerrain.Data, xSrc, ySrc );393 xxt * 2, yyt, HGrTerrain.Data, xSrc, ySrc, SRCCOPY, True); 385 394 for Y := -2 to 6 do 386 395 BitBltBitmap(LandPatch, (X + 2) * (xxt * 2), (Y + 2) * yyt, xxt, 387 yyt, HGrTerrain.Data, xSrc + xxt, ySrc + yyt, SRCPAINT );396 yyt, HGrTerrain.Data, xSrc + xxt, ySrc + yyt, SRCPAINT, True); 388 397 for Y := -2 to 6 do 389 398 BitBltBitmap(LandPatch, (X + 2) * (xxt * 2) + xxt, (Y + 2) * yyt, 390 xxt, yyt, HGrTerrain.Data, xSrc, ySrc + yyt, SRCPAINT );399 xxt, yyt, HGrTerrain.Data, xSrc, ySrc + yyt, SRCPAINT, True); 391 400 for Y := -2 to 6 do 392 401 BitBltBitmap(LandPatch, (X + 2) * (xxt * 2), (Y + 2) * yyt, xxt, 393 yyt, DitherMask, xxt, yyt, SRCAND );402 yyt, DitherMask, xxt, yyt, SRCAND, True); 394 403 for Y := -2 to 6 do 395 404 BitBltBitmap(LandPatch, (X + 2) * (xxt * 2) + xxt, (Y + 2) * yyt, 396 xxt, yyt, DitherMask, 0, yyt, SRCAND );405 xxt, yyt, DitherMask, 0, yyt, SRCAND, True); 397 406 end; 398 407 … … 411 420 for X := -2 to 6 do 412 421 BitBltBitmap(LandMore, (X + 2) * (xxt * 2), (Y + 2) * yyt, 413 xxt * 2, yyt, HGrTerrain.Data, xSrc, ySrc );422 xxt * 2, yyt, HGrTerrain.Data, xSrc, ySrc, SRCCOPY, True); 414 423 BitBltBitmap(LandMore, xxt * 2, (Y + 2) * yyt, xxt, yyt, 415 HGrTerrain.Data, xSrc + xxt, ySrc + yyt, SRCPAINT );424 HGrTerrain.Data, xSrc + xxt, ySrc + yyt, SRCPAINT, True); 416 425 for X := 0 to 7 do 417 426 BitBltBitmap(LandMore, (X + 2) * (xxt * 2) - xxt, (Y + 2) * yyt, 418 xxt * 2, yyt, HGrTerrain.Data, xSrc, ySrc + yyt, SRCPAINT );427 xxt * 2, yyt, HGrTerrain.Data, xSrc, ySrc + yyt, SRCPAINT, True); 419 428 for X := -2 to 6 do 420 429 BitBltBitmap(LandMore, (X + 2) * (xxt * 2), (Y + 2) * yyt, 421 xxt * 2, yyt, DitherMask, 0, 0, SRCAND );430 xxt * 2, yyt, DitherMask, 0, 0, SRCAND, True); 422 431 end; 423 432 … … 430 439 if (X >= 1) = (Y >= 2) then 431 440 BitBltBitmap(OceanPatch, X * (xxt * 2), Y * yyt, xxt * 2, yyt, 432 HGrTerrain.Data, xSrc, ySrc );441 HGrTerrain.Data, xSrc, ySrc, SRCCOPY, True); 433 442 if (X >= 1) and ((Y < 2) or (X >= 2)) then 434 443 begin 435 444 BitBltBitmap(OceanPatch, X * (xxt * 2), Y * yyt, xxt, yyt, 436 HGrTerrain.Data, xSrc + xxt, ySrc + yyt, SRCPAINT );445 HGrTerrain.Data, xSrc + xxt, ySrc + yyt, SRCPAINT, True); 437 446 BitBltBitmap(OceanPatch, X * (xxt * 2) + xxt, Y * yyt, xxt, yyt, 438 HGrTerrain.Data, xSrc, ySrc + yyt, SRCPAINT );447 HGrTerrain.Data, xSrc, ySrc + yyt, SRCPAINT, True); 439 448 end; 440 449 BitBltBitmap(OceanPatch, X * (xxt * 2), Y * yyt, xxt, yyt, 441 DitherMask, xxt, yyt, SRCAND );450 DitherMask, xxt, yyt, SRCAND, True); 442 451 BitBltBitmap(OceanPatch, X * (xxt * 2) + xxt, Y * yyt, xxt, yyt, 443 DitherMask, 0, yyt, SRCAND );452 DitherMask, 0, yyt, SRCAND, True); 444 453 end; 445 454 end; … … 453 462 if (X < 1) or (Y >= 2) then 454 463 BitBltBitmap(OceanMore, X * (xxt * 2), Y * yyt, xxt * 2, yyt, 455 HGrTerrain.Data, xSrc, ySrc );464 HGrTerrain.Data, xSrc, ySrc, SRCCOPY, True); 456 465 if (X = 1) and (Y < 2) or (X >= 2) and (Y >= 1) then 457 466 begin 458 467 BitBltBitmap(OceanMore, X * (xxt * 2), Y * yyt, xxt, yyt, 459 HGrTerrain.Data, xSrc + xxt, ySrc + yyt, SRCPAINT );468 HGrTerrain.Data, xSrc + xxt, ySrc + yyt, SRCPAINT, True); 460 469 BitBltBitmap(OceanMore, X * (xxt * 2) + xxt, Y * yyt, xxt, yyt, 461 HGrTerrain.Data, xSrc, ySrc + yyt, SRCPAINT );470 HGrTerrain.Data, xSrc, ySrc + yyt, SRCPAINT, True); 462 471 end; 463 472 BitBltBitmap(OceanMore, X * (xxt * 2), Y * yyt, xxt * 2, yyt, 464 DitherMask, 0, 0, SRCAND );473 DitherMask, 0, 0, SRCAND, True); 465 474 end; 466 475 end; 467 476 468 477 BitBltBitmap(DitherMask, 0, 0, xxt * 2, yyt * 2, 469 DitherMask, 0, 0, DSTINVERT ); { invert dither mask }478 DitherMask, 0, 0, DSTINVERT, True); { invert dither mask } 470 479 BitBltBitmap(DitherMask, 0, 0, xxt * 2, yyt * 2, 471 HGrTerrain.Mask, 1, 1 + yyt, SRCPAINT );480 HGrTerrain.Mask, 1, 1 + yyt, SRCPAINT, True); 472 481 473 482 for X := -1 to 6 do 474 483 for Y := -2 to 6 do 475 484 BitBltBitmap(LandPatch, (X + 2) * (xxt * 2), (Y + 2) * yyt, 476 xxt * 2, yyt, DitherMask, 0, 0, SRCAND );485 xxt * 2, yyt, DitherMask, 0, 0, SRCAND, True); 477 486 478 487 for Y := -1 to 6 do 479 488 for X := -2 to 7 do 480 489 BitBltBitmap(LandMore, (X + 2) * (xxt * 2) - xxt, (Y + 2) * yyt, 481 xxt * 2, yyt, DitherMask, 0, yyt, SRCAND );490 xxt * 2, yyt, DitherMask, 0, yyt, SRCAND, True); 482 491 483 492 BitBltBitmap(LandPatch, 0, 0, (xxt * 2) * 9, yyt * 9, 484 LandMore, 0, 0, SRCPAINT );493 LandMore, 0, 0, SRCPAINT, True); 485 494 486 495 for X := 0 to 3 do 487 496 for Y := 0 to 3 do 488 497 BitBltBitmap(OceanPatch, X * (xxt * 2), Y * yyt, xxt * 2, yyt, 489 DitherMask, 0, 0, SRCAND );498 DitherMask, 0, 0, SRCAND, True); 490 499 491 500 for Y := 0 to 3 do 492 501 for X := 0 to 4 do 493 502 BitBltBitmap(OceanMore, X * (xxt * 2) - xxt, Y * yyt, xxt * 2, 494 yyt, DitherMask, 0, yyt, SRCAND); 495 496 BitBltBitmap(OceanPatch, 0, 0, (xxt * 2) * 4, yyt * 4, OceanMore, 0, 0, SRCPAINT); 503 yyt, DitherMask, 0, yyt, SRCAND, True); 504 505 BitBltBitmap(OceanPatch, 0, 0, (xxt * 2) * 4, yyt * 4, OceanMore, 0, 0, 506 SRCPAINT, True); 497 507 498 508 with DitherMask.Canvas do begin … … 500 510 FillRect(Rect(0, 0, xxt * 2, yyt)); 501 511 end; 502 BitBltBitmap(DitherMask, 0, 0, xxt * 2, yyt, HGrTerrain.Mask, 1, 1 + yyt); 512 BitBltBitmap(DitherMask, 0, 0, xxt * 2, yyt, HGrTerrain.Mask, 1, 1 + yyt, 513 SRCCOPY, True); 503 514 504 515 for X := 0 to 6 do 505 516 BitBltBitmap(LandPatch, (X + 2) * (xxt * 2), yyt, xxt * 2, yyt, 506 DitherMask, 0, 0, SRCAND );507 BitBltBitmap(DitherMask, 0, 0, xxt * 2, yyt, DitherMask, 0, 0, DSTINVERT );517 DitherMask, 0, 0, SRCAND, True); 518 BitBltBitmap(DitherMask, 0, 0, xxt * 2, yyt, DitherMask, 0, 0, DSTINVERT, True); 508 519 509 520 for Y := 0 to 6 do 510 521 BitBltBitmap(LandPatch, xxt * 2, (Y + 2) * yyt, xxt * 2, yyt, 511 DitherMask, 0, 0, SRCAND );522 DitherMask, 0, 0, SRCAND, True); 512 523 513 524 FreeAndNil(LandMore); … … 592 603 end; 593 604 594 procedure TIsoMap.BitBltBitmapOutput(Src: TBitmap; X, Y, Width, Height, xSrc, ySrc ,595 Rop: Integer );605 procedure TIsoMap.BitBltBitmapOutput(Src: TBitmap; X, Y, Width, Height, xSrc, ySrc: Integer; 606 Rop: Integer = SRCCOPY; Precise: Boolean = False); 596 607 begin 597 608 if X < FLeft then … … 615 626 616 627 {$IFDEF DPI} 617 BitBltBitmap(FOutput, X, Y, Width, Height, Src, xSrc, ySrc, Rop );628 BitBltBitmap(FOutput, X, Y, Width, Height, Src, xSrc, ySrc, Rop, Precise); 618 629 {$ELSE} 619 630 BitBltCanvas(FOutput.Canvas, X, Y, Width, Height, Src.Canvas, xSrc, ySrc, Rop); … … 628 639 629 640 procedure TIsoMap.TerrainSprite(xDst, yDst, grix: Integer; 630 PureBlack: Boolean = False );641 PureBlack: Boolean = False; Precise: Boolean = False); 631 642 var 632 643 Width: Integer; … … 658 669 Exit; 659 670 660 BitBltBitmap(FOutput, xDst, yDst, Width, Height, HGrTerrain.Mask, xSrc, ySrc, SRCAND );671 BitBltBitmap(FOutput, xDst, yDst, Width, Height, HGrTerrain.Mask, xSrc, ySrc, SRCAND, Precise); 661 672 if not PureBlack then 662 BitBltBitmap(FOutput, xDst, yDst, Width, Height, HGrTerrain.Data, xSrc, ySrc, SRCPAINT );673 BitBltBitmap(FOutput, xDst, yDst, Width, Height, HGrTerrain.Data, xSrc, ySrc, SRCPAINT, Precise); 663 674 end; 664 675 … … 963 974 end; 964 975 BitBltBitmapOutput(OceanPatch, X + dx * xxt, Y + dy * yyt, xxt, yyt, 965 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY );976 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY, True); 966 977 end; 967 978 end else begin … … 1009 1020 BitBltBitmapOutput(HGrTerrain.Data, X + dx * xxt, Y + dy * yyt, xxt, 1010 1021 yyt, 1 + 6 * (xxt * 2 + 1) + (dx + dy + 1) and 1 * xxt, 1 + yyt, 1011 SRCCOPY ) // arctic <-> ocean1022 SRCCOPY, True) // arctic <-> ocean 1012 1023 else if bix = -1 then 1013 1024 BitBltBitmapOutput(HGrTerrain.Data, X + dx * xxt, Y + dy * yyt, xxt, 1014 1025 yyt, 1 + 6 * (xxt * 2 + 1) + xxt - (dx + dy + 1) and 1 * xxt, 1015 1 + yyt * 2, SRCCOPY ) // arctic <-> ocean1026 1 + yyt * 2, SRCCOPY, True) // arctic <-> ocean 1016 1027 else 1017 1028 BitBltBitmapOutput(LandPatch, X + dx * xxt, Y + dy * yyt, xxt, yyt, 1018 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY );1029 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY, True); 1019 1030 end; 1020 1031 end; … … 1040 1051 BitBltBitmapOutput(HGrTerrain.Data, X + xxt div 2, Y, xxt, yyt, 1041 1052 1 + (Conn shr 6 + Conn and 1 shl 2) * (xxt * 2 + 1), 1042 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT );1053 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT, True); 1043 1054 BitBltBitmapOutput(HGrTerrain.Data, X + xxt, Y + yyt div 2, xxt, yyt, 1044 1055 1 + (Conn and 7) * (xxt * 2 + 1) + xxt, 1045 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT );1056 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT, True); 1046 1057 BitBltBitmapOutput(HGrTerrain.Data, X + xxt div 2, Y + yyt, xxt, yyt, 1047 1058 1 + (Conn shr 2 and 7) * (xxt * 2 + 1) + xxt, 1048 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT );1059 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT, True); 1049 1060 BitBltBitmapOutput(HGrTerrain.Data, X, Y + yyt div 2, xxt, yyt, 1050 1061 1 + (Conn shr 4 and 7) * (xxt * 2 + 1), 1051 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT );1062 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT, True); 1052 1063 Conn := Connection4(Loc, fTerrain, fUNKNOWN); { dither to black } 1053 1064 if Conn and 1 <> 0 then 1054 1065 BitBltBitmapOutput(HGrTerrain.Mask, X + xxt, Y, xxt, yyt, 1 + 7 * (xxt * 2 + 1) + 1055 xxt, 1 + yyt + 15 * (yyt * 3 + 1), SRCAND );1066 xxt, 1 + yyt + 15 * (yyt * 3 + 1), SRCAND, True); 1056 1067 if Conn and 2 <> 0 then 1057 1068 BitBltBitmapOutput(HGrTerrain.Mask, X + xxt, Y + yyt, xxt, yyt, 1058 1 + 7 * (xxt * 2 + 1) + xxt, 1 + yyt * 2 + 15 * (yyt * 3 + 1), SRCAND );1069 1 + 7 * (xxt * 2 + 1) + xxt, 1 + yyt * 2 + 15 * (yyt * 3 + 1), SRCAND, True); 1059 1070 if Conn and 4 <> 0 then 1060 1071 BitBltBitmapOutput(HGrTerrain.Mask, X, Y + yyt, xxt, yyt, 1 + 7 * (xxt * 2 + 1), 1061 1 + yyt * 2 + 15 * (yyt * 3 + 1), SRCAND );1072 1 + yyt * 2 + 15 * (yyt * 3 + 1), SRCAND, True); 1062 1073 if Conn and 8 <> 0 then 1063 1074 BitBltBitmapOutput(HGrTerrain.Mask, X, Y, xxt, yyt, 1 + 7 * (xxt * 2 + 1), 1064 1 + yyt + 15 * (yyt * 3 + 1), SRCAND );1075 1 + yyt + 15 * (yyt * 3 + 1), SRCAND, True); 1065 1076 end; 1066 1077 … … 1068 1079 var 1069 1080 Dir, Conn, RRConn, yGr, Tile, yLoc: Integer; 1081 const 1082 Precise = True; 1070 1083 begin 1071 1084 if (Loc < 0) or (Loc >= G.lx * G.ly) or (Y <= -yyt * 2) or … … 1086 1099 then 1087 1100 Conn := Conn and not 9; // no connection to north 1088 TerrainSprite(X, Y, yGr + Conn mod 8 + (Conn div 8) * TerrainIconCols );1101 TerrainSprite(X, Y, yGr + Conn mod 8 + (Conn div 8) * TerrainIconCols, False, Precise); 1089 1102 end 1090 1103 else if Tile and fTerrain in [fHills, fMountains, fForest] then … … 1092 1105 yGr := 3 + 2 * (Tile and fTerrain - fForest); 1093 1106 Conn := Connection4(Loc, fTerrain, Tile and fTerrain); 1094 TerrainSprite(X, Y, Conn mod 8 + (yGr + Conn div 8) * TerrainIconCols );1107 TerrainSprite(X, Y, Conn mod 8 + (yGr + Conn div 8) * TerrainIconCols, False, Precise); 1095 1108 end 1096 1109 else if Tile and fDeadLands <> 0 then 1097 TerrainSprite(X, Y, spRow2 );1110 TerrainSprite(X, Y, spRow2, False, Precise); 1098 1111 1099 1112 if ShowObjects then 1100 1113 begin 1101 1114 if Tile and fTerImp = tiFarm then 1102 TerrainSprite(X, Y, spFarmLand )1115 TerrainSprite(X, Y, spFarmLand, False, Precise) 1103 1116 else if Tile and fTerImp = tiIrrigation then 1104 TerrainSprite(X, Y, spIrrigation );1117 TerrainSprite(X, Y, spIrrigation, False, Precise); 1105 1118 end; 1106 1119 if Tile and fRiver <> 0 then … … 1108 1121 Conn := Connection4(Loc, fRiver, fRiver) or 1109 1122 Connection4(Loc, fTerrain, fShore) or Connection4(Loc, fTerrain, fUNKNOWN); 1110 TerrainSprite(X, Y, spRiver + Conn mod 8 + (Conn div 8) * TerrainIconCols );1123 TerrainSprite(X, Y, spRiver + Conn mod 8 + (Conn div 8) * TerrainIconCols, False, Precise); 1111 1124 end; 1112 1125 … … 1116 1129 for Dir := 0 to 3 do 1117 1130 if Conn and (1 shl Dir) <> 0 then { river mouths } 1118 TerrainSprite(X, Y, spRiverMouths + Dir );1131 TerrainSprite(X, Y, spRiverMouths + Dir, False, Precise); 1119 1132 if ShowObjects then 1120 1133 begin … … 1122 1135 for Dir := 0 to 7 do 1123 1136 if Conn and (1 shl Dir) <> 0 then { canal mouths } 1124 TerrainSprite(X, Y, spCanalMouths + 1 + Dir );1137 TerrainSprite(X, Y, spCanalMouths + 1 + Dir, False, Precise); 1125 1138 end; 1126 1139 end; … … 1134 1147 if Conn = 0 then begin 1135 1148 if Tile and fCanal <> 0 then 1136 TerrainSprite(X, Y, spCanal );1149 TerrainSprite(X, Y, spCanal, False, Precise); 1137 1150 end 1138 1151 else 1139 1152 for Dir := 0 to 7 do 1140 1153 if (1 shl Dir) and Conn <> 0 then 1141 TerrainSprite(X, Y, spCanal + 1 + Dir );1154 TerrainSprite(X, Y, spCanal + 1 + Dir, False, Precise); 1142 1155 end; 1143 1156 … … 1151 1164 Conn := Connection8(Loc, fRoad or fRR or fCity) and not RRConn; 1152 1165 if (Conn = 0) and (Tile and (fRR or fCity) = 0) then 1153 TerrainSprite(X, Y, spRoad )1166 TerrainSprite(X, Y, spRoad, False, Precise) 1154 1167 else if Conn > 0 then 1155 1168 for Dir := 0 to 7 do 1156 1169 if (1 shl Dir) and Conn <> 0 then 1157 TerrainSprite(X, Y, spRoad + 1 + Dir );1170 TerrainSprite(X, Y, spRoad + 1 + Dir, False, Precise); 1158 1171 end; 1159 1172 1160 1173 // Paint railroad connections 1161 1174 if (Tile and fRR <> 0) and (RRConn = 0) then 1162 TerrainSprite(X, Y, spRailRoad )1175 TerrainSprite(X, Y, spRailRoad, False, Precise) 1163 1176 else if RRConn > 0 then begin 1164 1177 for Dir := 0 to 7 do 1165 1178 if (1 shl Dir) and RRConn <> 0 then 1166 TerrainSprite(X, Y, spRailRoad + 1 + Dir );1179 TerrainSprite(X, Y, spRailRoad + 1 + Dir, False, Precise); 1167 1180 end; 1168 1181 end; 1182 end; 1183 1184 procedure TIsoMap.PaintTileObjects(nx, ny, X, Y, Loc, CityLoc, CityOwner: Integer; 1185 UseBlink: Boolean); 1186 var 1187 dx, dy: Integer; 1188 begin 1189 for dy := -2 to ny + 1 do 1190 for dx := -2 to nx + 1 do 1191 if (dx + dy) and 1 = 0 then 1192 PaintTileObjects1(X + xxt * dx, Y + yyt + yyt * dy, dLoc(Loc, dx, dy), 1193 CityLoc, CityOwner, UseBlink); 1194 1195 for dy := -2 to ny + 1 do 1196 for dx := -2 to nx + 1 do 1197 if (dx + dy) and 1 = 0 then 1198 PaintTileObjects2(X + xxt * dx, Y + yyt + yyt * dy, dLoc(Loc, dx, dy), 1199 CityLoc, CityOwner, UseBlink); 1200 1201 for dy := -2 to ny + 1 do 1202 for dx := -2 to nx + 1 do 1203 if (dx + dy) and 1 = 0 then 1204 PaintTileObjects3(X + xxt * dx, Y + yyt + yyt * dy, dLoc(Loc, dx, dy), 1205 CityLoc, CityOwner, UseBlink); 1206 end; 1207 1208 procedure TIsoMap.PaintTileObjectsRadius(nx, ny, X, Y, Loc, CityLoc, 1209 CityOwner: Integer; UseBlink: Boolean; Radius: Integer; Inside: Boolean); 1210 var 1211 dx, dy: Integer; 1212 ALoc: Integer; 1213 begin 1214 for dy := -2 to ny + 1 do 1215 for dx := -2 to nx + 1 do 1216 if (dx + dy) and 1 = 0 then 1217 begin 1218 ALoc := dLoc(Loc, dx, dy); 1219 if (Inside and (Distance(ALoc, CityLoc) <= 5)) or 1220 (not Inside and (Distance(ALoc, CityLoc) > 5)) then 1221 PaintTileObjects1(X + xxt * dx, Y + yyt + yyt * dy, ALoc, CityLoc, 1222 CityOwner, UseBlink); 1223 end; 1224 1225 for dy := -2 to ny + 1 do 1226 for dx := -2 to nx + 1 do 1227 if (dx + dy) and 1 = 0 then 1228 begin 1229 ALoc := dLoc(Loc, dx, dy); 1230 if (Inside and (Distance(ALoc, CityLoc) <= 5)) or 1231 (not Inside and (Distance(ALoc, CityLoc) > 5)) then 1232 PaintTileObjects2(X + xxt * dx, Y + yyt + yyt * dy, ALoc, CityLoc, 1233 CityOwner, UseBlink); 1234 end; 1235 1236 for dy := -2 to ny + 1 do 1237 for dx := -2 to nx + 1 do 1238 if (dx + dy) and 1 = 0 then 1239 begin 1240 ALoc := dLoc(Loc, dx, dy); 1241 if (Inside and (Distance(ALoc, CityLoc) <= 5)) or 1242 (not Inside and (Distance(ALoc, CityLoc) > 5)) then 1243 PaintTileObjects3(X + xxt * dx, Y + yyt + yyt * dy, ALoc, CityLoc, 1244 CityOwner, UseBlink); 1245 end; 1169 1246 end; 1170 1247 … … 1245 1322 1246 1323 // (x,y) is top left pixel of (2*xxt,3*yyt) rectangle 1247 procedure TIsoMap.PaintTileObjects (X, Y, Loc, CityLoc, CityOwner: Integer;1324 procedure TIsoMap.PaintTileObjects1(X, Y, Loc, CityLoc, CityOwner: Integer; 1248 1325 UseBlink: Boolean); 1249 1326 var 1250 uix, cix, dy, Tile, Multi, Destination: Integer;1327 cix, dy, Tile: Integer; 1251 1328 CityInfo: TCityInfo; 1252 UnitInfo: TUnitInfo;1253 Fog: Boolean;1254 1329 SpecialRow: Integer; 1255 1330 SpecialCol: Integer; … … 1259 1334 else 1260 1335 Tile := MyMap[Loc]; 1336 1261 1337 if ShowObjects and not (moEditMode in MapOptions) and 1262 1338 (Tile and fCity <> 0) then … … 1313 1389 if (Tile and fDeadLands) <> 0 then 1314 1390 TerrainSprite(X, Y, spMinerals + (Tile shr 25 and 3) * TerrainIconCols); 1391 end; 1392 1393 procedure TIsoMap.PaintTileObjects2(X, Y, Loc, CityLoc, CityOwner: Integer; 1394 UseBlink: Boolean); 1395 var 1396 Fog: Boolean; 1397 Tile: Integer; 1398 begin 1399 if (Loc < 0) or (Loc >= G.lx * G.ly) then 1400 Tile := PoleTile(Loc) 1401 else 1402 Tile := MyMap[Loc]; 1315 1403 1316 1404 if moEditMode in MapOptions then 1317 Fog := (Loc < 0) or (Loc >= G.lx * G.ly) 1318 // else if CityLoc >= 0 then 1319 // Fog:= (Loc < 0) or (Loc >= G.lx * G.ly) or (Distance(Loc, CityLoc) > 5) 1320 else if ShowGrWall then 1321 Fog := Tile and fGrWall = 0 1405 Fog := (Loc < 0) or (Loc >= G.lx * G.ly) 1406 // else if CityLoc >= 0 then 1407 // Fog:= (Loc < 0) or (Loc >= G.lx * G.ly) or (Distance(Loc, CityLoc) > 5) 1408 else if ShowGrWall then 1409 Fog := Tile and fGrWall = 0 1410 else 1411 Fog := FogOfWar and (Tile and fObserved = 0); 1412 if Fog and ShowObjects then 1413 if Loc < -G.lx then 1414 Sprite(HGrTerrain, X, Y + yyt, xxt * 2, yyt, 1 + 6 * (xxt * 2 + 1), 1415 1 + yyt * 2 + 15 * (yyt * 3 + 1)) 1416 else if Loc >= G.lx * (G.ly + 1) then 1417 Sprite(HGrTerrain, X, Y, xxt * 2, yyt, 1 + 6 * (xxt * 2 + 1), 1418 1 + yyt + 15 * (yyt * 3 + 1)) 1419 else begin 1420 TerrainSprite(X, Y, spGrid, xxt <> 33, True); 1421 end; 1422 end; 1423 1424 procedure TIsoMap.PaintTileObjects3(X, Y, Loc, CityLoc, CityOwner: Integer; 1425 UseBlink: Boolean); 1426 var 1427 Tile: Integer; 1428 cix, uix, Multi, Destination: Integer; 1429 UnitInfo: TUnitInfo; 1430 CityInfo: TCityInfo; 1431 begin 1432 if (Loc < 0) or (Loc >= G.lx * G.ly) then 1433 Tile := PoleTile(Loc) 1322 1434 else 1323 Fog := FogOfWar and (Tile and fObserved = 0); 1324 if Fog and ShowObjects then 1325 if Loc < -G.lx then 1326 Sprite(HGrTerrain, X, Y + yyt, xxt * 2, yyt, 1 + 6 * (xxt * 2 + 1), 1327 1 + yyt * 2 + 15 * (yyt * 3 + 1)) 1328 else if Loc >= G.lx * (G.ly + 1) then 1329 Sprite(HGrTerrain, X, Y, xxt * 2, yyt, 1 + 6 * (xxt * 2 + 1), 1330 1 + yyt + 15 * (yyt * 3 + 1)) 1331 else 1332 TerrainSprite(X, Y, spGrid, xxt <> 33); 1435 Tile := MyMap[Loc]; 1436 1437 if ShowObjects and not (moEditMode in MapOptions) and 1438 (Tile and fCity <> 0) then 1439 GetCityInfo(Loc, cix, CityInfo); 1333 1440 1334 1441 if FogOfWar and (Tile and fObserved = 0) then 1335 1442 PaintBorder(X, Y, Loc, Tile); 1336 1443 1337 {$IFNDEF SCR}1444 {$IFNDEF SCR} 1338 1445 // paint goto destination mark 1339 1446 if DestinationMarkON and (CityOwner < 0) and (UnFocus >= 0) and … … 1345 1452 TerrainSprite(X, Y, spBlink1) 1346 1453 else 1347 TerrainSprite(X, Y, spBlink2) 1348 end; 1349 {$ENDIF}1454 TerrainSprite(X, Y, spBlink2); 1455 end; 1456 {$ENDIF} 1350 1457 if moEditMode in MapOptions then 1351 1458 begin … … 1365 1472 if Tile and fCity <> 0 then 1366 1473 PaintCity(X + xxt, Y + yyt, CityInfo, CityOwner < 0); 1367 1368 1474 if (Tile and fUnit <> 0) and (Loc <> AttLoc) and 1369 1475 ((Loc <> DefLoc) or (DefHealth <> 0)) 1370 {$IFNDEF SCR} and ((CityOwner >= 0) or (UnFocus < 0) or not UseBlink or1476 {$IFNDEF SCR} and ((CityOwner >= 0) or (UnFocus < 0) or not UseBlink or 1371 1477 BlinkOn or (Loc <> MyUn[UnFocus].Loc)){$ENDIF} 1372 1478 and ((Tile and fCity <> fCity) or (Loc = DefLoc) 1373 {$IFNDEF SCR} or (not UseBlink or BlinkOn) and (UnFocus >= 0) and1479 {$IFNDEF SCR} or (not UseBlink or BlinkOn) and (UnFocus >= 0) and 1374 1480 (Loc = MyUn[UnFocus].Loc){$ENDIF}) then 1375 1481 begin { unit } … … 1380 1486 not ((CityOwner = Me) and (MyRO.Treaty[UnitInfo.Owner] = trAlliance)) 1381 1487 then 1382 {$IFNDEF SCR} if (UnFocus >= 0) and (Loc = MyUn[UnFocus].Loc) then { active unit } 1488 {$IFNDEF SCR} 1489 if (UnFocus >= 0) and (Loc = MyUn[UnFocus].Loc) then { active unit } 1383 1490 begin 1384 1491 Multi := UnitInfo.Flags and unMulti; … … 1408 1515 end; 1409 1516 1410 if ShowObjects and (Tile and fTerImp = tiFort) and (Tile and fObserved <> 0) 1411 then 1517 if ShowObjects and (Tile and fTerImp = tiFort) and (Tile and fObserved <> 0) then 1412 1518 TerrainSprite(X, Y, spFortFront); 1413 1519 … … 1641 1747 PaintTileExtraTerrain(X + xxt * dx, Y + yyt + yyt * dy, dLoc(Loc, dx, dy)); 1642 1748 1749 UnshareBitmap(FOutput); 1750 1643 1751 if CityOwner >= 0 then begin 1644 1752 // Paint objects outside radius 1645 for dy := -2 to ny + 1 do 1646 for dx := -2 to nx + 1 do 1647 if (dx + dy) and 1 = 0 then 1648 begin 1649 ALoc := dLoc(Loc, dx, dy); 1650 if Distance(ALoc, CityLoc) > 5 then 1651 PaintTileObjects(X + xxt * dx, Y + yyt + yyt * dy, ALoc, CityLoc, 1652 CityOwner, UseBlink); 1653 end; 1753 PaintTileObjectsRadius(nx, ny, X, Y, Loc, CityLoc, CityOwner, UseBlink, 5, False); 1654 1754 1655 1755 dx := ((CityLoc mod G.lx * 2 + CityLoc div G.lx and 1) - … … 1663 1763 1664 1764 // Paint objects inside radius 1665 for dy := -2 to ny + 1 do 1666 for dx := -2 to nx + 1 do 1667 if (dx + dy) and 1 = 0 then 1668 begin 1669 ALoc := dLoc(Loc, dx, dy); 1670 if Distance(ALoc, CityLoc) <= 5 then 1671 PaintTileObjects(X + xxt * dx, Y + yyt + yyt * dy, ALoc, CityLoc, 1672 CityOwner, UseBlink); 1673 end; 1765 PaintTileObjectsRadius(nx, ny, X, Y, Loc, CityLoc, CityOwner, UseBlink, 5, True); 1674 1766 end else begin 1675 1767 if ShowLoc or (moEditMode in MapOptions) or (moGrid in MapOptions) then 1676 1768 PaintGrid(X, Y, nx, ny); 1677 1769 1678 for dy := -2 to ny + 1 do 1679 for dx := -2 to nx + 1 do 1680 if (dx + dy) and 1 = 0 then 1681 PaintTileObjects(X + xxt * dx, Y + yyt + yyt * dy, dLoc(Loc, dx, dy), 1682 CityLoc, CityOwner, UseBlink); 1770 PaintTileObjects(nx, ny, X, Y, Loc, CityLoc, CityOwner, UseBlink); 1683 1771 end; 1684 1772 end; -
trunk/LocalPlayer/Term.pas
r550 r552 4601 4601 4602 4602 NoMap.BitBltBitmapOutput(Panel, -xMap - MapOffset, -yMap + MapHeight - Overlap, xMidPanel, 4603 Overlap, 0, 0 , SRCCOPY);4603 Overlap, 0, 0); 4604 4604 NoMap.BitBltBitmapOutput(Panel, -xMap - MapOffset + xRightPanel, 4605 4605 -yMap + MapHeight - Overlap, Panel.Width - xRightPanel, Overlap, 4606 xRightPanel, 0 , SRCCOPY);4606 xRightPanel, 0); 4607 4607 if yMap < 0 then 4608 4608 begin -
trunk/Packages/DpiControls/Dpi.Common.pas
r547 r552 15 15 XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; 16 16 function BitBltBitmap(Dest: TBitmap; X, Y, Width, Height: Integer; Src: TBitmap; 17 XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY ): Boolean;17 XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY; Precise: Boolean = False): Boolean; 18 18 function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; 19 19 {$IFDEF WINDOWS} … … 56 56 57 57 function BitBltBitmap(Dest: TBitmap; X, Y, Width, Height: Integer; 58 Src: TBitmap; XSrc, YSrc: Integer; Rop: DWORD): Boolean; 58 Src: TBitmap; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY; 59 Precise: Boolean = False): Boolean; 59 60 var 60 61 SrcPixel: TPixelPointer; … … 65 66 NewX, NewY: Integer; 66 67 begin 67 if Frac(ScreenInfo.Dpi / 96) = 0 then 68 begin 68 if not Precise or (Frac(ScreenInfo.Dpi / 96) = 0) then begin 69 69 // Use faster non-fractional scaling 70 70 Result := BitBlt(Dest.Canvas.Handle, X, Y, Width, Height, Src.Canvas.Handle, … … 238 238 function ScaleToNative(Value: Integer): Integer; 239 239 begin 240 // Round function is faster than Ceil and Floor 241 Result := Round(Value * ScreenInfo.ToNative); 240 Result := ScreenInfo.Lookup[Value]; 241 // Round and Trunc are fast. Ceil and Floor slow. 242 // Without lookup table we would use: 243 // Result := Ceil(Value * ScreenInfo.ToNative); 242 244 end; 243 245 … … 249 251 function ScaleFromNative(Value: Integer): Integer; 250 252 begin 251 Result := Floor(Value * ScreenInfo.FromNative);253 Result := Trunc(Value * ScreenInfo.FromNative); 252 254 end; 253 255 -
trunk/Packages/DpiControls/Dpi.Graphics.pas
r548 r552 4 4 5 5 uses 6 Classes, SysUtils, Graphics, LCLType, GraphType, Types;6 Classes, SysUtils, Math, Graphics, LCLType, GraphType, Types; 7 7 8 8 const … … 347 347 ToNative: Double; 348 348 FromNative: Double; 349 Lookup: array[-10000..10000] of Integer; // Should be sufficient for 8K screens 349 350 property Dpi: Integer read FDpi write SetDpi; 350 351 end; … … 1322 1323 1323 1324 procedure TScreenInfo.SetDpi(AValue: Integer); 1325 var 1326 I: Integer; 1324 1327 begin 1325 1328 if FDpi = AValue then Exit; … … 1327 1330 ToNative := ScreenInfo.Dpi / 96; 1328 1331 FromNative := 96 / ScreenInfo.Dpi; 1332 for I := -10000 to 10000 do 1333 Lookup[I] := Ceil(I * ToNative); 1329 1334 end; 1330 1335
Note:
See TracChangeset
for help on using the changeset viewer.