Aero Glass/es

// 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
      
    {$mode delphi}
      
    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.

MyProyecto\glass.pas

unit form1;
      
    {$mode objfpc}{$H+}
      
    interface
      
    uses
      Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs
      glass; // Esto incluye el procedimiento GlassForm

procedure TForm1.FormActivate(Sender: TObject);
    begin
      GlassForm(Form1,clBlue); // Esto aplica el efecto Aero Glass en Form1
    end;