Changeset 538 for trunk

Timestamp:

Apr 16, 2024, 10:57:39 AM (7 months ago)

Author:

chronos

Message:

• Fixed: Map drawing in case of fractional scaling.

Location:

trunk

Files:

• LocalPlayer/IsoEngine.pas (modified) (12 diffs)
• Packages/CevoComponents/ScreenTools.pas (modified) (1 diff)
• Packages/DpiControls/Dpi.Common.pas (modified) (4 diffs)
• Packages/DpiControls/Dpi.Graphics.pas (modified) (1 diff)
• Packages/DpiControls/Dpi.PixelPointer.pas (modified) (2 diffs)
• Packages/DpiControls/NativePixelPointer.pas (modified) (3 diffs)

trunk/LocalPlayer/IsoEngine.pas

@@ -52 +52 @@
     DefHealth: Integer;
     FAdviceLoc: Integer;
-    DataCanvas: TCanvas;
-    MaskCanvas: TCanvas;
     LandPatch: TBitmap;
     OceanPatch: TBitmap;
@@ -329 +327 @@
     raise Exception.Create(FileName + ' not found.');
 
+
   FileName := Format('Cities%dx%d.png', [xxt * 2, yyt * 2]);
   IsoMapCache[ATileSize].HGrCities := LoadGraphicSet(FileName);
@@ -584 +583 @@
 begin
   FOutput.Canvas.Font.Color := Color;
-  FOutput.Canvas.TextRect(Rect(FLeft, FTop, FRight, FBottom), X, Y, S)
+  FOutput.Canvas.TextRect(Rect(FLeft, FTop, FRight, FBottom), X, Y, S);
 end;
 
@@ -593 +592 @@
   begin
     Width := Width - (FLeft - X);
-    xSrc := xSrc + (FLeft - X);
+    XSrc := XSrc + (FLeft - X);
     X := FLeft;
   end;
@@ -599 +598 @@
   begin
     Height := Height - (FTop - Y);
-    ySrc := ySrc + (FTop - Y);
+    YSrc := YSrc + (FTop - Y);
     Y := FTop;
   end;
@@ -609 +608 @@
     Exit;
 
+  {$IFDEF DPI}
   BitBltBitmap(FOutput, X, Y, Width, Height, Src, xSrc, ySrc, Rop);
+  {$ELSE}
+  BitBltCanvas(FOutput.Canvas, X, Y, Width, Height, Src.Canvas, xSrc, ySrc, Rop);
+  {$ENDIF}
 end;
 
@@ -649 +652 @@
     Exit;
 
-  BitBltCanvas(FOutput.Canvas, xDst, yDst, Width, Height, MaskCanvas, xSrc, ySrc, SRCAND);
+  BitBltBitmap(FOutput, xDst, yDst, Width, Height, HGrTerrain.Mask, xSrc, ySrc, SRCAND);
   if not PureBlack then
-    BitBltCanvas(FOutput.Canvas, xDst, yDst, Width, Height, DataCanvas, xSrc, ySrc, SRCPAINT);
+    BitBltBitmap(FOutput, xDst, yDst, Width, Height, HGrTerrain.Data, xSrc, ySrc, SRCPAINT);
 end;
 
@@ -707 +710 @@
       if Flags and unFortified <> 0 then
       begin
-        { DataCanvas := HGrTerrain.Data.Canvas;
-          MaskCanvas := HGrTerrain.Mask.Canvas;
-          TerrainSprite(X, Y + 16, 12 * 9 + 7);  }
+        { TerrainSprite(X, Y + 16, 12 * 9 + 7);  }
         Sprite(HGrStdUnits, X, Y, xxu * 2, yyu * 2, 1 + 6 * (xxu * 2 + 1), 1);
       end;
@@ -1152 +1153 @@
   end; { square not discovered }
 
-  if not(FoW and (Tile and fObserved = 0)) then
+  if not (FoW and (Tile and fObserved = 0)) then
     PaintBorder;
 
@@ -1569 +1570 @@
                 end;
               BitBltBitmapOutput(OceanPatch, X + dx * xxt, Y + dy * yyt, xxt, yyt,
-                Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY)
-            end
+                Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY);
+            end;
           end
           else
@@ -1625 +1626 @@
             else
               BitBltBitmapOutput(LandPatch, X + dx * xxt, Y + dy * yyt, xxt, yyt,
-                Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY)
+                Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY);
           end;
       end;
 
-  DataCanvas := HGrTerrain.Data.Canvas;
-  MaskCanvas := HGrTerrain.Mask.Canvas;
   for dy := -2 to ny + 1 do
     for dx := -1 to nx do
@@ -1640 +1639 @@
         PaintTileExtraTerrain(X + xxt * dx, Y + yyt + yyt * dy,
           dLoc(Loc, dx, dy));
+
   if CityOwner >= 0 then
   begin

trunk/Packages/CevoComponents/ScreenTools.pas

@@ -549 +549 @@
             DataPixel.PixelB := 0;
           end else begin
-            MaskPixel.PixelR := $00;
-            MaskPixel.PixelG := $00;
-            MaskPixel.PixelB := $00;
+            MaskPixel.PixelR := 0;
+            MaskPixel.PixelG := 0;
+            MaskPixel.PixelB := 0;
           end;
           DataPixel.NextPixel;

trunk/Packages/DpiControls/Dpi.Common.pas

@@ -11 +11 @@
 
 function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc,
-    YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
+  YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
 function BitBltCanvas(Dest: TCanvas; X, Y, Width, Height: Integer; Src: TCanvas;
-    XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
+  XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
+function BitBltBitmap(Dest: TBitmap; X, Y, Width, Height: Integer; Src: TBitmap;
+  XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
 function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
 {$IFDEF WINDOWS}
@@ -39 +41 @@
 resourcestring
   SNotImplemented = 'Not implemented';
+  SUnsupportedPaintOperationType = 'Unsupported paint operation type';
 
 
 implementation
+
+uses
+  NativePixelPointer;
 
 function BitBltCanvas(Dest: TCanvas; X, Y, Width, Height: Integer;
@@ -47 +53 @@
 begin
   Result := BitBlt(Dest.Handle, X, Y, Width, Height, Src.Handle, XSrc, YSrc, Rop);
+end;
+
+function BitBltBitmap(Dest: TBitmap; X, Y, Width, Height: Integer;
+  Src: TBitmap; XSrc, YSrc: Integer; Rop: DWORD): Boolean;
+var
+  SrcPixel: TPixelPointer;
+  DstPixel: TPixelPointer;
+  DstWidth, DstHeight: Integer;
+  SrcWidth, SrcHeight: Integer;
+  XX, YY: Integer;
+  DstPixelX, DstPixelY: Integer;
+  XNative, YNative: Integer;
+  DstPixelWidth, DstPixelHeight: Integer;
+begin
+  if Frac(ScreenInfo.Dpi / 96) = 0 then
+  begin
+    // Use faster non-fractional scaling
+    Result := BitBlt(Dest.Canvas.Handle, X, Y, Width, Height, Src.Canvas.Handle, XSrc, YSrc, Rop);
+    Exit;
+  end;
+
+  if X < 0 then begin
+    Width := Width + X;
+    XSrc := XSrc - X;
+    X := 0;
+  end;
+  if Y < 0 then begin
+    Height := Height + Y;
+    YSrc := YSrc - Y;
+    Y := 0;
+  end;
+  if (X + Width) > Dest.Width then begin
+    Width := Dest.Width - X;
+  end;
+  if (Y + Height) > Dest.Height then begin
+    Height := Dest.Height - Y;
+  end;
+
+  DstWidth := ScaleToNativeDist(X, Width);
+  DstHeight := ScaleToNativeDist(Y, Height);
+  SrcWidth := ScaleToNativeDist(XSrc, Width);
+  SrcHeight := ScaleToNativeDist(YSrc, Height);
+  XNative := ScaleToNative(X);
+  YNative := ScaleToNative(Y);
+
+  Dest.BeginUpdate;
+  SrcPixel := TPixelPointer.Create(Src.NativeBitmap);
+  DstPixel := TPixelPointer.Create(Dest.NativeBitmap);
+  for YY := 0 to Height - 1 do begin
+    DstPixelHeight := ScaleToNative(Y + YY + 1) - ScaleToNative(Y + YY);
+    for DstPixelY := 0 to DstPixelHeight - 1 do begin
+      for XX := 0 to Width - 1 do begin
+        SrcPixel.SetXY(ScaleToNative(XSrc + XX), ScaleToNative(YSrc + YY));
+        DstPixel.SetXY(ScaleToNative(X + XX), ScaleToNative(Y + YY) + DstPixelY);
+        DstPixelWidth := ScaleToNative(X + XX + 1) - ScaleToNative(X + XX);
+        for DstPixelX := 0 to DstPixelWidth - 1 do begin
+{$IFDEF DEBUG}
+          if SrcPixel.PosValid and DstPixel.PosValid then
+{$ENDIF}
+            if Rop = SRCCOPY then begin
+              DstPixel.PixelB := SrcPixel.PixelB;
+              DstPixel.PixelG := SrcPixel.PixelG;
+              DstPixel.PixelR := SrcPixel.PixelR;
+            end else
+            if Rop = SRCPAINT then begin
+              DstPixel.PixelB := SrcPixel.PixelB or DstPixel.PixelB;
+              DstPixel.PixelG := SrcPixel.PixelG or DstPixel.PixelG;
+              DstPixel.PixelR := SrcPixel.PixelR or DstPixel.PixelR;
+            end else
+            if Rop = SRCAND then begin
+              DstPixel.PixelB := SrcPixel.PixelB and DstPixel.PixelB;
+              DstPixel.PixelG := SrcPixel.PixelG and DstPixel.PixelG;
+              DstPixel.PixelR := SrcPixel.PixelR and DstPixel.PixelR;
+            end else
+            if Rop = DSTINVERT then begin
+              DstPixel.PixelB := not DstPixel.PixelB;
+              DstPixel.PixelG := not DstPixel.PixelG;
+              DstPixel.PixelR := not DstPixel.PixelR;
+            end else begin
+              raise Exception.Create(SUnsupportedPaintOperationType);
+            end;
+          DstPixel.NextPixel;
+        end;
+      end;
+      //DstPixel.NextLine;
+    end;
+  end;
+  Dest.EndUpdate;
+  Result := True;
 end;
 
@@ -95 +190 @@
 function ScaleToNative(Value: Integer): Integer;
 begin
-  Result := Round(Value * ScreenInfo.Dpi / 96);
+  Result := Ceil(Value * ScreenInfo.Dpi / 96);
 end;
 

trunk/Packages/DpiControls/Dpi.Graphics.pas

@@ -692 +692 @@
   SrcPtr: TPixelPointer;
   DstPtr: TPixelPointer;
-  xx, yy: Integer;
-  SrcX, SrcY: Integer;
-  DstX, DstY: Integer;
-  DstWidth, DstHeight: Integer;
-begin
-  //Dst.Canvas.StretchDraw(Rect(0, 0, ScaleToNative(Dst.Width), ScaleToNative(Dst.Height)), Src);
-  //Exit;
+  XX, YY: Integer;
+  DstPixelX, DstPixelY: Integer;
+  DstPixelWidth, DstPixelHeight: Integer;
+begin
   Dst.BeginUpdate;
   SrcPtr := TPixelPointer.Create(Src, 0, 0);
   DstPtr := TPixelPointer.Create(Dst, 0, 0);
-  {for yy := 0 to Dst.Height - 1 do begin
-    for xx := 0 to Dst.Width - 1 do begin
-      SrcPtr.SetXY(Min(ScaleFromNative(xx), Src.Width - 1),
-        Min(ScaleFromNative(yy), Src.Height - 1));
-      DstPtr.PixelB := SrcPtr.PixelB;
-      DstPtr.PixelG := SrcPtr.PixelG;
-      DstPtr.PixelR := SrcPtr.PixelR;
-      DstPtr.NextPixel;
-    end;
-    DstPtr.NextLine;
-  end;
-  }
-  for SrcY := 0 to Src.Height - 1 do begin
-    DstHeight := ScaleToNative(SrcY + 1) - ScaleToNative(SrcY);
-    for DstY := 0 to DstHeight - 1 do begin
-      for SrcX := 0 to Src.Width - 1 do begin
-        DstWidth := ScaleToNative(SrcX + 1) - ScaleToNative(SrcX);
-        for DstX := 0 to DstWidth - 1 do begin
+  for YY := 0 to Src.Height - 1 do begin
+    DstPixelHeight := ScaleToNative(YY + 1) - ScaleToNative(YY);
+    for DstPixelY := 0 to DstPixelHeight - 1 do begin
+      for XX := 0 to Src.Width - 1 do begin
+        DstPixelWidth := ScaleToNative(XX + 1) - ScaleToNative(XX);
+        for DstPixelX := 0 to DstPixelWidth - 1 do begin
           DstPtr.PixelB := SrcPtr.PixelB;
           DstPtr.PixelG := SrcPtr.PixelG;

trunk/Packages/DpiControls/Dpi.PixelPointer.pas

@@ -93 +93 @@
 
 resourcestring
-  SOutOfRange = 'Pixel pointer out of range [X: %d. Y: %d]';
+  SOutOfRange = 'Pixel pointer out of range [X: %d, Y: %d, Width: %d, Height: %d]';
   SWrongBitmapSize = 'Wrong bitmap size [width: %d, height: %d]';
 
@@ -160 +160 @@
     X := B - Y * BytesPerLine;
     X := Floor(X / BytesPerPixel);
-    raise Exception.Create(Format(SOutOfRange, [X, Y]));
+    raise Exception.Create(Format(SOutOfRange, [X, Y, Width, Height]));
   end;
   {$ENDIF}

trunk/Packages/DpiControls/NativePixelPointer.pas

@@ -63 +63 @@
     procedure SetX(X: Integer); inline; // Set horizontal pixel position relative to base
     procedure CheckRange; inline; // Check if current pixel position is not out of range
+    function PosValid: Boolean;
     class function Create(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; static;
     property PixelARGB: TColor32 read GetPixelARGB write SetPixelARGB;
@@ -93 +94 @@
 
 resourcestring
-  SOutOfRange = 'Pixel pointer out of range [X: %d. Y: %d]';
+  SOutOfRange = 'Pixel pointer out of range [X: %d, Y: %d, Width: %d, Height: %d]';
   SWrongBitmapSize = 'Wrong bitmap size [width: %d, height: %d]';
 
@@ -159 +160 @@
     X := X - Y * BytesPerLine;
     X := Floor(X / BytesPerPixel);
-    raise Exception.Create(Format(SOutOfRange, [X, Y]));
+    raise Exception.Create(Format(SOutOfRange, [X, Y, Width, Height]));
   end;
   {$ENDIF}
+end;
+
+function TPixelPointer.PosValid: Boolean;
+begin
+  Result := not ((PByte(Pixel) < PByte(Data)) or
+    (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine));
 end;