Sign in Join
Wiki copytemporary

Aero Glass/es: what changed

Revision 2 to 3. Removed lines have a minus sign; added lines have a plus sign.

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

Back to history