Difference between revisions of "Aero Glass"

From Free Pascal wiki
Jump to navigationJump to search
m (Added custom margins, code commented.)
Line 7: Line 7:
 
First save the above code to a text file "glass.pas":
 
First save the above code to a text file "glass.pas":
  
<delphi>// Aero Glass Effekt für Delphi-Forms
+
<delphi>unit glass;
//
+
 
// Mit der Methode GlassForm kann für eine Form der
+
{$mode delphi}
// Aero Glass Effekt unter Vista aktiviert werden.
+
//{$mode objfpc}{$H+}
// 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
 
interface
 
+
 
{$mode delphi}
 
 
 
 
uses
 
uses
   Windows,
+
   Windows, Forms, Graphics;
  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
 
type
 
   _MARGINS = packed record
 
   _MARGINS = packed record
     cxLeftWidth: Integer;
+
     cxLeftWidth   : Integer;
     cxRightWidth: Integer;
+
     cxRightWidth   : Integer;
     cyTopHeight: Integer;
+
     cyTopHeight   : Integer;
     cyBottomHeight: Integer;
+
     cyBottomHeight : Integer;
 
   end;
 
   end;
 +
 
   PMargins = ^_MARGINS;
 
   PMargins = ^_MARGINS;
 
   TMargins = _MARGINS;
 
   TMargins = _MARGINS;
 
+
 
   DwmIsCompositionEnabledFunc = function(pfEnabled: PBoolean): HRESULT; stdcall;
+
   DwmIsCompositionEnabledFunc     = function(pfEnabled: PBoolean): HRESULT; stdcall;
 
   DwmExtendFrameIntoClientAreaFunc = function(destWnd: HWND; const pMarInset: PMargins): HRESULT; stdcall;
 
   DwmExtendFrameIntoClientAreaFunc = function(destWnd: HWND; const pMarInset: PMargins): HRESULT; stdcall;
   SetLayeredWindowAttributesFunc = function(destWnd: HWND; cKey: TColor; bAlpha: Byte; dwFlags: DWord): BOOL; stdcall;
+
   SetLayeredWindowAttributesFunc   = function(destWnd: HWND; cKey: TColor; bAlpha: Byte; dwFlags: DWord): BOOL; stdcall;
    
+
 
 +
const
 +
  WS_EX_LAYERED = $80000;
 +
   LWA_COLORKEY  = 1;
 +
 
 +
procedure GlassForm(frm: TForm; tmpMargins: TMargins; cBlurColorKey: TColor = clFuchsia);
 +
function WindowsAeroGlassCompatible: Boolean;
 +
 
 +
implementation
 +
 
 +
function WindowsAeroGlassCompatible: Boolean;
 
var
 
var
  hDWMDLL: Cardinal;
 
 
   osVinfo: TOSVERSIONINFO;
 
   osVinfo: TOSVERSIONINFO;
 +
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 Result:=True
 +
  else Result:=False;
 +
end;
 +
 +
procedure GlassForm(frm: TForm; tmpMargins: TMargins; cBlurColorKey: TColor = clFuchsia);
 +
var
 +
  hDwmDLL: Cardinal;
 
   fDwmIsCompositionEnabled: DwmIsCompositionEnabledFunc;
 
   fDwmIsCompositionEnabled: DwmIsCompositionEnabledFunc;
 
   fDwmExtendFrameIntoClientArea: DwmExtendFrameIntoClientAreaFunc;
 
   fDwmExtendFrameIntoClientArea: DwmExtendFrameIntoClientAreaFunc;
Line 83: Line 64:
 
   bCmpEnable: Boolean;
 
   bCmpEnable: Boolean;
 
   mgn: TMargins;
 
   mgn: TMargins;
 
 
 
begin
 
begin
   ZeroMemory(@osVinfo, SizeOf(osVinfo));
+
   { Continue if Windows version is compatible }
  OsVinfo.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);
+
   if WindowsAeroGlassCompatible then begin
 
+
    { Continue if 'dwmapi' library is loaded }
   if ((GetVersionEx(osVInfo) = True) and (osVinfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (osVinfo.dwMajorVersion >= 6)) then
+
     hDwmDLL := LoadLibrary('dwmapi.dll');
  begin
+
     if hDwmDLL <> 0 then begin
     hDWMDLL := LoadLibrary('dwmapi.dll');
+
      { Get values }
 
+
       @fDwmIsCompositionEnabled       := GetProcAddress(hDwmDLL, 'DwmIsCompositionEnabled');
     if hDWMDLL <> 0 then
+
       @fDwmExtendFrameIntoClientArea   := GetProcAddress(hDwmDLL, 'DwmExtendFrameIntoClientArea');
    begin
 
       @fDwmIsCompositionEnabled := GetProcAddress(hDWMDLL, 'DwmIsCompositionEnabled');
 
       @fDwmExtendFrameIntoClientArea := GetProcAddress(hDWMDLL, 'DwmExtendFrameIntoClientArea');
 
 
       @fSetLayeredWindowAttributesFunc := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
 
       @fSetLayeredWindowAttributesFunc := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
 
+
      { Continue if values are <> nil }
       if ((@fDwmIsCompositionEnabled <> nil) and (@fDwmExtendFrameIntoClientArea <> nil) and (@fSetLayeredWindowAttributesFunc <> nil)) then
+
       if (
       begin
+
      (@fDwmIsCompositionEnabled <> nil) and
 +
      (@fDwmExtendFrameIntoClientArea <> nil) and
 +
      (@fSetLayeredWindowAttributesFunc <> nil)
 +
      )
 +
       then begin
 +
        { Continue if composition is enabled }
 
         fDwmIsCompositionEnabled(@bCmpEnable);
 
         fDwmIsCompositionEnabled(@bCmpEnable);
 
+
         if bCmpEnable = True then begin
         if bCmpEnable = True then
+
          { Set Form Color same as cBlurColorKey }
        begin
 
 
           frm.Color := cBlurColorKey;
 
           frm.Color := cBlurColorKey;
 
+
          { ... }
 
           SetWindowLong(frm.Handle, GWL_EXSTYLE, GetWindowLong(frm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
 
           SetWindowLong(frm.Handle, GWL_EXSTYLE, GetWindowLong(frm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
 +
          { ... }
 
           fSetLayeredWindowAttributesFunc(frm.Handle, cBlurColorKey, 0, LWA_COLORKEY);
 
           fSetLayeredWindowAttributesFunc(frm.Handle, cBlurColorKey, 0, LWA_COLORKEY);
 
+
          { Set margins }
 
           ZeroMemory(@mgn, SizeOf(mgn));
 
           ZeroMemory(@mgn, SizeOf(mgn));
           mgn.cxLeftWidth := -1;
+
           mgn.cxLeftWidth   := tmpMargins.cxLeftWidth;
           mgn.cxRightWidth := -1;
+
           mgn.cxRightWidth   := tmpMargins.cxRightWidth;
           mgn.cyTopHeight := -1;
+
           mgn.cyTopHeight   := tmpMargins.cyTopHeight;
           mgn.cyBottomHeight := -1;
+
           mgn.cyBottomHeight := tmpMargins.cyBottomHeight;
 
+
          { Extend Form }
           fDwmExtendFrameIntoClientArea(frm.Handle, @mgn);
+
           fDwmExtendFrameIntoClientArea(frm.Handle,@mgn);
 
         end;
 
         end;
 
       end;
 
       end;
 
+
      { Free loaded 'dwmapi' library }
 
       FreeLibrary(hDWMDLL);
 
       FreeLibrary(hDWMDLL);
 
     end;
 
     end;
 
   end;
 
   end;
 
end;
 
end;
 
+
 
 
end.</delphi>
 
end.</delphi>
  
Line 145: Line 127:
  
 
<delphi>procedure TForm1.FormActivate(Sender: TObject);
 
<delphi>procedure TForm1.FormActivate(Sender: TObject);
 +
var
 +
  tmpMargins: TMargins;
 
begin
 
begin
   GlassForm(Form1,clBlue); // This applyes the Aero Glass effect in Form1 
+
  { If all margins are -1 the whole form will be aero glass}
 +
  tmpMargins.cxLeftWidth    := -1;
 +
  tmpMargins.cxRightWidth  := -1;
 +
  tmpMargins.cyBottomHeight := -1;
 +
  tmpMargins.cyTopHeight    := -1;
 +
  { FormName ; Margins ; TransparentColor }
 +
   GlassForm(Form1, tmpMargins, clFuchsia);  
 
end;</delphi>
 
end;</delphi>
  

Revision as of 02:40, 8 July 2011

Deutsch (de) English (en) español (es) polski (pl)

Aero Glass effect on Lazarus Form

aero glass lazarus.png

First save the above code to a text file "glass.pas":

<delphi>unit glass;

{$mode delphi} //{$mode objfpc}{$H+}

interface

uses

 Windows, Forms, Graphics;

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;

const

 WS_EX_LAYERED = $80000;
 LWA_COLORKEY  = 1;

procedure GlassForm(frm: TForm; tmpMargins: TMargins; cBlurColorKey: TColor = clFuchsia); function WindowsAeroGlassCompatible: Boolean;

implementation

function WindowsAeroGlassCompatible: Boolean; var

 osVinfo: TOSVERSIONINFO;

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 Result:=True
 else Result:=False;

end;

procedure GlassForm(frm: TForm; tmpMargins: TMargins; cBlurColorKey: TColor = clFuchsia); var

 hDwmDLL: Cardinal;
 fDwmIsCompositionEnabled: DwmIsCompositionEnabledFunc;
 fDwmExtendFrameIntoClientArea: DwmExtendFrameIntoClientAreaFunc;
 fSetLayeredWindowAttributesFunc: SetLayeredWindowAttributesFunc;
 bCmpEnable: Boolean;
 mgn: TMargins;

begin

 { Continue if Windows version is compatible }
 if WindowsAeroGlassCompatible then begin
   { Continue if 'dwmapi' library is loaded }
   hDwmDLL := LoadLibrary('dwmapi.dll');
   if hDwmDLL <> 0 then begin
     { Get values }
     @fDwmIsCompositionEnabled        := GetProcAddress(hDwmDLL, 'DwmIsCompositionEnabled');
     @fDwmExtendFrameIntoClientArea   := GetProcAddress(hDwmDLL, 'DwmExtendFrameIntoClientArea');
     @fSetLayeredWindowAttributesFunc := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
     { Continue if values are <> nil }
     if (
     (@fDwmIsCompositionEnabled <> nil) and
     (@fDwmExtendFrameIntoClientArea <> nil) and
     (@fSetLayeredWindowAttributesFunc <> nil)
     )
     then begin
       { Continue if composition is enabled }
       fDwmIsCompositionEnabled(@bCmpEnable);
       if bCmpEnable = True then begin
         { Set Form Color same as cBlurColorKey }
         frm.Color := cBlurColorKey;
         { ... }
         SetWindowLong(frm.Handle, GWL_EXSTYLE, GetWindowLong(frm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
         { ... }
         fSetLayeredWindowAttributesFunc(frm.Handle, cBlurColorKey, 0, LWA_COLORKEY);
         { Set margins }
         ZeroMemory(@mgn, SizeOf(mgn));
         mgn.cxLeftWidth    := tmpMargins.cxLeftWidth;
         mgn.cxRightWidth   := tmpMargins.cxRightWidth;
         mgn.cyTopHeight    := tmpMargins.cyTopHeight;
         mgn.cyBottomHeight := tmpMargins.cyBottomHeight;
         { Extend Form }
         fDwmExtendFrameIntoClientArea(frm.Handle,@mgn);
       end;
     end;
     { Free loaded 'dwmapi' library }
     FreeLibrary(hDWMDLL);
   end;
 end;

end;

end.</delphi>

Copy the "glass.pas" file to the main folder of your project:

 MyProject\glass.pas
 

In the "uses" section of your project you need to add "glass":

<delphi>unit form1;

{$mode objfpc}{$H+}

interface

uses

 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs
 glass; // This includes GlassForm procedure </delphi>

OnActivate event of each form call the procedure in this way:

<delphi>procedure TForm1.FormActivate(Sender: TObject); var

 tmpMargins: TMargins;

begin

 { If all margins are -1 the whole form will be aero glass}
 tmpMargins.cxLeftWidth    := -1;
 tmpMargins.cxRightWidth   := -1;
 tmpMargins.cyBottomHeight := -1;
 tmpMargins.cyTopHeight    := -1;
 { FormName ; Margins ; TransparentColor }
 GlassForm(Form1, tmpMargins, clFuchsia); 

end;</delphi>

Also you need to enable Themes to use this procedure, go to Options > Project Options > then select "Use Manifest to Enable Themes (Windows)".

Bugs

As you can see in the first image Labels aren't displayed fine in Aero Glass, there are links with components and code that show how to make "Glow Labels":

About

This was converted to Lazarus using "{$mode delphi}" from "Aero Glass Effekt für Delphi-Forms, Delphi-Unit von Daniel Mitte (2006)":

There is a Delphi component here (to be ported in Lazarus):