paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 12:18:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazFreeType: Move strike-out and underline decoration to TFreeTypeRenderableFont. Based on patch by "circular"

Browse Source 
git-svn-id: trunk@40147 -
This commit is contained in:
ask 2013-02-03 10:43:22 +00:00
parent b0eb1b3018
commit 7745a4f174
2 changed files with 69 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
components/lazutils/easylazfreetype.pas
View File

@ -157,6 +157,7 @@ type
function GetHinted: boolean; virtual; abstract;
procedure SetHinted(const AValue: boolean); virtual; abstract;
public
UnderlineDecoration,StrikeOutDecoration: boolean;
function TextWidth(AText: string): single; virtual; abstract;
function TextHeight(AText: string): single; virtual; abstract;
function CharWidthFromUnicode(AUnicode: integer): single; virtual; abstract;
@ -225,6 +226,8 @@ type
procedure UpdateSizeInPoints;
procedure UpdateMetrics;
procedure UpdateCharmap;
procedure RenderTextDecoration(AText: string; x,y: single; ARect: TRect; OnRender : TDirectRenderingFunction);
procedure FillRect(ARect: TRect; OnRender : TDirectRenderingFunction);
protected
FFace: TT_Face;
FFaceItem: TCustomFontCollectionItem;
@ -374,6 +377,8 @@ function StylesToArray(AStyles: string): ArrayOfString;
implementation
uses Math;
function StylesToArray(AStyles: string): ArrayOfString;
var
StartIndex, EndIndex: integer;
@ -1212,6 +1217,64 @@ begin
FCharmapOk := false;
end;
procedure TFreeTypeFont.RenderTextDecoration(AText: string; x, y: single;
ARect: TRect; OnRender: TDirectRenderingFunction);
procedure HorizLine(AYCoeff, AHeightCoeff: single);
var
ly, height: single;
clippedRect,unclippedRect: TRect;
begin
ly := y + self.Ascent * AYCoeff;
height := Max(self.Ascent * AHeightCoeff, 1);
unclippedRect := Types.Rect(round(x),round(ly),
round(x+self.TextWidth(AText)),round(ly+height));
clippedRect := rect(0,0,0,0);
if IntersectRect(clippedRect,unclippedRect,ARect) then
FillRect(clippedRect,OnRender);
end;
begin
if UnderlineDecoration then
HorizLine(+1.5*0.08, 0.08);
if StrikeoutDecoration then
HorizLine(-0.3, 0.06);
end;
procedure TFreeTypeFont.FillRect(ARect: TRect; OnRender: TDirectRenderingFunction);
var
yb,temp,tx: integer;
data: pbyte;
begin
if ARect.Top > ARect.Bottom then
begin
temp := ARect.Top;
ARect.Top := ARect.Bottom;
ARect.Bottom := temp;
end;
if ARect.Left > ARect.Right then
begin
temp := ARect.Left;
ARect.Left := ARect.Right;
ARect.Right:= temp;
end;
if ClearType then
begin
ARect.Left *= 3;
ARect.Right *= 3;
end;
tx := ARect.Right-ARect.Left;
if tx > 0 then
begin
getmem(data,tx);
try
fillchar(data^, tx, 255);
for yb := ARect.Top to ARect.Bottom-1 do
OnRender(ARect.Left,yb,tx,data);
finally
freemem(data);
end;
end;
end;
constructor TFreeTypeFont.Create;
begin
EnsureFreeTypeInitialized;
@ -1259,6 +1322,7 @@ begin
end;
If Assigned(FOnRenderText) then
FOnRenderText(AText,x,y);
RenderTextDecoration(AText,x,y,ARect,OnRender);
pstr := @AText[1];
left := length(AText);
while left > 0 do

41
lcl/lazfreetypeintfdrawer.pas
View File

@ -25,7 +25,6 @@ type
FWidth, FHeight: integer;
procedure SetDestination(AValue: TLazIntfImage);
protected
FRenderedFont: TFreeTypeRenderableFont;
procedure RenderDirectly(x, y, tx: integer; data: pointer);
procedure RenderDirectlyClearType(x, y, tx: integer; data: pointer);
procedure InternalMergeColorOver(var merge: TFPColor; const c: TFPColor; calpha: word); inline;
@ -36,10 +35,8 @@ type
procedure ClearTypePixelAt(p: pointer; Cr,Cg,Cb: byte; const Color: TFPColor);
function UnclippedGetPixelAddress(x, y: integer): pointer; inline;
function ClippedGetPixelAddress(x, y: integer): pointer; inline;
procedure OnRenderTextHandler(s: string; x,y: single);
public
ClearTypeRGBOrder: boolean;
UnderlineDecoration, StrikeOutDecoration: boolean;
constructor Create(ADestination: TLazIntfImage);
procedure ClippedDrawPixel(x,y: integer; const c: TFPColor);
procedure UnclippedDrawPixel(x,y: integer; const c: TFPColor);
@ -57,7 +54,7 @@ type
implementation
uses LCLType, Math, GraphType;
uses LCLType, GraphType;
type
PFPColorBytes = ^TFPColorBytes;
@ -86,26 +83,6 @@ begin
result := pbyte(Destination.GetDataLineStart(y))+(x*FPixelSizeInBytes);
end;
procedure TIntfFreeTypeDrawer.OnRenderTextHandler(s: string; x, y: single);
procedure HorizLine(AYCoeff, AHeightCoeff: single);
var
ly, height: single;
begin
ly := y + FRenderedFont.Ascent * AYCoeff;
height := Max(FRenderedFont.Ascent * AHeightCoeff, 1);
FillRect(
round(x),round(ly),
round(x+FRenderedFont.TextWidth(s)),round(ly+height),FColor,False);
end;
begin
if UnderlineDecoration then
HorizLine(+1.5*0.08, 0.08);
if StrikeoutDecoration then
HorizLine(-0.3, 0.06);
end;
procedure InternalGetPixelAtWithoutAlphaRGB(p: pointer; out Color: TFPColor);
begin
with PFourBytes(p)^ do
@ -739,20 +716,12 @@ end;
procedure TIntfFreeTypeDrawer.DrawText(AText: string; AFont: TFreeTypeRenderableFont; x, y: single;
AColor: TFPColor);
var OldRenderTextHandler: TOnRenderTextHandler;
begin
FColor := AColor;
OldRenderTextHandler := AFont.OnRenderText;
FRenderedFont:= AFont;
try
AFont.OnRenderText := @OnRenderTextHandler;
if AFont.ClearType then
AFont.RenderText(AText, x, y, rect(0,0,Destination.Width,Destination.Height), @RenderDirectlyClearType)
else
AFont.RenderText(AText, x, y, rect(0,0,Destination.Width,Destination.Height), @RenderDirectly);
finally
AFont.OnRenderText := OldRenderTextHandler;
end;
if AFont.ClearType then
AFont.RenderText(AText, x, y, rect(0,0,Destination.Width,Destination.Height), @RenderDirectlyClearType)
else
AFont.RenderText(AText, x, y, rect(0,0,Destination.Width,Destination.Height), @RenderDirectly);
end;
destructor TIntfFreeTypeDrawer.Destroy;