delphi - 在屏幕上绘制透明消息会导致系统资源不足

Question

我有一个代码，可以将消息 str 直接绘制到屏幕中心，而无需可见窗口。

为什么使用这段代码第一次工作正常，但经过几十次调用后，它给出了Out of system resources。 似乎可以释放 BM，而且我根本没有看到它分配其他资源。

procedure ttsplash.UpdateSplash(const Str: string);
var
  R: TRect;
  P: TPoint;
  S: TPoint;
  bm: TBitmap;
  bf: TBlendFunction;
  EXSTYLE: DWORD;
  x, y: integer;
  pixel: PRGBQuad;
  TextRed,
  TextGreen,
  TextBlue: byte;
begin

if str='' then exit;

  EXSTYLE := GetWindowLong(Handle, GWL_EXSTYLE);
  SetWindowLong(Handle, GWL_EXSTYLE, EXSTYLE or $80000);

  R := ClientRect;

  bm := TBitmap.Create;
  try
    bm.PixelFormat := pf32bit;
//    bm.SetSize(ClientWidth, ClientHeight);
    bm.Width := clientwidth;
        bm.height := clientheight;

    bm.Canvas.Brush.Color := clBlack;
    bm.Canvas.FillRect(ClientRect);

    bm.Canvas.Font.Assign(Self.Font);
    bm.Canvas.Font.Color := clWhite;
    DrawText(bm.Canvas.Handle, PChar(Str), Length(Str), R,
      DT_SINGLELINE or DT_VCENTER or DT_CENTER or DT_WORD_ELLIPSIS);

    TextRed := GetRValue(ColorToRGB(Font.Color));
    TextGreen := GetGValue(ColorToRGB(Font.Color));
    TextBlue := GetBValue(ColorToRGB(Font.Color));

    for y := 0 to bm.Height - 1 do
    begin
      pixel := bm.ScanLine[y];
      x := 0;
      while x < bm.Width do
      begin
        with pixel^ do
        begin
          rgbReserved := (rgbRed + rgbGreen + rgbBlue) div 3;

          rgbBlue := TextBlue * rgbReserved div 255;
          rgbGreen := TextGreen * rgbReserved div 255;
          rgbRed := TextRed * rgbReserved div 255;
        end;

        inc(pixel);
        inc(x);
      end;
    end;      

    P := Point(0, 0);
    S := Point(bm.Width, bm.Height);
    bf.BlendOp := AC_SRC_OVER;
    bf.BlendFlags := 0;
    bf.SourceConstantAlpha := 255;
    bf.AlphaFormat := AC_SRC_ALPHA;
    UpdateLayeredWindow(Handle, 0, nil, @S, bm.Canvas.Handle, @P, 0, @bf,      ULW_ALPHA)
  finally
    bm.Free;
  end;
end;

Answer 1

如何调试这个。

1. 在项目选项中启用调试 DCU，禁用优化。
2. 当出现资源不足错误时，请点击“中断”。
3. 检查调用堆栈:

当调用GDICheck时，问题发生在CopyBitmap中 -> 双击GDICheck去那里。

设置断点。运行程序 - 计算错误出现之前需要多少次，并在预期错误之前中断。

四处看看是否有任何奇怪的地方。一个好的起点是位图本身。您的第一个线索应该是，每次调用此方法时，您的文本都会爬到隐形表单的角落。

让我们检查位图 header ，看看发生了什么:

看起来您的位图尺寸为负。我想知道这是怎么发生的。事实上，如果您每次调用此函数时都观察一下，您的位图每次都会缩小。事实上，它的宽度缩小了 16 像素，高度缩小了 38 像素，即窗框的大小。

每次调用UpdateLayeredWindow时，您都会将表单(其外部尺寸)的大小调整为客户区域的大小 - 没有窗口框架的大小。您的新窗口会获得新的框架，并且客户区会缩小。

最终什么都没有剩下，你正在尝试制作一个具有负尺寸的位图。因此，在构建位图时应考虑帧大小。使用表单宽度和高度而不是客户端尺寸:

 bm.Width := Width;
 bm.height := Height;

此外，在进行 API 调用时，请养成检查返回值是否有错误的习惯，如相关函数的文档中所述。如果您不检查错误，那么您就是在自找问题。