Aero Glass/es
│
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":
<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>
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":
<delphi>unit form1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs glass; // Esto incluye el procedimiento GlassForm</delphi>
En el evento OnActivate llama el procedimiento de esta forma:
<delphi>procedure TForm1.FormActivate(Sender: TObject); begin
GlassForm(Form1,clBlue); // Esto aplica el efecto Aero Glass en Form1
end;</delphi>
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)":