diff --git a/docs/xml/lcl/graphics.xml b/docs/xml/lcl/graphics.xml
index 0da4358403..a1be0eedaf 100644
--- a/docs/xml/lcl/graphics.xml
+++ b/docs/xml/lcl/graphics.xml
@@ -217,6 +217,32 @@
+
+
+ Output font quality, such as antialiasing
+
+
+
+
+
+ Default font quality
+
+
+
+ Draft font quality
+
+
+
+ Proof font quality
+
+
+
+ Disable font antialiasing
+
+
+
+ Force font antialiasing
+
A record holding Data about the current Font
@@ -248,6 +274,10 @@
The Character Set of the current Font (expresed as an integer)
+
+ Output Quality of the current Font, such as antialiasing
+
+
The Name (as a string) of the current Font
@@ -1797,6 +1827,12 @@ Since FPC 2.0 the LCL uses TFPCanvasHelper as ancestor.
+
+
+
+
+
+
@@ -2068,6 +2104,17 @@ Since FPC 2.0 the LCL uses TFPCanvasHelper as ancestor.
+
+
+
+
+
+
+
+
+
+
+
@@ -2218,6 +2265,14 @@ Reads or writes a flag to determine pitch type
+
+ Output quality of the Font, such as antialiasing
+
+
+
+
+
+
Font
@@ -7498,7 +7553,8 @@ Checks for the presence of a valid Lazarus Resource, then uses
- TPortableNetworkGraphic - a PNG image
+
+ TPortableNetworkGraphic - a PNG image
diff --git a/lcl/graphics.pp b/lcl/graphics.pp
index f21d194268..f6d24f69cd 100644
--- a/lcl/graphics.pp
+++ b/lcl/graphics.pp
@@ -56,6 +56,7 @@ type
TFontStyles = set of TFontStyle;
TFontStylesbase = set of TFontStyle;
TFontCharSet = 0..255;
+ TFontQuality = (fqDefault, fqDraft, fqProof, fqNonAntialiased, fqAntialiased);
TFontData = record
Handle: HFont;
@@ -63,6 +64,7 @@ type
Pitch: TFontPitch;
Style: TFontStylesBase;
CharSet: TFontCharSet;
+ Quality: TFontQuality;
Name: TFontDataName;
end;
@@ -77,6 +79,7 @@ const
Pitch: fpDefault;
Style: [];
Charset: DEFAULT_CHARSET;
+ Quality: fqDefault;
Name: 'default'
);
@@ -463,6 +466,7 @@ type
FIsMonoSpace: boolean;
FIsMonoSpaceValid: boolean;
FPitch: TFontPitch;
+ FQuality: TFontQuality;
FStyle: TFontStylesBase;
FCharSet: TFontCharSet;
FPixelsPerInch: Integer;
@@ -503,6 +507,7 @@ type
procedure SetPitch(Value: TFontPitch);
procedure SetSize(AValue: integer); override;
procedure SetStyle(Value: TFontStyles);
+ procedure SetQuality(const AValue: TFontQuality);
public
constructor Create; override;
destructor Destroy; override;
@@ -525,6 +530,7 @@ type
property Height: Integer read GetHeight write SetHeight;
property Name: string read GetName write SetName stored IsNameStored;
property Pitch: TFontPitch read GetPitch write SetPitch default fpDefault;
+ property Quality: TFontQuality read FQuality write SetQuality default fqDefault;
property Size: Integer read GetSize write SetSize stored false;
property Style: TFontStyles read GetStyle write SetStyle;
end;
diff --git a/lcl/include/font.inc b/lcl/include/font.inc
index 7d3dea2ad3..b1fb9cd081 100644
--- a/lcl/include/font.inc
+++ b/lcl/include/font.inc
@@ -603,6 +603,7 @@ begin
FPixelsPerInch := ScreenInfo.PixelsPerInchY;
FPitch := DefFontData.Pitch;
FCharSet := DefFontData.CharSet;
+ FQuality := DefFontData.Quality;
DelayAllocate := True;
inherited SetName(DefFontData.Name);
inherited SetFPColor(colBlack);
@@ -636,6 +637,7 @@ begin
Name := TFont(Source).Name;
Pitch := TFont(Source).Pitch;
Style := TFont(Source).Style;
+ Quality := TFont(Source).Quality;
finally
EndUpdate;
end;
@@ -683,6 +685,7 @@ begin
else
Pitch := fpDefault;
Style := AStyle;
+ Quality := TFontQuality(ALogFont.lfQuality);
Name := ALogFont.lfFaceName;
end;
finally
@@ -701,6 +704,7 @@ begin
or (Height<>AFont.Height)
or (Name<>AFont.Name)
or (Pitch<>AFont.Pitch)
+ or (Quality<>AFont.Quality)
or (Style<>AFont.Style) then
Result := False
else
@@ -742,6 +746,7 @@ begin
and (not IsNameStored)
and (Pitch=fpDefault)
and (Size=0)
+ and (Quality=fqDefault)
and (Style=[]);
end;
@@ -758,6 +763,7 @@ begin
Charset := DefFontData.CharSet;
Height := DefFontData.Height;
Pitch := DefFontData.Pitch;
+ Quality := DefFontData.Quality;
Style := DefFontData.Style;
Color := clWindowText;
finally
@@ -925,6 +931,7 @@ begin
SrcFont := TFont(From);
Pitch := SrcFont.Pitch;
CharSet := SrcFont.CharSet;
+ Quality := SrcFont.Quality;
Style := SrcFont.Style;
end;
finally
@@ -1007,6 +1014,8 @@ procedure TFont.ReferenceNeeded;
const
LF_BOOL: array[Boolean] of Byte = (0, 255);
LF_WEIGHT: array[Boolean] of Integer = (FW_NORMAL, FW_BOLD);
+ LF_QUALITY: array[TFontQuality] of Integer = (DEFAULT_QUALITY,
+ DRAFT_QUALITY, PROOF_QUALITY, NONANTIALIASED_QUALITY, ANTIALIASED_QUALITY);
var
ALogFont: TLogFont;
CachedFont: TFontHandleCacheDescriptor;
@@ -1045,7 +1054,7 @@ begin
lfCharSet := Byte(FCharset);
SetLogFontName(Name);
- lfQuality := DEFAULT_QUALITY;
+ lfQuality := LF_QUALITY[FQuality];
lfOutPrecision := OUT_DEFAULT_PRECIS;
lfClipPrecision := CLIP_DEFAULT_PRECIS;
case Pitch of
@@ -1073,6 +1082,20 @@ begin
FIsMonoSpaceValid := False;
end;
+procedure TFont.SetQuality(const AValue: TFontQuality);
+begin
+ if FQuality <> AValue then
+ begin
+ BeginUpdate;
+ FreeReference;
+ FQuality := AValue;
+ if IsFontNameXLogicalFontDesc(Name) then
+ Name := ClearXLFDStyle(Name);
+ Changed;
+ EndUpdate;
+ end;
+end;
+
{------------------------------------------------------------------------------
Function: TFont.GetHandle
Params: none
@@ -1141,6 +1164,7 @@ begin
FontData.Pitch := Pitch;
FontData.Style := Style;
FontData.CharSet := CharSet;
+ FontData.Quality := Quality;
FontData.Name := LeftStr(Name, SizeOf(FontData.Name) - 1);
end;
@@ -1179,6 +1203,7 @@ begin
FPitch := FontData.Pitch;
FStyle := FontData.Style;
FCharSet := FontData.CharSet;
+ FQuality := FontData.Quality;
inherited SetName(FontData.Name);
Bold; // it calls GetFlags
if (fsBold in OldStyle)<>(fsBold in FStyle) then