Changeset 323 for trunk/Packages/CevoComponents

Timestamp:

Mar 23, 2021, 2:46:42 PM (4 years ago)

Author:

chronos

Message:

• Modified: Created single procedure for unshare/free bitmap before BitBlt use.

Location:

trunk/Packages/CevoComponents

Files:

• EOTButton.pas (modified) (2 diffs)
• ScreenTools.pas (modified) (3 diffs)

trunk/Packages/CevoComponents/EOTButton.pas

@@ -74 +74 @@
 begin
   with Canvas do
-    if FGraphic <> nil then
-    begin
-      // TODO: For some reason BitBlt is not working with gray background here
-      //BitBltCanvas(Buffer.Canvas, 0, 0, 48, 48, Back.Canvas, 0, 0);
-      Buffer.Canvas.Draw(0, 0, Back);
+    if FGraphic <> nil then begin
+      UnshareBitmap(Buffer);
+      BitBltCanvas(Buffer.Canvas, 0, 0, 48, 48, Back.Canvas, 0, 0);
       ImageOp_CBC(Buffer, Template, 0, 0, 133, 149 + 48 * Byte(FDown), 48, 48,
         $000000, $FFFFFF);
@@ -85 +83 @@
           $000000, $FFFFFF);
       BitBltCanvas(Canvas, 0, 0, 48, 48, Buffer.Canvas, 0, 0);
-    end
-    else
-    begin
+    end else begin
       Brush.Color := $0000FF;
       FrameRect(Rect(0, 0, 48, 48))

trunk/Packages/CevoComponents/ScreenTools.pas

@@ -109 +109 @@
 function ScaleToNative(Value: Integer): Integer;
 function ScaleFromNative(Value: Integer): Integer;
+procedure UnshareBitmap(Bitmap: TBitmap);
 
 const
@@ -1514 +1515 @@
 procedure PaintLogo(Canvas: TCanvas; X, Y, LightColor, ShadeColor: Integer);
 begin
-  // TODO: Explicitly clear background to black but in fact BitBlt SRCCOPY should do it
-  LogoBuffer.Canvas.FillRect(0, 0, LogoBuffer.Width, LogoBuffer.Height);
+  UnshareBitmap(LogoBuffer);
   BitBltCanvas(LogoBuffer.Canvas, 0, 0, Logo.Width, Logo.Height, Canvas, X, Y);
   ImageOp_BCC(LogoBuffer, Templates.Data, Point(0, 0), Logo.BoundsRect,
@@ -1626 +1626 @@
 begin
   Result := Value;
+end;
+
+procedure UnshareBitmap(Bitmap: TBitmap);
+begin
+  // FillRect cause image data to be freed so subsequent BitBlt can access valid image data
+  Bitmap.Canvas.FillRect(0, 0, 0, 0);
 end;