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 1 von 10  1 23     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, 960x aufgerufen)
 
jbg

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

 
Delphi 7 Professional
 
#3
  Alt 4. Aug 2006, 20:10
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.
  Mit Zitat antworten Zitat
mkinzler

 
Delphi 11 Alexandria
 
#4
  Alt 4. Aug 2006, 20:15
Dann wäre vielleicht loaded die richtige Methode.
Markus Kinzler
  Mit Zitat antworten Zitat
Hanzmeierschulz

 
Delphi 7 Professional
 
#5
  Alt 4. Aug 2006, 20:22
Da müsste der Programmierer die Loaded Methode der Form überschreiben. Aber ich wollte eher das Prinzip "Zeile einfügen und geht".
  Mit Zitat antworten Zitat
jbg

 
Delphi 10.1 Berlin Professional
 
#6
  Alt 4. Aug 2006, 21:21
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.
Andreas aka AHUser aka jbg
  Mit Zitat antworten Zitat
Hanzmeierschulz

 
Delphi 7 Professional
 
#7
  Alt 4. Aug 2006, 23:01
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.
  Mit Zitat antworten Zitat
Benutzerbild von DGL-luke
DGL-luke

 
Delphi 2006 Professional
 
#8
  Alt 4. Aug 2006, 23:22
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;
Lukas Erlacher
  Mit Zitat antworten Zitat
Benutzerbild von Martin K
Martin K

 
Turbo Delphi für Win32
 
#9
  Alt 4. Aug 2006, 23:46
...oder so:
Delphi-Quellcode:
procedure TForm1.FormShow(Sender: TObject);
begin
  OnShow := nil;
  ...
end;
  Mit Zitat antworten Zitat
jbg

 
Delphi 10.1 Berlin Professional
 
#10
  Alt 5. Aug 2006, 14:19
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.
Andreas aka AHUser aka jbg
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 10  1 23     Letzte » 

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:28 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