Changeset 514 for trunk/Packages

Timestamp:

Jan 3, 2024, 3:05:32 PM (4 months ago)

Author:

chronos

Message:

• Modified: LogoBuffer is in fact general DrawBuffer. Use single DrawBuffer for all units.
• Modified: Improved fractional scaling.

Location:

trunk/Packages

Files:

• CevoComponents/ScreenTools.pas (modified) (6 diffs)
• DpiControls/Dpi.Common.pas (modified) (6 diffs)

trunk/Packages/CevoComponents/ScreenTools.pas

@@ -97 +97 @@
   T: TTexture);
 procedure PaintLogo(Canvas: TCanvas; X, Y, LightColor, ShadeColor: Integer);
+procedure DrawBufferEnsureSize(Width, Height: Integer);
 procedure LoadPhrases;
 procedure Texturize(Dest, Texture: TBitmap; TransparentColor: Cardinal);
@@ -190 +191 @@
   Paper: TBitmap;
   BigImp: TBitmap;
-  LogoBuffer: TBitmap;
+  DrawBuffer: TBitmap;
   FullScreen: Boolean;
   GenerateNames: Boolean;
@@ -1567 +1568 @@
 procedure PaintLogo(Canvas: TCanvas; X, Y, LightColor, ShadeColor: Integer);
 begin
-  if not Assigned(LogoBuffer) then Exit;
-  UnshareBitmap(LogoBuffer);
-  BitBltCanvas(LogoBuffer.Canvas, 0, 0, Logo.Width, Logo.Height, Canvas, X, Y);
-  ImageOp_BCC(LogoBuffer, Templates.Data, Point(0, 0), Logo.BoundsRect,
+  if not Assigned(DrawBuffer) then Exit;
+  DrawBufferEnsureSize(Logo.Width, Logo.Height);
+  UnshareBitmap(DrawBuffer);
+  BitBltCanvas(DrawBuffer.Canvas, 0, 0, Logo.Width, Logo.Height, Canvas, X, Y);
+  ImageOp_BCC(DrawBuffer, Templates.Data, Point(0, 0), Logo.BoundsRect,
     LightColor, ShadeColor);
-  BitBltCanvas(Canvas, X, Y, Logo.Width, Logo.Height, LogoBuffer.Canvas, 0, 0);
+  BitBltCanvas(Canvas, X, Y, Logo.Width, Logo.Height, DrawBuffer.Canvas, 0, 0);
+end;
+
+procedure DrawBufferEnsureSize(Width, Height: Integer);
+begin
+  if (DrawBuffer.Width >= Width) and (DrawBuffer.Height >= Height) then Exit;
+  if (DrawBuffer.Width < Width) and (DrawBuffer.Height < Height) then
+    DrawBuffer.SetSize(Width, Height)
+  else if DrawBuffer.Width < Width then DrawBuffer.Width := Width
+  else if DrawBuffer.Height < Height then DrawBuffer.Height := Height;
+  DrawBuffer.Canvas.FillRect(0, 0, DrawBuffer.Width, DrawBuffer.Height);
 end;
 
@@ -1813 +1825 @@
   end;
 
-  if not Assigned(LogoBuffer) then begin
-    LogoBuffer := TBitmap.Create;
-    LogoBuffer.PixelFormat := TPixelFormat.pf24bit;
-    LogoBuffer.SetSize(BigBook.Width, BigBook.Height);
-  end;
-
   LoadGraphicFile(Colors, GetGraphicsDir + DirectorySeparator + 'Colors.png');
   LoadGraphicFile(Paper, GetGraphicsDir + DirectorySeparator + 'Paper.jpg');
@@ -1838 +1844 @@
   for Section := Low(TFontType) to High(TFontType) do
     UniFont[Section] := TFont.Create;
+
+  DrawBuffer := TBitmap.Create;
+  DrawBuffer.PixelFormat := TPixelFormat.pf24bit;
 
   GrExt := TGraphicSets.Create;
@@ -1877 +1886 @@
   FreeAndNil(Phrases);
   FreeAndNil(Phrases2);
-  if Assigned(LogoBuffer) then FreeAndNil(LogoBuffer);
+  FreeAndNil(DrawBuffer);
   FreeAndNil(BigImp);
   FreeAndNil(Paper);

trunk/Packages/DpiControls/Dpi.Common.pas

@@ -5 +5 @@
 uses
   {$IFDEF WINDOWS}Windows,{$ENDIF}
-  Classes, SysUtils, LCLType, Types, LCLIntf, Graphics, Dpi.Graphics;
+  Classes, SysUtils, LCLType, Types, Math, LCLIntf, Graphics, Dpi.Graphics;
 
 const
@@ -100 +100 @@
 function ScaleToNative(Value: Integer): Integer;
 begin
-  Result := Round(Value * ScreenInfo.Dpi / 96);
+  Result := Ceil(Value * ScreenInfo.Dpi / 96);
 end;
 
@@ -110 +110 @@
 function ScaleFromNative(Value: Integer): Integer;
 begin
-  Result := Round(Value * 96 / ScreenInfo.Dpi);
+  Result := Floor(Value * 96 / ScreenInfo.Dpi);
 end;
 
@@ -185 +185 @@
   DstWidth, DstHeight: Integer;
   SrcWidth, SrcHeight: Integer;
+  ReduceWidth, ReduceHeight: Integer;
 begin
   {$IFDEF WINDOWS}
@@ -193 +194 @@
   {$ELSE}
 
-
   DstWidth := ScaleToNativeDist(X, Width);
   DstHeight := ScaleToNativeDist(Y, Height);
   SrcWidth := ScaleToNativeDist(XSrc, Width);
   SrcHeight := ScaleToNativeDist(YSrc, Height);
+  if (Frac(ScaleFloatToNative(XSrc)) > 0) or
+    (Frac(ScaleFloatToNative(X)) > 0) then ReduceWidth := 1
+    else ReduceWidth := 0;
+  if (Frac(ScaleFloatToNative(YSrc)) > 0) or
+    (Frac(ScaleFloatToNative(Y)) > 0) then ReduceHeight := 1
+    else ReduceHeight := 0;
   if (DstWidth = SrcWidth) and (DstHeight = SrcHeight) then begin
     Result := LCLIntf.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
@@ -204 +210 @@
   end else begin
     Result := LCLIntf.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
-      DstWidth, DstHeight, SrcDC,
+      DstWidth - ReduceWidth, DstHeight - ReduceHeight, SrcDC,
       ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
-{    Result := LCLIntfStretchBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
+
+    // Instead calling StretchBlt for entire region try to draw missing part with BitBlt
+    if DstWidth > SrcWidth then begin
+      LCLIntf.BitBlt(DestDC, ScaleToNative(X) + SrcWidth, ScaleToNative(Y),
+        DstWidth - SrcWidth, DstHeight, SrcDC,
+        ScaleToNative(XSrc) + SrcWidth - (DstWidth - SrcWidth), ScaleToNative(YSrc), Rop);
+    end;
+    if DstHeight > SrcHeight then begin
+      LCLIntf.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y) + SrcHeight,
+        DstWidth, DstHeight - SrcHeight, SrcDC,
+        ScaleToNative(XSrc), ScaleToNative(YSrc) + SrcHeight - (DstHeight - SrcHeight), Rop);
+    end;
+
+  {  Result := LCLIntf.StretchBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
       DstWidth, DstHeight, SrcDC,
       ScaleToNative(XSrc), ScaleToNative(YSrc),
-      SrcWidth, SrcHeight, Rop);
-}  end;
+      SrcWidth, SrcHeight, Rop);}
+  end;
 
 {  Result := LCLIntf.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),