paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-10 22:39:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL graphics: implemented specifying font anti-aliasing as TFont.Quality (works in win so far)

Browse Source 
git-svn-id: trunk@16907 -
This commit is contained in:
tombo 2008-10-07 07:58:09 +00:00
parent ca68a99f0a
commit 60fc419118
3 changed files with 89 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
docs/xml/lcl/graphics.xml
View File

@ -217,6 +217,32 @@
<descr/>
<seealso/>
</element>
<!-- enumeration type Visibility: default -->
<element name="TFontQuality">
<short>Output font quality, such as antialiasing</short>
<descr/>
<seealso/>
</element>
<!-- enumeration value Visibility: default -->
<element name="TFontQuality.fqDefault">
<short>Default font quality</short>
</element>
<!-- enumeration value Visibility: default -->
<element name="TFontQuality.fqDraft">
<short>Draft font quality</short>
</element>
<!-- enumeration value Visibility: default -->
<element name="TFontQuality.fqProof">
<short>Proof font quality</short>
</element>
<!-- enumeration value Visibility: default -->
<element name="TFontQuality.fqNonAntialiased">
<short>Disable font antialiasing</short>
</element>
<!-- enumeration value Visibility: default -->
<element name="TFontQuality.fqAntialiased">
<short>Force font antialiasing</short>
</element>
<!-- record type Visibility: default -->
<element name="TFontData">
<short>A <b>record</b> holding <var>Data</var> about the current <var>Font</var>
@ -248,6 +274,10 @@
<short>The <var>Character Set</var> of the current <var>Font</var> (expresed as an integer)</short>
</element>
<!-- variable Visibility: default -->
<element name="TFontData.Quality">
<short>Output <var>Quality</var> of the current <var>Font</var>, such as antialiasing</short>
</element>
<!-- variable Visibility: default -->
<element name="TFontData.Name">
<short>The <var>Name</var> (as a string) of the current <var>Font</var>
</short>
@ -1797,6 +1827,12 @@ Since FPC 2.0 the LCL uses TFPCanvasHelper as ancestor.</descr>
<seealso/>
</element>
<!-- variable Visibility: private -->
<element name="TFont.FQuality">
<short/>
<descr/>
<seealso/>
</element>
<!-- variable Visibility: private -->
<element name="TFont.FStyle">
<short/>
<descr/>
@ -2068,6 +2104,17 @@ Since FPC 2.0 the LCL uses TFPCanvasHelper as ancestor.</descr>
<element name="TFont.SetStyle.Value">
<short/>
</element>
<!-- procedure Visibility: protected -->
<element name="TFont.SetQuality">
<short/>
<descr/>
<errors/>
<seealso/>
</element>
<!-- argument Visibility: default -->
<element name="TFont.SetQuality.AValue">
<short/>
</element>
<!-- constructor Visibility: public -->
<element name="TFont.Create">
<short>
@ -2218,6 +2265,14 @@ Reads or writes a flag to determine pitch type</descr>
</seealso>
</element>
<!-- property Visibility: published -->
<element name="TFont.Quality">
<short>Output quality of the <var>Font</var>, such as antialiasing</short>
<descr/>
<seealso>
<link id="TFontQuality"/>
</seealso>
</element>
<!-- property Visibility: published -->
<element name="TFont.Size">
<short>
<var>Font</var>
@ -7498,7 +7553,8 @@ Checks for the presence of a valid Lazarus Resource, then uses
</element>
<!-- object Visibility: default -->
<element name="TPortableNetworkGraphic">
<short><var>TPortableNetworkGraphic</var> - a PNG image</short>
<short>
<var>TPortableNetworkGraphic</var> - a PNG image</short>
<descr/>
<errors/>
<seealso/>

6
lcl/graphics.pp
View File

@ -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;

27
lcl/include/font.inc
View File

@ -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