Changeset 552


Ignore:
Timestamp:
Apr 24, 2024, 10:28:34 AM (7 months ago)
Author:
chronos
Message:
  • Modified: Optimized high DPI scaling. Use lookup table for scaled values. Draw only terrain textures with precise scaling.
Location:
trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/LocalPlayer/IsoEngine.pas

    r551 r552  
    7676    procedure PaintShore(X, Y, Loc: Integer);
    7777    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;
    7987      UseBlink: Boolean);
    8088    procedure PaintGrid(X, Y, nx, ny: Integer);
    … …  
    8290    procedure TextOut(X, Y, Color: Integer; const S: string);
    8391    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);
    8594    procedure ApplyTileSize(ATileSize: TTileSize);
    8695  public
    … …  
    102111    procedure PaintCity(X, Y: Integer; const CityInfo: TCityInfo;
    103112      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);
    106115    procedure AttackBegin(const ShowMove: TShowMove);
    107116    procedure AttackEffect(const ShowMove: TShowMove);
    … …  
    366375  BitBltBitmap(DitherMask, 0, 0, xxt * 2, yyt * 2,
    367376    HGrTerrain.Mask, 1 + 7 * (xxt * 2 + 1),
    368     1 + yyt + 15 * (yyt * 3 + 1), SRCAND);
     377    1 + yyt + 15 * (yyt * 3 + 1), SRCAND, True);
    369378
    370379  for X := -1 to 6 do begin
    … …  
    382391    for Y := -1 to 6 do
    383392      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);
    385394    for Y := -2 to 6 do
    386395      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);
    388397    for Y := -2 to 6 do
    389398      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);
    391400    for Y := -2 to 6 do
    392401      BitBltBitmap(LandPatch, (X + 2) * (xxt * 2), (Y + 2) * yyt, xxt,
    393         yyt, DitherMask, xxt, yyt, SRCAND);
     402        yyt, DitherMask, xxt, yyt, SRCAND, True);
    394403    for Y := -2 to 6 do
    395404      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);
    397406  end;
    398407
    … …  
    411420    for X := -2 to 6 do
    412421      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);
    414423    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);
    416425    for X := 0 to 7 do
    417426      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);
    419428    for X := -2 to 6 do
    420429      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);
    422431  end;
    423432
    … …  
    430439      if (X >= 1) = (Y >= 2) then
    431440        BitBltBitmap(OceanPatch, X * (xxt * 2), Y * yyt, xxt * 2, yyt,
    432           HGrTerrain.Data, xSrc, ySrc);
     441          HGrTerrain.Data, xSrc, ySrc, SRCCOPY, True);
    433442      if (X >= 1) and ((Y < 2) or (X >= 2)) then
    434443      begin
    435444        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);
    437446        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);
    439448      end;
    440449      BitBltBitmap(OceanPatch, X * (xxt * 2), Y * yyt, xxt, yyt,
    441         DitherMask, xxt, yyt, SRCAND);
     450        DitherMask, xxt, yyt, SRCAND, True);
    442451      BitBltBitmap(OceanPatch, X * (xxt * 2) + xxt, Y * yyt, xxt, yyt,
    443         DitherMask, 0, yyt, SRCAND);
     452        DitherMask, 0, yyt, SRCAND, True);
    444453    end;
    445454  end;
    … …  
    453462      if (X < 1) or (Y >= 2) then
    454463        BitBltBitmap(OceanMore, X * (xxt * 2), Y * yyt, xxt * 2, yyt,
    455           HGrTerrain.Data, xSrc, ySrc);
     464          HGrTerrain.Data, xSrc, ySrc, SRCCOPY, True);
    456465      if (X = 1) and (Y < 2) or (X >= 2) and (Y >= 1) then
    457466      begin
    458467        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);
    460469        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);
    462471      end;
    463472      BitBltBitmap(OceanMore, X * (xxt * 2), Y * yyt, xxt * 2, yyt,
    464         DitherMask, 0, 0, SRCAND);
     473        DitherMask, 0, 0, SRCAND, True);
    465474    end;
    466475  end;
    467476
    468477  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 }
    470479  BitBltBitmap(DitherMask, 0, 0, xxt * 2, yyt * 2,
    471     HGrTerrain.Mask, 1, 1 + yyt, SRCPAINT);
     480    HGrTerrain.Mask, 1, 1 + yyt, SRCPAINT, True);
    472481
    473482  for X := -1 to 6 do
    474483    for Y := -2 to 6 do
    475484      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);
    477486
    478487  for Y := -1 to 6 do
    479488    for X := -2 to 7 do
    480489      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);
    482491
    483492  BitBltBitmap(LandPatch, 0, 0, (xxt * 2) * 9, yyt * 9,
    484     LandMore, 0, 0, SRCPAINT);
     493    LandMore, 0, 0, SRCPAINT, True);
    485494
    486495  for X := 0 to 3 do
    487496    for Y := 0 to 3 do
    488497      BitBltBitmap(OceanPatch, X * (xxt * 2), Y * yyt, xxt * 2, yyt,
    489         DitherMask, 0, 0, SRCAND);
     498        DitherMask, 0, 0, SRCAND, True);
    490499
    491500  for Y := 0 to 3 do
    492501    for X := 0 to 4 do
    493502      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);
    497507
    498508  with DitherMask.Canvas do begin
    … …  
    500510    FillRect(Rect(0, 0, xxt * 2, yyt));
    501511  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);
    503514
    504515  for X := 0 to 6 do
    505516    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);
    508519
    509520  for Y := 0 to 6 do
    510521    BitBltBitmap(LandPatch, xxt * 2, (Y + 2) * yyt, xxt * 2, yyt,
    511       DitherMask, 0, 0, SRCAND);
     522      DitherMask, 0, 0, SRCAND, True);
    512523
    513524  FreeAndNil(LandMore);
    … …  
    592603end;
    593604
    594 procedure TIsoMap.BitBltBitmapOutput(Src: TBitmap; X, Y, Width, Height, xSrc, ySrc,
    595   Rop: Integer);
     605procedure TIsoMap.BitBltBitmapOutput(Src: TBitmap; X, Y, Width, Height, xSrc, ySrc: Integer;
     606  Rop: Integer = SRCCOPY; Precise: Boolean = False);
    596607begin
    597608  if X < FLeft then
    … …  
    615626
    616627  {$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);
    618629  {$ELSE}
    619630  BitBltCanvas(FOutput.Canvas, X, Y, Width, Height, Src.Canvas, xSrc, ySrc, Rop);
    … …  
    628639
    629640procedure TIsoMap.TerrainSprite(xDst, yDst, grix: Integer;
    630   PureBlack: Boolean = False);
     641  PureBlack: Boolean = False; Precise: Boolean = False);
    631642var
    632643  Width: Integer;
    … …  
    658669    Exit;
    659670
    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);
    661672  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);
    663674end;
    664675
    … …  
    963974                end;
    964975              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);
    966977            end;
    967978          end else begin
    … …  
    10091020              BitBltBitmapOutput(HGrTerrain.Data, X + dx * xxt, Y + dy * yyt, xxt,
    10101021                yyt, 1 + 6 * (xxt * 2 + 1) + (dx + dy + 1) and 1 * xxt, 1 + yyt,
    1011                 SRCCOPY) // arctic <-> ocean
     1022                SRCCOPY, True) // arctic <-> ocean
    10121023            else if bix = -1 then
    10131024              BitBltBitmapOutput(HGrTerrain.Data, X + dx * xxt, Y + dy * yyt, xxt,
    10141025                yyt, 1 + 6 * (xxt * 2 + 1) + xxt - (dx + dy + 1) and 1 * xxt,
    1015                 1 + yyt * 2, SRCCOPY) // arctic <-> ocean
     1026                1 + yyt * 2, SRCCOPY, True) // arctic <-> ocean
    10161027            else
    10171028              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);
    10191030          end;
    10201031      end;
    … …  
    10401051  BitBltBitmapOutput(HGrTerrain.Data, X + xxt div 2, Y, xxt, yyt,
    10411052    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);
    10431054  BitBltBitmapOutput(HGrTerrain.Data, X + xxt, Y + yyt div 2, xxt, yyt,
    10441055    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);
    10461057  BitBltBitmapOutput(HGrTerrain.Data, X + xxt div 2, Y + yyt, xxt, yyt,
    10471058    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);
    10491060  BitBltBitmapOutput(HGrTerrain.Data, X, Y + yyt div 2, xxt, yyt,
    10501061    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);
    10521063  Conn := Connection4(Loc, fTerrain, fUNKNOWN); { dither to black }
    10531064  if Conn and 1 <> 0 then
    10541065    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);
    10561067  if Conn and 2 <> 0 then
    10571068    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);
    10591070  if Conn and 4 <> 0 then
    10601071    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);
    10621073  if Conn and 8 <> 0 then
    10631074    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);
    10651076end;
    10661077
    … …  
    10681079var
    10691080  Dir, Conn, RRConn, yGr, Tile, yLoc: Integer;
     1081const
     1082  Precise = True;
    10701083begin
    10711084  if (Loc < 0) or (Loc >= G.lx * G.ly) or (Y <= -yyt * 2) or
    … …  
    10861099    then
    10871100      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);
    10891102  end
    10901103  else if Tile and fTerrain in [fHills, fMountains, fForest] then
    … …  
    10921105    yGr := 3 + 2 * (Tile and fTerrain - fForest);
    10931106    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);
    10951108  end
    10961109  else if Tile and fDeadLands <> 0 then
    1097     TerrainSprite(X, Y, spRow2);
     1110    TerrainSprite(X, Y, spRow2, False, Precise);
    10981111
    10991112  if ShowObjects then
    11001113  begin
    11011114    if Tile and fTerImp = tiFarm then
    1102       TerrainSprite(X, Y, spFarmLand)
     1115      TerrainSprite(X, Y, spFarmLand, False, Precise)
    11031116    else if Tile and fTerImp = tiIrrigation then
    1104       TerrainSprite(X, Y, spIrrigation);
     1117      TerrainSprite(X, Y, spIrrigation, False, Precise);
    11051118  end;
    11061119  if Tile and fRiver <> 0 then
    … …  
    11081121    Conn := Connection4(Loc, fRiver, fRiver) or
    11091122      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);
    11111124  end;
    11121125
    … …  
    11161129    for Dir := 0 to 3 do
    11171130      if Conn and (1 shl Dir) <> 0 then { river mouths }
    1118         TerrainSprite(X, Y, spRiverMouths + Dir);
     1131        TerrainSprite(X, Y, spRiverMouths + Dir, False, Precise);
    11191132    if ShowObjects then
    11201133    begin
    … …  
    11221135      for Dir := 0 to 7 do
    11231136        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);
    11251138    end;
    11261139  end;
    … …  
    11341147      if Conn = 0 then begin
    11351148        if Tile and fCanal <> 0 then
    1136           TerrainSprite(X, Y, spCanal);
     1149          TerrainSprite(X, Y, spCanal, False, Precise);
    11371150      end
    11381151      else
    11391152        for Dir := 0 to 7 do
    11401153          if (1 shl Dir) and Conn <> 0 then
    1141             TerrainSprite(X, Y, spCanal + 1 + Dir);
     1154            TerrainSprite(X, Y, spCanal + 1 + Dir, False, Precise);
    11421155    end;
    11431156
    … …  
    11511164      Conn := Connection8(Loc, fRoad or fRR or fCity) and not RRConn;
    11521165      if (Conn = 0) and (Tile and (fRR or fCity) = 0) then
    1153         TerrainSprite(X, Y, spRoad)
     1166        TerrainSprite(X, Y, spRoad, False, Precise)
    11541167      else if Conn > 0 then
    11551168        for Dir := 0 to 7 do
    11561169          if (1 shl Dir) and Conn <> 0 then
    1157             TerrainSprite(X, Y, spRoad + 1 + Dir);
     1170            TerrainSprite(X, Y, spRoad + 1 + Dir, False, Precise);
    11581171    end;
    11591172
    11601173    // Paint railroad connections
    11611174    if (Tile and fRR <> 0) and (RRConn = 0) then
    1162       TerrainSprite(X, Y, spRailRoad)
     1175      TerrainSprite(X, Y, spRailRoad, False, Precise)
    11631176    else if RRConn > 0 then begin
    11641177      for Dir := 0 to 7 do
    11651178        if (1 shl Dir) and RRConn <> 0 then
    1166           TerrainSprite(X, Y, spRailRoad + 1 + Dir);
     1179          TerrainSprite(X, Y, spRailRoad + 1 + Dir, False, Precise);
    11671180    end;
    11681181  end;
     1182end;
     1183
     1184procedure TIsoMap.PaintTileObjects(nx, ny, X, Y, Loc, CityLoc, CityOwner: Integer;
     1185  UseBlink: Boolean);
     1186var
     1187  dx, dy: Integer;
     1188begin
     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);
     1206end;
     1207
     1208procedure TIsoMap.PaintTileObjectsRadius(nx, ny, X, Y, Loc, CityLoc,
     1209  CityOwner: Integer; UseBlink: Boolean; Radius: Integer; Inside: Boolean);
     1210var
     1211  dx, dy: Integer;
     1212  ALoc: Integer;
     1213begin
     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;
    11691246end;
    11701247
    … …  
    12451322
    12461323// (x,y) is top left pixel of (2*xxt,3*yyt) rectangle
    1247 procedure TIsoMap.PaintTileObjects(X, Y, Loc, CityLoc, CityOwner: Integer;
     1324procedure TIsoMap.PaintTileObjects1(X, Y, Loc, CityLoc, CityOwner: Integer;
    12481325  UseBlink: Boolean);
    12491326var
    1250   uix, cix, dy, Tile, Multi, Destination: Integer;
     1327  cix, dy, Tile: Integer;
    12511328  CityInfo: TCityInfo;
    1252   UnitInfo: TUnitInfo;
    1253   Fog: Boolean;
    12541329  SpecialRow: Integer;
    12551330  SpecialCol: Integer;
    … …  
    12591334  else
    12601335    Tile := MyMap[Loc];
     1336
    12611337  if ShowObjects and not (moEditMode in MapOptions) and
    12621338    (Tile and fCity <> 0) then
    … …  
    13131389  if (Tile and fDeadLands) <> 0 then
    13141390    TerrainSprite(X, Y, spMinerals + (Tile shr 25 and 3) * TerrainIconCols);
     1391end;
     1392
     1393procedure TIsoMap.PaintTileObjects2(X, Y, Loc, CityLoc, CityOwner: Integer;
     1394  UseBlink: Boolean);
     1395var
     1396  Fog: Boolean;
     1397  Tile: Integer;
     1398begin
     1399  if (Loc < 0) or (Loc >= G.lx * G.ly) then
     1400    Tile := PoleTile(Loc)
     1401  else
     1402    Tile := MyMap[Loc];
    13151403
    13161404  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;
     1422end;
     1423
     1424procedure TIsoMap.PaintTileObjects3(X, Y, Loc, CityLoc, CityOwner: Integer;
     1425  UseBlink: Boolean);
     1426var
     1427  Tile: Integer;
     1428  cix, uix, Multi, Destination: Integer;
     1429  UnitInfo: TUnitInfo;
     1430  CityInfo: TCityInfo;
     1431begin
     1432  if (Loc < 0) or (Loc >= G.lx * G.ly) then
     1433    Tile := PoleTile(Loc)
    13221434  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);
    13331440
    13341441  if FogOfWar and (Tile and fObserved = 0) then
    13351442    PaintBorder(X, Y, Loc, Tile);
    13361443
    1337 {$IFNDEF SCR}
     1444  {$IFNDEF SCR}
    13381445  // paint goto destination mark
    13391446  if DestinationMarkON and (CityOwner < 0) and (UnFocus >= 0) and
    … …  
    13451452        TerrainSprite(X, Y, spBlink1)
    13461453      else
    1347         TerrainSprite(X, Y, spBlink2)
    1348   end;
    1349 {$ENDIF}
     1454        TerrainSprite(X, Y, spBlink2);
     1455  end;
     1456  {$ENDIF}
    13501457  if moEditMode in MapOptions then
    13511458  begin
    … …  
    13651472    if Tile and fCity <> 0 then
    13661473      PaintCity(X + xxt, Y + yyt, CityInfo, CityOwner < 0);
    1367 
    13681474    if (Tile and fUnit <> 0) and (Loc <> AttLoc) and
    13691475      ((Loc <> DefLoc) or (DefHealth <> 0))
    1370 {$IFNDEF SCR} and ((CityOwner >= 0) or (UnFocus < 0) or not UseBlink or
     1476 {$IFNDEF SCR} and ((CityOwner >= 0) or (UnFocus < 0) or not UseBlink or
    13711477      BlinkOn or (Loc <> MyUn[UnFocus].Loc)){$ENDIF}
    13721478      and ((Tile and fCity <> fCity) or (Loc = DefLoc)
    1373 {$IFNDEF SCR} or (not UseBlink or BlinkOn) and (UnFocus >= 0) and
     1479 {$IFNDEF SCR} or (not UseBlink or BlinkOn) and (UnFocus >= 0) and
    13741480      (Loc = MyUn[UnFocus].Loc){$ENDIF}) then
    13751481    begin { unit }
    … …  
    13801486        not ((CityOwner = Me) and (MyRO.Treaty[UnitInfo.Owner] = trAlliance))
    13811487      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 }
    13831490        begin
    13841491          Multi := UnitInfo.Flags and unMulti;
    … …  
    14081515  end;
    14091516
    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
    14121518    TerrainSprite(X, Y, spFortFront);
    14131519
    … …  
    16411747        PaintTileExtraTerrain(X + xxt * dx, Y + yyt + yyt * dy, dLoc(Loc, dx, dy));
    16421748
     1749  UnshareBitmap(FOutput);
     1750
    16431751  if CityOwner >= 0 then begin
    16441752    // 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);
    16541754
    16551755    dx := ((CityLoc mod G.lx * 2 + CityLoc div G.lx and 1) -
    … …  
    16631763
    16641764    // 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);
    16741766  end else begin
    16751767    if ShowLoc or (moEditMode in MapOptions) or (moGrid in MapOptions) then
    16761768      PaintGrid(X, Y, nx, ny);
    16771769
    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);
    16831771  end;
    16841772end;

  • trunk/LocalPlayer/Term.pas

    r550 r552  
    46014601
    46024602  NoMap.BitBltBitmapOutput(Panel, -xMap - MapOffset, -yMap + MapHeight - Overlap, xMidPanel,
    4603     Overlap, 0, 0, SRCCOPY);
     4603    Overlap, 0, 0);
    46044604  NoMap.BitBltBitmapOutput(Panel, -xMap - MapOffset + xRightPanel,
    46054605    -yMap + MapHeight - Overlap, Panel.Width - xRightPanel, Overlap,
    4606     xRightPanel, 0, SRCCOPY);
     4606    xRightPanel, 0);
    46074607  if yMap < 0 then
    46084608  begin

  • trunk/Packages/DpiControls/Dpi.Common.pas

    r547 r552  
    1515  XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
    1616function 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;
    1818function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
    1919{$IFDEF WINDOWS}
    … …  
    5656
    5757function 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;
    5960var
    6061  SrcPixel: TPixelPointer;
    … …  
    6566  NewX, NewY: Integer;
    6667begin
    67   if Frac(ScreenInfo.Dpi / 96) = 0 then
    68   begin
     68  if not Precise or (Frac(ScreenInfo.Dpi / 96) = 0) then begin
    6969    // Use faster non-fractional scaling
    7070    Result := BitBlt(Dest.Canvas.Handle, X, Y, Width, Height, Src.Canvas.Handle,
    … …  
    238238function ScaleToNative(Value: Integer): Integer;
    239239begin
    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);
    242244end;
    243245
    … …  
    249251function ScaleFromNative(Value: Integer): Integer;
    250252begin
    251   Result := Floor(Value * ScreenInfo.FromNative);
     253  Result := Trunc(Value * ScreenInfo.FromNative);
    252254end;
    253255

  • trunk/Packages/DpiControls/Dpi.Graphics.pas

    r548 r552  
    44
    55uses
    6   Classes, SysUtils, Graphics, LCLType, GraphType, Types;
     6  Classes, SysUtils, Math, Graphics, LCLType, GraphType, Types;
    77
    88const
    … …  
    347347    ToNative: Double;
    348348    FromNative: Double;
     349    Lookup: array[-10000..10000] of Integer; // Should be sufficient for 8K screens
    349350    property Dpi: Integer read FDpi write SetDpi;
    350351  end;
    … …  
    13221323
    13231324procedure TScreenInfo.SetDpi(AValue: Integer);
     1325var
     1326  I: Integer;
    13241327begin
    13251328  if FDpi = AValue then Exit;
    … …  
    13271330  ToNative := ScreenInfo.Dpi / 96;
    13281331  FromNative := 96 / ScreenInfo.Dpi;
     1332  for I := -10000 to 10000 do
     1333    Lookup[I] := Ceil(I * ToNative);
    13291334end;
    13301335
Note: See TracChangeset for help on using the changeset viewer.