Sign in Join
Wiki copytemporary

Aero Glass/es: what changed

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

OldNewLine
11## Efecto Aero Glass en Lazarus Form
22
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":
3+[![aero glass lazarus.png](/wiki-images/8/83/aero_glass_lazarus.png)](</File:aero_glass_lazarus.png>)
94
10-``` pascal
5+Primero guarda el siguiente código en un archivo de texto "glass.pas":
6+```
117// 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
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+
9784 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
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
10389 begin
104- fDwmIsCompositionEnabled(@bCmpEnable);
105-
106- if bCmpEnable = True then
90+ hDWMDLL := LoadLibrary('dwmapi.dll');
91+
92+ if hDWMDLL <> 0 then
10793 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);
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);
120120 end;
121121 end;
122-
123- FreeLibrary(hDWMDLL);
124122 end;
125- end;
126-end;
127-
128-end.
123+
124+ end.
129125```
130126
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":
127+Luego copia "glass.pas" a la carpeta principal de tu proyecto:
128+```
129+MyProyecto\glass.pas
130+```
137131
138-``` pascal
132+En la sección "uses" de tu proyecto necesitas agregar "glass":
133+```
139134unit 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
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
148143```
149144
150-En el evento OnActivate llama el procedimiento de esta forma:
151-
152-``` pascal
145+En el evento OnActivate llama el procedimiento de esta forma:
146+```
153147procedure TForm1.FormActivate(Sender: TObject);
154-begin
155- GlassForm(Form1,clBlue); // Esto aplica el efecto Aero Glass en Form1
156-end;
148+ begin
149+ GlassForm(Form1,clBlue); // Esto aplica el efecto Aero Glass en Form1
150+ end;
157151```
158152
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)"
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)"
160154
161155## Acerca de
162156
163-Convetdido a lazarus usando "{\$mode delphi}" desde "Aero Glass Effekt für Delphi-Forms, Delphi-Unit von Daniel Mitte (2006)":
157+Convetdido a lazarus usando "{$mode delphi}" desde "Aero Glass Effekt für Delphi-Forms, Delphi-Unit von Daniel Mitte (2006)":
164158
165-- [Aero Glass Effekt für Delphi-Forms](http://www.delphipraxis.net/74538-aero-glass-effekt-fuer-delphi-forms.html)
159+ * [Aero Glass Effekt für Delphi-Forms](<http://www.delphipraxis.net/74538-aero-glass-effekt-fuer-delphi-forms.html>)
166160
167161---
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
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).*

Back to history