Aero Glass/es

From Free Pascal wiki
Jump to navigationJump to search

Deutsch (de) English (en) español (es) polski (pl)

Efecto Aero Glass en Lazarus Form

aero glass lazarus.png

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)":