MakeScreenshot漏水？

Question

大家晚上好！

在当前的一个项目中，我遇到了一个令人担心的内存泄漏，似乎无法插入。

我让应用程序在一夜之间运行，标准使用继续进行，当我8小时后醒来时，它消耗了~750 on的内存，而它的启动时间是~50 on。Windows任务管理器不适合检查泄漏，只允许您首先发现存在漏洞。

我已经清除了其他一些内存泄漏，其中主要的一个与火猴的TGlowEffect有关。ReportLeaksOnShutdown没有检测到它，但是在动态修改的对象(例如旋转或缩放更改)上，它的内存使用量变得非常大。

我已经跟踪它到一个计时器(并且禁用它完全阻止泄漏)，如果可能的话，我需要帮助修复它。

描述：--此代码使用Fire猴子MakeScreenshot函数将TPanel (SigPanel)的可视外观保存到TMemoryStream。然后使用标准代码将这些流数据上载到远程FTP服务器(见下文)。在SigPanel内部，有4个TLabel子、1个TRectangle子和6个TImage子。

Notes：CfId是一个全局字符串，它基于一个随机的extended浮点值生成，然后与格式yyyymmdd_hhnnsszzz的DateTime一起进行散列。此生成是在创建表单时完成的，并且会重复执行，直到它成为有效的CfId (即不包含不允许在Windows文件名中使用的字符)。一旦它获得了一个有效的CfId，它就不会再次运行(因为我不再需要生成一个新的ID)。这使我几乎完全消除了复制CfId的机会。

定时器中的代码如下；

var
  i : Integer;
  SigStream : TMemoryStream;
begin
  SigStream := TMemoryStream.Create;
  SigPanel.MakeScreenshot.SaveToStream(SigStream);
  SigPanel.MakeScreenshot.Free;
  if VT2SigUp.Connected then
  begin
    VT2SigUp.Put(SigStream,'Sig_'+CfId+'.png',False);
  end else
  begin
    VT2SigUp.Connect;
    VT2SigUp.Put(SigStream,'Sig_'+CfId+'.png',False);
  end;
    SigStream.Free;
end;

在计时器不运行的情况下，代码完全在没有泄漏的情况下运行，而ReportMemoryLeaksOnShutdown不需要生成消息。在启用计时器并允许至少“运行”一次的情况下，我得到了大量的泄漏，这会增加计时器运行的次数。所报告的泄漏情况如下；

Small Block Leaks

1 - 12 Bytes: Unknown x 1
13 - 20 Bytes: TList x 5, Unknown x 1
21 - 28 Bytes: TFont x 2, TGradientPoint x 8, TGradientPoints x 4, Unknown x 4
29 - 36 Bytes: TObjectList<FMX.Types.TCanvasSaveState> x 1, TBrushBitmap x 4,
TBrushGrab x 4, TPosition x 24, TGradient x 4, UnicodeString x1
37 - 44 Bytes: TBrushResource x 4
53 - 60 Bytes: TBrush x 4
61 - 68 Bytes: TBitmap x 5
69 - 76 Bytes: TD2DCanvasSaveState x 1
205 - 220 Bytes: TCanvasD2D x 1

Sizes of Medium and Large Block Leaks
200236

当计时器运行时，这些值被乘以n次(n是计时器运行的次数)。中型和大型块的n值为200236 (例如，如果计时器运行了3次，则为200236、200236、200326)。

令人感兴趣的是，如果我删除与MakeScreenshot相关的代码，泄漏就不再存在，内存的使用也保持在正常水平。除了通常的内存使用，没有什么异常，也没有泄漏的报告。我尝试过多个代码示例，既可以保存到流中并从那里上传，也可以保存到流> file，然后上传文件，但是函数本身似乎存在漏洞。我甚至在这里发现一个漏洞后就添加了MakeScreenshot.Free，但是我似乎无法插入它，当然，我在我的代码“测试运行”中使用了try..finally。

我甚至用GDI+作为画布类型运行了代码，并且在那里也发生了相同的泄漏(唯一的变化是D2D泄漏引用了GDI+ )。

我非常感谢任何人对此进行的任何研究或记录，以及这个问题的解决方案。

Answer 1

您没有释放MakeScreenshot创建的位图。

procedure TForm1.Button1Click(Sender: TObject);
var
  ms: TMemoryStream;
begin
  ms := TMemoryStream.Create;
  Panel1.MakeScreenshot.SaveToStream(ms);
  ms.Free;
end;

上面的代码不保留对创建的位图的引用，因此没有机会释放它。相反，请按以下方式更改您的设计：

procedure TForm1.Button2Click(Sender: TObject);
var
  ms: TMemoryStream;
  bmp: TBitmap;
begin
  ms := TMemoryStream.Create;
  bmp := Panel1.MakeScreenshot;
  bmp.SaveToStream(ms);
  ms.Free;
  bmp.Free;
end;

使用下面的代码，您实际上正在创建两个位图，并释放其中一个位图。

  SigPanel.MakeScreenshot.SaveToStream(SigStream);
  SigPanel.MakeScreenshot.Free;

最后，您的代码将更类似于以下内容：

var
  i : Integer;
  Bmp: TBitmap;
  SigStream : TMemoryStream;
begin
  SigStream := TMemoryStream.Create;
  try
    Bmp := SigPanel.MakeScreenshot;
    try
      Bmp.SaveToStream(SigStream);
      if not VT2SigUp.Connected then
        VT2SigUp.Connect;
      VT2SigUp.Put(SigStream, 'Sig_'+CfId+'.png', False);
    finally
      Bmp.Free;
    end;
  finally
    SigStream.Free;
  end;
end;

Answer 2

我尝试在fmx中使用它，但是它没有工作，所以我从FMXexpress中获得了一个类似的函数，这个函数也是内存泄漏和修改的。

我将函数转换为传递2个参数的过程。第一个是您希望使用makescreen的对象，第二个是目标对象。最后，它清除了记忆。

class Procedure MakeScaleScreenshot(Sender: TControl; SetImg: TImage);

Class Procedure MakeScaleScreenshot(Sender: TControl; SetImg: TImage);
var
  fScreenScale: Single;
  Result:TBitmap;
function GetScreenScale: Single;
  var
    ScreenService: IFMXScreenService;
  begin
    Result := 1;
    if TPlatformServices.Current.SupportsPlatformService(IFMXScreenService,
      IInterface(ScreenService)) then
    begin
      Result := ScreenService.GetScreenScale;
    end;
  end;

begin    
  fScreenScale := GetScreenScale;
  Result := TBitmap.Create(Round(Sender.Width * fScreenScale), Round(Sender.Height * fScreenScale));
  Result.Clear(0);

  if Result.Canvas.BeginScene then
  try
    Sender.PaintTo(Result.Canvas, RectF(0, 0, Result.Width, Result.Height));
  finally
    Result.Canvas.EndScene;
    SetImg.Bitmap:=Result;
  end;

 Result.FreeHandle;
 Result.DisposeOf;

end;

//how to use

Procedure
Begin
  {TControl source screen}, {Img destiny of the TImage type}
  MakeScaleScreenshot(Image1,Image2);
end;