Sign in Join
Wiki copytemporary

Aero Glass/pl: what changed

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

Title: Aero Glass/pl

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