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]

[MarcoWarm]

Zitat von alias5000:

Unter WinXP steht das alles natürlich nciht zur Verfügung. Dein Demoprojekt erzeugt aber auch einen haufen AVs dann.

Irgendwie wäre ich nie auf die Idee gekommen es unter XP auszuprobieren. Mir ist der Sachverhalt vollkommen klar. Das problem lässt sich mit einem einfachen If-Statement lösen. Wenn die DWM-Library nicht geladen werden kann, dann wird das Programm beendet oder ggf. ne Message ausgegeben

gute Nacht

[mkinzler]

Oder vor dem Laden das BS überprüfen.

[MarcoWarm]

Aber wie gesagt ist es ja eine DEMO der API und kein vollwertiges Programm. Welchen Sinn hätte es ein Demoprogramm für ein Betriebssystem lauffähig zu machen, für welches es nicht bestimmt ist (was sollte es dann auch demonstrieren)? Aber ich würde mich dann doch lieber wieder auf sachliche Kritik verlegen... danke

[zahor]

endlich geht's wieder!
danke!!!!!!!!!!!

[almisoft]

Danke Marco für dein Codebeispiel, welches wunderbar funktioniert. Weiß aber jemand, wie man erreicht, dass alle Objekte, die auf dem Form abgelegt werden _nicht_ transparent angezeigt werden. Ich arbeite mit Delphi 7. Unter Delphi 2007 kann man zumindest bei einigen Objekten wie TButton einfach die Eigenschaft DoubleBuffered auf true setzen, damit der Button nicht transparent erscheint. Bei TPanel klappt das aber nicht. Und unter Delphi 7 geht bewirkt DoubleBuffered nichts.

Alexander Miehlke

[MarcoWarm]

Es ist ja eigentlich nicht empfehlenswert zu viele Controls auf die Glasfläche zu legen. Schließlich ist das ja nur ein optisches Schmankerl und man sollte dessen Einsatz nicht übertreiben. Wenn man schon schick auf die Glasfläche zeichnen möchte sollte man dann auf GDI+ ausweichen.

[Cyberbob]

und wie mache ich das? wie kann ich ein Label oder nen TImage in GDI+ zeichnen lassen?

[MarcoWarm]

GDI+ kommt in unserer Delphisphäre leider noch vieeel zu selten vor... daher findet man in der Suche leider nicht so viel. Am besten du besorgst dir erstmal GID+ API ( http://www.progdigy.com/modules.php?name=gdiplus ) und schaust dir die Beispiele an ... das ist alles recht selbsterklärend

[K.S.M.]

Hurra, es funktioniert!

Kann man die Hintergrundfarbe, die in den Glaseffekt geändert wird, ändern? (Schwarz ist ein wenig ungünstig)

[zahor]

und was genau hast du gemacht?