AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Projekte Delphi Aero Glass Effekt für Delphi-Forms

Aero Glass Effekt für Delphi-Forms

Ein Thema von Hanzmeierschulz · begonnen am 4. Aug 2006 · letzter Beitrag vom 1. Jul 2010
Antwort Antwort
Seite 3 von 10     123 45     Letzte » 
Hanzmeierschulz
Registriert seit: 10. Jun 2006
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]
Miniaturansicht angehängter Grafiken
glass_preview_1_102.jpg   glass_preview_2_157.jpg  
Angehängte Dateien
Dateityp: zip glass_152.zip (110,0 KB, 950x aufgerufen)
 
Benutzerbild von robinWie
robinWie

 
Delphi 2005 Personal
 
#21
  Alt 20. Aug 2006, 09:41
Kann man dieses schöne Design auch unter Windows XP anzeigen lassen? Wenn ja, wie?
Robin W.
  Mit Zitat antworten Zitat
jbg

 
Delphi 10.1 Berlin Professional
 
#22
  Alt 20. Aug 2006, 11:03
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.
Andreas aka AHUser aka jbg
  Mit Zitat antworten Zitat
Hanzmeierschulz

 
Delphi 7 Professional
 
#23
  Alt 20. Aug 2006, 11:22
Zitat von jbg:
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.
Ich dachte man braucht ne DX8 Karte + Vista-Treiber für Glass und beide gibts doch eigentlich nicht für die VM's, oder?
  Mit Zitat antworten Zitat
jbg

 
Delphi 10.1 Berlin Professional
 
#24
  Alt 20. Aug 2006, 11:30
Ich wollte ja nur ironisch andeuten, dass es unter WinXP nicht gehen wird.
Andreas aka AHUser aka jbg
  Mit Zitat antworten Zitat
Benutzerbild von MagicAndre1981
MagicAndre1981

 
Delphi 7 Enterprise
 
#25
  Alt 20. Aug 2006, 12:09
Zitat von Hanzmeierschulz:
Ich dachte man braucht ne DX8 Karte + Vista-Treiber für Glass
Dx9 mit PixelShader 2.0
André
  Mit Zitat antworten Zitat
Benutzerbild von robinWie
robinWie

 
Delphi 2005 Personal
 
#26
  Alt 20. Aug 2006, 12:22
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
Robin W.
  Mit Zitat antworten Zitat
Benutzerbild von Khabarakh
Khabarakh
 
#27
  Alt 20. Aug 2006, 12:38
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.
Sebastian
  Mit Zitat antworten Zitat
Jonas

 
Delphi 2007 Professional
 
#28
  Alt 30. Aug 2006, 12:55
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.
  Mit Zitat antworten Zitat
gromar
 
#29
  Alt 31. Aug 2006, 23:16
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……
Miniaturansicht angehängter Grafiken
capture_102.jpg  
  Mit Zitat antworten Zitat
Jonas

 
Delphi 2007 Professional
 
#30
  Alt 17. Sep 2006, 19:40
Das von gromar beschriebene Problem trifft genau auf meines zu. Ich bitte daher um Hilfe. ^^
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:45 Uhr.
Powered by vBulletin® Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf