Difference between revisions of "Aero Glass/es"

From Free Pascal wiki
Jump to navigationJump to search
(New page: {{Aero Glass}} == Efecto Aero Glass en Lazarus Form == Image:aero_glass_lazarus.png Primero guarda el siguiente código en un archivo de texto "glass.pas": <delphi>// Aero Glass Ef...)
 
m
Line 1: Line 1:
{{Aero Glass}}
+
{{Aero Glass}}[[category:Castellano|C]][[category:Español|C]]
  
 
== Efecto Aero Glass en Lazarus Form ==
 
== Efecto Aero Glass en Lazarus Form ==

Revision as of 15:42, 5 May 2011

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