Delphi-PRAXiS
Seite 1 von 10  1 23     Letzte » 

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Software-Projekte der Mitglieder (https://www.delphipraxis.net/26-software-projekte-der-mitglieder/)
-   -   Delphi Aero Glass Effekt für Delphi-Forms (https://www.delphipraxis.net/74538-aero-glass-effekt-fuer-delphi-forms.html)

Hanzmeierschulz 4. Aug 2006 19:56


Aero Glass Effekt für Delphi-Forms
 
Liste der Anhänge anzeigen (Anzahl: 3)
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]

jbg 4. Aug 2006 20:03

Re: Aero Glass Effekt für Delphi-Forms
 
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.

Hanzmeierschulz 4. Aug 2006 20:10

Re: Aero Glass Effekt für Delphi-Forms
 
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.

mkinzler 4. Aug 2006 20:15

Re: Aero Glass Effekt für Delphi-Forms
 
Dann wäre vielleicht loaded die richtige Methode.

Hanzmeierschulz 4. Aug 2006 20:22

Re: Aero Glass Effekt für Delphi-Forms
 
Da müsste der Programmierer die Loaded Methode der Form überschreiben. Aber ich wollte eher das Prinzip "Zeile einfügen und geht".

jbg 4. Aug 2006 21:21

Re: Aero Glass Effekt für Delphi-Forms
 
Zitat:

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.

Hanzmeierschulz 4. Aug 2006 23:01

Re: Aero Glass Effekt für Delphi-Forms
 
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.

DGL-luke 4. Aug 2006 23:22

Re: Aero Glass Effekt für Delphi-Forms
 
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;

Martin K 4. Aug 2006 23:46

Re: Aero Glass Effekt für Delphi-Forms
 
...oder so: :zwinker:
Delphi-Quellcode:
procedure TForm1.FormShow(Sender: TObject);
begin
  OnShow := nil;
  ...
end;

jbg 5. Aug 2006 14:19

Re: Aero Glass Effekt für Delphi-Forms
 
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.


Alle Zeitangaben in WEZ +1. Es ist jetzt 00:25 Uhr.
Seite 1 von 10  1 23     Letzte » 

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