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]

[turboPASCAL]

Zitat von lbccaleb:

standartmäßig ist das ja Schwarz?!

Nein, nicht schwarz sondern $00005050.
Veränderbar ist das nicht. ...ich muss doch mal "wischda" anschmeissen.


// Edit: Äh, Das gibt anscheinend Vista vor. Da muss man mal genauer nachforschen...

[MCXSC]

Wie schaut das ganze denn unter XP aus? Läuft eine EXE mit der Komponente überhaupt?

[lbccaleb]

Eigentlich nicht, da in XP kein Desktop Windows Manger mit den Funktionen bereit steht...

[turboPASCAL]

Zitat von MCXSC:

Wie schaut das ganze denn unter XP aus?

Wie XP halt.

Zitat von MCXSC:

Läuft eine EXE mit der Komponente überhaupt?

Jo. Also mit meiner schon.

Zitat von lbccaleb:

Eigentlich nicht, da in XP kein Desktop Windows Manger mit den Funktionen bereit steht...

Eigentlich doch, da die Funktionen dynamisch geladen werden wenn die dwmapi.dll vorhanden ist.
Jedenfalls macht das meine Unit. ( Wenn man beim Programieren etwas Obacht gibt. )

[lbccaleb]

Was ist denn deine Unit?? Also ich benutze für so was eine etwas weiterentwickelte Unit, von der hier schon geposteten! Nur in der sind ja leider noch nciht alles funktionen der DWMAPI.dll enthalten, muss man sich vllt mal die Zeit nehmen und die ein wenig weiterentwickeln...

[turboPASCAL]

Ja wo ist sie denn ? Na hier: (siehe Anhang)
Warnung: Absolute Beta.- & Testversion

Zitat:

muss man sich vllt mal die Zeit nehmen und die ein wenig weiterentwickeln...

jupp.

// Edit:

So, kleines Update der Demo. Funktionsfähigkeit für XP war nicht gegeben.
Kleiner Dummheitsfehler der eine Stunde anstrengender Suche bedurfte.
Tja man wird vergesslich...

[Cyberbob]

Sieht eigentlich ganz gut aus. Allerdings werden Labels und Schrift von Buttons immer noch transparent angezeigt. Schade, dass man das nicht mit nem einfachen befehl ändern kann.

[turboPASCAL]

Zitat von Cyberbob:

Sieht eigentlich ganz gut aus. Allerdings werden Labels und Schrift von Buttons immer noch transparent angezeigt. Schade, dass man das nicht mit nem einfachen befehl ändern kann.

Ich habe in Vista selbst noch kein Programm gesehen das solch ein Formdesign (wie im Demo) hat oder so genutzt wird.
Da die Vista theme DLL drübermalt, zB. über eien Button kan man IMHO nix machen.

PS.:

Wenn jmd grade Vista laufen hat kann er mal bitte einen Screenshot des Fensters machen ?
Ich muss sonst erst umstöpseln. ^^

[Polynom]

Hallo,

Ich hab mal die Demo aus dem Post #76 runtergeladen und ausprobiert. Und jetzt wollt ich mal fragen, ob das so sein soll ... Weil nach Aero-Glass-Effekt sieht das nicht aus.
Ich hab mit meinem Delphi 2007 noch schnell eine Form mit "SheetOfGlass" auf "True" daneben gesetzt, damit man sieht, dass es sonst funktionieren müsste.

Mit freundlichen Grüßen, Michi

[turboPASCAL]

Doch, das schon richtig.selle mal im Code folgendes um:

Delphi-Quellcode:

// uMain.pas
WM_CREATE:
      begin
        //...

        //DWM_EnableBlurBehind(_hWnd, TRUE);
        //DWM_ExtendFrameIntoClientArea(_hWnd, 50,0,0,0);
        DWM_ExtendFrameIntoAll(_hWnd); // <--<<<

        ShowWindow(_hWnd, SW_SHOWNORMAL);
        UpdateWindow(_hWnd);
      end;

// und bei:

function WinMain(hInstance: HINST; hPrevInstance: HINST;
  lpCmdLine: PChar; nCmdShow: Integer): Integer; stdcall;
var
  WndClassEx: TWndClassEx;
  msg: TMsg;
begin
  InitCommonControls;

  bsBKColor := CreateSolidBrush(RGB(0,0,0)); // <--<< die Hintergrundfarbe ändern

PS.: Apropo Delphi 2007 und SheetOfGlas, wie ist es denn da mit einem Button auf der Form ?