Difference between revisions of "Aero Glass/pl"

From Free Pascal wiki
Jump to navigationJump to search
Line 2: Line 2:
 
{{Aero Glass}}
 
{{Aero Glass}}
  
== Efekt szkła (Aero Glass) na formularzu Lazarusa ==
+
== Efekt szkła (Aero Glass) na formularzu ==
  
 
[[Image:aero_glass_lazarus.png]]
 
[[Image:aero_glass_lazarus.png]]
  
Na początku stwórz i zapisz plik ,,glass.pas", zawierający poniższy kod:
+
Na początku utwórz moduł ,,glass.pas", zawierający poniższy kod:
  
 
<syntaxhighlight>unit glass;
 
<syntaxhighlight>unit glass;
Line 66: Line 66:
 
   mgn: TMargins;
 
   mgn: TMargins;
 
begin
 
begin
   { Continue if Windows version is compatible }
+
   { Kontynuuj, jeśli wersja Windowsa jest kompatybilna }
 
   if WindowsAeroGlassCompatible then begin
 
   if WindowsAeroGlassCompatible then begin
     { Continue if 'dwmapi' library is loaded }
+
     { 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
       { Get values }
+
       { 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');
       { Continue if values are <> nil }
+
       { Kontynuuj, jeśli wartości <> nil }
 
       if (
 
       if (
 
       (@fDwmIsCompositionEnabled <> nil) and
 
       (@fDwmIsCompositionEnabled <> nil) and
Line 82: Line 82:
 
       )
 
       )
 
       then begin
 
       then begin
         { Continue if composition is enabled }
+
         { Kontynuuj, jeżeli kompozycje systemowe są włączone }
 
         fDwmIsCompositionEnabled(@bCmpEnable);
 
         fDwmIsCompositionEnabled(@bCmpEnable);
 
         if bCmpEnable = True then begin
 
         if bCmpEnable = True then begin
           { Set Form Color same as cBlurColorKey }
+
           { 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);
           { Set margins }
+
           { 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;
           { Extend Form }
+
           { Rozszerz formę }
 
           fDwmExtendFrameIntoClientArea(frm.Handle,@mgn);
 
           fDwmExtendFrameIntoClientArea(frm.Handle,@mgn);
 
         end;
 
         end;
 
       end;
 
       end;
       { Free loaded 'dwmapi' library }
+
       { Zwolnij bibliotekę ,,dwmapi" }
 
       FreeLibrary(hDWMDLL);
 
       FreeLibrary(hDWMDLL);
 
     end;
 
     end;
Line 109: Line 109:
 
end.</syntaxhighlight>
 
end.</syntaxhighlight>
  
Następnie skopiuj moduł ,,glass.pas" do katalogu głównego Twojej aplikacji (tu: MojProjekt):
+
Następnie skopiuj powyższy plik do folderu głównego Twojej aplikacji (tu: MojProjekt):
  
 
   MojProjekt\glass.pas
 
   MojProjekt\glass.pas
 
    
 
    
W sekcji ,,uses" w module głównym aplikacji (tu: form1) dopisz frazę ,,glass":
+
W sekcji ,,uses" dopisz nazwę powyższego modułu:
  
 
<syntaxhighlight>unit form1;
 
<syntaxhighlight>unit form1;
Line 125: Line 125:
 
   glass; // Tu zawiera się procedura GlassForm </syntaxhighlight>
 
   glass; // Tu zawiera się procedura GlassForm </syntaxhighlight>
  
Utwórz na formularzu zdarzenie OnActivate i uzupełnij je, tak jak poniżej:
+
Utwórz zdarzenie OnActivate i uzupełnij je, tak jak poniżej:
  
 
<syntaxhighlight>procedure TForm1.FormActivate(Sender: TObject);
 
<syntaxhighlight>procedure TForm1.FormActivate(Sender: TObject);
Line 140: Line 140:
 
end;</syntaxhighlight>
 
end;</syntaxhighlight>
  
WAŻNE: Przed uruchomieniem aplikacji włącz kompozycje, wchodząc w Projekt > Opcje projektu > zaznacz opcję ,,Użyj pliku manifest aby odblokować kompozycje".
+
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"; aby to rozwiązać, poniżej znajdują się linki do komponentów zwanych ,,Glow Labels":
+
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 używając "{$mode delphi}" z "Aero Glass Effekt für Delphi-Forms, Delphi-Unit von Daniel Mitte (2006)":
+
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 164: Line 164:
 
'''Tłumaczenie'''
 
'''Tłumaczenie'''
  
Na język polski przełożył: --[[User:Matek]] 20:10, 29 February 2016 (CEST)
+
Na język polski przełożył: --[[User:Matek.y]] 18:30, 12.12.2017

Revision as of 18:32, 12 December 2017

Windows logo - 2012.svg

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

aero glass lazarus.png

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