【问题标题】:Create a transparent bitmap and UpdateLayeredWindow创建透明位图和 UpdateLayeredWindow
【发布时间】:2013-11-03 13:31:24
【问题描述】:

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

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

  • BorderStyle = bsNone
  • 颜色 = clBlack
  • AlphaBlend = 真
  • 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;

【问题讨论】:

  • 你的问题是?
  • 我不明白:为什么不在透明表单上使用 TLable?
  • 尝试使用像 TAHOMA 或 VERDANA 这样具有透明形式的字体...您会遇到一些边框问题,因为抗锯齿字体...
  • 或许以下问题的答案会对你有所帮助:How do I put a semi transparent layer on my form
  • kobik:我将透明色设置为黑色(我设置为紫红色),现在它可以随心所欲地绘画了。谢谢!

标签: delphi winapi graphics bitmap alpha


【解决方案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;
     }
}

【讨论】:

    猜你喜欢
    • 2011-10-06
    • 1970-01-01
    • 1970-01-01
    • 2017-02-15
    • 1970-01-01
    • 2012-06-16
    • 2020-04-12
    • 2019-01-04
    • 1970-01-01
    相关资源
    最近更新 更多