Aero Glass/de: what changed

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

Old	New		Line
1	1		## Der Aero-Glass-Effekt in einem Lazarus-Formular
2	2
3	3		![](/wiki-images/5/5b/Aero_glass_lazarus.png)
4	4
5	5		Hinweis: Funktioniert nur mit Windows !
6	6
7	7		Speichern Sie zuerst den nachfolgenden Code in einer Textdatei namens "glass.pas":
8	8
9	9		``` pascal
10	10		// Aero Glass Effekt für Delphi-Forms
11	11		//
12	12		// Mit der Methode GlassForm kann für eine Form der
13	13		// Aero Glass Effekt unter Vista aktiviert werden.
14	14		// Der erste Parameter ist die Form-Klasse, der zweite
15	15		// optionale Parameter ist der BlurColorKey. Mit dem
16	16		// BlurColorKey wird eine Farbe festgelegt, auf dem
17	17		// der Effekt wirken soll, d.h. benutzt eine Komponente,
18	18		// auf der Form, für visuelle Darstellungen (Linien, Punkte,
19	19		// Bilder, ...), diese Farbe, so wird an dieser Stelle der
20	20		// Effekt wirksam. Der Standardwert für BlurColorKey ist
21	21		// clFuchsia.
22	22		//
23	23		// Hinweis: Für die Aktivierung wird zusätzlich TXPManifest
24	24		// bzw. eine RES-Datei die die Manifest-Daten
25	25		// enthält benötigt.
26	26		//
27	27		//
28	28		// Delphi-Unit von Daniel Mitte (2006)
29	29		//
30	30		//
31	31		// Beispiel:
32	32		//
33	33		// uses glass;
34	34		//
35	35		// [...]
36	36		//
37	37		// procedure TForm1.FormActivate(Sender: TObject);
38	38		// begin
39	39		// GlassForm(Form1);
40	40		// // oder mit anderem BlurColorKey
41	41		// // GlassForm(Form1, clBlue)
42	42		// end;
43	43
44	44		unit glass;
45	45
46	46		interface
47	47
48	48		{$mode delphi}
49	49
50	50		uses
51	51		Windows,
52	52		Forms,
53	53		Graphics;
54	54
55	55		procedure GlassForm(frm: TForm; cBlurColorKey: TColor = clFuchsia);
56	56
57	57		implementation
58	58
59	59		procedure GlassForm(frm: TForm; cBlurColorKey: TColor = clFuchsia);
60	60		const
61	61		WS_EX_LAYERED = $80000;
62	62		LWA_COLORKEY = 1;
63	63
64	64		type
65	65		_MARGINS = packed record
66	66		cxLeftWidth: Integer;
67	67		cxRightWidth: Integer;
68	68		cyTopHeight: Integer;
69	69		cyBottomHeight: Integer;
70	70		end;
71	71		PMargins = ^_MARGINS;
72	72		TMargins = _MARGINS;
73	73
74	74		DwmIsCompositionEnabledFunc = function(pfEnabled: PBoolean): HRESULT; stdcall;
75	75		DwmExtendFrameIntoClientAreaFunc = function(destWnd: HWND; const pMarInset: PMargins): HRESULT; stdcall;
76	76		SetLayeredWindowAttributesFunc = function(destWnd: HWND; cKey: TColor; bAlpha: Byte; dwFlags: DWord): BOOL; stdcall;
77	77
78	78		var
79	79		hDWMDLL: Cardinal;
80	80		osVinfo: TOSVERSIONINFO;
81	81		fDwmIsCompositionEnabled: DwmIsCompositionEnabledFunc;
82	82		fDwmExtendFrameIntoClientArea: DwmExtendFrameIntoClientAreaFunc;
83	83		fSetLayeredWindowAttributesFunc: SetLayeredWindowAttributesFunc;
84	84		bCmpEnable: Boolean;
85	85		mgn: TMargins;
86	86
87	87		begin
88	88		ZeroMemory(@osVinfo, SizeOf(osVinfo));
89	89		OsVinfo.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);
90	90
91	91		if ((GetVersionEx(osVInfo) = True) and (osVinfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (osVinfo.dwMajorVersion >= 6)) then
92	92		begin
93	93		hDWMDLL := LoadLibrary('dwmapi.dll');
94	94
95	95		if hDWMDLL <> 0 then
96	96		begin
97	97		@fDwmIsCompositionEnabled := GetProcAddress(hDWMDLL, 'DwmIsCompositionEnabled');
98	98		@fDwmExtendFrameIntoClientArea := GetProcAddress(hDWMDLL, 'DwmExtendFrameIntoClientArea');
99	99		@fSetLayeredWindowAttributesFunc := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
100	100
101	101		if ((@fDwmIsCompositionEnabled <> nil) and (@fDwmExtendFrameIntoClientArea <> nil) and (@fSetLayeredWindowAttributesFunc <> nil)) then
102	102		begin
103	103		fDwmIsCompositionEnabled(@bCmpEnable);
104	104
105	105		if bCmpEnable = True then
106	106		begin
107	107		frm.Color := cBlurColorKey;
108	108
109	109		SetWindowLong(frm.Handle, GWL_EXSTYLE, GetWindowLong(frm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
110	110		fSetLayeredWindowAttributesFunc(frm.Handle, cBlurColorKey, 0, LWA_COLORKEY);
111	111
112	112		ZeroMemory(@mgn, SizeOf(mgn));
113	113		mgn.cxLeftWidth := -1;
114	114		mgn.cxRightWidth := -1;
115	115		mgn.cyTopHeight := -1;
116	116		mgn.cyBottomHeight := -1;
117	117
118	118		fDwmExtendFrameIntoClientArea(frm.Handle, @mgn);
119	119		end;
120	120		end;
121	121
122	122		FreeLibrary(hDWMDLL);
123	123		end;
124	124		end;
125	125		end;
126	126
127	127		end.
128	128		```
129	129
130	130		Kopieren Sie die Datei "glass.pas" in den Hauptordner Ihres Projektes:
131	131
132		-	~~```~~
	132	+	```text
133	133		MeinProjekt\glass.pas
134	134		```
135	135
136	136		Fügen Sie im Abschnitt "uses" Ihres Projektes das Wort "glass" hinzu:
137	137
138	138		``` pascal
139	139		unit form1;
140	140
141	141		{$mode objfpc}{$H+}
142	142
143	143		interface
144	144
145	145		uses
146	146		Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs
147	147		glass; // Dadurch wird die Prozedur 'GlassForm' verfügbar gemacht
148	148		```
149	149
150	150		Rufen Sie diese Prozedur im 'OnActivate'-Ereignis eines jeden Formulars auf:
151	151
152	152		``` pascal
153	153		procedure TForm1.FormActivate(Sender: TObject);
154	154		begin
155	155		GlassForm(Form1,clBlue); // Dies wendet den Aero-Glass-Effekt auf Form1 an
156	156		end;
157	157		```
158	158
159	159		Außerdem müssen Sie Themen aktivieren, um diese Prozedur einsetzen zu können. Gehen Sie dazu zu Projektinspektor \> Einstellungen \> Projekteinstellungen \> und wählen Sie "Themen mit Manifest-Datei einschalten (nur in Windows)".
160	160
161	161		## Fehler
162	162
163	163		Wie Sie sehen können, werden die Labels im ersten Bild nicht sehr schön dargestellt in Aero Glass. Es folgen einige Links zu Komponenten und Code die zeigen, wie man "Labels zum Leuchten bringt":
164	164
165	165		- [GlowLabel for Delphi](http://development.mwcs.de/glowlabel.html)
166	166		- [Aero Glass - ein Text (Label) hintergrund "machen"](http://www.delphipraxis.net/953968-post4.html)
167	167
168	168		## Über
169	169
170	170		Diese Komponente wurde zu Lazarus konvertiert mit "{\$mode delphi}". Sie stammt her von "Aero Glass Effekt für Delphi-Forms, Delphi-Unit von Daniel Mitte (2006)":
171	171
172	172		- [Aero Glass Effekt für Delphi-Forms](http://www.delphipraxis.net/74538-aero-glass-effekt-fuer-delphi-forms.html)
173	173
174	174		Es gibt eine Delphi-Komponente (die nach Lazarus portiert werden könnte) hier:
175	175
176	176		- [D. Mitte in Torry's Delphi Page](http://www.torry.net/authorsmore.php?id=6179)
177	177
178	178		---
179	179		From the Free Pascal wiki, page "Aero Glass/de", as it stood on 2020-02-04 after a change by GAN, 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).
180	180		Category: Tutorials/de

Back to history