Aero Glass/pl: what changed

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

Old	New		Line
1	1		(Windows only)
2	2
3	3		## Efekt szkła (Aero Glass) na formularzu
4	4
5		-	~~<figure>~~
6		-	~~<img src="aero_glass_lazarus.png" title="aero_glass_lazarus.png" />~~
7		-	~~<figcaption>aero_glass_lazarus.png</figcaption>~~
8		-	~~</figure>~~
	5	+	![](/wiki-images/5/5b/Aero_glass_lazarus.png)
9	6
10	7		Na początku utwórz moduł ,,glass.pas", zawierający poniższy kod:
11	8
12	9		``` pascal
13	10		unit glass;
14	11
15	12		{$mode delphi}
16	13		//{$mode objfpc}{$H+}
17	14
18	15		interface
19	16
20	17		uses
21	18		Windows, Forms, Graphics;
22	19
23	20		type
24	21		_MARGINS = packed record
25	22		cxLeftWidth : Integer;
26	23		cxRightWidth : Integer;
27	24		cyTopHeight : Integer;
28	25		cyBottomHeight : Integer;
29	26		end;
30	27
31	28		PMargins = ^_MARGINS;
32	29		TMargins = _MARGINS;
33	30
34	31		DwmIsCompositionEnabledFunc = function(pfEnabled: PBoolean): HRESULT; stdcall;
35	32		DwmExtendFrameIntoClientAreaFunc = function(destWnd: HWND; const pMarInset: PMargins): HRESULT; stdcall;
36	33		SetLayeredWindowAttributesFunc = function(destWnd: HWND; cKey: TColor; bAlpha: Byte; dwFlags: DWord): BOOL; stdcall;
37	34
38	35		const
39	36		WS_EX_LAYERED = $80000;
40	37		LWA_COLORKEY = 1;
41	38
42	39		procedure GlassForm(frm: TForm; tmpMargins: TMargins; cBlurColorKey: TColor = clFuchsia);
43	40		function WindowsAeroGlassCompatible: Boolean;
44	41
45	42		implementation
46	43
47	44		function WindowsAeroGlassCompatible: Boolean;
48	45		var
49	46		osVinfo: TOSVERSIONINFO;
50	47		begin
51	48		ZeroMemory(@osVinfo, SizeOf(osVinfo));
52	49		OsVinfo.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);
53	50		if (
54	51		(GetVersionEx(osVInfo) = True) and
55	52		(osVinfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and
56	53		(osVinfo.dwMajorVersion >= 6)
57	54		)
58	55		then Result:=True
59	56		else Result:=False;
60	57		end;
61	58
62	59		procedure GlassForm(frm: TForm; tmpMargins: TMargins; cBlurColorKey: TColor = clFuchsia);
63	60		var
64	61		hDwmDLL: Cardinal;
65	62		fDwmIsCompositionEnabled: DwmIsCompositionEnabledFunc;
66	63		fDwmExtendFrameIntoClientArea: DwmExtendFrameIntoClientAreaFunc;
67	64		fSetLayeredWindowAttributesFunc: SetLayeredWindowAttributesFunc;
68	65		bCmpEnable: Boolean;
69	66		mgn: TMargins;
70	67		begin
71	68		{ Kontynuuj, jeśli wersja Windowsa jest kompatybilna }
72	69		if WindowsAeroGlassCompatible then begin
73	70		{ Kontynuuj, jeśli biblioteka ,,dwmapi" jest załadowana }
74	71		hDwmDLL := LoadLibrary('dwmapi.dll');
75	72		if hDwmDLL <> 0 then begin
76	73		{ Pobierz wartości }
77	74		@fDwmIsCompositionEnabled := GetProcAddress(hDwmDLL, 'DwmIsCompositionEnabled');
78	75		@fDwmExtendFrameIntoClientArea := GetProcAddress(hDwmDLL, 'DwmExtendFrameIntoClientArea');
79	76		@fSetLayeredWindowAttributesFunc := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
80	77		{ Kontynuuj, jeśli wartości <> nil }
81	78		if (
82	79		(@fDwmIsCompositionEnabled <> nil) and
83	80		(@fDwmExtendFrameIntoClientArea <> nil) and
84	81		(@fSetLayeredWindowAttributesFunc <> nil)
85	82		)
86	83		then begin
87	84		{ Kontynuuj, jeżeli kompozycje systemowe są włączone }
88	85		fDwmIsCompositionEnabled(@bCmpEnable);
89	86		if bCmpEnable = True then begin
90	87		{ Ustaw kolor formy na cBlurColorKey }
91	88		frm.Color := cBlurColorKey;
92	89		{ ... }
93	90		SetWindowLong(frm.Handle, GWL_EXSTYLE, GetWindowLong(frm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
94	91		{ ... }
95	92		fSetLayeredWindowAttributesFunc(frm.Handle, cBlurColorKey, 0, LWA_COLORKEY);
96	93		{ Ustaw marginesy }
97	94		ZeroMemory(@mgn, SizeOf(mgn));
98	95		mgn.cxLeftWidth := tmpMargins.cxLeftWidth;
99	96		mgn.cxRightWidth := tmpMargins.cxRightWidth;
100	97		mgn.cyTopHeight := tmpMargins.cyTopHeight;
101	98		mgn.cyBottomHeight := tmpMargins.cyBottomHeight;
102	99		{ Rozszerz formę }
103	100		fDwmExtendFrameIntoClientArea(frm.Handle,@mgn);
104	101		end;
105	102		end;
106	103		{ Zwolnij bibliotekę ,,dwmapi" }
107	104		FreeLibrary(hDWMDLL);
108	105		end;
109	106		end;
110	107		end;
111	108
112	109		end.
113	110		```
114	111
115	112		Następnie skopiuj powyższy plik do folderu głównego Twojej aplikacji (tu: MojProjekt):
116	113
117	114		` MojProjekt\glass.pas`\
118	115		` `
119	116
120	117		W sekcji ,,uses" dopisz nazwę powyższego modułu:
121	118
122	119		``` pascal
123	120		unit form1;
124	121
125	122		{$mode objfpc}{$H+}
126	123
127	124		interface
128	125
129	126		uses
130	127		Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs
131	128		glass; // Tu zawiera się procedura GlassForm
132	129		```
133	130
134	131		Utwórz zdarzenie OnActivate i uzupełnij je, tak jak poniżej:
135	132
136	133		``` pascal
137	134		procedure TForm1.FormActivate(Sender: TObject);
138	135		var
139	136		tmpMargins: TMargins;
140	137		begin
141	138		{ Jeżeli marginesy mają wartość -1, to cała forma będzie pokryta szkłem }
142	139		tmpMargins.cxLeftWidth := -1;
143	140		tmpMargins.cxRightWidth := -1;
144	141		tmpMargins.cyBottomHeight := -1;
145	142		tmpMargins.cyTopHeight := -1;
146	143		{ NazwaFormularza ; Marginesy ; KolorPrzezroczystości }
147	144		GlassForm(Self, tmpMargins, clFuchsia);
148	145		end;
149	146		```
150	147
151	148		WAŻNE: Przed uruchomieniem aplikacji włącz kompozycje, wchodząc w Projekt \> Opcje projektu \> Użyj pliku manifest aby odblokować kompozycje.
152	149
153	150		## Bugi
154	151
155	152		Po włączeniu efektu szkła wyraźnie widać, iż napisy (TLabel) nie mają tzw. ,,otoczki szkła". Aby rozwiązać ten problem, należy odpowiednio zaprogramować napisy. Z pomocą przychodzą poniższe linki do komponentów zwanych ,,Glow Labels":
156	153
157	154		- [GlowLabel for Delphi](http://development.mwcs.de/glowlabel.html)
158	155		- [Aero Glass - ein Text (Label) hintergrund "machen"](http://www.delphipraxis.net/953968-post4.html)
159	156
160	157		Jeżeli ustawisz kolor części systemowych (np. kolor okna), to kliknięcie na formularz będzie niemożliwe (forma traci fokus przez szkło).
161	158
162	159		## Informacje
163	160
164	161		Powyższe kody zostały przekonwertowane do Lazarusa na podstawie "Aero Glass Effekt für Delphi-Forms, Delphi-Unit von Daniel Mitte (2006)":
165	162
166	163		- [Aero Glass Effekt für Delphi-Forms](http://www.delphipraxis.net/74538-aero-glass-effekt-fuer-delphi-forms.html)
167	164
168	165		Tu znajduje się komponent (przekonwertowany także do Lazarusa):
169	166
170	167		- [D. Mitte in Torry's Delphi Page](http://www.torry.net/authorsmore.php?id=6179)
171	168
172	169		Tłumaczenie
173	170
174	171		Na język polski przełożył: --User:Matek.y 18:30, 12.12.2017
175	172
176	173		---
177	174		From the Free Pascal wiki, page "Aero Glass/pl", 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).

Back to history