Changeset 247

Timestamp:

May 21, 2020, 10:30:59 PM (5 years ago)

Author:

chronos

Message:

• Modified: Enabled scaling under Windows.
• Fixed: Use correct scaled Windows BitBlt.
• Modified: Fixed and optimized help watermark method.

Location:

branches/highdpi

Files:

• Integrated.lpi (modified) (1 diff)
• LocalPlayer/Help.pas (modified) (3 diffs)
• Packages/CevoComponents/ScreenTools.pas (modified) (1 diff)
• Packages/DpiControls/UDpiControls.pas (modified) (2 diffs)

branches/highdpi/Integrated.lpi

@@ -16 +16 @@
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
       <Icon Value="0"/>
       <Resources Count="2">

branches/highdpi/LocalPlayer/Help.pas

@@ -443 +443 @@
   MaxSum = 9 * 9 * 255 * 75 div 100;
 var
-  x, y, dx, dy, xSrc, ySrc, sum, xx: integer;
+  x, y, dx, dy, xSrc, ySrc, Sum, xx: integer;
   Heaven: array [0..nHeaven] of integer;
-  PaintPtr, CoalPtr: TPixelPointer;
+  PaintPtr: TPixelPointer;
+  CoalPtr: TPixelPointer;
   ImpPtr: array [-1..1] of TPixelPointer;
 begin
@@ -457 +458 @@
   xSrc := iix mod 7 * xSizeBig;
   ySrc := (iix div 7 + 1) * ySizeBig;
-  for y := 0 to ScaleToNative(ySizeBig) * 2 - 1 do
+  PaintPtr := PixelPointer(OffScreen, ScaleToNative(x0), ScaleToNative(y0));
+  CoalPtr := PixelPointer(Templates, ScaleToNative(xCoal), ScaleToNative(yCoal));
+  for dy := -1 to 1 do
+    ImpPtr[dy] := PixelPointer(BigImp, ScaleToNative(xSrc), ScaleToNative(ySrc));
+  for y := 0 to ScaleToNative(ySizeBig) * 2 - 1 do begin
     if ((ScaleToNative(y0) + y) >= 0) and ((ScaleToNative(y0) + y) < ScaleToNative(InnerHeight)) then begin
-      PaintPtr := PixelPointer(OffScreen, 0, ScaleToNative(y0) + y);
-      CoalPtr := PixelPointer(Templates, 0, ScaleToNative(yCoal) + y);
       for dy := -1 to 1 do
         if ((Max(y + ScaleToNative(dy), 0) shr 1) >= 0) and ((Max(y + ScaleToNative(dy), 0) shr 1) < ScaleToNative(ySizeBig)) then
-          ImpPtr[dy] := PixelPointer(BigImp, 0, ScaleToNative(ySrc) + (Max(y + ScaleToNative(dy), 0) shr 1));
-      for x := 0 to ScaleToNative(xSizeBig) * 2 - 1 do begin
-        sum := 0;
+          ImpPtr[dy].SetXY(0, Max(y + ScaleToNative(dy), 0) shr 1);
+      for x := 0 to ScaleToNative(xSizeBig * 2) - 1 do begin
+        Sum := 0;
         for dx := -1 to 1 do begin
-          xx := ScaleToNative(xSrc) + Max((x + ScaleToNative(dx)), 0) shr 1;
+          xx := Max((x + ScaleToNative(dx)), 0) shr 1;
           for dy := -1 to 1 do begin
             ImpPtr[dy].SetX(xx);
@@ -475 +478 @@
               (ImpPtr[dy].Pixel^.B shl 16 + ImpPtr[dy].Pixel^.G shl 8 +
               ImpPtr[dy].Pixel^.R = Heaven[(ScaleFromNative(y) + dy) shr 1]) then
-              sum := sum + 9 * 255
+              Sum := Sum + 9 * 255
             else
-              sum := sum + ImpPtr[dy].Pixel^.B + 5 * ImpPtr[dy].Pixel^.G + 3 *
+              Sum := Sum + ImpPtr[dy].Pixel^.B + 5 * ImpPtr[dy].Pixel^.G + 3 *
                 ImpPtr[dy].Pixel^.R;
           end;
         end;
-        if sum < MaxSum then begin // no saturation
-          CoalPtr.SetX(ScaleToNative(xCoal) + x);
-          sum := 1 shl 22 - (MaxSum - sum) * (256 - CoalPtr.Pixel^.B * 2);
-          PaintPtr.SetX(x0 + x);
-          PaintPtr.Pixel^.B := PaintPtr.Pixel^.B * sum shr 22;
-          PaintPtr.Pixel^.G := PaintPtr.Pixel^.G * sum shr 22;
-          PaintPtr.Pixel^.R := PaintPtr.Pixel^.R * sum shr 22;
+        if Sum < MaxSum then begin // no saturation
+          Sum := 1 shl 22 - (MaxSum - Sum) * (256 - CoalPtr.Pixel^.B * 2);
+          PaintPtr.Pixel^.B := Min(PaintPtr.Pixel^.B * Sum shr 22, 255);
+          PaintPtr.Pixel^.G := Min(PaintPtr.Pixel^.G * Sum shr 22, 255);
+          PaintPtr.Pixel^.R := Min(PaintPtr.Pixel^.R * Sum shr 22, 255);
         end;
+        PaintPtr.NextPixel;
+        CoalPtr.NextPixel;
       end;
     end;
+    PaintPtr.NextLine;
+    CoalPtr.NextLine;
+  end;
   Offscreen.EndUpdate;
   BigImp.EndUpdate;

branches/highdpi/Packages/CevoComponents/ScreenTools.pas

@@ -820 +820 @@
   {$IFDEF WINDOWS}
   // LCLIntf.BitBlt is slower than direct Windows BitBlt
-  Result := Windows.DpiBitBlt(DestCanvas.Handle, X, Y, Width, Height, SrcCanvas.Handle, XSrc, YSrc, Rop);
+  Result := DpiBitBlt(DestCanvas.Handle, X, Y, Width, Height, SrcCanvas.Handle, XSrc, YSrc, Rop);
   {$ELSE}
   Result := DpiBitBlt(DestCanvas.Handle, X, Y, Width, Height, SrcCanvas.Handle, XSrc, YSrc, Rop);

branches/highdpi/Packages/DpiControls/UDpiControls.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf, ProjectIntf,
+  Windows, Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf, ProjectIntf,
   Controls, StdCtrls, fgl, Graphics, ComCtrls, ExtCtrls, LCLType, GraphType,
   Types, CustApp, LMessages, LCLIntf, Menus;
@@ -990 +990 @@
   YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
 begin
-  Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y), ScaleToNative(Width),
-    ScaleToNative(Height), SrcDC, ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
+  {$IFDEF WINDOWS}
+  // LCLIntf.BitBlt is slower than direct Windows BitBlt
+  Result := Windows.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
+    ScaleToNative(Width), ScaleToNative(Height), SrcDC,
+    ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
+  {$ELSE}
+  Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
+    ScaleToNative(Width), ScaleToNative(Height), SrcDC,
+    ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
+  {$ENDIF}
 end;