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]

[robinWie]

Kann man dieses schöne Design auch unter Windows XP anzeigen lassen? Wenn ja, wie?

[jbg]

Zitat von robinWie:

Kann man dieses schöne Design auch unter Windows XP anzeigen lassen? Wenn ja, wie?

Ja, mit einer Virtuellen Machine (VMware, VirtualPC, ...) und einem Windows Vista.

[Hanzmeierschulz]

Zitat von jbg:

Zitat von robinWie:

Kann man dieses schöne Design auch unter Windows XP anzeigen lassen? Wenn ja, wie?

Ja, mit einer Virtuellen Machine (VMware, VirtualPC, ...) und einem Windows Vista.

Ich dachte man braucht ne DX8 Karte + Vista-Treiber für Glass und beide gibts doch eigentlich nicht für die VM's, oder?

[jbg]

Ich wollte ja nur ironisch andeuten, dass es unter WinXP nicht gehen wird.

[MagicAndre1981]

Zitat von Hanzmeierschulz:

Ich dachte man braucht ne DX8 Karte + Vista-Treiber für Glass

Dx9 mit PixelShader 2.0

[robinWie]

Zitat:

Ich wollte ja nur ironisch andeuten, dass es unter WinXP nicht gehen wird.

Hätte ja sein könnten das man sich irgendwas installieren kann und dan geht

[Khabarakh]

Zitat von robinWie:

Zitat:

Ich wollte ja nur ironisch andeuten, dass es unter WinXP nicht gehen wird.

Hätte ja sein könnten das man sich irgendwas installieren kann und dan geht

Natürlich geht das. Die Software, die du dazu installieren musst, hört auf den Namen "Microsoft Windows Vista".
Und es geht sogar ganz ohne Installation: Den Effekt selbst machen.

[Jonas]

Bei mir funktioniert es irgendwie nicht. Sobald ich das Projekt starte, wird DWM beendet. Wenn ich DWM neustarte, habe ich das Fenster einfach nur schwarz, aber keinen DWM effekt, oderso. Nutze Pre-RC 1, 5536.

[gromar]

Hey guys.
I’m sorry for the English, but my German sucks pretty bad so……

Anyway, I really liked what you done here, neat stuff.
But when I try to compile and run the demos or using the code in my own apps. The same thing happen all the time. The form background becomes absolutely black. ( I included an screenshot)
I compiled the demos on the following:
Borland developer studio 2006 (architect) sp1 (Delphi 2006 win32 part) on Vista pre RC1 (build 5536)
Borland developer studio 2006 sp2 architect) (Delphi 2006 win32 part) winXP pro sp2
Delphi 7 pro winXP pro sp2
All the executables produced that black form background.
I run the exe’s on Vista pre RC1 (build 5536).


Any idea how to fix this?
Btw. Its running on a
AMD 2800+,1GB RAM and a Nvidia 6600GT 128MB


.:martin


Ps: I tride all the onActivate, onShowe, onClik an sow on……

[Jonas]

Das von gromar beschriebene Problem trifft genau auf meines zu. Ich bitte daher um Hilfe. ^^