Aero Glass/es
From Free Pascal wiki
Jump to navigationJump to searchThe printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
│
Deutsch (de) │
English (en) │
español (es) │
polski (pl) │
Efecto Aero Glass en Lazarus Form
Primero guarda el siguiente código en un archivo de texto "glass.pas":
// 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.
Luego copia "glass.pas" a la carpeta principal de tu proyecto:
MyProyecto\glass.pas
En la sección "uses" de tu proyecto necesitas agregar "glass":
unit form1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs
glass; // Esto incluye el procedimiento GlassForm
En el evento OnActivate llama el procedimiento de esta forma:
procedure TForm1.FormActivate(Sender: TObject);
begin
GlassForm(Form1,clBlue); // Esto aplica el efecto Aero Glass en Form1
end;
Necesitas tener habilitados los Temas (Themes), ve a Opciones > Opciones del proyecto > y seleccionando las opciones "Usar el archivo de manifiesto para habilitar temas (solo Windows)"
Acerca de
Convetdido a lazarus usando "{$mode delphi}" desde "Aero Glass Effekt für Delphi-Forms, Delphi-Unit von Daniel Mitte (2006)":