// 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.