Difference between revisions of "Aero Glass/pl"
(2 intermediate revisions by 2 users not shown) | |||
Line 2: | Line 2: | ||
{{Aero Glass}} | {{Aero Glass}} | ||
− | == Efekt szkła (Aero Glass) na formularzu | + | == Efekt szkła (Aero Glass) na formularzu == |
[[Image:aero_glass_lazarus.png]] | [[Image:aero_glass_lazarus.png]] | ||
− | Na początku | + | Na początku utwórz moduł ,,glass.pas", zawierający poniższy kod: |
− | <syntaxhighlight>unit glass; | + | <syntaxhighlight lang=pascal>unit glass; |
{$mode delphi} | {$mode delphi} | ||
Line 66: | Line 66: | ||
mgn: TMargins; | mgn: TMargins; | ||
begin | begin | ||
− | { | + | { Kontynuuj, jeśli wersja Windowsa jest kompatybilna } |
if WindowsAeroGlassCompatible then begin | if WindowsAeroGlassCompatible then begin | ||
− | { | + | { Kontynuuj, jeśli biblioteka ,,dwmapi" jest załadowana } |
hDwmDLL := LoadLibrary('dwmapi.dll'); | hDwmDLL := LoadLibrary('dwmapi.dll'); | ||
if hDwmDLL <> 0 then begin | if hDwmDLL <> 0 then begin | ||
− | { | + | { Pobierz wartości } |
@fDwmIsCompositionEnabled := GetProcAddress(hDwmDLL, 'DwmIsCompositionEnabled'); | @fDwmIsCompositionEnabled := GetProcAddress(hDwmDLL, 'DwmIsCompositionEnabled'); | ||
@fDwmExtendFrameIntoClientArea := GetProcAddress(hDwmDLL, 'DwmExtendFrameIntoClientArea'); | @fDwmExtendFrameIntoClientArea := GetProcAddress(hDwmDLL, 'DwmExtendFrameIntoClientArea'); | ||
@fSetLayeredWindowAttributesFunc := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes'); | @fSetLayeredWindowAttributesFunc := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes'); | ||
− | { | + | { Kontynuuj, jeśli wartości <> nil } |
if ( | if ( | ||
(@fDwmIsCompositionEnabled <> nil) and | (@fDwmIsCompositionEnabled <> nil) and | ||
Line 82: | Line 82: | ||
) | ) | ||
then begin | then begin | ||
− | { | + | { Kontynuuj, jeżeli kompozycje systemowe są włączone } |
fDwmIsCompositionEnabled(@bCmpEnable); | fDwmIsCompositionEnabled(@bCmpEnable); | ||
if bCmpEnable = True then begin | if bCmpEnable = True then begin | ||
− | { | + | { Ustaw kolor formy na cBlurColorKey } |
frm.Color := cBlurColorKey; | frm.Color := cBlurColorKey; | ||
{ ... } | { ... } | ||
Line 91: | Line 91: | ||
{ ... } | { ... } | ||
fSetLayeredWindowAttributesFunc(frm.Handle, cBlurColorKey, 0, LWA_COLORKEY); | fSetLayeredWindowAttributesFunc(frm.Handle, cBlurColorKey, 0, LWA_COLORKEY); | ||
− | { | + | { Ustaw marginesy } |
ZeroMemory(@mgn, SizeOf(mgn)); | ZeroMemory(@mgn, SizeOf(mgn)); | ||
mgn.cxLeftWidth := tmpMargins.cxLeftWidth; | mgn.cxLeftWidth := tmpMargins.cxLeftWidth; | ||
Line 97: | Line 97: | ||
mgn.cyTopHeight := tmpMargins.cyTopHeight; | mgn.cyTopHeight := tmpMargins.cyTopHeight; | ||
mgn.cyBottomHeight := tmpMargins.cyBottomHeight; | mgn.cyBottomHeight := tmpMargins.cyBottomHeight; | ||
− | { | + | { Rozszerz formę } |
fDwmExtendFrameIntoClientArea(frm.Handle,@mgn); | fDwmExtendFrameIntoClientArea(frm.Handle,@mgn); | ||
end; | end; | ||
end; | end; | ||
− | { | + | { Zwolnij bibliotekę ,,dwmapi" } |
FreeLibrary(hDWMDLL); | FreeLibrary(hDWMDLL); | ||
end; | end; | ||
Line 109: | Line 109: | ||
end.</syntaxhighlight> | end.</syntaxhighlight> | ||
− | Następnie skopiuj | + | Następnie skopiuj powyższy plik do folderu głównego Twojej aplikacji (tu: MojProjekt): |
MojProjekt\glass.pas | MojProjekt\glass.pas | ||
− | W sekcji ,,uses" | + | W sekcji ,,uses" dopisz nazwę powyższego modułu: |
− | <syntaxhighlight>unit form1; | + | <syntaxhighlight lang=pascal>unit form1; |
{$mode objfpc}{$H+} | {$mode objfpc}{$H+} | ||
Line 125: | Line 125: | ||
glass; // Tu zawiera się procedura GlassForm </syntaxhighlight> | glass; // Tu zawiera się procedura GlassForm </syntaxhighlight> | ||
− | Utwórz | + | Utwórz zdarzenie OnActivate i uzupełnij je, tak jak poniżej: |
− | <syntaxhighlight>procedure TForm1.FormActivate(Sender: TObject); | + | <syntaxhighlight lang=pascal>procedure TForm1.FormActivate(Sender: TObject); |
var | var | ||
tmpMargins: TMargins; | tmpMargins: TMargins; | ||
Line 140: | Line 140: | ||
end;</syntaxhighlight> | end;</syntaxhighlight> | ||
− | WAŻNE: Przed uruchomieniem aplikacji włącz kompozycje, wchodząc w Projekt > Opcje projektu > | + | WAŻNE: Przed uruchomieniem aplikacji włącz kompozycje, wchodząc w Projekt > Opcje projektu > Użyj pliku manifest aby odblokować kompozycje. |
== Bugi == | == Bugi == | ||
− | Po włączeniu szkła wyraźnie widać, iż napisy (TLabel) nie mają tzw. ,,otoczki szkła" | + | 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": |
*[http://development.mwcs.de/glowlabel.html GlowLabel for Delphi] | *[http://development.mwcs.de/glowlabel.html GlowLabel for Delphi] | ||
*[http://www.delphipraxis.net/953968-post4.html Aero Glass - ein Text (Label) hintergrund "machen"] | *[http://www.delphipraxis.net/953968-post4.html Aero Glass - ein Text (Label) hintergrund "machen"] | ||
− | 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). | + | 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). |
== Informacje == | == Informacje == | ||
− | Powyższe kody zostały przekonwertowane do Lazarusa | + | Powyższe kody zostały przekonwertowane do Lazarusa na podstawie "Aero Glass Effekt für Delphi-Forms, Delphi-Unit von Daniel Mitte (2006)": |
*[http://www.delphipraxis.net/74538-aero-glass-effekt-fuer-delphi-forms.html Aero Glass Effekt für Delphi-Forms] | *[http://www.delphipraxis.net/74538-aero-glass-effekt-fuer-delphi-forms.html Aero Glass Effekt für Delphi-Forms] | ||
Line 161: | Line 161: | ||
*[http://www.torry.net/authorsmore.php?id=6179 D. Mitte in Torry's Delphi Page] | *[http://www.torry.net/authorsmore.php?id=6179 D. Mitte in Torry's Delphi Page] | ||
− | |||
− | |||
'''Tłumaczenie''' | '''Tłumaczenie''' | ||
− | Na język polski przełożył: --[[User:Matek]] | + | Na język polski przełożył: --[[User:Matek.y]] 18:30, 12.12.2017 |
Latest revision as of 04:55, 4 February 2020
Ten artykuł odnosi się tylko do Windows.
Zobacz także: Przewodnik programowania wieloplatformowego
│
Deutsch (de) │
English (en) │
español (es) │
polski (pl) │
Efekt szkła (Aero Glass) na formularzu
Na początku utwórz moduł ,,glass.pas", zawierający poniższy kod:
unit glass;
{$mode delphi}
//{$mode objfpc}{$H+}
interface
uses
Windows, Forms, Graphics;
type
_MARGINS = packed record
cxLeftWidth : Integer;
cxRightWidth : Integer;
cyTopHeight : Integer;
cyBottomHeight : Integer;
end;
PMargins = ^_MARGINS;
TMargins = _MARGINS;
DwmIsCompositionEnabledFunc = function(pfEnabled: PBoolean): HRESULT; stdcall;
DwmExtendFrameIntoClientAreaFunc = function(destWnd: HWND; const pMarInset: PMargins): HRESULT; stdcall;
SetLayeredWindowAttributesFunc = function(destWnd: HWND; cKey: TColor; bAlpha: Byte; dwFlags: DWord): BOOL; stdcall;
const
WS_EX_LAYERED = $80000;
LWA_COLORKEY = 1;
procedure GlassForm(frm: TForm; tmpMargins: TMargins; cBlurColorKey: TColor = clFuchsia);
function WindowsAeroGlassCompatible: Boolean;
implementation
function WindowsAeroGlassCompatible: Boolean;
var
osVinfo: TOSVERSIONINFO;
begin
ZeroMemory(@osVinfo, SizeOf(osVinfo));
OsVinfo.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);
if (
(GetVersionEx(osVInfo) = True) and
(osVinfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and
(osVinfo.dwMajorVersion >= 6)
)
then Result:=True
else Result:=False;
end;
procedure GlassForm(frm: TForm; tmpMargins: TMargins; cBlurColorKey: TColor = clFuchsia);
var
hDwmDLL: Cardinal;
fDwmIsCompositionEnabled: DwmIsCompositionEnabledFunc;
fDwmExtendFrameIntoClientArea: DwmExtendFrameIntoClientAreaFunc;
fSetLayeredWindowAttributesFunc: SetLayeredWindowAttributesFunc;
bCmpEnable: Boolean;
mgn: TMargins;
begin
{ Kontynuuj, jeśli wersja Windowsa jest kompatybilna }
if WindowsAeroGlassCompatible then begin
{ Kontynuuj, jeśli biblioteka ,,dwmapi" jest załadowana }
hDwmDLL := LoadLibrary('dwmapi.dll');
if hDwmDLL <> 0 then begin
{ Pobierz wartości }
@fDwmIsCompositionEnabled := GetProcAddress(hDwmDLL, 'DwmIsCompositionEnabled');
@fDwmExtendFrameIntoClientArea := GetProcAddress(hDwmDLL, 'DwmExtendFrameIntoClientArea');
@fSetLayeredWindowAttributesFunc := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
{ Kontynuuj, jeśli wartości <> nil }
if (
(@fDwmIsCompositionEnabled <> nil) and
(@fDwmExtendFrameIntoClientArea <> nil) and
(@fSetLayeredWindowAttributesFunc <> nil)
)
then begin
{ Kontynuuj, jeżeli kompozycje systemowe są włączone }
fDwmIsCompositionEnabled(@bCmpEnable);
if bCmpEnable = True then begin
{ Ustaw kolor formy na cBlurColorKey }
frm.Color := cBlurColorKey;
{ ... }
SetWindowLong(frm.Handle, GWL_EXSTYLE, GetWindowLong(frm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
{ ... }
fSetLayeredWindowAttributesFunc(frm.Handle, cBlurColorKey, 0, LWA_COLORKEY);
{ Ustaw marginesy }
ZeroMemory(@mgn, SizeOf(mgn));
mgn.cxLeftWidth := tmpMargins.cxLeftWidth;
mgn.cxRightWidth := tmpMargins.cxRightWidth;
mgn.cyTopHeight := tmpMargins.cyTopHeight;
mgn.cyBottomHeight := tmpMargins.cyBottomHeight;
{ Rozszerz formę }
fDwmExtendFrameIntoClientArea(frm.Handle,@mgn);
end;
end;
{ Zwolnij bibliotekę ,,dwmapi" }
FreeLibrary(hDWMDLL);
end;
end;
end;
end.
Następnie skopiuj powyższy plik do folderu głównego Twojej aplikacji (tu: MojProjekt):
MojProjekt\glass.pas
W sekcji ,,uses" dopisz nazwę powyższego modułu:
unit form1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs
glass; // Tu zawiera się procedura GlassForm
Utwórz zdarzenie OnActivate i uzupełnij je, tak jak poniżej:
procedure TForm1.FormActivate(Sender: TObject);
var
tmpMargins: TMargins;
begin
{ Jeżeli marginesy mają wartość -1, to cała forma będzie pokryta szkłem }
tmpMargins.cxLeftWidth := -1;
tmpMargins.cxRightWidth := -1;
tmpMargins.cyBottomHeight := -1;
tmpMargins.cyTopHeight := -1;
{ NazwaFormularza ; Marginesy ; KolorPrzezroczystości }
GlassForm(Self, tmpMargins, clFuchsia);
end;
WAŻNE: Przed uruchomieniem aplikacji włącz kompozycje, wchodząc w Projekt > Opcje projektu > Użyj pliku manifest aby odblokować kompozycje.
Bugi
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":
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).
Informacje
Powyższe kody zostały przekonwertowane do Lazarusa na podstawie "Aero Glass Effekt für Delphi-Forms, Delphi-Unit von Daniel Mitte (2006)":
Tu znajduje się komponent (przekonwertowany także do Lazarusa):
Tłumaczenie
Na język polski przełożył: --User:Matek.y 18:30, 12.12.2017