Aero Glass

From Free Pascal wiki
Revision as of 15:04, 29 January 2011 by Lainz (talk | contribs) (added "Bugs" section)
Jump to navigationJump to search

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>// 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.</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); begin

 GlassForm(Form1,clBlue); // This applyes the Aero Glass effect in Form1  

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 Label's":

About

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