Aero Glass Effekt für Delphi-Forms

[Hanzmeierschulz]

Also ich habe mich mit dem neuen Aero Glass Effekt unter Windows Vista beschäftigt. Dabei hatte ich verschiedene Funktionen der neuen DWM Api von MS ausprobiert.
Als Ergebnis habe ich die am sinnvollsten einsetzbare Funktion herausgegriffen und eine Delphi Unit darum gepackt:

Delphi-Quellcode:

// Aero Glass Effekt für Delphi-Forms
//
// Mit der Methode GlassForm kann für eine Form der
// Aero Glass Effekt unter Vista aktiviert werden.
// Der erste Parameter ist die Form-Klasse, der zweite
// optionale Parameter ist der BlurColorKey. Mit dem
// BlurColorKey wird eine Farbe festgelegt, auf dem
// der Effekt wirken soll, d.h. benutzt eine Komponente,
// auf der Form, für visuelle Darstellungen (Linien, Punkte,
// Bilder, ...), diese Farbe, so wird an dieser Stelle der
// Effekt wirksam. Der Standardwert für BlurColorKey ist
// clFuchsia.
//
// Hinweis: Für die Aktivierung wird zusätzlich TXPManifest
//          bzw. eine RES-Datei die die Manifest-Daten
//          enthält benötigt.
//
//
// Delphi-Unit von Daniel Mitte (2006)
//
//
// Beispiel:
//
// uses glass;
//
// [...]
//
// procedure TForm1.FormActivate(Sender: TObject);
// begin
//   GlassForm(Form1);
//   // oder mit anderem BlurColorKey
//   // GlassForm(Form1, clBlue)
// end;

unit glass;

interface

uses
  Windows,
  Forms,
  Graphics;
  
procedure GlassForm(frm: TForm; cBlurColorKey: TColor = clFuchsia);

implementation

procedure GlassForm(frm: TForm; cBlurColorKey: TColor = clFuchsia);
const
  WS_EX_LAYERED = $80000;
  LWA_COLORKEY = 1;

type
  _MARGINS = packed record
    cxLeftWidth: Integer;
    cxRightWidth: Integer;
    cyTopHeight: Integer;
    cyBottomHeight: Integer;
  end;
  PMargins = ^_MARGINS;
  TMargins = _MARGINS;
  
  DwmIsCompositionEnabledFunc = function(pfEnabled: PBoolean): HRESULT; stdcall;
  DwmExtendFrameIntoClientAreaFunc = function(destWnd: HWND; const pMarInset: PMargins): HRESULT; stdcall;
  SetLayeredWindowAttributesFunc = function(destWnd: HWND; cKey: TColor; bAlpha: Byte; dwFlags: DWord): BOOL; stdcall;

var
  hDWMDLL: Cardinal;
  osVinfo: TOSVERSIONINFO;
  fDwmIsCompositionEnabled: DwmIsCompositionEnabledFunc;
  fDwmExtendFrameIntoClientArea: DwmExtendFrameIntoClientAreaFunc;
  fSetLayeredWindowAttributesFunc: SetLayeredWindowAttributesFunc;
  bCmpEnable: Boolean;
  mgn: TMargins;
  
begin
  ZeroMemory(@osVinfo, SizeOf(osVinfo));
  OsVinfo.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);

  if ((GetVersionEx(osVInfo) = True) and (osVinfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (osVinfo.dwMajorVersion >= 6)) then
  begin
    hDWMDLL := LoadLibrary('dwmapi.dll');

    if hDWMDLL <> 0 then
    begin
      @fDwmIsCompositionEnabled := GetProcAddress(hDWMDLL, 'DwmIsCompositionEnabled');
      @fDwmExtendFrameIntoClientArea := GetProcAddress(hDWMDLL, 'DwmExtendFrameIntoClientArea');
      @fSetLayeredWindowAttributesFunc := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
      
      if ((@fDwmIsCompositionEnabled <> nil) and (@fDwmExtendFrameIntoClientArea <> nil) and (@fSetLayeredWindowAttributesFunc <> nil)) then
      begin
        fDwmIsCompositionEnabled(@bCmpEnable);
        
        if bCmpEnable = True then
        begin
          frm.Color := cBlurColorKey;

          SetWindowLong(frm.Handle, GWL_EXSTYLE, GetWindowLong(frm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
          fSetLayeredWindowAttributesFunc(frm.Handle, cBlurColorKey, 0, LWA_COLORKEY);

          ZeroMemory(@mgn, SizeOf(mgn));
          mgn.cxLeftWidth := -1;
          mgn.cxRightWidth := -1;
          mgn.cyTopHeight := -1;
          mgn.cyBottomHeight := -1;

          fDwmExtendFrameIntoClientArea(frm.Handle, @mgn);          
        end;
      end;
      
      FreeLibrary(hDWMDLL);
    end;
  end;
end;

end.

Im Anhang sind noch ein Demo-Projekt und zwei Vorschaubilder.

[edit=Chakotay1308]Klassifizierung korrigiert. Mfg, Chakotay1308[/edit]

[Hanzmeierschulz]

Bin schon (lange) zu einer Lösung gekommen, aber das wird niemanden gefallen, deshalb suche ich nach einer besseren Lösung und das wird wohl noch etwas dauern.

Wen's interessiert, die Lösung ist, dass man SetLayeredWindowAttributes nicht mehr verwendet. Das hat zur Folge, dass dort wo es schwarz ist, wird das Glass angewendet. Da aber Delphi, GDI und nicht GDI+ verwendet, wird es schwierig sein eine Lösung zu finden, denn GDI kann kein ARGB, d.h. leider macht u.a. Vista den Alpha-Teil = 0 für GDI (nicht Plus). Das bedeutet wiederrum, dass aber 0 für volle Transparenz steht (da verstehe ich MS nicht???). Wie auch immer, der Glass-Effekt wird aber auf Schwarz (bis vor kurzem auch alle anderen Farben) mit Alpha=0 angewendet. Somit würde das Glass auf normalen GDI Anwendungen gehen, nur leider auch in Textboxen und anderen Controls, die Schwarz verwenden. Hätte nur MS in beiden Fällen Alpha=255 gewählt oder zumindest beim DWM die freie Wahl gelassen. Mit SetLayeredWindowAttributes konnte man dieser GDI vs. ARGB entgegensteuern, nur hat MS dort seit 5536 was geändert das sich SetLayeredWindowAttributes mit DWM nicht mehr so richtig verträgt.

Mal sehen ob es da eine Lösung gibt, ich suchen...

[shifter]

Das ist aber sehr enteuschend , habe die Version 5728 und bleibt auch alles schwarz.



gruss
seba

[Jonas]

Hat schon jemand ne richtige Lösung?

Ich habs mal ohne "SetLayeredWindowAttributes" versucht, aber so wirklich der bringer isses ja nu nicht. Ich würd mir wünschen wenns eine richtige Lösung gäbe!

[mimarsinan]

Hi,

Sorry for the English - my German is non-existent!

I was looking for someone who could help fix this component? I am trying it on the latest RC2 of Vista and its showing black instead of glass...

I would like to hire a developer who will fix and enhance the component as follows:

1) Make sure the glass effects are proper
2) Allow the glass color to be tinted in a particular color (ex: pink, green, etc)
3) Make sure that when objects are placed on glass regions, they render properly
4) Especially for plain text objects on glass, and other objects as possible, allow for a mechanism whereby they can be painted with a background glow (like the captions of Windows on Vista) so they are easier to read

My budget is $500. Please contact me at [e-mail] directly, post back here, or send PMs (in that order of priority) if you can do all 4 steps above. Thank you!

[Jonas]

noch immer nichts neues? oô

[MuTzE]

Jop. Find die Komponente richtig gut! Hoffe es wird bald gefixt.

[Cyberbob]

Wurde inzwischen eine Lösung gefunden? Oder gibts ne andere Methode, den Glasseffekt auf das ganze Formular auszuweiten?

[DGL-luke]

Zitat von Hanzmeierschulz:

Das bedeutet wiederrum, dass aber 0 für volle Transparenz steht (da verstehe ich MS nicht???).

Das ist normal. Alpha=255 bedeutet voll opak, Alpha=0 bedeutet volle Transparenz. Das ist überall so

Kleine Anmerkung: Kann man die GDI-Calls application-wide hooken und durch GDI+-Calls ersetzen?

[xaromz]

Hallo,

Zitat von DGL-luke:

Kleine Anmerkung: Kann man die GDI-Calls application-wide hooken und durch GDI+-Calls ersetzen?

das kann nicht funktionieren. GDI+ ist ja nur eine Schicht, die über das GDI gelegt wird (und auch noch ganz anders funktioniert). Du hättest also eine Endlosschleife.

Gruß
xaromz

[DGL-luke]

Ok, das wusste ich nicht