Omschrijving
Deze unit bevat een drietal functies om een TFont weer te geven met anti-alias. Anti-alias is een techniek die ervoor zorgt dat rondingen netter worden afgewerkt. Een voorbeeld van wat deze unit doet:
Opmerkingen
Er is een ding waar je op moet letten: deze truuk werkt alleen bij TrueType lettertypen, anders wordt de tekst gewoon op de oude manier weergegeven.
Ik moedig jullie niet aan om voor normale applicaties een vast lettertype in te stellen zodat de gebruiker altijd dit leuke effect ziet, maar in sommige gevallen kan het gewenst zijn een bepaald lettertype te forceren (in mijn geval was dat voor een interactieve presentatie waarbij de graphics een grote rol spelen).
En excuses voor het engelse commentaar, is automatisme
Code
Code:
unit UAAFonts;
interface
uses
Classes,
Controls,
Graphics;
procedure AAFont(const AFont: TFont);
procedure AAControl(const AControl: TControl);
procedure AAChildren(const AParent: TComponent);
implementation
uses
SysUtils,
Windows;
type
{ Explanation of sneaky hack:
Normally, protected members are available only in either the unit in which
the class is declared, or any descendants. Using this fact, we create a
descendant of the class and use the descendant in the same class, thus
we are able to access the protected properties...
}
THackControl = class(TControl);
// Anti-Alias a TFont
procedure AAFont;
var
pFont: TLogFont;
hAAFont: HFONT;
begin
// Use AFont as a starting point...
with pFont do begin
lfHeight := AFont.Height;
lfWidth := 0;
lfEscapement := 0;
lfOrientation := 0;
if fsBold in AFont.Style then
lfWeight := FW_BOLD
else
lfWeight := 0;
// These are actually booleans, but implemented as bytes for some reason
lfItalic := Byte(fsItalic in AFont.Style);
lfUnderline := Byte(fsUnderline in AFont.Style);
lfStrikeOut := 0;
lfCharSet := DEFAULT_CHARSET;
lfOutPrecision := OUT_DEFAULT_PRECIS;
lfClipPrecision := CLIP_DEFAULT_PRECIS;
// This is what causes the anti-aliasing
lfQuality := ANTIALIASED_QUALITY;
lfPitchAndFamily := DEFAULT_PITCH;
StrPCopy(lfFaceName, AFont.Name);
end;
// Create the font
hAAFont := CreateFontIndirect(pFont);
// Assign it to the control
AFont.Handle := hAAFont;
end;
// Anti-Alias a TControl's Font
procedure AAControl;
var
pControl: THackControl;
begin
pControl := THackControl(AControl);
AAFont(pControl.Font);
end;
// Anti-Alias every child of the parent
procedure AAChildren;
var
iControl: Integer;
begin
// The reason for not using Controls/ControlCount is that it only lists
// direct children of the parent. Components/ComponentCount lists every
// component which has AParent as it's owner...
for iControl := 0 to AParent.ComponentCount - 1 do
if AParent.Components[iControl] is TControl then
AAControl(TControl(AParent.Components[iControl]));
end;
end.
Bookmarks