Aero Glass/es: what changed

Revision 0 to 1. Removed lines have a minus sign; added lines have a plus sign.

Title: Aero Glass/es

New		Line
1	+	## Efecto Aero Glass en Lazarus Form
2	+
3	+	<figure>
4	+	<img src="aero_glass_lazarus.png" title="aero_glass_lazarus.png" />
5	+	<figcaption>aero_glass_lazarus.png</figcaption>
6	+	</figure>
7	+
8	+	Primero guarda el siguiente código en un archivo de texto "glass.pas":
9	+
10	+	``` pascal
11	+	// Aero Glass Effekt für Delphi-Forms
12	+	//
13	+	// Mit der Methode GlassForm kann für eine Form der
14	+	// Aero Glass Effekt unter Vista aktiviert werden.
15	+	// Der erste Parameter ist die Form-Klasse, der zweite
16	+	// optionale Parameter ist der BlurColorKey. Mit dem
17	+	// BlurColorKey wird eine Farbe festgelegt, auf dem
18	+	// der Effekt wirken soll, d.h. benutzt eine Komponente,
19	+	// auf der Form, für visuelle Darstellungen (Linien, Punkte,
20	+	// Bilder, ...), diese Farbe, so wird an dieser Stelle der
21	+	// Effekt wirksam. Der Standardwert für BlurColorKey ist
22	+	// clFuchsia.
23	+	//
24	+	// Hinweis: Für die Aktivierung wird zusätzlich TXPManifest
25	+	// bzw. eine RES-Datei die die Manifest-Daten
26	+	// enthält benötigt.
27	+	//
28	+	//
29	+	// Delphi-Unit von Daniel Mitte (2006)
30	+	//
31	+	//
32	+	// Beispiel:
33	+	//
34	+	// uses glass;
35	+	//
36	+	// [...]
37	+	//
38	+	// procedure TForm1.FormActivate(Sender: TObject);
39	+	// begin
40	+	// GlassForm(Form1);
41	+	// // oder mit anderem BlurColorKey
42	+	// // GlassForm(Form1, clBlue)
43	+	// end;
44	+
45	+	unit glass;
46	+
47	+	interface
48	+
49	+	{$mode delphi}
50	+
51	+	uses
52	+	Windows,
53	+	Forms,
54	+	Graphics;
55	+
56	+	procedure GlassForm(frm: TForm; cBlurColorKey: TColor = clFuchsia);
57	+
58	+	implementation
59	+
60	+	procedure GlassForm(frm: TForm; cBlurColorKey: TColor = clFuchsia);
61	+	const
62	+	WS_EX_LAYERED = $80000;
63	+	LWA_COLORKEY = 1;
64	+
65	+	type
66	+	_MARGINS = packed record
67	+	cxLeftWidth: Integer;
68	+	cxRightWidth: Integer;
69	+	cyTopHeight: Integer;
70	+	cyBottomHeight: Integer;
71	+	end;
72	+	PMargins = ^_MARGINS;
73	+	TMargins = _MARGINS;
74	+
75	+	DwmIsCompositionEnabledFunc = function(pfEnabled: PBoolean): HRESULT; stdcall;
76	+	DwmExtendFrameIntoClientAreaFunc = function(destWnd: HWND; const pMarInset: PMargins): HRESULT; stdcall;
77	+	SetLayeredWindowAttributesFunc = function(destWnd: HWND; cKey: TColor; bAlpha: Byte; dwFlags: DWord): BOOL; stdcall;
78	+
79	+	var
80	+	hDWMDLL: Cardinal;
81	+	osVinfo: TOSVERSIONINFO;
82	+	fDwmIsCompositionEnabled: DwmIsCompositionEnabledFunc;
83	+	fDwmExtendFrameIntoClientArea: DwmExtendFrameIntoClientAreaFunc;
84	+	fSetLayeredWindowAttributesFunc: SetLayeredWindowAttributesFunc;
85	+	bCmpEnable: Boolean;
86	+	mgn: TMargins;
87	+
88	+	begin
89	+	ZeroMemory(@osVinfo, SizeOf(osVinfo));
90	+	OsVinfo.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);
91	+
92	+	if ((GetVersionEx(osVInfo) = True) and (osVinfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (osVinfo.dwMajorVersion >= 6)) then
93	+	begin
94	+	hDWMDLL := LoadLibrary('dwmapi.dll');
95	+
96	+	if hDWMDLL <> 0 then
97	+	begin
98	+	@fDwmIsCompositionEnabled := GetProcAddress(hDWMDLL, 'DwmIsCompositionEnabled');
99	+	@fDwmExtendFrameIntoClientArea := GetProcAddress(hDWMDLL, 'DwmExtendFrameIntoClientArea');
100	+	@fSetLayeredWindowAttributesFunc := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
101	+
102	+	if ((@fDwmIsCompositionEnabled <> nil) and (@fDwmExtendFrameIntoClientArea <> nil) and (@fSetLayeredWindowAttributesFunc <> nil)) then
103	+	begin
104	+	fDwmIsCompositionEnabled(@bCmpEnable);
105	+
106	+	if bCmpEnable = True then
107	+	begin
108	+	frm.Color := cBlurColorKey;
109	+
110	+	SetWindowLong(frm.Handle, GWL_EXSTYLE, GetWindowLong(frm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
111	+	fSetLayeredWindowAttributesFunc(frm.Handle, cBlurColorKey, 0, LWA_COLORKEY);
112	+
113	+	ZeroMemory(@mgn, SizeOf(mgn));
114	+	mgn.cxLeftWidth := -1;
115	+	mgn.cxRightWidth := -1;
116	+	mgn.cyTopHeight := -1;
117	+	mgn.cyBottomHeight := -1;
118	+
119	+	fDwmExtendFrameIntoClientArea(frm.Handle, @mgn);
120	+	end;
121	+	end;
122	+
123	+	FreeLibrary(hDWMDLL);
124	+	end;
125	+	end;
126	+	end;
127	+
128	+	end.
129	+	```
130	+
131	+	Luego copia "glass.pas" a la carpeta principal de tu proyecto:
132	+
133	+	` MyProyecto\glass.pas`\
134	+	` `
135	+
136	+	En la sección "uses" de tu proyecto necesitas agregar "glass":
137	+
138	+	``` pascal
139	+	unit form1;
140	+
141	+	{$mode objfpc}{$H+}
142	+
143	+	interface
144	+
145	+	uses
146	+	Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs
147	+	glass; // Esto incluye el procedimiento GlassForm
148	+	```
149	+
150	+	En el evento OnActivate llama el procedimiento de esta forma:
151	+
152	+	``` pascal
153	+	procedure TForm1.FormActivate(Sender: TObject);
154	+	begin
155	+	GlassForm(Form1,clBlue); // Esto aplica el efecto Aero Glass en Form1
156	+	end;
157	+	```
158	+
159	+	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)"
160	+
161	+	## Acerca de
162	+
163	+	Convetdido a lazarus usando "{\$mode delphi}" desde "Aero Glass Effekt für Delphi-Forms, Delphi-Unit von Daniel Mitte (2006)":
164	+
165	+	- [Aero Glass Effekt für Delphi-Forms](http://www.delphipraxis.net/74538-aero-glass-effekt-fuer-delphi-forms.html)
166	+
167	+	---
168	+	From the Free Pascal wiki, page "Aero Glass/es", as it stood on 2022-06-30 after a change by Iskraelectrica, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).
169	+	Category: Castellano
170	+	Category: Español

Back to history