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]

[jbg]

Ich hoffe du weißt, dass OnActivate nicht das richtige Ereignis dafür ist. Zudem würde ich die DLL laufend laden und entladen. Besser beim ersten Zugriff laden und dann im Speicher lassen.

[Hanzmeierschulz]

Ich habe OnActivate deshalb genommen, weil der Effekt nur gesetzt werden kann, wenn das Fenster schon da ist. OnCreate ging bei mir nicht (muss nicht heißen, kann an Vista liegen) und OnShow wird sehr viel öffters aufgerufen als OnActivate.

[mkinzler]

Dann wäre vielleicht loaded die richtige Methode.

[Hanzmeierschulz]

Da müsste der Programmierer die Loaded Methode der Form überschreiben. Aber ich wollte eher das Prinzip "Zeile einfügen und geht".

[jbg]

Zitat:

Zitat von Hanzmeierschulz

OnShow wird sehr viel öffters aufgerufen als OnActivate.

Das meinst du. Wenn du nur ein Formular hast und den Rest modal öffnest, stimmt deine Aussage. Hast du aber mehrere Fenster die "nur" mit Show angezeigt wurden, so wird OnActivate und OnDeactivate bei jedem Fensterwechsel ausgelöst.

[Hanzmeierschulz]

Ach ja, stimmt, daran habe ich garnicht gedacht. Ich werde es nochmal mit OnCreate probieren, denn OnCreate Test habe nur während des Testens (nicht mit dieser Unit) benutzt und keinen Erfolg gehabt. Darum kann es sein, dass es denoch klappt.

[DGL-luke]

MÖP!

Im OnCreatze wirds nicht funktionieren, viele Kompoennten sind da noch nicht erstellt (ich sage viele, weil ein paar DInge bei einigen zwischendurch doch klappen).

Das macht man so:

1. private-feld "Init: Boolean" in die Formdeklaration

2. Init := true ins Oncreate

3. Ins OnShow:

Delphi-Quellcode:

if Init then
  begin
    Init := false;

    ......
    .......
    ...
  end;

[Martin K]

...oder so: :zwinker:

Delphi-Quellcode:

procedure TForm1.FormShow(Sender: TObject);
begin
  OnShow := nil;
  ...
end;

[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.

[Hanzmeierschulz]

Zitat:

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:

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.

[robinWie]

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

[jbg]

Zitat:

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. :roll:

[Hanzmeierschulz]

Zitat:

Zitat von jbg

Zitat:

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. :roll:

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:

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:

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. ^^

[Hanzmeierschulz]

Bin schon (lange) zu einer Lösung gekommen, aber das wird niemanden gefallen, deshalb suche ich nach einer besseren Lösung und das wird wohl noch etwas dauern.

Wen's interessiert, die Lösung ist, dass man SetLayeredWindowAttributes nicht mehr verwendet. Das hat zur Folge, dass dort wo es schwarz ist, wird das Glass angewendet. Da aber Delphi, GDI und nicht GDI+ verwendet, wird es schwierig sein eine Lösung zu finden, denn GDI kann kein ARGB, d.h. leider macht u.a. Vista den Alpha-Teil = 0 für GDI (nicht Plus). Das bedeutet wiederrum, dass aber 0 für volle Transparenz steht (da verstehe ich MS nicht???). Wie auch immer, der Glass-Effekt wird aber auf Schwarz (bis vor kurzem auch alle anderen Farben) mit Alpha=0 angewendet. Somit würde das Glass auf normalen GDI Anwendungen gehen, nur leider auch in Textboxen und anderen Controls, die Schwarz verwenden. Hätte nur MS in beiden Fällen Alpha=255 gewählt oder zumindest beim DWM die freie Wahl gelassen. Mit SetLayeredWindowAttributes konnte man dieser GDI vs. ARGB entgegensteuern, nur hat MS dort seit 5536 was geändert das sich SetLayeredWindowAttributes mit DWM nicht mehr so richtig verträgt.

Mal sehen ob es da eine Lösung gibt, ich suchen...

[shifter]

Das ist aber sehr enteuschend , habe die Version 5728 und bleibt auch alles schwarz.

:cry:

gruss
seba

[Jonas]

Hat schon jemand ne richtige Lösung?

Ich habs mal ohne "SetLayeredWindowAttributes" versucht, aber so wirklich der bringer isses ja nu nicht. Ich würd mir wünschen wenns eine richtige Lösung gäbe!

[mimarsinan]

Hi,

Sorry for the English - my German is non-existent!

I was looking for someone who could help fix this component? I am trying it on the latest RC2 of Vista and its showing black instead of glass...

I would like to hire a developer who will fix and enhance the component as follows:

1) Make sure the glass effects are proper
2) Allow the glass color to be tinted in a particular color (ex: pink, green, etc)
3) Make sure that when objects are placed on glass regions, they render properly
4) Especially for plain text objects on glass, and other objects as possible, allow for a mechanism whereby they can be painted with a background glow (like the captions of Windows on Vista) so they are easier to read

My budget is $500. Please contact me at [e-mail] directly, post back here, or send PMs (in that order of priority) if you can do all 4 steps above. Thank you!

[Jonas]

noch immer nichts neues? oô

[MuTzE]

Jop. Find die Komponente richtig gut! Hoffe es wird bald gefixt.

[Cyberbob]

Wurde inzwischen eine Lösung gefunden? Oder gibts ne andere Methode, den Glasseffekt auf das ganze Formular auszuweiten?

[DGL-luke]

Zitat:

Zitat von Hanzmeierschulz

Das bedeutet wiederrum, dass aber 0 für volle Transparenz steht (da verstehe ich MS nicht???).

Das ist normal. Alpha=255 bedeutet voll opak, Alpha=0 bedeutet volle Transparenz. Das ist überall so ;-)

Kleine Anmerkung: Kann man die GDI-Calls application-wide hooken und durch GDI+-Calls ersetzen?

[xaromz]

Hallo,

Zitat:

Zitat von DGL-luke

Kleine Anmerkung: Kann man die GDI-Calls application-wide hooken und durch GDI+-Calls ersetzen?

das kann nicht funktionieren. GDI+ ist ja nur eine Schicht, die über das GDI gelegt wird (und auch noch ganz anders funktioniert). Du hättest also eine Endlosschleife.

Gruß
xaromz

[DGL-luke]

Ok, das wusste ich nicht :)