2

アプリケーションのビジー状態についてユーザーに警告するために、「読み込み中」のテキストを含むマスク ウィンドウを作成しようとしています。

このために、最初に次のフォームを 1 つ作成しました。

  • BorderStyle = bsNone
  • カラー = clBlack
  • AlphaBlend = True
  • AlphaBlendValue = 180;

2 番目のステップとして、別のフォームを作成したいのですが、これには動的コンテンツが含まれます。ステータス テキストを含む透明なビットマップを作成し、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;
4

1 に答える 1

0

Delphi から Windows API 関数を使用できると仮定すると (タグ付けしたためwinapi)、1 つの簡単な方法は次のとおりです。

  • CreateDIBSection()32 ビットのビットマップを作成するには
  • FillRect()背景を塗りつぶす、DrawText()テキストを描画する
  • アルファを修正する
  • そのビットマップを使用しますUpdateLayeredWindow()

アルファを修正するには、 から取得したビットマップ ビットを直接変更しますCreateDIBSection()。UpdateLayeredWindow()事前に乗算されたアルファが必要なため、事前にアルファ値で RGB コンポーネントを乗算する必要があることに注意してください。

次のコードは 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;
     }
}
于 2013-10-24T18:44:44.047 に答える