Aero Glass - ein Text (Label) hintergrund "machen" ?

[turboPASCAL]

War ja einfacher als ich dachte. Es hat nur den ganzen halben Tag gebraucht.

Delphi-Quellcode:

function CreateBitmap32(DC: HDC; W, H: Integer; var BitmapBits: Pointer): HBITMAP;
var
  bi: BITMAPINFO;
begin
  ZeroMemory(@bi, sizeof(BITMAPINFO));
  with bi.bmiHeader do
  begin
    biSize          := sizeof(BITMAPINFOHEADER);
    biWidth         := W;
    biHeight        := -H;
    biCompression   := BI_RGB;
    biBitCount      := 32;
    biPlanes        := 1;
    biXPelsPerMeter := 0;
    biYPelsPerMeter := 0;
    biClrUsed       := 0;
    biClrImportant  := 0;
  end;
  Result := CreateDIBSection(DC, bi, DIB_RGB_COLORS, BitmapBits, 0, 0);
end;

var
  hTheme: THandle;

procedure DrawAlphaText(wnd: hwnd; DC: HDC; x,y: integer; txt: WideString);
var
  tr: trect;
  txtOptions: TDTTOPTS;
  hBmp: HBITMAP;
  hBmpDC: HDC;
  hFnt: HFont;
  p: pointer;
  ts: SIZE;
begin
  hTheme := OpenThemeData(wnd, 'window');

  hBmpDC := CreateCompatibleDC(0);

  hFnt := CreateFont(-MulDiv(10, GetDeviceCaps(hBmpDC, LOGPIXELSY), 72), 0, 0, 0, FW_BOLD {FW_NORMAL}, 0, 0, 0,
     DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, 'arial');

  SelectObject(hBmpDC, hFnt);

  GetTextExtentPointW(hBmpDC, PWideChar(txt), length(txt), ts);

  SetRect(tr, 0, 0, ts.cx + 5, ts.cy + 5);

  hBmp := CreateBitmap32(hBmpDC, tr.Right, tr.Bottom, p);
  SelectObject(hBmpDC, hBmp);

  ZeroMemory(@txtOptions, sizeof(TDTTOPTS));
  txtOptions.dwSize := sizeof(TDTTOPTS);
  txtOptions.dwFlags := DTT_COMPOSITED or DTT_GLOWSIZE or DTT_TEXTCOLOR;
  txtOptions.iGlowSize := 5;
  txtOptions.crText := $00FF0000;

  DrawThemeTextEx(hTheme, hBmpDC, 0, 0, PWideChar(txt), length(txt), DT_SINGLELINE or DT_vCENTER, tr, @txtOptions);

  BitBlt(dc, x, y, tr.Right, tr.Bottom, hBmpDC, 0, 0, SRCCOPY);

  DeleteObject(hBmpDC);
  DeleteObject(hBmp);
  DeleteObject(hFnt);

  CloseThemeData(hTheme);
end;