Changeset 538 for trunk/Packages/DpiControls/Dpi.Common.pas

Timestamp:

Apr 16, 2024, 10:57:39 AM (4 weeks ago)

Author:

chronos

Message:

• Fixed: Map drawing in case of fractional scaling.

File:

• trunk/Packages/DpiControls/Dpi.Common.pas (modified) (4 diffs)

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;