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 2 von 10     12 34     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)
 
Hanzmeierschulz

 
Delphi 7 Professional
 
#11
  Alt 7. Aug 2006, 10:30
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.
  Mit Zitat antworten Zitat
Hanzmeierschulz

 
Delphi 7 Professional
 
#12
  Alt 8. Aug 2006, 11:23
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.
  Mit Zitat antworten Zitat
NicoDE
 
#13
  Alt 8. Aug 2006, 12:03
Delphi-Quellcode:
const
  WM_DWMCOMPOSITIONCHANGED = $031E;
  WM_DWMNCRENDERINGCHANGED = $031F;
  WM_DWMCOLORIZATIONCOLORCHANGED = $0320;
  WM_DWMWINDOWMAXIMIZEDCHANGE = $0321;
  Mit Zitat antworten Zitat
Hanzmeierschulz

 
Delphi 7 Professional
 
#14
  Alt 8. Aug 2006, 12:13
Super Danke
  Mit Zitat antworten Zitat
Hanzmeierschulz

 
Delphi 7 Professional
 
#15
  Alt 8. Aug 2006, 16:53
Habe nun alles in eine Komponente gepackt, zusätzlich wurden noch ein paar Features hinzugefügt und einige Fehler bereinigt.
Miniaturansicht angehängter Grafiken
demo_preview_1_926.jpg   demo_preview_2_594.jpg  
Angehängte Dateien
Dateityp: zip aeroglass_119.zip (112,6 KB, 603x aufgerufen)
  Mit Zitat antworten Zitat
CalganX

 
Turbo Delphi für Win32
 
#16
  Alt 8. Aug 2006, 18:19
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
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

 
Delphi 10.4 Sydney
 
#17
  Alt 19. Aug 2006, 01:20
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.
  Mit Zitat antworten Zitat
Hanzmeierschulz

 
Delphi 7 Professional
 
#18
  Alt 19. Aug 2006, 09:44
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.
  Mit Zitat antworten Zitat
MathiasSimmack
 
#19
  Alt 19. Aug 2006, 10:49
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);
  Mit Zitat antworten Zitat
Hanzmeierschulz

 
Delphi 7 Professional
 
#20
  Alt 19. Aug 2006, 11:03
Stimmt. Danke ich werts ändern.
  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 21:36 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