pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

PowerPDF, added support for underline font style

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1175 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
jesusr
2010-03-05 16:42:19 +00:00
parent 99fc954036
commit 6b8197d3ee
4 changed files with 104 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
components/powerpdf/PReport.pas
View File

@ -338,8 +338,10 @@ type
FFontBold: boolean;
FFontItalic: boolean;
FCharSpace: Single;
FFontUnderLine: boolean;
FWordSpace: Single;
procedure SetCharSpace(Value: Single);
procedure SetFontUnderline(const Value: boolean);
procedure SetWordSpace(Value: Single);
procedure SetFontColor(Value: TColor);
function GetFontClassName: string;
@ -363,6 +365,7 @@ type
property FontSize: Single read FFontSize write SetFontSize;
property FontBold: boolean read FFontBold write SetFontBold default false;
property FontItalic: boolean read FFontItalic write SetFontItalic default false;
property FontUnderline: boolean read FFontUnderLine write SetFontUnderline default false;
property CharSpace: Single read FCharSpace write SetCharSpace;
property WordSpace: Single read FWordSpace write SetWordSpace;
end;
@ -1798,7 +1801,7 @@ end;
// GetText
function TPRText.GetText: string;
begin
result := Trim(FLines.Text);
result := TrimRight(FLines.Text);
end;
// Create
@ -1918,6 +1921,7 @@ begin
SetCharSpace(CharSpace);
SetWordSpace(WordSpace);
SetLeading(Leading);
Attribute.FontUnderline:=FontUnderline;
with ARect do
MultilineTextRect(_PdfRect(Left, GetPage.Height- Top, Right, GetPage.Height- Bottom),
@ -1935,6 +1939,19 @@ begin
end;
end;
procedure TPRCustomLabel.SetFontUnderline(const Value: boolean);
begin
if FFontUnderLine <> Value then
begin
FFontUnderLine := Value;
if Value then
Font.Style := Font.Style + [fsUnderline]
else
Font.Style := Font.Style - [fsUnderline];
Invalidate;
end;
end;
// SetLeading
procedure TPRText.SetLeading(Value: Single);
begin

81
components/powerpdf/PdfDoc.pas
View File

@ -357,6 +357,7 @@ type
FFont: TPdfFont;
FLeading: Single;
FHorizontalScaling: Word;
FFontUnderline: boolean;
procedure SetWordSpace(Value: Single);
procedure SetCharSpace(Value: Single);
procedure SetFontSize(Value: Single);
@ -372,6 +373,7 @@ type
property Leading: Single read FLeading write SetLeading;
property FontSize: Single read FFontSize write SetFontSize;
property Font: TPdfFont read FFont write FFont;
property FontUnderline: boolean read FFontUnderline write FFontUnderline;
end;
{ TPdfCanvas }
@ -541,9 +543,13 @@ type
property Pages: TPdfDictionary read GetPages write SetPages;
end;
{ TPdfFont }
TPdfFont = class(TPdfDictionaryWrapper)
private
FName: string;
FUnderlinePosition: Integer;
FUnderlineThickness: Integer;
protected
procedure AddStrElements(ADic: TPdfDictionary; ATable: array of TPDF_STR_TBL);
procedure AddIntElements(ADic: TPdfDictionary; ATable: array of TPDF_INT_TBL);
@ -551,6 +557,8 @@ type
constructor Create(AXref: TPdfXref; AName: string); virtual;
function GetCharWidth(AText: string; APos: integer): integer; virtual;
property Name: string read FName;
property UnderlinePosition: Integer read FUnderlinePosition write FUnderlinePosition;
property UnderlineThickness: Integer read FUnderlineThickness write FUnderlineThickness;
end;
TPdfDestination = class(TObject)
@ -1500,11 +1508,22 @@ end;
// TextOut
procedure TPdfCanvas.TextOut(X, Y: Single; Text: string);
var
UPos, UWidth: Single;
begin
BeginText;
MoveTextPoint(X, Y);
ShowText(Text);
EndText;
//TODO: Check Underline
if FAttr.FontUnderline then
begin
UPos := FAttr.Font.UnderlinePosition/1000*FAttr.FontSize;
UWidth := FAttr.Font.UnderlineThickness/1000*FAttr.FontSize;
Rectangle(X, Y+UPos, FAttr.TextWidth(Text), UWidth);
Fill;
end;
end;
// TextRect
@ -1512,7 +1531,7 @@ procedure TPdfCanvas.TextRect(ARect: TPdfRect; Text: string;
Alignment: TPdfAlignment; Clipping: boolean);
var
tmpWidth: Single;
XPos: Single;
XPos,YPos,UPos,UWidth: Single;
begin
// calculate text width.
tmpWidth := TextWidth(Text);
@ -1540,22 +1559,32 @@ begin
NewPath;
end;
YPos := ARect.Top - FAttr.FontSize * 0.85;
BeginText;
MoveTextPoint(ARect.Left + XPos, ARect.Top - FAttr.FontSize * 0.85);
MoveTextPoint(ARect.Left + XPos, YPos);
ShowText(Text);
EndText;
//TODO: Check Underline
if FAttr.FontUnderline then
begin
UPos := FAttr.Font.UnderlinePosition/1000*FAttr.FontSize;
UWidth := FAttr.Font.UnderlineThickness/1000*FAttr.FontSize;
Rectangle(ARect.Left + XPos, YPos + UPos, FAttr.TextWidth(Text), UWidth);
Fill;
end;
if Clipping then
GRestore;
end;
// MultilineTextRect
procedure TPdfCanvas.MultilineTextRect(ARect: TPdfRect;
Text: string; WordWrap: boolean);
procedure TPdfCanvas.MultilineTextRect(ARect: TPdfRect; Text: string;
WordWrap: boolean);
var
i: integer;
S1, S2: string;
XPos, YPos: Single;
XPos, YPos, UPos, UWidth: Single;
tmpXPos: Single;
tmpWidth: Single;
ln: integer;
@ -1571,14 +1600,36 @@ var
ShowText(S);
end;
procedure WriteText;
begin
if FAttr.FontUnderline then
begin
BeginText;
MoveTextPoint(ARect.Left, YPos);
InternalShowText(S2, ARect.Right - ARect.Left);
EndText;
Rectangle(ARect.Left, YPos+UPos, XPos-ARect.Left, UWidth);
Fill;
end else
InternalShowText(S2, ARect.Right - ARect.Left);
end;
begin
YPos := ARect.Top - FAttr.FontSize*0.85;
XPos := ARect.Left;
FText := Text;
BeginText;
if FAttr.FontUnderline then
begin
UPos := FAttr.Font.UnderlinePosition/1000*FAttr.FontSize;
UWidth := FAttr.Font.UnderlineThickness/1000*FAttr.FontSize;
end else
begin
BeginText;
MoveTextPoint(XPos, YPos);
end;
MoveTextPoint(XPos, YPos);
i := 1;
S2 := GetNextWord(FText, i);
XPos := XPos + TextWidth(S2);
@ -1604,9 +1655,13 @@ begin
FourceReturn then
begin
if S2 <> '' then
InternalShowText(S2, ARect.Right - ARect.Left);
WriteText;
S2 := '';
MoveToNextLine;
if not FAttr.FontUnderline then
MoveToNextLine;
ARect.Top := ARect.Top - FAttr.Leading;
if ARect.Top < ARect.Bottom + FAttr.FontSize then
Break;
@ -1619,8 +1674,10 @@ begin
end;
if S2 <> '' then
InternalShowText(S2, ARect.Right - ARect.Left);
EndText;
WriteText;
if not FAttr.FontUnderline then
EndText;
end;
// DrawXObject
@ -2559,6 +2616,8 @@ constructor TPdfFont.Create(AXref: TPdfXref; AName: string);
begin
inherited Create;
FName := AName;
FUnderlinePosition := -150;
FUnderlineThickness := 50;
end;
{ PdfDestination }

14
components/powerpdf/PdfFonts.pas
View File

@ -490,6 +490,9 @@ const
SCRIPT_BBOX: array[0..3] of Integer = (-184,-363,505,758);
type
{ TPdfType1Font }
TPdfType1Font = class(TPdfFont)
private
FFirstChar: Byte;
@ -578,6 +581,7 @@ var
i: integer;
DefaultWidth: Word;
Widths: TPdfArray;
ANumber: TPdfNumber;
begin
inherited SetData(Value);
@ -700,6 +704,8 @@ begin
FWidths := TPdfArray.CreateNumArray(AXref, ARIAL_W_ARRAY);
FFont.AddInternalItem('Widths', FWidths);
UnderlinePosition := -151;
SetData(FFont);
end;
@ -720,6 +726,9 @@ begin
FWidths := TPdfArray.CreateNumArray(AXref, ARIAL_BOLD_W_ARRAY);
FFont.AddInternalItem('Widths', FWidths);
UnderlinePosition := -155;
UnderlineThickness := 69;
SetData(FFont);
end;
@ -740,6 +749,8 @@ begin
FWidths := TPdfArray.CreateNumArray(AXref, ARIAL_ITALIC_W_ARRAY);
FFont.AddInternalItem('Widths', FWidths);
UnderlinePosition := -151;
SetData(FFont);
end;
@ -760,6 +771,9 @@ begin
FWidths := TPdfArray.CreateNumArray(AXref, ARIAL_BOLDITALIC_W_ARRAY);
FFont.AddInternalItem('Widths', FWidths);
UnderlinePosition := -111;
UnderlineThickness := 69;
SetData(FFont);
end;

5
components/powerpdf/pack_powerpdf.lpk
View File

@ -16,12 +16,11 @@
</SyntaxOptions>
</Parsing>
<Other>
<CustomOptions Value="-dLAZ_POWERPDF
"/>
<CustomOptions Value="-dLAZ_POWERPDF"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Version Minor="9" Release="3" Build="1"/>
<Version Minor="9" Release="4"/>
<Files Count="12">
<Item1>
<Filename Value="PdfTypes.pas"/>