Difference between revisions of "Aero Glass"
m (Undo revision 49867 by Special:Contributions/Iskraelectrica (User talk:Iskraelectrica)) |
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> | + | <delphi>unit glass; |
− | + | ||
− | + | {$mode delphi} | |
− | + | //{$mode objfpc}{$H+} | |
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | // | ||
− | |||
− | |||
interface | interface | ||
− | + | ||
− | |||
− | |||
uses | uses | ||
− | Windows, | + | Windows, Forms, Graphics; |
− | + | ||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
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 | ||
− | |||
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 | ||
− | + | { Continue if Windows version is compatible } | |
− | + | if WindowsAeroGlassCompatible then begin | |
− | + | { Continue if 'dwmapi' library is loaded } | |
− | if | + | hDwmDLL := LoadLibrary('dwmapi.dll'); |
− | + | if hDwmDLL <> 0 then begin | |
− | + | { Get values } | |
− | + | @fDwmIsCompositionEnabled := GetProcAddress(hDwmDLL, 'DwmIsCompositionEnabled'); | |
− | if | + | @fDwmExtendFrameIntoClientArea := GetProcAddress(hDwmDLL, 'DwmExtendFrameIntoClientArea'); |
− | |||
− | @fDwmIsCompositionEnabled := GetProcAddress( | ||
− | @fDwmExtendFrameIntoClientArea := GetProcAddress( | ||
@fSetLayeredWindowAttributesFunc := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes'); | @fSetLayeredWindowAttributesFunc := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes'); | ||
− | + | { Continue if values are <> nil } | |
− | if ((@fDwmIsCompositionEnabled <> nil) and (@fDwmExtendFrameIntoClientArea <> nil) and (@fSetLayeredWindowAttributesFunc <> nil)) | + | 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 } |
− | |||
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 := | + | mgn.cxLeftWidth := tmpMargins.cxLeftWidth; |
− | mgn.cxRightWidth := | + | mgn.cxRightWidth := tmpMargins.cxRightWidth; |
− | mgn.cyTopHeight := | + | mgn.cyTopHeight := tmpMargins.cyTopHeight; |
− | mgn.cyBottomHeight := | + | 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, | + | { 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 03:40, 8 July 2011
│
Deutsch (de) │
English (en) │
español (es) │
polski (pl) │
Aero Glass effect on Lazarus Form
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):