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]

[g1o2k4]

ich hab die demo ausprobiert aber bei mir bleibt der bereich wo eigentlich das glass sein sollte schwarz...
ich benutze win vista x64, liegts daran oder an was anderen ?

[Polynom]

Zitat von turboPASCAL:

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

Da hab ich einen Rand um den Button (so, wie es Prototypjack hier beschreibt).
Das ärgert mich auch. Normalerweise steig' ich dann auf einen "SpeedButton" um, aber sobald man mit "SetShield" das "Admin-Schild" anzeigen will ist man da am Ende ... Vielleicht bringt ja Delphi 2009 in der Hinsicht was Neues - Der Button wurde ja sowieso verbessert.
(Und wenn wir gerade beim Wünschen sind : Eine einfache Methode (oder Objektinspektor-Eigenschaft) um mehreren Labels einen Glowstyle zu verpassen wäre noch schön und vielleicht noch eine Möglichkeit um Panels (und andere Controls) so transparent zu machen, dass man den Glass-Effekt sieht - so wie hier )

Mit freundlichen Grüßen, Michi

[Cyberbob]

So, anbei mal einen Screenshot wie das ganze bei mir unter vista aussieht

[zahor]

kann man das auch in ner normalen vlc-anwendung verwenden? du erzeugst die komponenten ja dynamisch...

[lbccaleb]

@TurboPASCAL:

Also ich weiß nicht, aber dein Programm hat bei mir noch ziemliche Probleme, liegt es vllt daran wie du die Controls einfärbst??

Ich hab es in meiner Anwedung so gemacht:

Delphi-Quellcode:

      WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
        if IsDWMloaded then
          if (lParam = hwndTrackBar1) then
            begin
              SetBkColor(loword(WParam), $FF);
              Result := GetStockObject(BLACK_BRUSH);
              Exit;
            end

Das funktioniert auch, nur hab ich das Problem, das die Controls schwarz gezeichnet werden, wenn ich das gar nicht haben will, also auch wenn ich den Status des DW Manager abfrage (IsDWMloaded in meiner Unit), und bei nicht vorhandensein die Controls in normaler Farbe zeichnen will!

Ich hab mir die DWMIAPI folgend geändert (unten angehängt)!

Ausserdem besteht auch bei mir noch das Problem mit den Schriften der Controls, alles durchsichtig! Es muss doch ne möglichkeit geben die Schriftfarbe zu ändern! Hab es auch über die messages "WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC" probiert, aber dort tut sich bei den Farben nichts, vllt hab ich aber auch nur ein Fehler gemacht beim Zeichen in den Canvas, denn da bin ich noch ein totaler Noob oO!

Vllt kennt sich damit ja nochjemand besser hier aus...

[Sherlock]

Zitat von zahor:

kann man das auch in ner normalen vlc-anwendung verwenden? du erzeugst die komponenten ja dynamisch...

Dieser ganze Thread richtet sich IMHO an die NonVCL-Fraktion...Denn schon mit Delphi7 und XPMan werden unter Vista die Rahmen durchsichtig...aber jedem das Seine.

Sherlock

[lbccaleb]

Zitat von Sherlock:

Zitat von zahor:

kann man das auch in ner normalen vlc-anwendung verwenden? du erzeugst die komponenten ja dynamisch...

Dieser ganze Thread richtet sich IMHO an die NonVCL-Fraktion...Denn schon mit Delphi7 und XPMan werden unter Vista die Rahmen durchsichtig...aber jedem das Seine.

Sherlock

Nee eigentlich eher die letzten Beiträge, davor war alles auf VCL Basis aufgebaut..

[zahor]

Zitat von lbccaleb:

Zitat von Sherlock:

Zitat von zahor:

kann man das auch in ner normalen vlc-anwendung verwenden? du erzeugst die komponenten ja dynamisch...

Dieser ganze Thread richtet sich IMHO an die NonVCL-Fraktion...Denn schon mit Delphi7 und XPMan werden unter Vista die Rahmen durchsichtig...aber jedem das Seine.

Nee eigentlich eher die letzten Beiträge, davor war alles auf VCL Basis aufgebaut..

eben, deshalb frage ich ja - also wie siehts mit vcl aus?

[turboPASCAL]

Zitat von lbccaleb:

Nee eigentlich eher die letzten Beiträge, davor war alles auf VCL Basis aufgebaut..

Jupp.

Um aber ein besseres Verständnis über die Arbeitsweise der/des DWM's zu bekommen, ohne die (störende) Einwirkung
der VCL habe ich das Testprogramm als nonVCL programiert.

Leider bekomme ich hier und da Problemchen die mir selbst das : MSDN Developer Centers nicht so recht
erklären kann.

[lbccaleb]

Na ich ja auch, wie ich in Post 85 schon geschrieben hab, und komm dort irgendwie auch noch nciht so recht weiter...

Hat denn schon jemand angefangen, mit der Thumbnail funktion aus der DWMAPI?? Die müsste man auch mal umsetzen in Delphi code..