mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-03 02:58:14 +02:00
LazReport, implemented css in html exporter, patch with changes from Ts.Petrov, issue #15011
git-svn-id: trunk@23089 -
This commit is contained in:
jesus
parent
fc25b96d25
commit
45f97fdb97
@ -12,5 +12,6 @@ Luiz Americo (br)
|
||||
Mattias Gaertner (de)
|
||||
Olivier Guilbaud (fr)
|
||||
Petr Smolik (cz)
|
||||
Ts. Petrov ( )
|
||||
Vincent Snijders (nl)
|
||||
|
||||
|
||||
@ -1108,9 +1108,15 @@ type
|
||||
TfrTextRec = record
|
||||
Next: PfrTextRec;
|
||||
X: Integer;
|
||||
Text: String[255];
|
||||
W: Integer;
|
||||
Text: string;
|
||||
FontName: String[32];
|
||||
FontSize, FontStyle, FontColor, FontCharset, FillColor: Integer;
|
||||
Alignment: TAlignment;
|
||||
Borders: TfrFrameBorders;
|
||||
BorderColor: TColor;
|
||||
BorderStyle: TfrFrameStyle;
|
||||
BorderWidth: Integer;
|
||||
Typ: Byte;
|
||||
end;
|
||||
|
||||
@ -8489,6 +8495,7 @@ begin
|
||||
else
|
||||
begin
|
||||
p := TfrPreviewForm.Create(nil);
|
||||
p.BorderIcons:=p.BorderIcons - [biMinimize];
|
||||
{$IFDEF DebugLR}
|
||||
DebugLn('1 TfrPreviewForm.visible=',BooLToStr(p.Visible));
|
||||
{$ENDIF}
|
||||
@ -8957,7 +8964,7 @@ begin
|
||||
inherited Create;
|
||||
Stream := AStream;
|
||||
Lines := TFpList.Create;
|
||||
FBandTypes := [btMasterHeader, btMasterData];
|
||||
FBandTypes := [btReportTitle..btNone];
|
||||
end;
|
||||
|
||||
destructor TfrExportFilter.Destroy;
|
||||
@ -8979,6 +8986,7 @@ begin
|
||||
begin
|
||||
p1 := p;
|
||||
p := p^.Next;
|
||||
SetLength(p1^.Text, 0);
|
||||
FreeMem(p1, SizeOf(TfrTextRec));
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -69,6 +69,7 @@ begin
|
||||
FQuoteType := qtQuoteChar;
|
||||
FQuoteChar := '"';
|
||||
FSeparator := ';';
|
||||
BandTypes := [btMasterHeader,btMasterData,btColumnHeader];
|
||||
end;
|
||||
|
||||
procedure TfrCSVExportFilter.OnBeginPage;
|
||||
|
||||
@ -13,26 +13,50 @@ unit LR_E_HTM;
|
||||
interface
|
||||
|
||||
{$I lr_vers.inc}
|
||||
{$COPERATORS on}
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources,
|
||||
Graphics,GraphType, Controls, Forms, Dialogs, LR_E_TXT,
|
||||
LCLType,LCLIntf,LR_Class;
|
||||
Graphics, GraphType, Controls, Forms, Dialogs, LR_E_TXT,
|
||||
LCLType, LCLIntf, LR_Class;
|
||||
|
||||
type
|
||||
|
||||
{ TStyleDesc }
|
||||
TStyleDesc = record
|
||||
styleID: AnsiString;
|
||||
styleInfo: AnsiString;
|
||||
end;
|
||||
|
||||
{ TfrHTMExport }
|
||||
|
||||
TfrHTMExport = class(TComponent)
|
||||
public
|
||||
Constructor Create(aOwner : TComponent); override;
|
||||
constructor Create(aOwner: TComponent); override;
|
||||
end;
|
||||
|
||||
{ TfrHTMExportFilter }
|
||||
|
||||
TfrHTMExportFilter = class(TfrTextExportFilter)
|
||||
private
|
||||
cssStyles: array of TStyleDesc;
|
||||
FUseCSS: boolean;
|
||||
styleStartLine: integer;
|
||||
outputLines: TStringList;
|
||||
function AddStyle(p: PfrTextRec): Integer;
|
||||
function ColorToHex(c: TColor): AnsiString;
|
||||
function StyleIndex(p: PfrTextRec; AddIfNotFound: boolean = true): Integer;
|
||||
function TextStyleID(p: PfrTextRec): AnsiString;
|
||||
protected
|
||||
procedure AppendLine(const s: UTF8String);
|
||||
procedure InsertLine(const s: UTF8String; position: Integer);
|
||||
public
|
||||
constructor Create(AStream: TStream); override;
|
||||
destructor Destroy; override;
|
||||
procedure OnEndPage; override;
|
||||
procedure OnEndDoc; override;
|
||||
|
||||
property UseCSS: boolean read FUseCSS write FUseCSS;
|
||||
end;
|
||||
|
||||
|
||||
@ -46,34 +70,47 @@ var
|
||||
s: String;
|
||||
begin
|
||||
inherited Create(AStream);
|
||||
outputLines:= TStringList.Create;
|
||||
SetLength(cssStyles, 0);
|
||||
|
||||
s := '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"' + LineEnding +
|
||||
' "http://www.w3.org/TR/html4/loose.dtd">' + LineEnding +
|
||||
'<html><head>' + LineEnding +
|
||||
'<meta name="generator" content="LazReport html exporter">' + LineEnding +
|
||||
'<title>LazReport Exported Report</title>' + LineEnding + // TODO: improve
|
||||
'<meta http-equiv="Content-Type" content="text/html; charset=utf-8">' + LineEnding +
|
||||
'</head><body><table>' + LineEnding;
|
||||
s:= '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">' + LineEnding;
|
||||
AppendLine(s);
|
||||
s:= '<html>' + LineEnding +
|
||||
'<head>' + LineEnding +
|
||||
'<meta name="generator" content="LazReport html exporter">' + LineEnding +
|
||||
'<meta http-equiv="content-type" content="text/html; charset=UTF-8">' + LineEnding +
|
||||
'<title>LazReport Exported Report</title>' + LineEnding; // TODO: improve
|
||||
AppendLine(s);
|
||||
s:= '<!-- CSS section start -->' + LineEnding +
|
||||
'<style type="text/css">' + LineEnding;
|
||||
AppendLine(s);
|
||||
styleStartLine:= outputLines.Count;
|
||||
|
||||
Stream.Write(s[1], Length(s));
|
||||
s:= '</style>' + LineEnding +
|
||||
'<!-- CSS section end -->' + LineEnding +
|
||||
'</head>' + LineEnding + LineEnding;
|
||||
AppendLine(s);
|
||||
s:= '<body bgColor="#FFFFFF">' + LineEnding;
|
||||
AppendLine(s);
|
||||
end;
|
||||
|
||||
destructor TfrHTMExportFilter.Destroy;
|
||||
var
|
||||
s: String;
|
||||
begin
|
||||
s := '</table></body></html>' + LineEnding;
|
||||
Stream.Write(s[1], Length(s));
|
||||
SetLength(cssStyles, 0);
|
||||
outputLines.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
{%REGION 'procedure TfrHTMExportFilter.OnEndPage' }
|
||||
procedure TfrHTMExportFilter.OnEndPage;
|
||||
var
|
||||
i, n: Integer;
|
||||
i, j, n, cw, xp, xp2: integer;
|
||||
p: PfrTextRec;
|
||||
s, s1, s2, s3: String;
|
||||
s, s1, s2, s3, s4, sp, sAlign, sStyle, sEmpCells, sColSpan: AnsiString;
|
||||
xPos: TStringList;
|
||||
|
||||
function GetHTMLFontSize(Size: Integer): String;
|
||||
function GetHTMLFontSize(Size: integer): string;
|
||||
begin
|
||||
case Size of
|
||||
6, 7: Result := '1';
|
||||
@ -86,64 +123,285 @@ var
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetHTMLFontStyle(Style: Integer): String;
|
||||
function GetHTMLFontStyle(Style: integer): string;
|
||||
begin
|
||||
Result := '';
|
||||
if (Style and $1) <> 0 then Result := '<i>';
|
||||
if (Style and $2) <> 0 then Result := Result + '<b>';
|
||||
if (Style and $4) <> 0 then Result := Result + '<u>';
|
||||
if (Style and $1) <> 0 then
|
||||
Result := '<i>';
|
||||
if (Style and $2) <> 0 then
|
||||
Result := Result + '<b>';
|
||||
if (Style and $4) <> 0 then
|
||||
Result := Result + '<u>';
|
||||
end;
|
||||
|
||||
function GetEndHTMLFontStyle(Style: Integer): String;
|
||||
begin
|
||||
Result := '';
|
||||
if (Style and $4) <> 0 then Result := '</u>';
|
||||
if (Style and $2) <> 0 then Result := Result + '</b>';
|
||||
if (Style and $1) <> 0 then Result := Result + '</i>';
|
||||
if (Style and $4) <> 0 then
|
||||
Result := '</u>';
|
||||
if (Style and $2) <> 0 then
|
||||
Result := Result + '</b>';
|
||||
if (Style and $1) <> 0 then
|
||||
Result := Result + '</i>';
|
||||
end;
|
||||
|
||||
function FormatCellText(const sIn: AnsiString): AnsiString;
|
||||
var
|
||||
c, m: Integer;
|
||||
begin
|
||||
Result:= '';
|
||||
c:=1;
|
||||
while (c<=Length(sIn)) and (sIn[c]=' ') do
|
||||
inc(c);
|
||||
dec(c);
|
||||
for m:=1 to c do
|
||||
Result:= Result + ' ';
|
||||
Result:= Result + Copy(sIn, c+1, Length(sIn)-c);
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
n := Lines.Count - 1;
|
||||
while n >= 0 do
|
||||
begin
|
||||
if Lines[n] <> nil then break;
|
||||
if Lines[n] <> nil then
|
||||
break;
|
||||
Dec(n);
|
||||
end;
|
||||
|
||||
xPos:= TStringList.Create;
|
||||
xPos.Sorted:= true;
|
||||
for i := 0 to n do
|
||||
begin
|
||||
p := PfrTextRec(Lines[i]);
|
||||
s := '';
|
||||
while p <> nil do
|
||||
begin
|
||||
s1 := ''; s2 := ''; s3 := '';
|
||||
s:= Format('%.5d', [p^.X]);
|
||||
if xPos.IndexOf(s) < 0 then
|
||||
xPos.Add(s);
|
||||
s:= Format('%.5d', [p^.X + p^.W]);
|
||||
if xPos.IndexOf(s) < 0 then
|
||||
xPos.Add(s);
|
||||
p:= p^.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
s := '<table align="center" width="90%">'+LineEnding;
|
||||
s += '<tr>';
|
||||
for j:=1 to xPos.Count do
|
||||
s += '<td></td>';
|
||||
s += '</tr>'+LineEnding;
|
||||
AppendLine(s);
|
||||
|
||||
for i := 0 to n do
|
||||
begin
|
||||
|
||||
p := PfrTextRec(Lines[i]);
|
||||
s := '<tr>';
|
||||
cw:= 0;
|
||||
while p <> nil do
|
||||
begin
|
||||
|
||||
s1:= '';
|
||||
s2:= '';
|
||||
s3:= '';
|
||||
s4:= '';
|
||||
sEmpCells:= '';
|
||||
sColSpan:= '';
|
||||
sAlign:= '';
|
||||
sStyle:= '';
|
||||
|
||||
if (p^.FontColor = clWhite) or (p^.FontColor = clNone) then
|
||||
p^.FontColor := clBlack;
|
||||
if p^.FontColor <> clBlack then
|
||||
|
||||
if FUseCSS then
|
||||
begin
|
||||
s1 := IntToHex(p^.FontColor, 6);
|
||||
s1 := 'Color="#' + Copy(s1, 5, 2) + Copy(s1, 3, 2) +
|
||||
Copy(s1, 1, 2) + '"';
|
||||
end;
|
||||
// most reports is done with font size = 10..13 - treat it as default font
|
||||
if not (p^.FontSize in [10..13]) then
|
||||
s1 := s1 + ' Size=' + GetHTMLFontSize(p^.FontSize);
|
||||
if p^.FontStyle <> 0 then
|
||||
sStyle:= Format(' class="fs%d"', [StyleIndex(p, true)]);
|
||||
end
|
||||
else
|
||||
begin
|
||||
s2 := GetHTMLFontStyle(p^.FontStyle);
|
||||
s3 := GetEndHTMLFontStyle(p^.FontStyle);
|
||||
if p^.FontColor <> clBlack then
|
||||
s1:= ' Color="' + ColorToHex(p^.FontColor) + '"';
|
||||
// most reports is done with font size = 10..13 - treat it as default font
|
||||
if not (p^.FontSize in [10..13]) then
|
||||
s1 := s1 + ' Size=' + GetHTMLFontSize(p^.FontSize);
|
||||
if p^.FontStyle <> 0 then
|
||||
begin
|
||||
s2 := GetHTMLFontStyle(p^.FontStyle);
|
||||
s3 := GetEndHTMLFontStyle(p^.FontStyle);
|
||||
end;
|
||||
if s1 <> '' then
|
||||
begin
|
||||
s1 := '<Font' + s1 + '>';
|
||||
s4 := '</Font>';
|
||||
end;
|
||||
end;
|
||||
if s1 <> '' then s1 := '<Font ' + s1 + '>';
|
||||
s := s + '<td>' + s1 + s2 + p^.Text + s3;
|
||||
if s1 <> '' then s := s + '</Font>';
|
||||
s := s + '</td>';
|
||||
|
||||
case p^.Alignment of
|
||||
taRightJustify: sAlign:= ' align="right"';
|
||||
taCenter: sAlign:= ' align="center"';
|
||||
end;
|
||||
|
||||
sp:= Format('%.5d', [p^.X]);
|
||||
xp:= xPos.IndexOf(sp);
|
||||
sp:= Format('%.5d', [p^.X + p^.W]);
|
||||
xPos.Find(sp, xp2);
|
||||
if Assigned(p^.Next) then
|
||||
begin
|
||||
sp:= Format('%.5d', [p^.Next^.X]);
|
||||
if xPos.IndexOf(sp)<xp2 then
|
||||
xp2:= xPos.IndexOf(sp);
|
||||
end;
|
||||
if xp>cw then
|
||||
if (xp-cw)>1 then
|
||||
sEmpCells:= Format('<td colspan=%d></td>', [xp - cw])
|
||||
else
|
||||
sEmpCells:= '<td></td>';
|
||||
|
||||
if (xp2-xp)>1 then
|
||||
sColSpan:= Format(' colspan=%d', [xp2 - xp]);
|
||||
cw:= xp2;
|
||||
|
||||
s := Format('%s%s<td%s%s%s>%s%s%s%s%s</td>', [s, sEmpCells, sAlign, sStyle,
|
||||
sColSpan, s1, s2, FormatCellText(p^.Text), s3, s4]);
|
||||
p := p^.Next;
|
||||
end;
|
||||
if s='' then
|
||||
s := '<td></td>';
|
||||
s := '<tr>' + s + '</tr>' + LineEnding;
|
||||
Stream.Write(s[1], Length(s));
|
||||
|
||||
if s = '<tr>' then
|
||||
s += '<td></td>';
|
||||
|
||||
s += '</tr>';
|
||||
AppendLine(s + LineEnding);
|
||||
|
||||
end;
|
||||
|
||||
xPos.Free;
|
||||
|
||||
s := '</table>' + LineEnding;
|
||||
AppendLine(s);
|
||||
end;
|
||||
{%ENDREGION }
|
||||
|
||||
|
||||
function TfrHTMExportFilter.TextStyleID(p: PfrTextRec): AnsiString;
|
||||
var
|
||||
x: Integer;
|
||||
begin
|
||||
Result:= '(none)';
|
||||
if p=nil then
|
||||
exit;
|
||||
Result := p^.FontName;
|
||||
Result += LowerCase(IntToHex(p^.FontSize, 2) + IntToHex(p^.FontStyle, 2) +
|
||||
IntToHex(p^.FontColor, 8) + IntToHex(p^.FillColor, 8) +
|
||||
IntToHex(Integer(p^.Borders), 2));
|
||||
for x:=1 to Length(Result) do
|
||||
if not (Result[x] in ['$', '%', '&', '0'..'9', '@'..'z']) then
|
||||
Result[x]:= '_';
|
||||
end;
|
||||
|
||||
|
||||
function TfrHTMExportFilter.StyleIndex(p: PfrTextRec; AddIfNotFound: boolean): integer;
|
||||
var
|
||||
s: string;
|
||||
x: integer;
|
||||
begin
|
||||
Result:= -1;
|
||||
s:= TextStyleID(p);
|
||||
for x:=0 to High(cssStyles) do
|
||||
if cssStyles[x].styleID = s then
|
||||
begin
|
||||
Result:= x;
|
||||
break;
|
||||
end;
|
||||
if (Result<0) and AddIfNotFound then
|
||||
Result:= AddStyle(p);
|
||||
end;
|
||||
|
||||
|
||||
function TfrHTMExportFilter.AddStyle(p: PfrTextRec): Integer;
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
Result:= Length(cssStyles);
|
||||
SetLength(cssStyles, Result+1);
|
||||
cssStyles[Result].styleID:= TextStyleID(p);
|
||||
s:= '';
|
||||
if Assigned(p) then
|
||||
begin
|
||||
// s += Format(' /* Cell Style "%s" */'#10, [cssStyles[Result].styleID]);
|
||||
s += Format(' td.fs%d {%s', [Result,LineEnding]);
|
||||
s += Format(' font-family: "%s";%s', [p^.FontName,LineEnding]);
|
||||
s += Format(' font-size: %dpt;%s', [p^.FontSize,LineEnding]);
|
||||
if (p^.FontStyle and $1) <> 0 then
|
||||
s += ' font-style: italic;'+LineEnding;
|
||||
if (p^.FontStyle and $2) <> 0 then
|
||||
s += ' font-weight: bold;'+LineEnding;
|
||||
if (p^.FontStyle and $4) <> 0 then
|
||||
s += ' text-decoration: underline;'+LineEnding;
|
||||
if (p^.FontColor <> clNone) and (p^.FontColor <> clDefault) and (p^.FontColor <> clBlack) then
|
||||
s += Format(' color: %s;%s', [ColorToHex(p^.FontColor),LineEnding]);
|
||||
if (p^.FillColor <> clNone) and (p^.FillColor <> clDefault) and (p^.FillColor <> clWhite) then
|
||||
s += Format(' background-color: %s;%s', [ColorToHex(p^.FillColor),LineEnding]);
|
||||
if (p^.Borders <> []) then
|
||||
begin
|
||||
case p^.BorderStyle of
|
||||
frsSolid: s += ' border-style: solid;'+LineEnding;
|
||||
frsDash: s += ' border-style: dashed;'+LineEnding;
|
||||
frsDot,
|
||||
frsDashDot,
|
||||
frsDashDotDot: s += ' border-style: dotted;'+LineEnding;
|
||||
frsDouble: s += ' border-style: double;'+LineEnding;
|
||||
end;
|
||||
if not (frbLeft in p^.Borders) then
|
||||
s += ' border-left-style: none;'+LineEnding;
|
||||
if not (frbTop in p^.Borders) then
|
||||
s += ' border-top-style: none;'+LineEnding;
|
||||
if not (frbRight in p^.Borders) then
|
||||
s += ' border-right-style: none;'+LineEnding;
|
||||
if not (frbBottom in p^.Borders) then
|
||||
s += ' border-bottom-style: none;'+LineEnding;
|
||||
s += Format(' border-width: %dpx;%s', [p^.BorderWidth,LineEnding]);
|
||||
s += Format(' border-color: %s;%s', [ColorToHex(p^.BorderColor),LineEnding]);
|
||||
end;
|
||||
s += ' } '+LineEnding+LineEnding;
|
||||
end;
|
||||
cssStyles[Result].styleInfo:= s;
|
||||
end;
|
||||
|
||||
|
||||
function TfrHTMExportFilter.ColorToHex(c: TColor): AnsiString;
|
||||
var
|
||||
s: AnsiString;
|
||||
begin
|
||||
s:= IntToHex(ColorToRGB(c), 8);
|
||||
Result:= '#' + Copy(s, 7, 2) + Copy(s, 5, 2) + Copy(s, 3, 2);
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrHTMExportFilter.AppendLine(const s: UTF8String);
|
||||
begin
|
||||
outputLines.Add(s);
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrHTMExportFilter.InsertLine(const s: UTF8String; position: Integer);
|
||||
begin
|
||||
outputLines.Insert(position, s);
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrHTMExportFilter.OnEndDoc;
|
||||
var
|
||||
s: string;
|
||||
x: Integer;
|
||||
begin
|
||||
s := '</body>'+LineEnding+'</html>'+LineEnding;
|
||||
AppendLine(s);
|
||||
for x:=0 to High(cssStyles) do
|
||||
InsertLine(cssStyles[x].StyleInfo, styleStartLine + x);
|
||||
for x:= 0 to Pred(outputLines.Count) do
|
||||
if Length(outputLines[x])>0 then
|
||||
Stream.Write(outputLines[x][1], Length(outputLines[x]));
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -15,9 +15,8 @@ interface
|
||||
{$I lr_vers.inc}
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources,
|
||||
Graphics,GraphType, Controls, Forms, Dialogs,
|
||||
LCLType,LCLIntf,LR_Class;
|
||||
Classes, SysUtils, LResources, Graphics, GraphType, Controls, Forms, Dialogs,
|
||||
LCLType, LCLIntf, LR_Class;
|
||||
|
||||
type
|
||||
|
||||
@ -25,7 +24,7 @@ type
|
||||
|
||||
TfrTextExport = class(TComponent)
|
||||
public
|
||||
Constructor Create(aOwner : TComponent); override;
|
||||
constructor Create(aOwner: TComponent); override;
|
||||
end;
|
||||
|
||||
{ TfrTextExportFilter }
|
||||
@ -106,21 +105,22 @@ begin
|
||||
n := Lines.Count - 1;
|
||||
while n >= 0 do
|
||||
begin
|
||||
if Lines[n] <> nil then break;
|
||||
if Lines[n] <> nil then
|
||||
break;
|
||||
Dec(n);
|
||||
end;
|
||||
|
||||
for i := 0 to n do
|
||||
begin
|
||||
s := '';
|
||||
tc1 := 0;
|
||||
p := PfrTextRec(Lines[i]);
|
||||
s := '';
|
||||
tc1:= 0;
|
||||
p := PfrTextRec(Lines[i]);
|
||||
while p <> nil do
|
||||
begin
|
||||
x := Round(p^.X / 6.5);
|
||||
s := s + Dup(x - tc1) + p^.Text;
|
||||
tc1 := x + Length(p^.Text);
|
||||
p := p^.Next;
|
||||
x := Round(p^.X / 6.5);
|
||||
s := s + Dup(x - tc1) + p^.Text;
|
||||
tc1:= x + Length(p^.Text);
|
||||
p := p^.Next;
|
||||
end;
|
||||
s := s + LineEnding;
|
||||
Stream.Write(s[1], Length(s));
|
||||
@ -131,10 +131,11 @@ end;
|
||||
|
||||
procedure TfrTextExportFilter.OnBeginPage;
|
||||
var
|
||||
i: Integer;
|
||||
i: integer;
|
||||
begin
|
||||
ClearLines;
|
||||
for i := 0 to 200 do Lines.Add(nil);
|
||||
for i := 0 to 200 do
|
||||
Lines.Add(nil);
|
||||
end;
|
||||
|
||||
procedure TfrTextExportFilter.OnText(X, Y: Integer; const Text: String;
|
||||
@ -142,30 +143,38 @@ procedure TfrTextExportFilter.OnText(X, Y: Integer; const Text: String;
|
||||
var
|
||||
p, p1, p2: PfrTextRec;
|
||||
begin
|
||||
if View = nil then Exit;
|
||||
if View = nil then
|
||||
Exit;
|
||||
Y := Round(Y / UsedFont);
|
||||
p1 := PfrTextRec(Lines[Y]);
|
||||
p1:= PfrTextRec(Lines[Y]);
|
||||
GetMem(p, SizeOf(TfrTextRec));
|
||||
FillChar(p^, SizeOf(TfrTextRec), 0);
|
||||
p^.Next := nil;
|
||||
p^.X := X;
|
||||
p^.X := Round(View.X / UsedFont);
|
||||
p^.W := Round(View.Width / UsedFont);
|
||||
p^.Text := Text;
|
||||
p^.FillColor := View.FillColor;
|
||||
p^.Borders := View.Frames;
|
||||
p^.BorderColor:= View.FrameColor;
|
||||
p^.BorderStyle:= View.FrameStyle;
|
||||
p^.BorderWidth:= Round(View.FrameWidth);
|
||||
if View is TfrMemoView then
|
||||
with View as TfrMemoView do
|
||||
begin
|
||||
p^.FontName := Font.Name;
|
||||
p^.FontSize := Font.Size;
|
||||
p^.FontStyle := frGetFontStyle(Font.Style);
|
||||
p^.FontColor := Font.Color;
|
||||
p^.FontName := Font.Name;
|
||||
p^.FontSize := Font.Size;
|
||||
p^.FontStyle := frGetFontStyle(Font.Style);
|
||||
p^.FontColor := Font.Color;
|
||||
p^.FontCharset := Font.Charset;
|
||||
p^.Alignment := Alignment;
|
||||
end;
|
||||
p^.FillColor := View.FillColor;
|
||||
|
||||
if p1 = nil then
|
||||
Lines[Y] := TObject(p)
|
||||
else
|
||||
begin
|
||||
p2 := p1;
|
||||
while (p1 <> nil) and (p1^.X < p^.X) do
|
||||
while (p1 <> nil) and (p1^.X <= p^.X) do
|
||||
begin
|
||||
p2 := p1;
|
||||
p1 := p1^.Next;
|
||||
@ -173,12 +182,12 @@ begin
|
||||
if p2 <> p1 then
|
||||
begin
|
||||
p2^.Next := p;
|
||||
p^.Next := p1;
|
||||
p^.Next := p1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Lines[Y] := TObject(p);
|
||||
p^.Next := p1;
|
||||
p^.Next := p1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user