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 9 von 10   « Erste     789 10   
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)
 
g1o2k4
 
#81
  Alt 26. Aug 2008, 18:50
ich hab die demo ausprobiert aber bei mir bleibt der bereich wo eigentlich das glass sein sollte schwarz...
ich benutze win vista x64, liegts daran oder an was anderen ?
  Mit Zitat antworten Zitat
Polynom

 
Delphi 2007 Professional
 
#82
  Alt 26. Aug 2008, 19:01
Zitat von turboPASCAL:
PS.: Apropo Delphi 2007 und SheetOfGlas, wie ist es denn da mit einem Button auf der Form ?
Da hab ich einen Rand um den Button (so, wie es Prototypjack hier beschreibt).
Das ärgert mich auch. Normalerweise steig' ich dann auf einen "SpeedButton" um, aber sobald man mit "SetShield" das "Admin-Schild" anzeigen will ist man da am Ende ... Vielleicht bringt ja Delphi 2009 in der Hinsicht was Neues - Der Button wurde ja sowieso verbessert.
(Und wenn wir gerade beim Wünschen sind : Eine einfache Methode (oder Objektinspektor-Eigenschaft) um mehreren Labels einen Glowstyle zu verpassen wäre noch schön und vielleicht noch eine Möglichkeit um Panels (und andere Controls) so transparent zu machen, dass man den Glass-Effekt sieht - so wie hier )

Mit freundlichen Grüßen, Michi
  Mit Zitat antworten Zitat
Benutzerbild von Cyberbob
Cyberbob

 
Delphi XE7 Architect
 
#83
  Alt 26. Aug 2008, 21:29
So, anbei mal einen Screenshot wie das ganze bei mir unter vista aussieht
Miniaturansicht angehängter Grafiken
aeroglass_328.jpg  
Christian
  Mit Zitat antworten Zitat
zahor

 
Delphi 2007 Professional
 
#84
  Alt 27. Aug 2008, 13:02
kann man das auch in ner normalen vlc-anwendung verwenden? du erzeugst die komponenten ja dynamisch...
  Mit Zitat antworten Zitat
Benutzerbild von lbccaleb
lbccaleb

 
Delphi 7 Enterprise
 
#85
  Alt 27. Aug 2008, 16:23
@TurboPASCAL:

Also ich weiß nicht, aber dein Programm hat bei mir noch ziemliche Probleme, liegt es vllt daran wie du die Controls einfärbst??

Ich hab es in meiner Anwedung so gemacht:


Delphi-Quellcode:
      WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
        if IsDWMloaded then
          if (lParam = hwndTrackBar1) then
            begin
              SetBkColor(loword(WParam), $FF);
              Result := GetStockObject(BLACK_BRUSH);
              Exit;
            end
Das funktioniert auch, nur hab ich das Problem, das die Controls schwarz gezeichnet werden, wenn ich das gar nicht haben will, also auch wenn ich den Status des DW Manager abfrage (IsDWMloaded in meiner Unit), und bei nicht vorhandensein die Controls in normaler Farbe zeichnen will!

Ich hab mir die DWMIAPI folgend geändert (unten angehängt)!

Ausserdem besteht auch bei mir noch das Problem mit den Schriften der Controls, alles durchsichtig! Es muss doch ne möglichkeit geben die Schriftfarbe zu ändern! Hab es auch über die messages "WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC" probiert, aber dort tut sich bei den Farben nichts, vllt hab ich aber auch nur ein Fehler gemacht beim Zeichen in den Canvas, denn da bin ich noch ein totaler Noob oO!

Vllt kennt sich damit ja nochjemand besser hier aus...
Angehängte Dateien
Dateityp: pas dwmapi_120.pas (5,3 KB, 77x aufgerufen)
Martin
  Mit Zitat antworten Zitat
Benutzerbild von Sherlock
Sherlock

 
Delphi 10.4 Sydney
 
#86
  Alt 27. Aug 2008, 16:30
Zitat von zahor:
kann man das auch in ner normalen vlc-anwendung verwenden? du erzeugst die komponenten ja dynamisch...
Dieser ganze Thread richtet sich IMHO an die NonVCL-Fraktion...Denn schon mit Delphi7 und XPMan werden unter Vista die Rahmen durchsichtig...aber jedem das Seine.

Sherlock
  Mit Zitat antworten Zitat
Benutzerbild von lbccaleb
lbccaleb

 
Delphi 7 Enterprise
 
#87
  Alt 27. Aug 2008, 16:37
Zitat von Sherlock:
Zitat von zahor:
kann man das auch in ner normalen vlc-anwendung verwenden? du erzeugst die komponenten ja dynamisch...
Dieser ganze Thread richtet sich IMHO an die NonVCL-Fraktion...Denn schon mit Delphi7 und XPMan werden unter Vista die Rahmen durchsichtig...aber jedem das Seine.

Sherlock
Nee eigentlich eher die letzten Beiträge, davor war alles auf VCL Basis aufgebaut..
Martin
  Mit Zitat antworten Zitat
zahor

 
Delphi 2007 Professional
 
#88
  Alt 27. Aug 2008, 16:54
Zitat von lbccaleb:
Zitat von Sherlock:
Zitat von zahor:
kann man das auch in ner normalen vlc-anwendung verwenden? du erzeugst die komponenten ja dynamisch...
Dieser ganze Thread richtet sich IMHO an die NonVCL-Fraktion...Denn schon mit Delphi7 und XPMan werden unter Vista die Rahmen durchsichtig...aber jedem das Seine.
Nee eigentlich eher die letzten Beiträge, davor war alles auf VCL Basis aufgebaut..
eben, deshalb frage ich ja - also wie siehts mit vcl aus?
  Mit Zitat antworten Zitat
Benutzerbild von turboPASCAL
turboPASCAL

 
Delphi 6 Personal
 
#89
  Alt 27. Aug 2008, 23:36
Zitat von lbccaleb:
Nee eigentlich eher die letzten Beiträge, davor war alles auf VCL Basis aufgebaut..
Jupp.

Um aber ein besseres Verständnis über die Arbeitsweise der/des DWM's zu bekommen, ohne die (störende) Einwirkung
der VCL habe ich das Testprogramm als nonVCL programiert.

Leider bekomme ich hier und da Problemchen die mir selbst das : MSDN Developer Centers nicht so recht
erklären kann.
Matti
  Mit Zitat antworten Zitat
Benutzerbild von lbccaleb
lbccaleb

 
Delphi 7 Enterprise
 
#90
  Alt 4. Sep 2008, 00:12
Na ich ja auch, wie ich in Post 85 schon geschrieben hab, und komm dort irgendwie auch noch nciht so recht weiter...

Hat denn schon jemand angefangen, mit der Thumbnail funktion aus der DWMAPI?? Die müsste man auch mal umsetzen in Delphi code..
Martin
  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 10:58 Uhr.
Powered by vBulletin® Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf