Changeset 265 for branches/highdpi/Packages/DpiControls/UDpiControls.pas

Timestamp:

Jun 25, 2020, 10:24:44 PM (4 years ago)

Author:

chronos

Message:

• Fixed: Scaling IsoEngine ForgOfWar sprites.
• Fixed: PopupMenu position calculated using not scaled GetSystemMetrics.
• Fixed: Scale TDpiBitmaps using normal scaling functions to get pixels on valid expected possition.
• Fixed: DpiBitBlt needs to be executed as StretchDraw for non-integer pixel scaling. This leads to slower drawing.

File:

• branches/highdpi/Packages/DpiControls/UDpiControls.pas (modified) (9 diffs)

branches/highdpi/Packages/DpiControls/UDpiControls.pas

@@ -8 +8 @@
   {$IFDEF WINDOWS}Windows, {$ENDIF}Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf, ProjectIntf,
   Controls, StdCtrls, fgl, Graphics, ComCtrls, ExtCtrls, LCLType, GraphType,
-  Types, CustApp, LMessages, LCLIntf, Menus, Math;
+  Types, CustApp, LMessages, LCLIntf, Menus, Math, UPixelPointer2;
 
 type
@@ -953 +953 @@
   const lprcClip:TRect; hrgnUpdate: Handle; lprcUpdate: PRect): Boolean;
 function ScaleToNative(Value: Integer): Integer;
+function ScaleToNativeDist(Base, Value: Integer): Integer;
 function ScaleFromNative(Value: Integer): Integer;
 function ScalePointToNative(Value: TPoint): TPoint;
@@ -963 +964 @@
 function ScaleFloatFromNative(Value: Double): Double;
 procedure WriteLog(Text: string);
+function DpiGetSystemMetrics(nIndex: Integer): Integer;
 
 implementation
@@ -1029 +1031 @@
 end;
 
+function ScaleToNativeDist(Base, Value: Integer): Integer;
+begin
+  Result := ScaleToNative(Base + Value) - ScaleToNative(Base);
+end;
+
 function ScaleFromNative(Value: Integer): Integer;
 begin
@@ -1096 +1103 @@
 end;
 
+function DpiGetSystemMetrics(nIndex: Integer): Integer;
+begin
+  Result := ScaleFromNative(GetSystemMetrics(nIndex));
+end;
+
 function DpiBitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc,
   YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
+var
+  DstWidth, DstHeight: Integer;
+  SrcWidth, SrcHeight: Integer;
 begin
   {$IFDEF WINDOWS}
@@ -1105 +1120 @@
     ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
   {$ELSE}
-  Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
+
+
+  DstWidth := ScaleToNativeDist(X, Width);
+  DstHeight := ScaleToNativeDist(Y, Height);
+  SrcWidth := ScaleToNativeDist(XSrc, Width);
+  SrcHeight := ScaleToNativeDist(YSrc, Height);
+  if (DstWidth = SrcWidth) and (DstHeight = SrcHeight) then begin
+    Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
+      DstWidth, DstHeight, SrcDC,
+      ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
+  end else begin
+    Result := StretchBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
+      DstWidth, DstHeight, SrcDC,
+      ScaleToNative(XSrc), ScaleToNative(YSrc),
+      SrcWidth, SrcHeight, Rop);
+  end;
+
+{  Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
     ScaleToNative(Width), ScaleToNative(Height), SrcDC,
     ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
+ }
   {$ENDIF}
 end;
@@ -1886 +1919 @@
 end;
 
+procedure StretchDrawBitmap(Src: TRasterImage; Dst: TBitmap);
+var
+  SrcPtr: TPixelPointer;
+  DstPtr: TPixelPointer;
+  xx, yy: Integer;
+  SrcX, SrcY: Integer;
+  DstX, DstY: Integer;
+  DstWidth, DstHeight: Integer;
+begin
+  Dst.BeginUpdate;
+  SrcPtr := PixelPointer(Src, 0, 0);
+  DstPtr := PixelPointer(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.Pixel^.B := SrcPtr.Pixel^.B;
+      DstPtr.Pixel^.G := SrcPtr.Pixel^.G;
+      DstPtr.Pixel^.R := SrcPtr.Pixel^.R;
+      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
+          DstPtr.Pixel^.B := SrcPtr.Pixel^.B;
+          DstPtr.Pixel^.G := SrcPtr.Pixel^.G;
+          DstPtr.Pixel^.R := SrcPtr.Pixel^.R;
+          DstPtr.NextPixel;
+        end;
+        SrcPtr.NextPixel;
+      end;
+      DstPtr.NextLine;
+      SrcPtr.SetX(0);
+    end;
+    SrcPtr.NextLine;
+  end;
+  Dst.EndUpdate;
+end;
+
 procedure TDpiGraphic.LoadFromFile(const Filename: string);
 var
@@ -1894 +1972 @@
   Width := Bitmap.Width;
   Height := Bitmap.Height;
-  if Self is TDpiBitmap then
-    TBitmap(GetNativeGraphic).Canvas.StretchDraw(Bounds(0, 0,
-    TBitmap(GetNativeGraphic).Width, TBitmap(GetNativeGraphic).Height), Bitmap)
-    else raise Exception.Create('Unsupported class ' + Self.ClassName);
+  if Self is TDpiBitmap then begin
+    StretchDrawBitmap(TRasterImage(Bitmap), TBitmap(GetNativeGraphic));
+    //TBitmap(GetNativeGraphic).Canvas.StretchDraw(Bounds(0, 0,
+    //TBitmap(GetNativeGraphic).Width, TBitmap(GetNativeGraphic).Height), Bitmap);
+  end else raise Exception.Create('Unsupported class ' + Self.ClassName);
   Bitmap.Free;
 end;
@@ -2806 +2885 @@
 begin
   //Dpi := 96 * 2; //Screen.PixelsPerInch;
-  //Dpi := 144; //Round(96 * 1.25)
+  //Dpi := Round(96 * 1.35);
+  //Dpi := 144; //Round(96 * 2);
   //Dpi := Round(96 * 1.6);
   Dpi := Screen.PixelsPerInch;