delphi - 创建透明位图并UpdateLayeredWindow

Question

我正在尝试创建一个带有“正在加载”文本的掩码窗口，以提醒用户我的应用程序处于繁忙状态。

为此，我首先创建了一个表单:

• BorderStyle = bsNone
• 颜色 = clBlack
• AlphaBlend = True
• AlphaBlendValue = 180;

作为第二步，我想创建另一个表单，但这个表单将具有动态内容。我需要创建一个带有一些状态文本的透明位图，并使用 UpdateLayeredWindow 将窗口绘制为文本。

看看我想要的结果:

请记住:在某些情况下文本会有所不同，例如:

• 重新计算
• 正在加载资源
• 正在加载报告

这就是我需要动态位图生成的原因。

问题

如何创建带有文本的透明位图并在带有 UpdateLayeredWindow 的表单上使用它？

我正在尝试这个，但没有成功(尝试将 Button5 和 Label2 放在表单上的代码):

  procedure Inc(var p: pointer);
  begin
    p := Pointer(Integer(p) + 1);
  end;

var
  s: string;
  frm: TForm;
  f: HFont;
  tx: HDC;
  bmp, old: HBITMAP;
  rc: TRect;
  h: BITMAPINFOHEADER;
  pvBits: Pointer;
  t: tagBITMAPINFO;
  x,y: integer;
  a, r, g, b: byte;
  sz: TSize;
  p: tpoint;
  BlendFunction: TBlendFunction;
begin
  tx := CreateCompatibleDC(0);


  s := label2.Caption;
  f := SelectObject(tx, label2.Font.Handle);


  fillchar(rc, SizeOf(rc), 0);
  DrawText(tx, PChar(s), length(s), rc, DT_CALCRECT);

  fillchar(h, SizeOf(h), 0);
  pvBits := nil;

  h.biSize := SizeOf(h);
  h.biWidth := rc.Right - rc.Left;
  h.biHeight := rc.Bottom - rc.Top;
  h.biPlanes := 1;
  h.biBitCount := 32;
  h.biCompression := BI_RGB;

  FillChar(t, SizeOf(t), 0);
  t.bmiHeader := h;

  bmp := CreateDIBSection(tx, t, 0, pvBits, 0, 0);
  old := SelectObject(tx, bmp);
  if old > 0 then
  begin
    SetTextColor(tx, $00FFFFFF);
    SetBkColor(tx, $00000000);
    SetBkMode(tx, TRANSPARENT);

    DrawText(tx, PChar(s), length(s), rc, DT_NOCLIP);

    r := GetRValue($FF);
    g := GetGValue($FF);
    b := GetBValue($FF);

    for x := 0 to h.biWidth-1 do
      for y := 0 to h.biHeight-1 do
      begin
        a := Byte(pvBits^);

        Inc(pvBits);
        Byte(pvBits^) := (b * a) shr 8;
        Inc(pvBits);
        Byte(pvBits^) := (g * a) shr 8;
        Inc(pvBits);
        Byte(pvBits^) := (r * a) shr 8;
        Inc(pvBits);
        Byte(pvBits^) := a;
      end;

    SelectObject(tx, old);
  end;

  SelectObject(tx, f);
  deleteDC(tx);

  sz.cx := h.biWidth;
  sz.cy := h.biHeight;
  p := Point(0,0);

  BlendFunction.BlendOp := AC_SRC_OVER;
  BlendFunction.BlendFlags := 0;
  BlendFunction.SourceConstantAlpha := 255;
  BlendFunction.AlphaFormat := AC_SRC_ALPHA;

  frm := TForm.CreateNew(self);
  frm.BorderStyle := bsNone;
  frm.Position := poOwnerFormCenter;
  frm.Show;

  UpdateLayeredWindow(frm.Handle, 0, nil, @sz, bmp, @p, 0, @BlendFunction, ULW_ALPHA);
end;

Answer 1

假设您可以使用 Delphi 中的 Windows API 函数(因为您已标记 winapi)，一种简单的方法是:

• CreateDIBSection() 创建 32 位位图
• FillRect() 填充背景，DrawText() 绘制文本
• 修复 Alpha
• 通过 UpdateLayeredWindow() 使用该位图

通过直接修改从 CreateDIBSection() 返回的位图位来修复 Alpha。请注意，UpdateLayeredWindow() 需要预乘 alpha，因此您必须提前将 RGB 分量乘以 alpha 值。

以下代码是 C 语言，但希望能给您带来启发:

LPVOID pBits; // bits from CreateDIBSection
const int width, height; // size of bitmap
const int alpha; // level of transparency

RGBQUAD* pPtr = (RGBQUAD*)pBits;
for (int y = 0; y < height; ++y)
{
     for (int x = 0; x < width; ++x, ++pPtr)
     {
        pPtr->rgbBlue = (alpha * pPtr->rgbBlue) / 255;
        pPtr->rgbGreen = (alpha * pPtr->rgbGreen) / 255;
        pPtr->rgbRed = (alpha * pPtr->rgbRed) / 255;
        pPtr->rgbReserved = alpha;
     }
}