Difference between revisions of "Aero Glass/pl"
(Created page with "{{Platform only|Windows|Windows|Windows}} {{Aero Glass}} == Efekt szkła (Aero Glass) na formularzu Lazarusa == Image:aero_glass_lazarus.png Na początku zapisz plik ,,...") |
|||
Line 157: | Line 157: | ||
*[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] | ||
− | Tu znajduje się komponent (przekonwertowany także | + | Tu znajduje się komponent (przekonwertowany także do Lazarusa): |
*[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] |
Revision as of 21:06, 29 February 2016
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 Lazarusa
Na początku zapisz plik ,,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
{ Continue if Windows version is compatible }
if WindowsAeroGlassCompatible then begin
{ Continue if 'dwmapi' library is loaded }
hDwmDLL := LoadLibrary('dwmapi.dll');
if hDwmDLL <> 0 then begin
{ Get values }
@fDwmIsCompositionEnabled := GetProcAddress(hDwmDLL, 'DwmIsCompositionEnabled');
@fDwmExtendFrameIntoClientArea := GetProcAddress(hDwmDLL, 'DwmExtendFrameIntoClientArea');
@fSetLayeredWindowAttributesFunc := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
{ Continue if values are <> nil }
if (
(@fDwmIsCompositionEnabled <> nil) and
(@fDwmExtendFrameIntoClientArea <> nil) and
(@fSetLayeredWindowAttributesFunc <> nil)
)
then begin
{ Continue if composition is enabled }
fDwmIsCompositionEnabled(@bCmpEnable);
if bCmpEnable = True then begin
{ Set Form Color same as 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);
{ Set margins }
ZeroMemory(@mgn, SizeOf(mgn));
mgn.cxLeftWidth := tmpMargins.cxLeftWidth;
mgn.cxRightWidth := tmpMargins.cxRightWidth;
mgn.cyTopHeight := tmpMargins.cyTopHeight;
mgn.cyBottomHeight := tmpMargins.cyBottomHeight;
{ Extend Form }
fDwmExtendFrameIntoClientArea(frm.Handle,@mgn);
end;
end;
{ Free loaded 'dwmapi' library }
FreeLibrary(hDWMDLL);
end;
end;
end;
end.
Następnie skopiuj moduł ,,glass.pas" do katalogu głównego Twojej aplikacji (tu: MojProjekt):
MojProjekt\glass.pas
W sekcji ,,uses" w module głównym aplikacji (tu: form1) dopisz frazę ,,glass":
unit form1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs
glass; // Tu zawiera się procedura GlassForm
Utwórz na formularzu 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;
{ FormName ; Margins ; TransparentColor }
GlassForm(Self, tmpMargins, clFuchsia);
end;
WAŻNE: Przed uruchomieniem aplikacji włącz kompozycje, wchodząc w Projekt > Opcje projektu > zaznacz opcję ,,Użyj pliku manifest aby odblokować kompozycje".
Bugi
Po włączeniu szkła wyraźnie widać, iż napisy (TLabel) nie mają tzw. ,,otoczki szkła"; aby to rozwiązać, poniżej znajdują się 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 używając "{$mode delphi}" z "Aero Glass Effekt für Delphi-Forms, Delphi-Unit von Daniel Mitte (2006)":
Tu znajduje się komponent (przekonwertowany także do Lazarusa):