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]

Zitat von jbg:

Irgendwie ist mir das zu durchsichtig. Ich darf jetzt nicht mehr das Formular anlicken, da der Klick auf das darunterliegende Fenster durchgeht.

Übrigens "function(pfEnabled: PBoolean): HRESULT; stdcall; " ist falsch deklariert. Das PBoolean muss ein PBOOL sein. Mit PBoolean hat er mir unter gewissen umständen Self überschrieben.

Danke für den Hinweis habs auch gleich geändert.

Ich habe das ganze jetzt in eine Komponente gepackt, somit fällt das OnActivate oder ähnliches weg. Geht soweit auch gut, nur wie jbg bereits erwähnte, kann man die Form nicht mehr anklicken. Das liegt an der Funktion SetLayeredWindowAttributes, somit wird das Fester bei der Farbe X (clFuchsia) transparent und die Events gehen durch auf das darunterliegente Fenster. Gibts da ne Möglichkeit die Transparenttechnik (nicht Alpha/Teiltransparenz) von SetLayeredWindowAttributes so zu benutzen, dass es nicht durch geht.

[Hanzmeierschulz]

Hat jemand die winuser.h aus dem letztem Vista SDK (glaube July CTP)?
Ich brauche den Wert für WM_DWMCOMPOMPOSITIONCHANGED. Da das SDK >1GB ist, wollte ich es nicht erst downloaden wegen der Header-Datei.

[NicoDE]

Delphi-Quellcode:

const
  WM_DWMCOMPOSITIONCHANGED        = $031E;
  WM_DWMNCRENDERINGCHANGED        = $031F;
  WM_DWMCOLORIZATIONCOLORCHANGED  = $0320;
  WM_DWMWINDOWMAXIMIZEDCHANGE     = $0321;

[Hanzmeierschulz]

Super Danke

[Hanzmeierschulz]

Habe nun alles in eine Komponente gepackt, zusätzlich wurden noch ein paar Features hinzugefügt und einige Fehler bereinigt.

[CalganX]

Hi,
bitte trenne den ursprünglichen Code und die Komponente voneinander. Für die Komponente ist die entsprechende OpenSource-Sparte wahrscheinlich passender.
Den Ausgangscode würden wir jedoch gerne als Solchen in korrigierter Form in die Code-Lib übernehmen.

Danke,
Chris

[himitsu]

Wegen dem "Durchklicken"...

hab das in PSDK gefunden, vielleicht hilft das ja och noch etwas mit?

Delphi-Quellcode:

WS_EX_TRANSPARENT

Hit testing of a layered window is based on the shape and transparency of the window. This means that the areas of the window that are color-keyed or whose alpha value is zero will let the mouse messages through. However, if the layered window has the WS_EX_TRANSPARENT extended window style, the shape of the layered window will be ignored and the mouse events will be passed to other windows underneath the layered window.

[Hanzmeierschulz]

Zitat von himitsu:

Wegen dem "Durchklicken"...

hab das in PSDK gefunden, vielleicht hilft das ja och noch etwas mit?

Das Durchklicken hat sich mit der TAeroGlass Komponente erledigt, ich bin noch dran, dass in der reinen Unit-Version auch hinzubekommen. Aber durch Zeitmangel meinerseits dauert das etwas.

[MathiasSimmack]

Müsstest du hier nicht eine 6 als Versionsnummer eintragen:

Delphi-Quellcode:

if (GetVersionEx(osVInfo)) and
           (osVinfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and
           (osVinfo.dwMajorVersion >= 6)) then

Quelle: constructor TAeroGlass.Create(AOwner: TComponent);

[Hanzmeierschulz]

Stimmt. Danke ich werts ändern.