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]

[smallsmoker]

vieleicht vertuhe ich mich ja aber wozu das ganze ?
bei mir gibt es bei jeder vcl anwendung ne eigenschaft tglassframe der form die das alles auch kann
vermute das das neu in delphi 2007 is ..
mfg smallsmoker

[Namenloser]

Hi,
wie du schon schreibst, das Feature ist erst ab BDS2007 verfügbar. Wenn man den Effekt in älteren Delphiversionen nutzen möchte, muss man eben Umwege gehen und die API direkt ansprechen.

[about_blank]

Hallo Leute, bei mir gibts nur ein Problem.

Auch das Projekt auf der 4. Seite bringt nichts.

Mein problem:
Ich habe ein Vista Aero Fenster aber die Textfarbe, egal welche, wird auch als transperent angezeigt.
Habe auch schon in mehreren Foren Hilfe gesucht, aber hier und bei joejoe.org könnte das Problem lösbar sein.
Auf dem joejoe.org thread hat ein Mitglieg geschrieben, dass die Farbe Schwarz als WIN Aero gerendert wird und daher es auch nicht auf Objekten angezeigt wird.
Link:
http://www.joejoe.org/forum/index.ph...dpost&p=190575

Screenshots: (siehe Link oben)

Das mit den Frames check ich jetzt schon, nur das Problem mit dem GLass.

Vielen Dank im Voraus

mfg.

[zahor]

was der mensch bei joejoe braucht heißt doublebuffering.
einfach in oncreate der form für jede komponente, die diese eigenschaft hat (labels haben sie nicht, die sind für windows keine komponenten sondern werden direkt auf die api gezeichnet wenn ich mich nicht ganz täusche)
Komponente.DoubleBuffered := true; dann sind alle labels ganz toll schwarz oder wie auch immer
bei mir funktioniert es jedenfalls prächtig.

[Cyberbob]

Unter Delphi 2007 tut es das, ja. Aber ich als TD nutzer musste feststellen, dass es nicht funktioniert!

[about_blank]

Danke zahor es funktioniert, aber nur nicht bei einem MainMenu

Und noch ne Frage wie kann ich die Hintergrundfarbe von einem Memo-Feld auf transperent stellen?


nochmals thx, sonst hätt ich in C# programmiert mit einem DWm Wrapper

mfg.

[Prototypjack]

Zitat von Cyberbob:

Unter Delphi 2007 tut es das, ja. Aber ich als TD nutzer musste feststellen, dass es nicht funktioniert!

DoubleBuffered arbeitet intern komplett anders ab 2007. Ich musste das selbst leider schmerzlich feststellen (vgl. http://www.delphipraxis.net/internal...t.php?t=127812). Dort steht eine Lösung von mir, die aber alle Ecken, die transparent sein sollten (siehe Bild) schwarz färbt.

Ich suche immer noch nach einer Lösung, aber vielleicht hilft dir das ja.

Grüße,
Max

[zahor]

So, jetzt mal die Schilderung wie das ganze bei D2007 aussieht:
Mein Beispiel-"Projekt" sieht folgendermaßen aus: Ich habe ein Formular mit einem button drauf, und bei formular ist SheetOfGlass enabled.
Für

Delphi-Quellcode:

button1.DoubleBuffered := true;
form1.DoubleBuffered := true;

habe ich einen Rand an den Ecken des Buttons in der Farbe des Formulars.
Bei nur
  button1.DoubleBuffered := true; habe ich den gleichen schwarzen Rand wie Prototypjack.
Also, prototypjack, probier's mal mit doublebuffering bei der form.
Mit nur
  form1.DoubleBuffered := true; ist die caption des buttons natürlich transparent - wie zu erwarten war. Screenshots im Anhang.

[edit=MrSpock]Layout repariert. Mfg, MrSpock[/edit]

[Jonas]

Kann denn nciht mal einer http://www.codeproject.com/KB/vista/...indowsApp.aspx diese Function übersetzen?
Dann muss man das rumgehampel mit den Margings und so nicht mehr machen. Ich denke das dort ist die ideale lösung?!

[lbccaleb]

Ich hab da auch noch mal eine Frage zu, weiß Jemand ob man die Alpha-Werte verändern kann??
Also der Wert, der die Transparente Fläche markiert, standartmäßig ist das ja Schwarz?!
Und wenn ja wie?