Repository URL to install this package:
|
Version:
3.2.0 ▾
|
unit fpreporthtmlutil;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpimage, fpreport, dom, dom_html;
Type
TStyleEmbedding = (seInline,seStyleTag,seCSSFile);
TTOCPosition = (tpLeft,tpRight,tpTop,tpBottom);
TNavigatorPosition = (npLeft,npRight,npTop,npBottom);
TNavigatorPositions = set of TNavigatorPosition;
THTMLNavigatorOption = (hnoFirstLast,hnoAlwaysFirstLast,hnoPageNo,hnoImage,hnoSkipStyling,hnoUsePageNOfM,hnoPageNoEdit);
THTMLNavigatorOptions = set of THTMLNavigatorOption;
TNavigatorButton = (nbFirst,nbPrevious,nbPage,nbNext,nbLast);
TNavigatorButtons = set of TNavigatorButton;
{ TGenerateHTMLContext }
TGenerateHTMLContext = Class(TObject)
private
FDPI: Integer;
FIDCount : Integer;
FBaseFileName: String;
FCSSDir: String;
FCurrentPageNo: Integer;
FReport: TFPCustomReport;
FDoc: THTMLDocument;
FSequenceDigits: Integer;
FSequenceFormat: String;
FStyleContent: TStrings;
FTotalPageCount: Integer;
FRunOffsetX : Integer;
FRunOffsetY : Integer;
Public
Constructor Create(AReport : TFPCustomReport; ADoc : THTMLDocument; ADPI : Integer);
Procedure Resetpage(ADoc : THTMLDocument);
function AllocateID(aElement: THTMLElement; AReportElement: TFPReportElement): String;
function CreateDiv(aParent: TDOMElement; AID: String): THTMLElement;
function CreateDiv(aParent: TDOMElement; AReportElement: TFPReportElement): THTMLElement;
procedure ApplyStyle(aElement: THTMLElement; const aStyle: TStrings);
procedure ApplyStyle(aElement: THTMLElement; const aStyle: String);
Procedure InitOffsets(aX,aY : Integer);
function mmToPixels(const AValue: TFPReportUnits): Integer;
class function ColorToRGBString(AColor: TFPReportColor; UseHex: Boolean=True): String;
function AllocatePageName(APageNo: Integer): string;
Property Report : TFPCustomReport Read FReport;
Property BaseFileName : String Read FBaseFileName Write FBaseFileName;
Property CSSDir : String Read FCSSDir Write FCSSDir;
Property CurrentPageNo : Integer Read FCurrentPageNo Write FCurrentPageNo;
Property TotalPageCount : Integer Read FTotalPageCount Write FTotalPageCount;
Property SequenceFormat : String Read FSequenceFormat Write FSequenceFormat;
Property SequenceDigits : Integer Read FSequenceDigits Write FSequenceDigits;
Property StyleContent : TStrings Read FStyleContent Write FStyleContent;
Property Doc : THTMlDocument Read FDoc;
Property DPI : Integer Read FDPI;
Property RunOffsetX : Integer Read FRunOffsetX;
Property RunOffsetY : Integer Read FRunOffsetY;
end;
{ TTOCPageOptions }
TTOCPageOptions = Class(TPersistent)
private
FCSSFileName: string;
FEvenPageStyle: string;
FFileName: string;
FOddPageStyle: string;
FSkipStyling: Boolean;
Public
Procedure Assign(Source : TPersistent) ; override;
Published
// TOC page filename.
// If empty, 'index.html' is used, unless used for frame page , then 'toc.html' is used.
// TOC CSS page filename.
Property FileName : string read FFileName write FFileName;
// Frame page CSS filename. If empty, no <link> is added. Relative to CSSDir
property CSSFileName: string read FCSSFileName write FCSSFileName;
// Odd page style elements.
property OddPageStyle : string read FOddPageStyle write FOddPageStyle;
// Even page style elements.
property EvenPageStyle : string read FEvenPageStyle write FEvenPageStyle;
// Skip styling alltogether
Property SkipStyling : Boolean Read FSkipStyling Write FSkipStyling;
end;
TFramePageOptions = Class(TPersistent)
private
FCSSFileName: string;
FFileName: string;
FTOCZonePosition: TTOCPosition;
FTOCZoneSize: Integer;
Public
Procedure Assign(Source : TPersistent) ; override;
Published
// Frame page filename. If not set, it will be 'index.html'
Property FileName : string read FFileName write FFileName;
// Frame page CSS filename. If empty, no <link> is added. Relative to CSSDir
property CSSFileName: string read FCSSFileName write FCSSFileName;
// Size, in percentage, of the TOC zone
Property TOCZoneSize : Integer Read FTOCZoneSize Write FTOCZoneSize;
// Position of TOC zone
Property TOCZonePosition : TTOCPosition Read FTOCZonePosition Write FTOCZonePosition;
end;
{ TPageNavigatorOptions }
TPageNavigatorOptions = class(TPersistent)
private
FActiveBGColor: TFPReportColor;
FFixedHeight: Integer;
FFixedMargin: Integer;
FFixedWidth: Integer;
FInActiveBGColor: TFPReportColor;
FOptions: THTMLNavigatorOptions;
FPositions: TNavigatorPositions;
Public
Procedure Assign(Source : TPersistent) ; override;
Published
Property Positions : TNavigatorPositions Read FPositions Write FPositions;
Property Options : THTMLNavigatorOptions Read FOptions Write FOptions;
Property FixedWidth : Integer Read FFixedWidth Write FFixedWidth;
Property FixedHeight : Integer Read FFixedHeight Write FFixedHeight;
Property FixedMargin : Integer Read FFixedMargin Write FFixedMargin;
Property ActiveBGColor : TFPReportColor Read FActiveBGColor Write FActiveBGColor;
Property InActiveBGColor : TFPReportColor Read FInActiveBGColor Write FInActiveBGColor;
end;
{ TTOCPageCreator }
TTOCPageCreator = class
private
FContext: TGenerateHTMLContext;
FTOCPage: TTocPageOptions;
FDoc : THTMLDocument;
function GetReport: TFPCustomReport;
Protected
function CreatePageLink(APageName: String; APageNo: Integer; ADoc: THTMLDocument; ForFrame: Boolean): THTMLElement; virtual;
Public
Constructor Create(AContext : TGenerateHTMLContext; AOptions : TTocPageOptions); virtual;
Destructor Destroy; override;
function CreateTOCPage(APageNames: TStrings; ForFrame: Boolean): String; virtual;
Property Context : TGenerateHTMLContext read FContext;
Property TOCPage : TTocPageOptions Read FTOCPage;
Property Report : TFPCustomReport Read GetReport;
Property Doc : THTMLDocument Read FDoc;
end;
{ TTOCFramePageCreator }
TTOCFramePageCreator = class
private
FFramePage: TFramePageOptions;
FContext : TGenerateHTMLContext;
FDoc : THTMLDocument;
function GetCSSDIR: String;
function GetReport: TFPCustomReport;
Public
Constructor Create(AContext : TGenerateHTMLContext; AOptions : TFramePageOptions); virtual;
Destructor Destroy; override;
procedure CreateFramePage(PageNames: TStrings; const ATOCPageFileName: String); virtual;
procedure ConfigureFrameSet(FramesEl: THTMLElement); virtual;
Property Context : TGenerateHTMLContext read FContext;
Property FramePage : TFramePageOptions Read FFramePage;
Property Report : TFPCustomReport Read GetReport;
Property CSSDIR : String Read GetCSSDIR;
end;
{ TPageNavigatorElementCreator }
TPageNavigatorElementCreator = Class
Private
FContext : TGenerateHTMLContext;
FCurrentPage: TFPReportPage;
FPageNavigator : TPageNavigatorOptions;
function GetDoc: THTMLDocument;
Protected
function StyleNavigatorButton(aPosition: TNavigatorPosition; AButton: TNavigatorButton; ActiveLink: Boolean): String; virtual;
procedure CreatePageNoNavigatorElement(AParentDiV: THTMLElement; aPosition: TNavigatorPosition); virtual;
procedure ApplyStyle(aElement: THTMLElement; const aStyle: TStrings); inline;
procedure ApplyStyle(aElement: THTMLElement; const aStyle: String); inline;
Public
Constructor Create(AContext : TGenerateHTMLContext; APage : TFPReportPage; AOptions : TPageNavigatorOptions); virtual;
Procedure CreatePageNavigator(aPosition : TNavigatorPosition; AParentDiV : THTMLElement); virtual;
procedure StyleNavigator(ND: THTMLElement; aPosition: TNavigatorPosition); virtual;
class procedure WriteDefaultScript(AContext: TGenerateHTMLContext; AScript: TStrings);
Property Context : TGenerateHTMLContext read FContext;
Property Doc : THTMLDocument Read GetDoc;
Property PageNavigator : TPageNavigatorOptions Read FPageNavigator;
Property CurrentPage : TFPReportPage Read FCurrentPage;
end;
Function Coalesce(S1,S2 : String) : String;
Function GetColorComponent(Var AColor: UInt32; Full : Boolean = true): Word; inline;
Function ColorToRGBTriple(const AColor: UInt32; Full : Boolean = true): TFPColor;
Function RGBTripleToColor(AColor : TFPColor) : UINT32;
Const
cInchToMM = 25.4;
PosStrings : Array[Boolean] of string = ('absolute','fixed');
NavigatorPositionNames : Array[TNavigatorPosition] of string =
('Left','Right','Top','Bottom');
resourcestring
SFirstPage = 'First';
SPreviousPage = 'Previous';
SLastPage = 'Last';
SNextPage = 'Next';
SCurrentPage = 'Page %d';
SCurrentPageOf = 'Page %d of %d';
STotalPages = 'total: %d';
SNoFrameSupport = 'Your browser must support frames to view this';
implementation
uses htmwrite;
{ Auxiliary functions }
function GetColorComponent(Var AColor: UInt32; Full : Boolean): Word; inline;
begin
Result:=(AColor and $FF);
if Full then
Result:=Result or (Result shl 8);
AColor:=(AColor shr 8);
end;
function ColorToRGBTriple(const AColor: UInt32; Full : Boolean = True): TFPColor;
Var
C : UInt32;
begin
C:=AColor;
with Result do
begin
Blue := GetColorComponent(C,Full);
Green := GetColorComponent(C,Full);
Red := GetColorComponent(C,Full);
Alpha := GetColorComponent(C,Full);
end
end;
Function RGBTripleToColor(AColor : TFPColor) : UINT32;
Function BS(C : Word; Sh : Byte) : UINT32;
begin
Result:=C shr 8;
If (Sh<>0) then
Result:=Result shl SH
end;
begin
Result:=BS(AColor.blue,0) or BS(AColor.Green,8) or BS(AColor.Red,16) or BS(AColor.alpha,24);
end;
Function Coalesce(S1,S2 : String) : String;
begin
if S1<>'' then
Result:=S1
else
Result:=S2;
end;
{ TTOCPageCreator }
function TTOCPageCreator.GetReport: TFPCustomReport;
begin
Result:=FContext.Report;
end;
constructor TTOCPageCreator.Create(AContext: TGenerateHTMLContext; AOptions: TTocPageOptions);
begin
FContext:=AContext;
FTOCPage:=AOptions;
FDoc := THTMLDocument.Create;
FDoc.AppendChild(FDoc.Impl.CreateDocumentType(
'HTML', '-//W3C//DTD HTML 4.01 Frameset//EN"',
'http://www.w3.org/TR/html4/loose.dtd'));
end;
destructor TTOCPageCreator.Destroy;
begin
FreeAndNil(FDoc);
inherited Destroy;
end;
function TTOCPageCreator.CreatePageLink(APageName : String;APageNo : Integer; ADoc : THTMLDocument; ForFrame : Boolean) : THTMLElement;
Const
DefaultOddPageStyle = 'width: 72px; height:100px; background-color: rgb(255,241,215); border: solid; margin: 5px;';
DefaultEvenPageStyle = 'width: 72px; height:100px; background-color: rgb(155,155,155); border: solid; margin: 5px;';
Var
L : THTMLLinkElement;
S,D : String;
begin
Result:=ADoc.CreateElement('div');
Result.ID:=format('page-%d',[APageNo]);
if ((APageNo mod 2)=1) then
begin
S:=TOCPage.OddPageStyle;
D:=DefaultOddPageStyle;
end
else
begin
S:=TOCPage.EvenPageStyle;
D:=DefaultEvenPageStyle;
end;
if Not TOCPage.SkipStyling then
begin
S:=Coalesce(S,D);
if (S<>'') then
Result['style']:=S;
end;
L:=ADoc.CreateLinkElement;
L.AppendChild(ADoc.CreateTextNode(Format('Page %d',[APAgeNo])));
L.HRef:=ExtractFileName(APageName);
if ForFrame then
L.Target:='reportpage';
Result.AppendChild(l);
end;
function TTOCPageCreator.CreateTOCPage(APageNames: TStrings; ForFrame: Boolean): String;
Var
AHeadElement,ABodyElement,AHTMLEl,El,PEL : THTMLElement;
D,FN : String;
I : Integer;
begin
AHTMLEl := FDoc.CreateHtmlElement;
FDoc.AppendChild(AHTMLEl);
AHeadElement:=FDoc.CreateHeadElement;
AHTMLEl.AppendChild(AHeadElement);
El := Doc.CreateElement('meta');
El['http-equiv'] := 'Content-Type';
El['content'] := 'text/html; charset=utf-8';
AHeadElement.AppendChild(El);
El := Doc.CreateElement('title');
AHeadElement.AppendChild(el);
el.AppendChild(Doc.CreateTextNode(Report.Title));
if (TOCPage.CSSFileName<>'') then
begin
El:=Doc.CreateElement('link');
El['rel']:='stylesheet';
D:=Context.CSSDir;
if (D<>'') then
D:=D+'/'; // not pathdelim !
El['href']:=D+TOCPage.CSSFileName;
AHeadElement.AppendChild(El);
end;
ABodyElement := Doc.CreateElement('body');
AHTMLEl.AppendChild(ABodyElement);
PEL:=Doc.CreateElement('div');
PEl.ID:='toctable';
ABodyElement.AppendChild(pel);
For I:=0 to APageNames.Count-1 do
begin
el:=CreatePageLink(APageNames[i],I+1,Doc,ForFrame);
if I=0 then
el.ClassName:=EL.ClassName+' '+'firstpage'
else if I= (APageNames.Count-1) then
EL.ClassName:=EL.ClassName+' '+'lastpage';
PEL.AppendChild(el);
end;
FN:=TOCPage.FileName;
if (FN='') then
if ForFrame then
FN:='toc.html'
else
FN:='index.html';
D:=ExtractFilePath(Context.BaseFileName);
FN:=D+FN;
WriteHTML(Doc,FN);
Result:=FN;
end;
{ TGenerateHTMLContext }
function TGenerateHTMLContext.mmToPixels(const AValue: TFPReportUnits): Integer;
begin
Result := Round(AValue * (DPI / cInchToMM));
end;
function TGenerateHTMLContext.AllocateID(aElement: THTMLElement; AReportElement: TFPReportElement): String;
Var
N : String;
begin
if (AElement.ID<>'') then
exit(AElement.ID);
if AReportElement<>Nil then
N:=AReportElement.ClassName
else if AElement.TagName='div' then
N:='div'
else
N:='el';
Result:=N+'-'+IntToStr(FIDCount);
AElement.ID:=Result
end;
function TGenerateHTMLContext.CreateDiv(aParent: TDOMElement; AReportElement: TFPReportElement): THTMLElement;
begin
inc(FIDCount);
Result:=FDoc.CreateElement('div');
AllocateID(Result,AReportElement);
if (AParent<>Nil) then
AParent.AppendChild(Result);
end;
function TGenerateHTMLContext.CreateDiv(aParent: TDOMElement; AID: String): THTMLElement;
begin
Result:=FDoc.CreateElement('div');
Result.ID:=AID;
if (AParent<>Nil) then
AParent.AppendChild(Result);
end;
constructor TGenerateHTMLContext.Create(AReport: TFPCustomReport; ADoc: THTMLDocument; ADPI: Integer);
begin
FReport:=AReport;
FDoc:=ADoc;
FIDCount:=0;
FDPI:=ADPI;
end;
procedure TGenerateHTMLContext.Resetpage(ADoc: THTMLDocument);
begin
FDoc:=ADoc;
FIDCount:=0;
end;
function TGenerateHTMLContext.AllocatePageName(APageNo: Integer): string;
Var
E,SN : String;
begin
SN:=Format(SequenceFormat,[APageNo]);
E:=ExtractFileExt(BaseFileName);
Result:=ChangeFileExt(BaseFileName,SN+E);
end;
procedure TGenerateHTMLContext.ApplyStyle(aElement: THTMLElement; const aStyle: TStrings);
Var
aID : String;
begin
if Not Assigned(FStyleContent) then
begin
{$if FPC_FULLVERSION<30000}
aStyle.Delimiter:=' ';
{$else}
aStyle.LineBreak:=' ';
{$ENDIF}
AElement['style']:=aStyle.text
end
else
begin
AID:=AllocateID(AElement,nil);
FStyleContent.Add('#'+aID+' {');
FStyleContent.AddStrings(aStyle);
FStyleContent.Add('}');
end
end;
procedure TGenerateHTMLContext.ApplyStyle(aElement: THTMLElement;
const aStyle: String);
Var
aID : String;
begin
if Not Assigned(FStyleContent) then
AElement['style']:=aStyle
else
begin
AID:=AllocateID(AElement,Nil);
FStyleContent.Add('#'+aID+' {');
FStyleContent.Add(aStyle);
FStyleContent.Add('}');
end
end;
procedure TGenerateHTMLContext.InitOffsets(aX, aY: Integer);
begin
FRunOffsetX:=aX;
FRunOffsetY:=aY;
end;
class function TGenerateHTMLContext.ColorToRGBString(AColor: TFPReportColor;
UseHex: Boolean): String;
Var
S : TFPColor;
begin
S:=ColorToRGBTriple(aColor,False);
if AColor=clNone then
exit;
if UseHex then
Result:=Format('#%.2x,%.2x,%2.x);',[S.red,S.green,S.Blue])
else
Result:=Format('rgb(%d,%d,%d);',[S.red,S.green,S.Blue]);
end;
{ TPageNavigatorElementCreator }
function TPageNavigatorElementCreator.GetDoc: THTMLDocument;
begin
Result:=Context.Doc;
end;
procedure TPageNavigatorElementCreator.ApplyStyle(aElement: THTMLElement; const aStyle: TStrings);
begin
FContext.ApplyStyle(aElement,AStyle);
end;
procedure TPageNavigatorElementCreator.ApplyStyle(aElement: THTMLElement; const aStyle: String);
begin
FContext.ApplyStyle(aElement,AStyle);
end;
constructor TPageNavigatorElementCreator.Create(AContext: TGenerateHTMLContext; APage : TFPReportPage; AOptions: TPageNavigatorOptions);
begin
FContext:=AContext;
FPageNavigator:=AOptions;
FCurrentPage:=APage;
end;
procedure TPageNavigatorElementCreator.CreatePageNavigator(aPosition: TNavigatorPosition; AParentDiV: THTMLElement);
Var
ND,N : THTMLElement;
BN : String;
ActiveLink : Boolean;
Function PageLinkNode(Target : Integer; AText : String; Out IsActive: Boolean) : THTMLElement;
var
L : THTMLLinkElement;
begin
if (Target<1) or (Target=Context.CurrentPageNo) or (Target>Context.TotalPageCount) then
begin
Result:=Doc.CreateSpanElement;
Result.ID:=ND.ID+'-deadlink';
IsActive:=False;
end
else
begin
L:=Doc.CreateLinkElement;
L.HRef:=ExtractFileName(Context.AllocatePageName(Target));
L.ID:=ND.ID+'-link';
IsActive:=True;
Result:=L;
end;
Result.AppendChild(Doc.CreateTextNode(AText));
end;
begin
BN:='navigator-'+NavigatorPositionNames[aPosition];
ND:=Context.CreateDiv(aParentDIV,BN);
ND.ClassName:='navigator '+NavigatorPositionNames[aPosition]+'navigation';
if (Context.CurrentPageNo>1) or (hnoAlwaysFirstLast in PageNavigator.Options) then
begin
if (hnoFirstLast in PageNavigator.Options) then
begin
N:=Context.CreateDiv(nd,bn+'first');
N.AppendChild(PageLinkNode(1,SFirstPage,ActiveLink));
ApplyStyle(N,StyleNavigatorButton(aPosition,nbFirst,ActiveLink));
end;
N:=Context.CreateDiv(nd,bn+'prev');
N.AppendChild(PageLinkNode(Context.CurrentPageNo-1,SPreviousPage,ActiveLink));
ApplyStyle(N,StyleNavigatorButton(aPosition,nbPrevious,ActiveLink));
end;
if hnoPageNo in PageNavigator.Options then
begin
N:=Context.CreateDiv(ND,bn+'pageno');
CreatePageNoNavigatorElement(N,aPosition);
ApplyStyle(N,StyleNavigatorButton(aPosition,nbPage,True));
end;
if (Context.CurrentPageNo<Context.TotalPageCount) or (hnoAlwaysFirstLast in PageNavigator.Options) then
begin
N:=Context.CreateDiv(nd,bn+'next');
N.AppendChild(PageLinkNode(Context.CurrentPageNo+1,SNextPage,ActiveLink));
ApplyStyle(N,StyleNavigatorButton(aPosition,nbNext,ActiveLink));
if (hnoFirstLast in PageNavigator.Options) then
begin
N:=Context.CreateDiv(nd,bn+'last');
N.AppendChild(PageLinkNode(Context.TotalPageCount,SLastPage,ActiveLink));
ApplyStyle(N,StyleNavigatorButton(aPosition,nbLast,ActiveLink));
end
end;
If not (hnoSkipStyling in PageNavigator.Options) then
StyleNavigator(ND,aPosition);
end;
procedure TPageNavigatorElementCreator.StyleNavigator(ND : THTMLElement; aPosition : TNavigatorPosition);
Var
S : String;
begin
begin
if (aPosition in [npTop,npBottom]) then
begin
S:='position: absolute; display: flex; width: 100%; align-items: center; justify-content: center; ';
S:=S+Format('height: %dpx;',[PageNavigator.FixedHeight]);
if (aPosition = npBottom) then
S:=S+Format('top: %dpx;',[Context.RunOffsetY+Context.mmToPixels(CurrentPage.PageSize.Height)]);
ApplyStyle(ND,S);
end;
if (aPosition in [npLeft,npRight]) then
begin
S:='position: absolute; top: 25%; align-content: center; ';
S:=S+Format('width: %dpx;',[PageNavigator.FixedWidth]);
if (aPosition = npRight) then
S:=S+Format('left: %dpx;',[Context.RunOffsetX+Context.mmToPixels(CurrentPage.PageSize.Width)+PageNavigator.FixedMargin]);
ApplyStyle(ND,S);
end;
end;
end;
class procedure TPageNavigatorElementCreator.WriteDefaultScript(AContext : TGenerateHTMLContext; AScript: TStrings);
Const
SScript = 'function maybesetpage(ev) {'+sLineBreak+
' if (ev.keyCode==13) {' +sLineBreak+
' var pageno= ""+ev.target.value;'+sLineBreak+
' while (pageno.length<SequenceDigits) { pageno = "0"+ pageno; }; '+sLineBreak+
' if ((pageno>0) && (pageno<=TotalPageCount)) {'+sLineBreak+
' var url = PageNameFormat.replace(/%d/,pageno);'+sLineBreak+
' window.location.href=url;'+sLineBreak+
' }'+sLineBreak+
' }'+sLineBreak+
'}';
Var
S : TStrings;
FN : String;
P : Integer;
begin
FN:=ChangeFileExt(extractFileName(AContext.BaseFileName),AContext.SequenceFormat+ExtractFileExt(AContext.BaseFileName));
P:=pos('%',FN);
if FN[P+1]='.' then
Delete(FN,P+1,2);
AScript.Add(Format('var PageNameFormat = "%s";',[FN]));
AScript.Add(Format('var TotalPageCount = %d;',[AContext.TotalPageCount]));
AScript.Add(Format('var CurrentPage = %d;',[AContext.CurrentPageNo]));
AScript.Add(Format('var SequenceDigits = %d;',[AContext.SequenceDigits]));
S:=TStringList.Create;
try
S.Text:=SScript;
AScript.AddStrings(S);
finally
S.Free;
end;
end;
function TPageNavigatorElementCreator.StyleNavigatorButton(aPosition: TNavigatorPosition; AButton: TNavigatorButton; ActiveLink: Boolean): String;
Var
C : String;
begin
if (hnoSkipStyling in PageNavigator.Options) then
exit;
if aPosition in [npTop,npBottom] then
begin
Result:='margin: 0 4px 0 4px;';
Result:=Result+' float: left;';
end
else
Result:='margin: 4px 0 4px 0;';
if aButton<>nbPage then
begin
if ActiveLink then
C:=Coalesce(Context.ColorToRGBString(PageNavigator.ActiveBGColor,True),'#63CF80')
else
C:=Coalesce(Context.ColorToRGBString(PageNavigator.InActiveBGColor,True),'#BABABA');
end;
Result:=Result+' background-color: '+C+';';
Result:=Result+' border: solid;';
Result:=Result+' border-width: 1px;';
end;
procedure TPageNavigatorElementCreator.CreatePageNoNavigatorElement(AParentDiV: THTMLElement; aPosition: TNavigatorPosition);
Var
N2 : THTMLElement;
IE : THTMLElement;
Fmt: String;
begin
if (hnoPageNoEdit in PageNavigator.Options) then
begin
IE:=Doc.CreateElement('input');
IE['type']:='number';
IE['id']:='pageedit'+NavigatorPositionNames[aPosition];
IE['onkeypress']:='maybesetpage(event)';
IE['value']:=IntToStr(Context.CurrentPageNo);
if not (hnoSkipStyling in PageNavigator.Options) then
ApplyStyle(IE,'width: 50px;');
AParentDiV.AppendChild(IE);
if hnoUsePageNOfM in PageNavigator.Options then
begin
N2:=Doc.CreateSpanElement;
N2.AppendChild(Doc.CreateTextNode(Format(STotalPages,[Context.TotalPageCount])));
AParentDiV.AppendChild(N2);
end;
end
else
begin
N2:=Doc.CreateSpanElement;
AParentDiv.AppendChild(N2);
if hnoUsePageNOfM in PageNavigator.Options then
Fmt:=SCurrentPageOf
else
Fmt:=SCurrentPage;
N2.AppendChild(Doc.CreateTextNode(Format(Fmt,[Context.CurrentPageNo,Context.TotalPageCount])));
end;
end;
{ TTOCFramePageCreator }
function TTOCFramePageCreator.GetReport: TFPCustomReport;
begin
Result:=Context.Report;
end;
function TTOCFramePageCreator.GetCSSDIR: String;
begin
Result:=FContext.CSSDir;
end;
constructor TTOCFramePageCreator.Create(AContext: TGenerateHTMLContext; AOptions: TFramePageOptions);
begin
FContext:=AContext;
FFramePage:=AOptions;
FDoc := THTMLDocument.Create;
FDoc.AppendChild(FDoc.Impl.CreateDocumentType(
'HTML', '-//W3C//DTD HTML 4.01 Frameset//EN"',
'http://www.w3.org/TR/html4/loose.dtd'));
end;
destructor TTOCFramePageCreator.Destroy;
begin
FreeAndNil(FDoc);
inherited Destroy;
end;
procedure TTOCFramePageCreator.ConfigureFrameSet(FramesEl : THTMLElement);
Const
ColRows : Array[Boolean] of string = ('rows','cols');
Var
IsCols, DirInvert : Boolean;
P : String;
begin
DirInvert:=(FramePage.TOCZonePosition in [tpRight,tpBottom]);
IsCols:=FramePage.TOCZonePosition in [tpLeft,tpRight];
if Not DirInvert then
P:=Format('%d%%,%d%%',[FramePage.TOCZoneSize,100-FramePage.TOCZoneSize])
else
P:=Format('%d%%,%d%%',[100-FramePage.TOCZoneSize,FramePage.TOCZoneSize]);
FramesEl[ColRows[isCols]]:=P;
end;
procedure TTOCFramePageCreator.CreateFramePage(PageNames: TStrings; const ATOCPageFileName: String);
Var
aTocPage,aReportPage,FrameSet,AHeadElement,AHTMLEl,El : THTMLElement;
FN,D,P : String;
DirInvert : Boolean;
begin
AHTMLEl := FDoc.CreateHtmlElement;
FDoc.AppendChild(AHTMLEl);
AHeadElement:=FDoc.CreateHeadElement;
AHTMLEl.AppendChild(AHeadElement);
El := FDoc.CreateElement('meta');
El['http-equiv'] := 'Content-Type';
El['content'] := 'text/html; charset=utf-8';
AHeadElement.AppendChild(El);
El := FDoc.CreateElement('title');
AHeadElement.AppendChild(el);
el.AppendChild(FDoc.CreateTextNode(Report.Title));
if (FFramePage.CSSFileName<>'') then
begin
El:=FDoc.CreateElement('link');
El['rel']:='stylesheet';
D:=CSSDir;
if (D<>'') then
D:=D+'/'; // not pathdelim !
El['href']:=D+FramePage.CSSFIleName;
AHeadElement.AppendChild(El);
end;
FrameSet := FDoc.CreateElement('frameset');
// No body element when using framesets
AHTMLEl.AppendChild(FrameSet);
ConfigureFrameSet(FrameSet) ;
el := FDoc.CreateNoframesElement;
El.AppendChild(FDoc.CreateTextNode(SNoFrameSupport));
FrameSet.AppendChild(el);
dirInvert:=FramePage.TOCZonePosition in [tpRight,tpBottom];
aTocPage:=FDoc.CreateElement('frame');
aTocPage['name']:='reporttoc';
aTocPage['src']:=ExtractFileName(ATocPageFileName);
aReportPage:=FDoc.CreateElement('frame');
aReportPage['name']:='reportpage';
if PageNames.Count>0 then
P:=ExtractFileName(PageNames[0]);
aReportPage['src']:=P;
if dirInvert then
begin
FrameSet.AppendChild(aReportPage);
FrameSet.AppendChild(aTOCPage);
end
else
begin
FrameSet.AppendChild(aTOCPage);
FrameSet.AppendChild(aReportPage);
end;
FN:=FramePage.FileName;
if (FN='') then
FN:='index.html';
D:=ExtractFilePath(Context.BaseFileName);
FN:=D+FN;
WriteHTML(FDoc,FN);
end;
{ TPageNavigatorOptions }
procedure TPageNavigatorOptions.Assign(Source: TPersistent);
Var
NO : TPageNavigatorOptions;
begin
if (source is TPageNavigatorOptions) then
begin
NO:=source as TPageNavigatorOptions;
Positions:=NO.Positions;
Options:=NO.Options;
FixedWidth:=NO.FixedWidth;
FixedMargin:=NO.FixedMargin;
FixedHeight:=NO.FixedHeight;
FActiveBGColor:=NO.ActiveBGColor;
FInActiveBGColor:=NO.InActiveBGColor;
end
else
inherited Assign(Source);
end;
{ TTOCPageOptions }
procedure TTOCPageOptions.Assign(Source: TPersistent);
Var
O : TTOCPageOptions;
begin
if (Source is TTOCPageOptions) then
begin
O:=Source as TTOCPageOptions;
FFileName:=O.FileName;
FCSSFileName:=O.CSSFileName;
OddPageStyle:=O.OddPageStyle;
EvenPageStyle:=O.EvenPageStyle;
SkipStyling:=SkipStyling;
end
else
inherited Assign(Source);
end;
{ TFramePageOptions }
procedure TFramePageOptions.Assign(Source: TPersistent);
Var
O : TFramePageOptions;
begin
if (Source is TFramePageOptions) then
begin
O:=Source as TFramePageOptions;
FFileName:=O.FileName;
FCSSFileName:=O.CSSFileName;
FTOCZoneSize:=O.TOCZoneSize;
FTOCZonePosition:=O.TOCZonePosition;
end
else
inherited Assign(Source);
end;
end.