DPI-aware aplikace v Delphi

Odesláno v June 17, 2016 | Kategorie Delphi, Programování | Leave a Comment

Ta hrůza, když najednou zjistíte, že vaše aplikace vypadá v jiném DPI tak nějak rozmazaně. Co s tím?

1. vytvořit soubor dpiAware.manifest

  1. <?xml version="1.0" encoding="UTF-8" standalone="yes"?>
  2. <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  3. <dependency>
  4. <dependentAssembly>
  5. <assemblyIdentity
  6. type="win32"
  7. name="Microsoft.Windows.Common-Controls"
  8. version="6.0.0.0"
  9. publicKeyToken="6595b64144ccf1df"
  10. language="*"
  11. processorArchitecture="*"/>
  12. </dependentAssembly>
  13. </dependency>
  14. <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
  15. <security>
  16. <requestedPrivileges>
  17. <requestedExecutionLevel
  18. level="asInvoker"
  19. uiAccess="false"/>
  20. </requestedPrivileges>
  21. </security>
  22. </trustInfo>
  23. <asmv3:application xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
  24. <asmv3:windowsSettings
  25. xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
  26. <dpiAware>True/PM</dpiAware>
  27. </asmv3:windowsSettings>
  28. </asmv3:application>
  29. </assembly>

Nastavíme v rozbalovací nabídce Project options > Application > Runtime themes > Use custom manifest a v poli pod ním vložíme odkaz na náš nový soubor.

Teď ještě message handler, který nám zajistí, aby se změna rozlišení vyhodnocovala i za běhu programu.

  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6. Winapi.Windows, Winapi.Messages, Vcl.Controls, Vcl.Forms;
  7.  
  8. const
  9. WM_DPICHANGED = 736; // 0x02E0
  10.  
  11. type
  12. TForm1 = class(TForm)
  13. private
  14.    procedure WMDpiChanged(var Message: TMessage); message WM_DPICHANGED;
  15. public
  16. end;
  17.  
  18. var
  19. Form1: TForm1;
  20. implementation
  21. {$R *.dfm}
  22. {-$DEFINE DELPHI_STYLE_SCALING}
  23.  procedure TForm1.WMDpiChanged(var Message: TMessage);
  24. {$IFDEF DELPHI_STYLE_SCALING}
  25. function FontHeightAtDpi(aDPI, aFontSize: integer): integer;
  26.   var
  27.    tmpCanvas: TCanvas;
  28.   begin
  29.    tmpCanvas := TCanvas.Create;
  30.    try
  31.      tmpCanvas.Handle := GetDC(0);
  32.      tmpCanvas.Font.Assign(self.Font);
  33.      tmpCanvas.Font.PixelsPerInch := aDPI; //must be set BEFORE size
  34.      tmpCanvas.Font.size := aFontSize;
  35.      result := tmpCanvas.TextHeight('0');
  36.    finally
  37.     tmpCanvas.free;
  38.    end;
  39. end;
  40. {$ENDIF}
  41.  
  42. begin
  43.   inherited;
  44.   {$IFDEF DELPHI_STYLE_SCALING}
  45.     ChangeScale(FontHeightAtDpi(LOWORD(Message.wParam), self.Font.Size),
  46.     FontHeightAtDpi(self.PixelsPerInch, self.Font.Size));
  47.   {$ELSE}
  48.     ChangeScale(LOWORD(Message.wParam), self.PixelsPerInch);
  49.   {$ENDIF}
  50.   self.PixelsPerInch := LOWORD(Message.wParam);
  51. end;
  52. end.
Hlasujte pro tento článek:
  • Bookmarky.cz
  • Digg
  • del.icio.us
  • Google
  • Linkuj
  • Vybrali.sme
  • E-mail this story to a friend!
  • Facebook
  • LinkedIn

Komentáře

Váš komentář: