Aero Glass/es

From Free Pascal wiki
Jump to: navigation, 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":

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