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

[turboPASCAL]

Hi,

kennt sich da einer aus ?
Ich glaube Daniel 29++ :stupid: hatte da mal was mit einem Bitmap gemacht. :gruebel:

[Codewalker]

Ja in der Monumentaltrilogie zum Delphi 2007 - Text auf ein Offscreen-Bitmap gezeichnet und dann ausgegeben. Ist im Video sehr gut erklär (ich weiß leider nicht mehr welcher der Teile es war)

[turboPASCAL]

Ja ich such mir schon 'n Wolf. :stupid:

Finde aber jetzt nix genaues.

// Harrh, gefunden... leider kann man in dem Video nicht scrollen. ;)

[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;

[EWeiss]

jo schon alt..
aber hast mal ein Pic wie das bei dir aussieht?

Eventuell muss ich das auch bei meiner listbox machen wenn nach Aero umgeschaltet wird.

gruss

[turboPASCAL]

Hier zum Testen das Progrämmchen:

[EWeiss]

Zitat:

Zitat von turboPASCAL (Beitrag 1107606)

Hier zum Testen das Progrämmchen:

OH.. Die Anwendung wäre nicht nötig gewesen
dafür einen extra Dank..

Sieht gut aus ;) :thumb:

EDIT:
Scheint aber so das du hier einen fehler hast!

Delphi-Quellcode:

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

sollte so sein

Delphi-Quellcode:

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

oder aber ich bekomme diese Fehlermeldung.

Zitat:

[DCC Fehler] uDrawText.pas(101): E2250 Es gibt keine überladene Version von 'DrawThemeTextEx', die man mit diesen Argumenten aufrufen kann

gruss

[turboPASCAL]

Ich habe eine steinalte "uxTheme.pas", da ist das noch so. ;)

[EWeiss]

Zitat:

Zitat von turboPASCAL (Beitrag 1107609)

Ich habe eine steinalte "uxTheme.pas", da ist das noch so. ;)

Ach so dann ist das verständlich :)

gruss

[EWeiss]

Hmm kein Fehler aber Text wird auch keiner ausgegeben.

Delphi-Quellcode:

  if SkinEngine.SK_AEROEMULATE = 0 then
    DrawText(DC, Text, length(Text), rc, DT_LEFT or DT_EXPANDTABS or DT_NOPREFIX)
  else
  DrawAlphaText(WinHandle, DC, rc.Left, rc.Top, Text);

:gruebel:

EDIT:
Geht jetzt!
Habe aber einen unschönen Rahme um den Text.

gruss

[jaenicke]

Gab es bei Delphi 2009 noch nicht die Eigenschaft GlowSize bei TLabel?

Bei Delphi XE zumindest setze ich darüber einfach die Stärke des Gloweffektes, beim Formular den Glasseffekt auf aktiv und fertig.

[EWeiss]

Zitat:

Zitat von jaenicke (Beitrag 1107624)

Gab es bei Delphi 2009 noch nicht die Eigenschaft GlowSize bei TLabel?

Bei Delphi XE zumindest setze ich darüber einfach die Stärke des Gloweffektes, beim Formular den Glasseffekt auf aktiv und fertig.

JO aber wie bekannt ist das nonvcl ;)
Es funktioniert ja jetzt aber leider nicht so kraftvoll wie im Beispiel von @turboPASCAL.
Ich denke weil der Hintergrund was den Glaseffekt angeht nicht stimmt.

Der sollte sich nicht ändern sondern so bleiben wie er ist.
Finde aber im moment nicht den Ansatz wo ich das ändern muss(kann)

Die Transparenz sollte so bleiben wie beim Bild "OhneAeroText"


gruss