Changeset 193 for branches/highdpi/Packages/CevoComponents/ScreenTools.pas

Timestamp:

May 7, 2020, 7:05:57 PM (4 years ago)

Author:

chronos

Message:

• Modified: Improved code in HighDPI branch.

File:

• branches/highdpi/Packages/CevoComponents/ScreenTools.pas (modified) (11 diffs)

branches/highdpi/Packages/CevoComponents/ScreenTools.pas

@@ -410 +410 @@
   Bitmap.BeginUpdate;
   PixelPtr.Init(Bitmap);
-  for Y := 0 to Bitmap.Height - 1 do begin
-    for X := 0 to Bitmap.Width - 1 do begin
+  for Y := 0 to ScaleToVcl(Bitmap.Height) - 1 do begin
+    for X := 0 to ScaleToVcl(Bitmap.Width) - 1 do begin
       PixelPtr.Pixel^ := ApplyGammaToPixel(PixelPtr.Pixel^);
       PixelPtr.NextPixel;
@@ -428 +428 @@
   SrcPtr.Init(Src);
   DstPtr.Init(Dst);
-  for Y := 0 to Src.Height - 1 do begin
-    for X := 0 to Src.Width - 1 do begin
+  for Y := 0 to ScaleToVcl(Src.Height) - 1 do begin
+    for X := 0 to ScaleToVcl(Src.Width) - 1 do begin
       DstPtr.Pixel^.B := SrcPtr.Pixel^.B;
       DstPtr.Pixel^.G := SrcPtr.Pixel^.B;
@@ -607 +607 @@
   PixelPtr: TPixelPointer;
 begin
+  X := ScaleToVcl(X);
+  Y := ScaleToVcl(Y);
+  W := ScaleToVcl(W);
+  H := ScaleToVcl(H);
   Dst.BeginUpdate;
   PixelPtr.Init(Dst, X, Y);
@@ -630 +634 @@
   PixelDst: TPixelPointer;
 begin
+  xDst := ScaleToVcl(xDst);
+  yDst := ScaleToVcl(yDst);
+  xSrc := ScaleToVcl(xSrc);
+  ySrc := ScaleToVcl(ySrc);
+  w := ScaleToVcl(w);
+  h := ScaleToVcl(h);
   //Assert(Src.PixelFormat = pf8bit);
   Assert(dst.PixelFormat = pf24bit);
@@ -642 +652 @@
     yDst := 0;
   end;
-  if xDst + w > dst.Width then
-    w := dst.Width - xDst;
-  if yDst + h > dst.Height then
-    h := dst.Height - yDst;
+  if xDst + w > ScaleToVcl(dst.Width) then
+    w := ScaleToVcl(dst.Width) - xDst;
+  if yDst + h > ScaleToVcl(dst.Height) then
+    h := ScaleToVcl(dst.Height) - yDst;
   if (w < 0) or (h < 0) then
     exit;
@@ -691 +701 @@
   SrcPixel, DstPixel: TPixelPointer;
 begin
+  xDst := ScaleToVcl(xDst);
+  yDst := ScaleToVcl(yDst);
+  xSrc := ScaleToVcl(xSrc);
+  ySrc := ScaleToVcl(ySrc);
+  w := ScaleToVcl(w);
+  h := ScaleToVcl(h);
   if xDst < 0 then begin
     w := w + xDst;
@@ -701 +717 @@
     yDst := 0;
   end;
-  if xDst + w > dst.Width then
-    w := dst.Width - xDst;
-  if yDst + h > dst.Height then
-    h := dst.Height - yDst;
+  if xDst + w > ScaleToVcl(dst.Width) then
+    w := ScaleToVcl(dst.Width) - xDst;
+  if yDst + h > ScaleToVcl(dst.Height) then
+    h := ScaleToVcl(dst.Height) - yDst;
   if (w < 0) or (h < 0) then
     exit;
@@ -756 +772 @@
   PixelPtr: TPixelPointer;
 begin
+  X := ScaleToVcl(X);
+  Y := ScaleToVcl(Y);
+  W := ScaleToVcl(W);
+  H := ScaleToVcl(H);
   bmp.BeginUpdate;
   assert(bmp.PixelFormat = pf24bit);
@@ -892 +912 @@
   x, y, ch, r: Integer;
   DstPtr: TPixelPointer;
-begin
+  DpiGlowRange: Integer;
+begin
+  DpiGlowRange := ScaleToVcl(GlowRange);
+  X0 := ScaleToVcl(X0);
+  Y0 := ScaleToVcl(Y0);
+  Width := ScaleToVcl(Width);
+  Height := ScaleToVcl(Height);
   dst.BeginUpdate;
   DstPtr.Init(dst, x0, y0);
-  for y := -GlowRange + 1 to Height - 1 + GlowRange - 1 do begin
-    for x := -GlowRange + 1 to Width - 1 + GlowRange - 1 do begin
+  for y := -DpiGlowRange + 1 to Height - 1 + DpiGlowRange - 1 do begin
+    for x := -DpiGlowRange + 1 to Width - 1 + DpiGlowRange - 1 do begin
       DstPtr.SetXY(x, y);
       if x < 0 then
@@ -924 +950 @@
           DstPtr.Pixel^.Planes[2 - ch] :=
             (DstPtr.Pixel^.Planes[2 - ch] * (r - 1) + (cl shr (8 * ch) and $FF) *
-            (GlowRange - r)) div (GlowRange - 1);
+            (DpiGlowRange - r)) div (DpiGlowRange - 1);
     end;
   end;
@@ -1559 +1585 @@
             // 0.8 constant is compensation for Lazarus as size of fonts against Delphi differs
             UniFont[section].Size :=
-              Round(Size * Screen.PixelsPerInch / UniFont[section].PixelsPerInch * 0.8);
+              Round(Size * Screen.PixelsPerInch / UniFont[section].PixelsPerInch);
           end;
         end;