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]

[zahor]

Also unter dem finalen Vista Home Premium geht es definitiv nicht, wenn ich es mit D7 Enterprise kompiliere.

[Cyberbob]

Schade eigentlich, das die Kompo zwar für die Beta aber nicht die Final funtioniert. Kennt sonst jemand ne Message, die ich senden kann, m mein Formular im Aero-Glass Lokk darstellen zu können?
Oder wird es bald eine Überarbeitete Version dieser Kompo geben


[EDIT] Hab was gefunden! Verstehe es nur noch nicht ganz. Siehe anhang!
[EDIT2] http://msdn.microsoft.com/msdnmag/is...lt.aspx?loc=de

[zahor]

Also ich habs mal ausprobiert und festgestellt: Alles, was schwarz ist (Also die Caption von den Buttons etc.) ist leider transparent, wie Hanzmeierschulz in Beitrag #31 beschrieben hat.
Das ganze in ein Panel zu setzen (EDIT: oder mit Frames zu arbeiten) ändert auch nichts.
EDIT3: Mit Canvas kann man auch nichts draufzeichnen, zum Beispiel nen einfachen Text oder so.

EDIT2: Ich hab den transparenten Bereich jetzt so geändert, dass alles bis auf eine Fläche, auf der zwei Buttons sind, transparent ist. Diese werden dann korrekt dargestellt.
Die restlichen Buttons werden aber transparent gezeichnet. Da man nur einen Bereich zeichnen kann, ist es ja keine Lösung, alle Elemente auf einen Haufen zu knallen.
Zu den Angaben MTop etc: das bedeutet, BIS MTop ist transparent, BIS MRight auch etc, jeweils von Oben bzw. Rechts usw.

[atgis]

Ist es auch möglich den Glass Effekt unter XP zum laufen zu bringen?

[sakura]

Zitat von atgis:

Ist es auch möglich den Glass Effekt unter XP zum laufen zu bringen?

Nur mit extra Skinning-Engines. Windows XP selbst unterstützt das gar nicht.

......

[mkinzler]

Wenn Microsoft sich entscheidet die API für XP nachzurüsten.

[01001]

Das wurde schon ein paar Beiträge darüber geklärt. Nein. Wenn es ginge, gäbe es ja überhaupt keinen Grund Vista zu kaufen...

[Cyberbob]

Microsoft hat sogar alles getan, um Programme zu stoppen, die das nachrüsten können.

[MarcoWarm]

Da die aktuelle Version der Komponente nur ein schwarzes Fenster bringt hab ich mal einen Anfang gemacht die DWM API zu übersetzen und nach einer alternativen (und meiner Meinung nach) korrekten Lösung des Problems zu suchen.
Im Anhang befindet sich die API und ein kleines Demo-Programm.
ein paar Anmerkungen:
Da "Delphifarben" keinen Alphachannel besitzen muss für die korrekte Transparenzdarstellung die Fensterfarbe schwarz sein. Das bedeutet jedoch, daß sämtliche schwarze labels oder andere GDI-gezeichneten Objekte ebenfalls transparent dargestellt werden. Um trotzdem schwarzen Text auszugeben muss man dann GDI+ bemühen.
Das Demoprojekt läuft auch nur unter Vista (siehe nächsten Post) ... Ich hab keine Plausibilitätskontrollen eingefügt, weil es ja nur eine Demonstration ist.

Ich hoffe es nützt dem einen oder anderen. Das Beispiel und die API sind Produkt von lediglich 2Stunden Arbeit... Also bitte keine zu harte Kritik. Es ist nur quick-n-dirty. Wer Spaß und Zeit hat sollte daraus eine komplette API Übersetzung (samt Komponente?) machen. Sehr schön wäre es auch die Thumbnailpreviews anzuzeigen (*träum*)
Die Anleitungen : http://msdn2.microsoft.com/en-us/library/aa969540.aspx

[alias5000]

Eine kleine Kleinigkeit:
Unter WinXP steht das alles natürlich nciht zur Verfügung. Dein Demoprojekt erzeugt aber auch einen haufen AVs dann.
Auf meinem Vista rechner schau ich mir das noch an

Gruß
alias5000