10

大家晚上好！

在当前的项目中，我遇到了一个相当令人担忧的内存泄漏，我似乎无法解决这个问题。

我让应用程序在标准使用情况下运行了一夜，当我在 8 小时后醒来时，它消耗了约 750MB 的内存，而它开始时的内存约为 50MB。Windows 任务管理器不适合检查泄漏，除了让您首先发现存在泄漏。

我已经清除了其他一些内存泄漏，主要与 Firemonkeys 相关TGlowEffect。它没有被检测到，ReportLeaksOnShutdown但它的内存使用在动态修改的对象（例如旋转或缩放变化）上变得非常过度。

我已经将它追踪到一个计时器（并禁用它完全阻止泄漏），如果可能的话，我需要帮助来修复它。

说明：此代码使用 FiremonkeyMakeScreenshot函数将 a 的视觉外观保存TPanel (SigPanel)到 a TMemoryStream。然后使用标准代码将此流数据上传到远程 FTP 服务器（见下文）。里面SigPanel有4个TLabel孩子，1个TRectangle孩子，6个TImage孩子。

注意：CfId是一个全局字符串，是根据一个随机extended浮点值生成的，该浮点值随后与格式中的 DateTime 一起散列yyyymmdd_hhnnsszzz。这一生成是在创建表单时完成的，它会重复直到它成为一个有效的CfId（即不包含在 Windows 文件名中使用的非法字符）。一旦它得到一个 valid 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，则泄漏不再存在，并且内存使用率保持在正常水平。除了通常的内存使用外，没有任何异常，也没有报告泄漏。我已经尝试了多个代码示例，无论是保存到流并从那里上传，还是保存到流>文件然后上传文件，但函数本身似乎存在泄漏。一旦我发现这里有泄漏，我什至添加MakeScreenshot.Free了，但我似乎无法插入它，当然，我已经try..finally在我的一个代码“测试运行”中使用过。

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

我非常感谢任何人对此进行的任何研究或笔记，此外，还有解决该问题的方法。

4

2 回答 2

15

您没有释放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;
于 2012-05-28T00:23:51.037 回答
0

我尝试在 fmx 中使用它，但它不起作用所以我从 FMXexpress 中获取了一个类似的功能，这也是内存泄漏并对其进行了修改。

我将函数转换为传递 2 个参数的过程。第一个是您想要生成屏幕的对象，第二个是目标对象。最后它会清除内存。

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;
于 2021-11-04T17:19:37.393 回答