AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Projekte Delphi Aero Glass Effekt für Delphi-Forms
Thema durchsuchen
Ansicht
Themen-Optionen

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 6 von 10   « Erste     456 78     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, 963x aufgerufen)
 
Benutzerbild von MarcoWarm
MarcoWarm

 
Delphi 10.1 Berlin Professional
 
#51
  Alt 19. Okt 2007, 20:46
Zitat von alias5000:
Unter WinXP steht das alles natürlich nciht zur Verfügung. Dein Demoprojekt erzeugt aber auch einen haufen AVs dann.
Irgendwie wäre ich nie auf die Idee gekommen es unter XP auszuprobieren. Mir ist der Sachverhalt vollkommen klar. Das problem lässt sich mit einem einfachen If-Statement lösen. Wenn die DWM-Library nicht geladen werden kann, dann wird das Programm beendet oder ggf. ne Message ausgegeben

gute Nacht
Marco Warm
  Mit Zitat antworten Zitat
mkinzler

 
Delphi 11 Alexandria
 
#52
  Alt 19. Okt 2007, 20:48
Oder vor dem Laden das BS überprüfen.
Markus Kinzler
  Mit Zitat antworten Zitat
Benutzerbild von MarcoWarm
MarcoWarm

 
Delphi 10.1 Berlin Professional
 
#53
  Alt 19. Okt 2007, 20:50
Aber wie gesagt ist es ja eine DEMO der API und kein vollwertiges Programm. Welchen Sinn hätte es ein Demoprogramm für ein Betriebssystem lauffähig zu machen, für welches es nicht bestimmt ist (was sollte es dann auch demonstrieren)? Aber ich würde mich dann doch lieber wieder auf sachliche Kritik verlegen... danke
Marco Warm
  Mit Zitat antworten Zitat
zahor

 
Delphi 2007 Professional
 
#54
  Alt 21. Okt 2007, 18:24
endlich geht's wieder!
danke!!!!!!!!!!!
  Mit Zitat antworten Zitat
Benutzerbild von almisoft
almisoft

 
Delphi 7 Professional
 
#55
  Alt 29. Okt 2007, 21:37
Danke Marco für dein Codebeispiel, welches wunderbar funktioniert. Weiß aber jemand, wie man erreicht, dass alle Objekte, die auf dem Form abgelegt werden _nicht_ transparent angezeigt werden. Ich arbeite mit Delphi 7. Unter Delphi 2007 kann man zumindest bei einigen Objekten wie TButton einfach die Eigenschaft DoubleBuffered auf true setzen, damit der Button nicht transparent erscheint. Bei TPanel klappt das aber nicht. Und unter Delphi 7 geht bewirkt DoubleBuffered nichts.

Alexander Miehlke
Alexander Miehlke
  Mit Zitat antworten Zitat
Benutzerbild von MarcoWarm
MarcoWarm

 
Delphi 10.1 Berlin Professional
 
#56
  Alt 1. Nov 2007, 07:20
Es ist ja eigentlich nicht empfehlenswert zu viele Controls auf die Glasfläche zu legen. Schließlich ist das ja nur ein optisches Schmankerl und man sollte dessen Einsatz nicht übertreiben. Wenn man schon schick auf die Glasfläche zeichnen möchte sollte man dann auf GDI+ ausweichen.
Marco Warm
  Mit Zitat antworten Zitat
Benutzerbild von Cyberbob
Cyberbob

 
Delphi XE7 Architect
 
#57
  Alt 1. Nov 2007, 14:19
und wie mache ich das? wie kann ich ein Label oder nen TImage in GDI+ zeichnen lassen?
Christian
  Mit Zitat antworten Zitat
Benutzerbild von MarcoWarm
MarcoWarm

 
Delphi 10.1 Berlin Professional
 
#58
  Alt 1. Nov 2007, 14:30
GDI+ kommt in unserer Delphisphäre leider noch vieeel zu selten vor... daher findet man in der Suche leider nicht so viel. Am besten du besorgst dir erstmal GID+ API ( http://www.progdigy.com/modules.php?name=gdiplus ) und schaust dir die Beispiele an ... das ist alles recht selbsterklärend
Marco Warm
  Mit Zitat antworten Zitat
K.S.M.
 
#59
  Alt 11. Feb 2008, 13:25
Hurra, es funktioniert!

Kann man die Hintergrundfarbe, die in den Glaseffekt geändert wird, ändern? (Schwarz ist ein wenig ungünstig)
  Mit Zitat antworten Zitat
zahor

 
Delphi 2007 Professional
 
#60
  Alt 11. Feb 2008, 14:05
und was genau hast du gemacht?
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 6 von 10   « Erste     456 78     Letzte »    


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 19:10 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz