Sign in Join
Wiki copytemporary

Aero Glass/de: what changed

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

Title: Aero Glass/de

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

Back to history