diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/reportengine/u_command.pas | 1118 | ||||
| -rw-r--r-- | src/reportengine/u_pdf.pas | 2752 | ||||
| -rw-r--r-- | src/reportengine/u_report.pas | 4486 |
3 files changed, 3991 insertions, 4365 deletions
diff --git a/src/reportengine/u_command.pas b/src/reportengine/u_command.pas index 52f88d60..bab1b6da 100644 --- a/src/reportengine/u_command.pas +++ b/src/reportengine/u_command.pas @@ -26,337 +26,336 @@ unit U_Command; interface uses - Classes, SysUtils, - fpg_base, fpg_main, + Classes, + SysUtils, + fpg_base, + fpg_main, U_Pdf; type - TZone = (zHeader,zFooter,zPage,zMargins); - TSectPageNum = (PageNum,SectNum,PSectNum); - TBorderFlags= set of (bfLeft,bfRight,bfTop,bfBottom); - - TDimensions= record - T: Single; - L: Single; - R: Single; - B: Single; - end; - - TPaper= record - H: Integer; - W: Integer; + TZone = (zHeader, zFooter, zPage, zMargins); + TSectPageNum = (PageNum, SectNum, PSectNum); + TBorderFlags = set of (bfLeft, bfRight, bfTop, bfBottom); + + TDimensions = record + T: single; + L: single; + R: single; + B: single; + end; + + TPaper = record + H: integer; + W: integer; Printable: TDimensions; - end; + end; // document classes - T_Section = class - private - FNumSect: Integer; - FNbPages: Integer; - FPaper: TPaper; - FMargins: TDimensions; - FBotHead: Single; - FTopFoot: Single; - FPages: TList; - FHeader: TList; - FFooter: TList; - FFrames: TList; - FDefCol: Integer; - FTitle: string; - function GetFirstPage: Integer; - function GetTotalPages: Integer; - public - constructor Create(APaper: TPaper; AMargins: TDimensions; ANum: Integer); virtual; - destructor Destroy; override; - procedure LoadPage(APageNum: Integer); - procedure LoadCmdHeader; - procedure LoadCmdPage; - procedure LoadCmdFooter; - procedure LoadCmdGroup; - procedure LoadCmdGroupToPage; - procedure LoadSpaceHeader(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer); - procedure LoadSpacePage(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer); - procedure LoadSpaceFooter(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer); - procedure LoadSpaceGroup(AHeight: Single); - procedure LoadFrame(AStyle: Integer; AZone: TZone); - procedure LoadLine(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single; AStyle: Integer); - procedure LoadLineHorizHeader(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single; AStyle: Integer); - procedure LoadLineHorizPage(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single; AStyle: Integer); - procedure LoadLineHorizFooter(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single; AStyle: Integer); - procedure LoadLineHorizGroupe(AHeight: Single); - procedure LoadSurf(APos: T_Points; AColor: TfpgColor); - procedure LoadImgHeader(APosX,APosY: Single; AColumn,AImgNum: Integer); - procedure LoadImgPage(APosX,APosY: Single; AColumn,AImgNum: Integer); - procedure LoadImgFooter(APosX,APosY: Single; AColumn,AImgNum: Integer); - function GetCmdPage(NumPage: Integer): TList; - property CmdHeader: TList read FHeader; - property CmdFooter: TList read FFooter; - property NbPages: Integer read FNbPages; - property FirstPage: Integer read GetFirstPage; - property Pages: TList read FPages; - property TotPages: Integer read GetTotalPages; - property Paper: TPaper read FPaper; - property Margins: TDimensions read FMargins; - property CmdFrames: TList read FFrames; - property DefaultCol: Integer read FDefCol write FDefCol; - property Title: string read FTitle write FTitle; - end; - - T_Page = class - private - FNumPageTot: Integer; - FNumPageSect: Integer; - FCommands: TList; - public - constructor Create(ANumSec,ANumTot: Integer); virtual; - destructor Destroy; override; - property Commands: TList read FCommands write FCommands; - property PagesTot: Integer read FNumPageTot; - property PagesSect: Integer read FNumPageSect; - end; - - T_Group = class - private - FLineHeight: Single; - FGroupHeight: Single; - FCommands: TList; - public - constructor Create; virtual; - destructor Destroy; override; - property Commands: TList read FCommands write FCommands; - property LineHeight: Single read FLineHeight; - property GroupeHeight: Single read FGroupHeight; - end; - - T_WriteLine = class - private - FHeight: Integer; - FCommands: TList; - public - constructor Create; virtual; - destructor Destroy; override; - procedure LoadText(APosX,APosY: Single; AColumn,AText,AFont,AHeight,ABackColor,ABorder,ALineSpace: Integer; - ACurFont: Boolean; AFlags: TfpgTextFlags); - procedure LoadNumber(APosX,APosY: Single; AColumn,ATextNum,ATextTot,AFont,AHeight,ABackColor,ABorder,ALineSpace: Integer; - ACurFont: Boolean; AFlags: TfpgTextFlags; ATotal,AAlpha: Boolean; ATypeNum: TSectPageNum); - property Commands: TList read FCommands; - property LineHeight: Integer read FHeight; - end; + T_Section = class(TObject) + private + FNumSect: integer; + FNbPages: integer; + FPaper: TPaper; + FMargins: TDimensions; + FBotHead: single; + FTopFoot: single; + FPages: TList; + FHeader: TList; + FFooter: TList; + FFrames: TList; + FDefCol: integer; + FTitle: string; + function GetFirstPage: integer; + function GetTotalPages: integer; + public + constructor Create(APaper: TPaper; AMargins: TDimensions; ANum: integer); virtual; + destructor Destroy; override; + procedure LoadPage(APageNum: integer); + procedure LoadCmdHeader; + procedure LoadCmdPage; + procedure LoadCmdFooter; + procedure LoadCmdGroup; + procedure LoadCmdGroupToPage; + procedure LoadSpaceHeader(APosY: single; AColumn: integer; AHeight: single; ABackColor: integer); + procedure LoadSpacePage(APosY: single; AColumn: integer; AHeight: single; ABackColor: integer); + procedure LoadSpaceFooter(APosY: single; AColumn: integer; AHeight: single; ABackColor: integer); + procedure LoadSpaceGroup(AHeight: single); + procedure LoadFrame(AStyle: integer; AZone: TZone); + procedure LoadLine(APosXBegin, APosYBegin: single; AColumn: integer; APosXEnd, APosYEnd: single; AStyle: integer); + procedure LoadLineHorizHeader(APosXBegin, APosYBegin: single; AColumn: integer; APosXEnd, APosYEnd: single; AStyle: integer); + procedure LoadLineHorizPage(APosXBegin, APosYBegin: single; AColumn: integer; APosXEnd, APosYEnd: single; AStyle: integer); + procedure LoadLineHorizFooter(APosXBegin, APosYBegin: single; AColumn: integer; APosXEnd, APosYEnd: single; AStyle: integer); + procedure LoadLineHorizGroupe(AHeight: single); + procedure LoadSurf(APos: T_Points; AColor: TfpgColor); + procedure LoadImgHeader(APosX, APosY: single; AColumn, AImgNum: integer); + procedure LoadImgPage(APosX, APosY: single; AColumn, AImgNum: integer); + procedure LoadImgFooter(APosX, APosY: single; AColumn, AImgNum: integer); + function GetCmdPage(NumPage: integer): TList; + property CmdHeader: TList read FHeader; + property CmdFooter: TList read FFooter; + property NbPages: integer read FNbPages; + property FirstPage: integer read GetFirstPage; + property Pages: TList read FPages; + property TotPages: integer read GetTotalPages; + property Paper: TPaper read FPaper; + property Margins: TDimensions read FMargins; + property CmdFrames: TList read FFrames; + property DefaultCol: integer read FDefCol write FDefCol; + property Title: string read FTitle write FTitle; + end; + + T_Page = class(TObject) + private + FNumPageTot: integer; + FNumPageSect: integer; + FCommands: TList; + public + constructor Create(ANumSec, ANumTot: integer); virtual; + destructor Destroy; override; + property Commands: TList read FCommands write FCommands; + property PagesTot: integer read FNumPageTot; + property PagesSect: integer read FNumPageSect; + end; + + T_Group = class(TObject) + private + FLineHeight: single; + FGroupHeight: single; + FCommands: TList; + public + constructor Create; virtual; + destructor Destroy; override; + property Commands: TList read FCommands write FCommands; + property LineHeight: single read FLineHeight; + property GroupeHeight: single read FGroupHeight; + end; + + T_WriteLine = class(TObject) + private + FHeight: integer; + FCommands: TList; + public + constructor Create; virtual; + destructor Destroy; override; + procedure LoadText(APosX, APosY: single; AColumn, AText, AFont, AHeight, ABackColor, ABorder, ALineSpace: integer; ACurFont: Boolean; AFlags: TfpgTextFlags); + procedure LoadNumber(APosX, APosY: single; AColumn, ATextNum, ATextTot, AFont, AHeight, ABackColor, ABorder, ALineSpace: integer; ACurFont: Boolean; AFlags: TfpgTextFlags; ATotal, AAlpha: Boolean; ATypeNum: TSectPageNum); + property Commands: TList read FCommands; + property LineHeight: integer read FHeight; + end; // command classes T_Command = class - end; + end; - PSection = ^T_Section; - PPage = ^T_Page; - PLigne = ^T_WriteLine; + PSection = ^T_Section; + PPage = ^T_Page; + PLigne = ^T_WriteLine; PCommande = ^T_Command; - PFont = ^TfpgFont; + PFont = ^TfpgFont; T_WriteText = class(T_Command) - private - FPosX: Single; - FPosY: Single; - FColumn: Integer; - FText: Integer; - FFont: Integer; - FBackColor: Integer; - FBorder: Integer; - FLineSpace: Integer; - FCurFont: Boolean; - FFlags: TfpgTextFlags; - public - constructor Create(APosX,APosY: Single; AColumn,AText,AFont,ABackColor,ABorder,ALineSpace: Integer; ACurFont: Boolean; AFlags: TfpgTextFlags); virtual; - procedure SetPosY(const AValue: Single); - property GetPosX: Single read FPosX; - property GetPosY: Single read FPosY; - property GetColumn: Integer read FColumn; - property GetText: Integer read FText; - property GetFont: Integer read FFont; - property GetBackColor: Integer read FBackColor; - property GetBorder: Integer read FBorder; - property GetLineSpace: Integer read FLineSpace; - property GetCurFont: Boolean read FCurFont; - property GetFlags: TfpgTextFlags read FFlags; - end; + private + FPosX: single; + FPosY: single; + FColumn: integer; + FText: integer; + FFont: integer; + FBackColor: integer; + FBorder: integer; + FLineSpace: integer; + FCurFont: Boolean; + FFlags: TfpgTextFlags; + public + constructor Create(APosX, APosY: single; AColumn, AText, AFont, ABackColor, ABorder, ALineSpace: integer; ACurFont: Boolean; AFlags: TfpgTextFlags); virtual; + procedure SetPosY(const AValue: single); + property GetPosX: single read FPosX; + property GetPosY: single read FPosY; + property GetColumn: integer read FColumn; + property GetText: integer read FText; + property GetFont: integer read FFont; + property GetBackColor: integer read FBackColor; + property GetBorder: integer read FBorder; + property GetLineSpace: integer read FLineSpace; + property GetCurFont: Boolean read FCurFont; + property GetFlags: TfpgTextFlags read FFlags; + end; T_Number = class(T_Command) - private - FPosX: Single; - FPosY: Single; - FColumn: Integer; - FTextNum: Integer; - FTextTot: Integer; - FFont: Integer; - FBackColor: Integer; - FBorder: Integer; - FLineSpace: Integer; - FCurFont: Boolean; - FFlags: TfpgTextFlags; - FTotal: Boolean; - FAlpha: Boolean; - FTypeNum: TSectPageNum; - public - constructor Create(APosX,APosY: Single; AColumn,ATextNum,ATextTot,AFont,ABackColor,ABorder,ALineSpace: Integer; - ACurFont: Boolean; AFlags: TfpgTextFlags; ATotal,AAlpha: Boolean; ATypeNum: TSectPageNum); virtual; - procedure SetPosY(const AValue: Single); - property GetPosX: Single read FPosX; - property GetPosY: Single read FPosY; - property GetColumn: Integer read FColumn; - property GetTextNum: Integer read FTextNum; - property GetTextTot: Integer read FTextTot; - property GetFont: Integer read FFont; - property GetBackColor: Integer read FBackColor; - property GetBorder: Integer read FBorder; - property GetLineSpace: Integer read FLineSpace; - property GetCurFont: Boolean read FCurFont; - property GetFlags: TfpgTextFlags read FFlags; - property GetTotal: Boolean read FTotal; - property GetAlpha: Boolean read FAlpha; - property GetTypeNum: TSectPageNum read FTypeNum; - end; + private + FPosX: single; + FPosY: single; + FColumn: integer; + FTextNum: integer; + FTextTot: integer; + FFont: integer; + FBackColor: integer; + FBorder: integer; + FLineSpace: integer; + FCurFont: Boolean; + FFlags: TfpgTextFlags; + FTotal: Boolean; + FAlpha: Boolean; + FTypeNum: TSectPageNum; + public + constructor Create(APosX, APosY: single; AColumn, ATextNum, ATextTot, AFont, ABackColor, ABorder, ALineSpace: integer; ACurFont: Boolean; AFlags: TfpgTextFlags; ATotal, AAlpha: Boolean; ATypeNum: TSectPageNum); virtual; + procedure SetPosY(const AValue: single); + property GetPosX: single read FPosX; + property GetPosY: single read FPosY; + property GetColumn: integer read FColumn; + property GetTextNum: integer read FTextNum; + property GetTextTot: integer read FTextTot; + property GetFont: integer read FFont; + property GetBackColor: integer read FBackColor; + property GetBorder: integer read FBorder; + property GetLineSpace: integer read FLineSpace; + property GetCurFont: Boolean read FCurFont; + property GetFlags: TfpgTextFlags read FFlags; + property GetTotal: Boolean read FTotal; + property GetAlpha: Boolean read FAlpha; + property GetTypeNum: TSectPageNum read FTypeNum; + end; T_Line = class(T_Command) - private - FPosX: Single; - FPosY: Single; - FColumn: Integer; - FStyle: Integer; - FEndX: Single; - FEndY: Single; - public - constructor Create(APosX,APosY: Single; AColumn,AStyle: Integer; AEndX,AEndY: Single); virtual; - property GetPosX: Single read FPosX; - property GetPosY: Single read FPosY; - property GetColumn: Integer read FColumn; - property GetStyle: Integer read FStyle; - property GetEndX: Single read FEndX; - property GetEndY: Single read FEndY; - end; + private + FPosX: single; + FPosY: single; + FColumn: integer; + FStyle: integer; + FEndX: single; + FEndY: single; + public + constructor Create(APosX, APosY: single; AColumn, AStyle: integer; AEndX, AEndY: single); virtual; + property GetPosX: single read FPosX; + property GetPosY: single read FPosY; + property GetColumn: integer read FColumn; + property GetStyle: integer read FStyle; + property GetEndX: single read FEndX; + property GetEndY: single read FEndY; + end; T_Column = class(T_Command) - private - FPos: Single; - FWidth: Single; - FMargin: Single; - FColor: TfpgColor; - public - constructor Create(APos,AWidth,AMargin: Single; AColor: TfpgColor); virtual; - function GetTextPos: Single; - function GetTextWidth: Single; - procedure SetColColor(AColor: TfpgColor); - property ColPos: Single read FPos write FPos; - property ColWidth: Single read FWidth write FWidth; - property ColMargin: Single read FMargin write FMargin; - property GetColor: TfpgColor read FColor; - end; + private + FPos: single; + FWidth: single; + FMargin: single; + FColor: TfpgColor; + public + constructor Create(APos, AWidth, AMargin: single; AColor: TfpgColor); virtual; + function GetTextPos: single; + function GetTextWidth: single; + procedure SetColColor(AColor: TfpgColor); + property ColPos: single read FPos write FPos; + property ColWidth: single read FWidth write FWidth; + property ColMargin: single read FMargin write FMargin; + property GetColor: TfpgColor read FColor; + end; T_Font = class(T_Command) - private - FFont: TfpgFont; - FColor: TfpgColor; - FSize: string; - public - constructor Create(AFont: string; AColor: TfpgColor); virtual; - destructor Destroy; override; - function GetHeight: Integer; - property GetFont: TfpgFont read FFont; - property GetColor: TfpgColor read FColor; - property GetSize: string read FSize; - end; + private + FFont: TfpgFont; + FColor: TfpgColor; + FSize: string; + public + constructor Create(AFont: string; AColor: TfpgColor); virtual; + destructor Destroy; override; + function GetHeight: integer; + property GetFont: TfpgFont read FFont; + property GetColor: TfpgColor read FColor; + property GetSize: string read FSize; + end; T_LineSpace = class(T_Command) - private - FSup: Single; - FInt: Single; - FInf: Single; - public - constructor Create(ASup,AInt,AInf: Single); virtual; - property GetSup: Single read FSup; - property GetInt: Single read FInt; - property GetInf: Single read FInf; - end; + private + FSup: single; + FInt: single; + FInf: single; + public + constructor Create(ASup, AInt, AInf: single); virtual; + property GetSup: single read FSup; + property GetInt: single read FInt; + property GetInf: single read FInf; + end; T_Space = class(T_Command) - private - FPosY: Single; - FColumn: Integer; - FHeight: Single; - FBackColor: Integer; - public - constructor Create(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer); virtual; - procedure SetPosY(const AValue: Single); - property GetPosY: Single read FPosY; - property GetColumn: Integer read FColumn; - property GetHeight: Single read FHeight; - property GetBackColor: Integer read FBackColor; - end; + private + FPosY: single; + FColumn: integer; + FHeight: single; + FBackColor: integer; + public + constructor Create(APosY: single; AColumn: integer; AHeight: single; ABackColor: integer); virtual; + procedure SetPosY(const AValue: single); + property GetPosY: single read FPosY; + property GetColumn: integer read FColumn; + property GetHeight: single read FHeight; + property GetBackColor: integer read FBackColor; + end; T_BackColor = class(T_Command) - private - FColor: TfpgColor; - public - constructor Create(AColor: TfpgColor); virtual; - property GetColor: TfpgColor read FColor; - end; + private + FColor: TfpgColor; + public + constructor Create(AColor: TfpgColor); virtual; + property GetColor: TfpgColor read FColor; + end; T_LineStyle = class(T_Command) - private - FThick: Single; - FColor: TfpgColor; - FStyle: TfpgLineStyle; - public - constructor Create(AThick: Single; AColor: Tfpgcolor; AStyle: TfpgLineStyle); virtual; - property GetThick: Single read FThick; - property GetColor: TfpgColor read FColor; - property GetStyle: TfpgLineStyle read FStyle; - end; + private + FThick: single; + FColor: TfpgColor; + FStyle: TfpgLineStyle; + public + constructor Create(AThick: single; AColor: TfpgColor; AStyle: TfpgLineStyle); virtual; + property GetThick: single read FThick; + property GetColor: TfpgColor read FColor; + property GetStyle: TfpgLineStyle read FStyle; + end; T_Border = class(T_Command) - private - FFlags: TBorderFlags; - FStyle: Integer; - public - constructor Create(AFlags: TBorderFlags; AStyle: Integer); - property GetFlags: TBorderFlags read FFlags; - property GetStyle: Integer read FStyle; - end; + private + FFlags: TBorderFlags; + FStyle: integer; + public + constructor Create(AFlags: TBorderFlags; AStyle: integer); + property GetFlags: TBorderFlags read FFlags; + property GetStyle: integer read FStyle; + end; T_Frame = class(T_Command) - private - FStyle: Integer; - FZone: TZone; - public - constructor Create(AStyle: Integer; AZone: TZone); - property GetStyle: Integer read FStyle; - property GetZone: TZone read FZone; - end; + private + FStyle: integer; + FZone: TZone; + public + constructor Create(AStyle: integer; AZone: TZone); + property GetStyle: integer read FStyle; + property GetZone: TZone read FZone; + end; T_Surface = class(T_Command) - private - FPoints: T_Points; - FColor: TfpgColor; - public - constructor Create(APoints: array of TRefPos; AColor: TfpgColor); - property GetPoints: T_Points read FPoints; - property GetColor: TfpgColor read FColor; - end; + private + FPoints: T_Points; + FColor: TfpgColor; + public + constructor Create(APoints: array of TRefPos; AColor: TfpgColor); + property GetPoints: T_Points read FPoints; + property GetColor: TfpgColor read FColor; + end; T_Image = class(T_Command) - private - FImage: Integer; - FColumn: Integer; - FPosX: Single; - FPosY: Single; - public - constructor Create(APosX,APosY: Single; AColumn,AImageNum: Integer); - property GetImage: Integer read FImage; - property GetColumn: Integer read FColumn; - property GetPosX: Single read FPosX; - property GetPosY: Single read FPosY; - end; + private + FImage: integer; + FColumn: integer; + FPosX: single; + FPosY: single; + public + constructor Create(APosX, APosY: single; AColumn, AImageNum: integer); + property GetImage: integer read FImage; + property GetColumn: integer read FColumn; + property GetPosX: single read FPosX; + property GetPosY: single read FPosY; + end; var Sections: TList; @@ -383,477 +382,456 @@ var implementation -// utility functions - -// extracts the font size from the fontdesc + // utility functions + // extracts the font size from the fontdesc function ExtractFontSize(const AValue: string): string; begin -if Pos(':',AValue)> 0 -then - Result:= Copy(AValue,Succ(Pos('-',AValue)),Pred(Pos(':',Avalue)-Pos('-',AValue))) -else - Result:= Copy(AValue,Succ(Pos('-',AValue)),Length(AValue)-Pos('-',AValue)); + if Pos(':', AValue) > 0 then + Result := Copy(AValue, Succ(Pos('-', AValue)), Pred(Pos(':', Avalue) - Pos('-', AValue))) + else + Result := Copy(AValue, Succ(Pos('-', AValue)), Length(AValue) - Pos('-', AValue)); end; // document class methods - -function T_Section.GetFirstPage: Integer; +function T_Section.GetFirstPage: integer; begin -Result:= T_Page(Pages[0]).PagesTot; + Result := T_Page(Pages[0]).PagesTot; end; -function T_Section.GetTotalPages: Integer; +function T_Section.GetTotalPages: integer; begin -if Pages.Count> 0 -then - Result:= T_Page(Pages[Pred(Pages.Count)]).PagesTot -else - Result:= 0; + if Pages.Count > 0 then + Result := T_Page(Pages[Pred(Pages.Count)]).PagesTot + else + Result := 0; end; -constructor T_Section.Create(APaper: TPaper; AMargins: TDimensions; ANum: Integer); +constructor T_Section.Create(APaper: TPaper; AMargins: TDimensions; ANum: integer); begin -FNumSect:= ANum; -FNbPages:= 0; -FPaper:= APaper; -FMargins:= AMargins; -FBotHead:= FMargins.T; -FTopFoot:= FMargins.B; -FPages:= TList.Create; -FHeader:= TList.Create; -FFooter:= TList.Create; -FFrames:= TList.Create; + FNumSect := ANum; + FNbPages := 0; + FPaper := APaper; + FMargins := AMargins; + FBotHead := FMargins.T; + FTopFoot := FMargins.B; + FPages := TList.Create; + FHeader := TList.Create; + FFooter := TList.Create; + FFrames := TList.Create; end; destructor T_Section.Destroy; var - Cpt: Integer; -begin -if FPages.Count> 0 -then - for Cpt:= 0 to Pred(FPages.Count) do - T_Page(FPages[Cpt]).Free; -FPages.Free; -if FHeader.Count> 0 -then - for Cpt:= 0 to Pred(FHeader.Count) do - T_Command(FHeader[Cpt]).Free; -FHeader.Free; -if FFooter.Count> 0 -then - for Cpt:= 0 to Pred(FFooter.Count) do - T_Command(FFooter[Cpt]).Free; -FFooter.Free; -if FFrames.Count> 0 -then - for Cpt:= 0 to Pred(FFrames.Count) do - T_Command(FFrames[Cpt]).Free; -FFrames.Free; -inherited Destroy; -end; - -procedure T_Section.LoadPage(APageNum: Integer); -begin -Inc(FNbPages); -VPage:= T_Page.Create(FNbPages,APageNum); -FPages.Add(VPage); + Cpt: integer; +begin + if FPages.Count > 0 then + for Cpt := 0 to Pred(FPages.Count) do + T_Page(FPages[Cpt]).Free; + FPages.Free; + if FHeader.Count > 0 then + for Cpt := 0 to Pred(FHeader.Count) do + T_Command(FHeader[Cpt]).Free; + FHeader.Free; + if FFooter.Count > 0 then + for Cpt := 0 to Pred(FFooter.Count) do + T_Command(FFooter[Cpt]).Free; + FFooter.Free; + if FFrames.Count > 0 then + for Cpt := 0 to Pred(FFrames.Count) do + T_Command(FFrames[Cpt]).Free; + FFrames.Free; + inherited Destroy; +end; + +procedure T_Section.LoadPage(APageNum: integer); +begin + Inc(FNbPages); + VPage := T_Page.Create(FNbPages, APageNum); + FPages.Add(VPage); end; procedure T_Section.LoadCmdHeader; var - Cpt: Integer; + Cpt: integer; begin -for Cpt:= 0 to Pred(VWriteLine.Commands.Count) do - FHeader.Add(VWriteLine.Commands.Items[Cpt]); -VWriteLine.FHeight:= 0; -VWriteLine.Commands.Clear; + for Cpt := 0 to Pred(VWriteLine.Commands.Count) do + FHeader.Add(VWriteLine.Commands.Items[Cpt]); + VWriteLine.FHeight := 0; + VWriteLine.Commands.Clear; end; procedure T_Section.LoadCmdPage; var - Cpt: Integer; + Cpt: integer; begin -for Cpt:= 0 to Pred(VWriteLine.Commands.Count) do - T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VWriteLine.Commands.Items[Cpt]); -VWriteLine.FHeight:= 0; -VWriteLine.Commands.Clear; + for Cpt := 0 to Pred(VWriteLine.Commands.Count) do + T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VWriteLine.Commands.Items[Cpt]); + VWriteLine.FHeight := 0; + VWriteLine.Commands.Clear; end; procedure T_Section.LoadCmdFooter; var - Cpt: Integer; + Cpt: integer; begin -for Cpt:= 0 to Pred(VWriteLine.Commands.Count) do - FFooter.Add(VWriteLine.Commands.Items[Cpt]); -VWriteLine.FHeight:= 0; -VWriteLine.Commands.Clear; + for Cpt := 0 to Pred(VWriteLine.Commands.Count) do + FFooter.Add(VWriteLine.Commands.Items[Cpt]); + VWriteLine.FHeight := 0; + VWriteLine.Commands.Clear; end; procedure T_Section.LoadCmdGroup; var - Cpt: Integer; + Cpt: integer; begin -for Cpt:= 0 to Pred(VWriteLine.Commands.Count) do - VGroup.Commands.Add(VWriteLine.Commands.Items[Cpt]); -with VGroup do + for Cpt := 0 to Pred(VWriteLine.Commands.Count) do + VGroup.Commands.Add(VWriteLine.Commands.Items[Cpt]); + with VGroup do begin - FLineHeight:= VWriteLine.FHeight; - FGroupHeight:= FGroupHeight+FLineHeight; + FLineHeight := VWriteLine.FHeight; + FGroupHeight := FGroupHeight + FLineHeight; end; -VWriteLine.FHeight:= 0; -VWriteLine.Commands.Clear; + VWriteLine.FHeight := 0; + VWriteLine.Commands.Clear; end; procedure T_Section.LoadCmdGroupToPage; var - Cpt: Integer; + Cpt: integer; begin -for Cpt:= 0 to Pred(VGroup.Commands.Count) do - T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VGroup.Commands.Items[Cpt]); -VGroup.FGroupHeight:= 0; -VGroup.Commands.Clear; + for Cpt := 0 to Pred(VGroup.Commands.Count) do + T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VGroup.Commands.Items[Cpt]); + VGroup.FGroupHeight := 0; + VGroup.Commands.Clear; end; -procedure T_Section.LoadSpaceHeader(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer); +procedure T_Section.LoadSpaceHeader(APosY: single; AColumn: integer; AHeight: single; ABackColor: integer); begin -VCommand:= T_Space.Create(APosY,AColumn,AHeight,ABackColor); -FHeader.Add(VCommand); + VCommand := T_Space.Create(APosY, AColumn, AHeight, ABackColor); + FHeader.Add(VCommand); end; -procedure T_Section.LoadSpacePage(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer); +procedure T_Section.LoadSpacePage(APosY: single; AColumn: integer; AHeight: single; ABackColor: integer); begin -VCommand:= T_Space.Create(APosY,AColumn,AHeight,ABackColor); -T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VCommand); + VCommand := T_Space.Create(APosY, AColumn, AHeight, ABackColor); + T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VCommand); end; -procedure T_Section.LoadSpaceFooter(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer); +procedure T_Section.LoadSpaceFooter(APosY: single; AColumn: integer; AHeight: single; ABackColor: integer); begin -VCommand:= T_Space.Create(APosY,AColumn,AHeight,ABackColor); -FFooter.Add(VCommand); + VCommand := T_Space.Create(APosY, AColumn, AHeight, ABackColor); + FFooter.Add(VCommand); end; -procedure T_Section.LoadSpaceGroup(AHeight: Single); +procedure T_Section.LoadSpaceGroup(AHeight: single); begin -VGroup.FGroupHeight:= VGroup.FGroupHeight+AHeight; + VGroup.FGroupHeight := VGroup.FGroupHeight + AHeight; end; -procedure T_Section.LoadFrame(AStyle: Integer; AZone: TZone); +procedure T_Section.LoadFrame(AStyle: integer; AZone: TZone); begin -VCommand:= T_Frame.Create(AStyle,AZone); -FFrames.Add(VCommand); + VCommand := T_Frame.Create(AStyle, AZone); + FFrames.Add(VCommand); end; -procedure T_Section.LoadLine(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single; AStyle: Integer); +procedure T_Section.LoadLine(APosXBegin, APosYBegin: single; AColumn: integer; APosXEnd, APosYEnd: single; AStyle: integer); begin -VCommand:= T_Line.Create(APosXBegin,APosYBegin,AColumn,AStyle,APosXEnd,APosYEnd); -T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VCommand); + VCommand := T_Line.Create(APosXBegin, APosYBegin, AColumn, AStyle, APosXEnd, APosYEnd); + T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VCommand); end; -procedure T_Section.LoadLineHorizHeader(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single; - AStyle: Integer); +procedure T_Section.LoadLineHorizHeader(APosXBegin, APosYBegin: single; AColumn: integer; APosXEnd, APosYEnd: single; AStyle: integer); begin -VCommand:= T_Line.Create(APosXBegin,APosYBegin,AColumn,AStyle,APosXEnd,APosYEnd); -FHeader.Add(VCommand); + VCommand := T_Line.Create(APosXBegin, APosYBegin, AColumn, AStyle, APosXEnd, APosYEnd); + FHeader.Add(VCommand); end; -procedure T_Section.LoadLineHorizPage(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single; AStyle: Integer); +procedure T_Section.LoadLineHorizPage(APosXBegin, APosYBegin: single; AColumn: integer; APosXEnd, APosYEnd: single; AStyle: integer); begin -VCommand:= T_Line.Create(APosXBegin,APosYBegin,AColumn,AStyle,APosXEnd,APosYEnd); -T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VCommand); + VCommand := T_Line.Create(APosXBegin, APosYBegin, AColumn, AStyle, APosXEnd, APosYEnd); + T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VCommand); end; -procedure T_Section.LoadLineHorizFooter(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single; AStyle: Integer); +procedure T_Section.LoadLineHorizFooter(APosXBegin, APosYBegin: single; AColumn: integer; APosXEnd, APosYEnd: single; AStyle: integer); begin -VCommand:= T_Line.Create(APosXBegin,APosYBegin,AColumn,AStyle,APosXEnd,APosYEnd); -FFooter.Add(VCommand); + VCommand := T_Line.Create(APosXBegin, APosYBegin, AColumn, AStyle, APosXEnd, APosYEnd); + FFooter.Add(VCommand); end; -procedure T_Section.LoadLineHorizGroupe(AHeight: Single); +procedure T_Section.LoadLineHorizGroupe(AHeight: single); begin -VGroup.FGroupHeight:= VGroup.FGroupHeight+AHeight; + VGroup.FGroupHeight := VGroup.FGroupHeight + AHeight; end; procedure T_Section.LoadSurf(APos: T_Points; AColor: TfpgColor); begin -VCommand:= T_Surface.Create(APos,AColor); -T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VCommand); + VCommand := T_Surface.Create(APos, AColor); + T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VCommand); end; -procedure T_Section.LoadImgHeader(APosX,APosY: Single; AColumn,AImgNum: Integer); +procedure T_Section.LoadImgHeader(APosX, APosY: single; AColumn, AImgNum: integer); begin -VCommand:= T_Image.Create(APosX,APosY,AColumn,AImgNum); -FHeader.Add(VCommand); + VCommand := T_Image.Create(APosX, APosY, AColumn, AImgNum); + FHeader.Add(VCommand); end; -procedure T_Section.LoadImgPage(APosX,APosY: Single; AColumn,AImgNum: Integer); +procedure T_Section.LoadImgPage(APosX, APosY: single; AColumn, AImgNum: integer); begin -VCommand:= T_Image.Create(APosX,APosY,AColumn,AImgNum); -T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VCommand); + VCommand := T_Image.Create(APosX, APosY, AColumn, AImgNum); + T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VCommand); end; -procedure T_Section.LoadImgFooter(APosX,APosY: Single; AColumn,AImgNum: Integer); +procedure T_Section.LoadImgFooter(APosX, APosY: single; AColumn, AImgNum: integer); begin -VCommand:= T_Image.Create(APosX,APosY,AColumn,AImgNum); -FFooter.Add(VCommand); + VCommand := T_Image.Create(APosX, APosY, AColumn, AImgNum); + FFooter.Add(VCommand); end; -function T_Section.GetCmdPage(NumPage: Integer): TList; +function T_Section.GetCmdPage(NumPage: integer): TList; begin -Result:= T_Page(Pages[Pred(NumPage)]).Commands; + Result := T_Page(Pages[Pred(NumPage)]).Commands; end; -constructor T_Page.Create(ANumSec,ANumTot: Integer); +constructor T_Page.Create(ANumSec, ANumTot: integer); begin -FNumPageTot:= ANumTot; -FNumPageSect:= ANumSec; -FCommands:= TList.Create; + FNumPageTot := ANumTot; + FNumPageSect := ANumSec; + FCommands := TList.Create; end; destructor T_Page.Destroy; var - Cpt: Integer; + Cpt: integer; begin -if FCommands.Count> 0 -then - for Cpt:= 0 to Pred(FCommands.Count) do - T_Command(FCommands[Cpt]).Free; -FCommands.Free; -inherited Destroy; + if FCommands.Count > 0 then + for Cpt := 0 to Pred(FCommands.Count) do + T_Command(FCommands[Cpt]).Free; + FCommands.Free; + inherited Destroy; end; constructor T_Group.Create; begin -FLineHeight:= 0; -FGroupHeight:= 0; -FCommands:= TList.Create; + FLineHeight := 0; + FGroupHeight := 0; + FCommands := TList.Create; end; destructor T_Group.Destroy; var - Cpt: Integer; + Cpt: integer; begin -if FCommands.Count> 0 -then - for Cpt:= 0 to Pred(FCommands.Count) do - T_Command(FCommands[Cpt]).Free; -FCommands.Free; -inherited Destroy; + if FCommands.Count > 0 then + for Cpt := 0 to Pred(FCommands.Count) do + T_Command(FCommands[Cpt]).Free; + FCommands.Free; + inherited Destroy; end; constructor T_WriteLine.Create; begin -FHeight:= 0; -FCommands:= TList.Create; + FHeight := 0; + FCommands := TList.Create; end; destructor T_WriteLine.Destroy; var - Cpt: Integer; + Cpt: integer; begin -if FCommands.Count> 0 -then - for Cpt:= 0 to Pred(FCommands.Count) do - T_Command(FCommands[Cpt]).Free; -FCommands.Free; -inherited Destroy; + if FCommands.Count > 0 then + for Cpt := 0 to Pred(FCommands.Count) do + T_Command(FCommands[Cpt]).Free; + FCommands.Free; + inherited Destroy; end; -procedure T_WriteLine.LoadText(APosX,APosY: Single; AColumn,AText,AFont,AHeight,ABackColor,ABorder,ALineSpace: Integer; - ACurFont: Boolean; AFlags: TfpgTextFlags); +procedure T_WriteLine.LoadText(APosX, APosY: single; AColumn, AText, AFont, AHeight, ABackColor, ABorder, ALineSpace: integer; ACurFont: Boolean; AFlags: TfpgTextFlags); begin -if FHeight< AHeight -then - FHeight:= AHeight; -VCommand:= T_WriteText.Create(APosX,APosY,AColumn,AText,AFont,ABackColor,ABorder,ALineSpace,ACurFont,AFlags); -Commands.Add(VCommand); + if FHeight < AHeight then + FHeight := AHeight; + VCommand := T_WriteText.Create(APosX, APosY, AColumn, AText, AFont, ABackColor, ABorder, ALineSpace, ACurFont, AFlags); + Commands.Add(VCommand); end; -procedure T_WriteLine.LoadNumber(APosX,APosY: Single; AColumn,ATextNum,ATextTot,AFont,AHeight,ABackColor,ABorder,ALineSpace: Integer; - ACurFont: Boolean; AFlags: TfpgTextFlags; ATotal,AAlpha: Boolean; ATypeNum: TSectPageNum); +procedure T_WriteLine.LoadNumber(APosX, APosY: single; AColumn, ATextNum, ATextTot, AFont, AHeight, ABackColor, ABorder, ALineSpace: integer; ACurFont: Boolean; AFlags: TfpgTextFlags; ATotal, AAlpha: Boolean; ATypeNum: TSectPageNum); begin -if FHeight< AHeight -then - FHeight:= AHeight; -VCommand:= T_Number.Create(APosX,APosY,AColumn,ATextNum,ATextTot,AFont,ABackColor,ABorder,ALineSpace,ACurFont,AFlags,ATotal,AAlpha,ATypeNum); -Commands.Add(VCommand); + if FHeight < AHeight then + FHeight := AHeight; + VCommand := T_Number.Create(APosX, APosY, AColumn, ATextNum, ATextTot, AFont, ABackColor, ABorder, ALineSpace, ACurFont, AFlags, ATotal, AAlpha, ATypeNum); + Commands.Add(VCommand); end; // command class methods -procedure T_WriteText.SetPosY(const AValue: Single); +procedure T_WriteText.SetPosY(const AValue: single); begin -if FPosY<> AValue -then - FPosY:= AValue; + if FPosY <> AValue then + FPosY := AValue; end; -constructor T_WriteText.Create(APosX,APosY: Single; AColumn,AText,AFont,ABackColor,ABorder,ALineSpace: Integer; ACurFont: Boolean; AFlags: TfpgTextFlags); +constructor T_WriteText.Create(APosX, APosY: single; AColumn, AText, AFont, ABackColor, ABorder, ALineSpace: integer; ACurFont: Boolean; AFlags: TfpgTextFlags); begin -inherited Create; -FPosX:= APosX; -FPosY:= APosY; -FColumn:= AColumn; -FText:= AText; -FFont:= AFont; -FBackColor:= ABackColor; -FBorder:= ABorder; -FLineSpace:= ALineSpace; -FCurFont:= ACurFont; -FFlags:= AFlags; + inherited Create; + FPosX := APosX; + FPosY := APosY; + FColumn := AColumn; + FText := AText; + FFont := AFont; + FBackColor := ABackColor; + FBorder := ABorder; + FLineSpace := ALineSpace; + FCurFont := ACurFont; + FFlags := AFlags; end; -procedure T_Number.SetPosY(const AValue: Single); +procedure T_Number.SetPosY(const AValue: single); begin -if FPosY<> AValue -then - FPosY:= AValue; + if FPosY <> AValue then + FPosY := AValue; end; -constructor T_Number.Create(APosX,APosY: Single; AColumn,ATextNum,ATextTot,AFont,ABackColor,ABorder,ALineSpace: Integer; - ACurFont: Boolean; AFlags: TfpgTextFlags; ATotal,AAlpha: Boolean; ATypeNum: TSectPageNum); +constructor T_Number.Create(APosX, APosY: single; AColumn, ATextNum, ATextTot, AFont, ABackColor, ABorder, ALineSpace: integer; ACurFont: Boolean; AFlags: TfpgTextFlags; ATotal, AAlpha: Boolean; ATypeNum: TSectPageNum); begin -inherited Create; -FPosX:= APosX; -FPosY:= APosY; -FColumn:= AColumn; -FTextNum:= ATextNum; -FTextTot:= ATextTot; -FFont:= AFont; -FBackColor:= ABackColor; -FBorder:= ABorder; -FLineSpace:= ALineSpace; -FCurFont:= ACurFont; -FFlags:= AFlags; -FTotal:= ATotal; -FAlpha:= AAlpha; -FTypeNum:= ATypeNum; + inherited Create; + FPosX := APosX; + FPosY := APosY; + FColumn := AColumn; + FTextNum := ATextNum; + FTextTot := ATextTot; + FFont := AFont; + FBackColor := ABackColor; + FBorder := ABorder; + FLineSpace := ALineSpace; + FCurFont := ACurFont; + FFlags := AFlags; + FTotal := ATotal; + FAlpha := AAlpha; + FTypeNum := ATypeNum; end; -constructor T_Line.Create(APosX,APosY: Single; AColumn,AStyle: Integer; AEndX,AEndY: Single); +constructor T_Line.Create(APosX, APosY: single; AColumn, AStyle: integer; AEndX, AEndY: single); begin -FPosX:= APosX; -FPosY:= APosY; -FColumn:= AColumn; -FStyle:= AStyle; -FEndX:= AEndX; -FEndY:= AEndY; + FPosX := APosX; + FPosY := APosY; + FColumn := AColumn; + FStyle := AStyle; + FEndX := AEndX; + FEndY := AEndY; end; -constructor T_Column.Create(APos,AWidth,AMargin: Single; AColor: TfpgColor); +constructor T_Column.Create(APos, AWidth, AMargin: single; AColor: TfpgColor); begin -inherited Create; -FPos:= APos; -FWidth:= AWidth; -FMargin:= AMargin; -FColor:= AColor; + inherited Create; + FPos := APos; + FWidth := AWidth; + FMargin := AMargin; + FColor := AColor; end; -function T_Column.GetTextPos: Single; +function T_Column.GetTextPos: single; begin -Result:= FPos+FMargin; + Result := FPos + FMargin; end; -function T_Column.GetTextWidth: Single; +function T_Column.GetTextWidth: single; begin -Result:= FWidth-(FMargin*2); + Result := FWidth - (FMargin * 2); end; procedure T_Column.SetColColor(AColor: TfpgColor); begin -if FColor<> AColor -then - FColor:= AColor; + if FColor <> AColor then + FColor := AColor; end; constructor T_Font.Create(AFont: string; AColor: TfpgColor); begin -inherited Create; -FFont:= fpgApplication.GetFont(AFont); -FColor:= AColor; -FSize:= ExtractFontSize(AFont); + inherited Create; + FFont := fpgApplication.GetFont(AFont); + FColor := AColor; + FSize := ExtractFontSize(AFont); end; destructor T_Font.Destroy; begin -FFont.Free; -inherited Destroy; + FFont.Free; + inherited Destroy; end; -function T_Font.GetHeight: Integer; +function T_Font.GetHeight: integer; begin -Result:= TfpgFont(FFont).Height; + Result := TfpgFont(FFont).Height; end; -constructor T_LineSpace.Create(ASup,AInt,AInf: Single); +constructor T_LineSpace.Create(ASup, AInt, AInf: single); begin -inherited Create; -FSup:= ASup; -FInt:= AInt; -FInf:= AInf; + inherited Create; + FSup := ASup; + FInt := AInt; + FInf := AInf; end; -constructor T_Space.Create(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer); +constructor T_Space.Create(APosY: single; AColumn: integer; AHeight: single; ABackColor: integer); begin -inherited Create; -FPosY:= APosY; -FColumn:= AColumn; -FHeight:= AHeight; -FBackColor:= ABackColor; + inherited Create; + FPosY := APosY; + FColumn := AColumn; + FHeight := AHeight; + FBackColor := ABackColor; end; constructor T_Surface.Create(APoints: array of TRefPos; AColor: TfpgColor); var - Cpt: Integer; + Cpt: integer; begin -inherited Create; -SetLength(FPoints,Length(APoints)); -for Cpt:= 0 to Pred(Length(FPoints)) do - FPoints[Cpt]:= APoints[Cpt]; -FColor:= AColor; + inherited Create; + SetLength(FPoints, Length(APoints)); + for Cpt := 0 to Pred(Length(FPoints)) do + FPoints[Cpt] := APoints[Cpt]; + FColor := AColor; end; -procedure T_Space.SetPosY(const AValue: Single); +procedure T_Space.SetPosY(const AValue: single); begin -if FPosY<> AValue -then - FPosY:= AValue; + if FPosY <> AValue then + FPosY := AValue; end; constructor T_BackColor.Create(AColor: TfpgColor); begin -FColor:= AColor; + FColor := AColor; end; -constructor T_LineStyle.Create(AThick: Single; AColor: Tfpgcolor; AStyle: TfpgLineStyle); +constructor T_LineStyle.Create(AThick: single; AColor: TfpgColor; AStyle: TfpgLineStyle); begin -inherited Create; -FThick:= AThick; -FColor:= AColor; -FStyle:= AStyle; + inherited Create; + FThick := AThick; + FColor := AColor; + FStyle := AStyle; end; -constructor T_Border.Create(AFlags: TBorderFlags; AStyle: Integer); +constructor T_Border.Create(AFlags: TBorderFlags; AStyle: integer); begin -inherited Create; -FFlags:= AFlags; -FStyle:= AStyle; + inherited Create; + FFlags := AFlags; + FStyle := AStyle; end; -constructor T_Frame.Create(AStyle: Integer; AZone: TZone); +constructor T_Frame.Create(AStyle: integer; AZone: TZone); begin -inherited Create; -FStyle:= AStyle; -FZone:= AZone; + inherited Create; + FStyle := AStyle; + FZone := AZone; end; -constructor T_Image.Create(APosX,APosY: Single; AColumn,AImageNum: Integer); +constructor T_Image.Create(APosX, APosY: single; AColumn, AImageNum: integer); begin -inherited Create; -FImage:= AImageNum; -FColumn:= AColumn; -FPosX:= APosX; -FPosY:= APosY; + inherited Create; + FImage := AImageNum; + FColumn := AColumn; + FPosX := APosX; + FPosY := APosY; end; end. diff --git a/src/reportengine/u_pdf.pas b/src/reportengine/u_pdf.pas index 850d8c94..12e3527c 100644 --- a/src/reportengine/u_pdf.pas +++ b/src/reportengine/u_pdf.pas @@ -26,275 +26,277 @@ unit U_Pdf; interface uses - Classes, SysUtils, StrUtils, - fpg_main, fpg_base, fpg_dialogs; + Classes, + SysUtils, + StrUtils, + fpg_main, + fpg_base, + fpg_dialogs; type TPdfObjet = class(TObject) - private - protected - public - constructor Create; virtual; - destructor Destroy; override; - end; + public + constructor Create; virtual; + destructor Destroy; override; + end; TPdfBoolean = class(TPdfObjet) - private - FValue: Boolean; - protected - procedure WriteBoolean(const AFlux: TStream); - public - constructor CreateBoolean(const AValue: Boolean); - destructor Destroy; override; - end; + private + FValue: Boolean; + protected + procedure WriteBoolean(const AFlux: TStream); + public + constructor CreateBoolean(const AValue: Boolean); + destructor Destroy; override; + end; TPdfInteger = class(TPdfObjet) - private - FValue: Integer; - protected - procedure WriteInteger(const AFlux: TStream); - procedure IncrementeInteger; - property Value: Integer read FValue write FValue; - public - constructor CreateInteger(const AValue: Integer); - destructor Destroy; override; - end; + private + FValue: integer; + protected + procedure WriteInteger(const AFlux: TStream); + procedure IncrementeInteger; + property Value: integer read FValue write FValue; + public + constructor CreateInteger(const AValue: integer); + destructor Destroy; override; + end; TPdfReference = class(TPdfObjet) - private - FValue: Integer; - protected - procedure WriteReference(const AFlux: TStream); - public - constructor CreateReference(const AValue: Integer); - destructor Destroy; override; - end; + private + FValue: integer; + protected + procedure WriteReference(const AFlux: TStream); + public + constructor CreateReference(const AValue: integer); + destructor Destroy; override; + end; TPdfName = class(TPdfObjet) - private - FValue: string; - protected - procedure WriteName(const AFlux: TStream); - public - constructor CreateName(const AValue: string); - destructor Destroy; override; - end; + private + FValue: string; + protected + procedure WriteName(const AFlux: TStream); + public + constructor CreateName(const AValue: string); + destructor Destroy; override; + end; TPdfString = class(TPdfObjet) - private - FValue: string; - protected - procedure WriteString(const AFlux: TStream); - public - constructor CreateString(const AValue: string); - destructor Destroy; override; - end; + private + FValue: string; + protected + procedure WriteString(const AFlux: TStream); + public + constructor CreateString(const AValue: string); + destructor Destroy; override; + end; TPdfArray = class(TPdfObjet) - private - FArray: TList; - protected - procedure WriteArray(const AFlux: TStream); - procedure AddItem(const AValue: TPdfObjet); - public - constructor CreateArray; - destructor Destroy; override; - end; + private + FArray: TList; + protected + procedure WriteArray(const AFlux: TStream); + procedure AddItem(const AValue: TPdfObjet); + public + constructor CreateArray; + destructor Destroy; override; + end; TPdfStream = class(TPdfObjet) - private - FStream: TList; - protected - procedure WriteStream(const AFlux: TStream); - procedure AddItem(const AValue: TPdfObjet); - public - constructor CreateStream; - destructor Destroy; override; - end; + private + FStream: TList; + protected + procedure WriteStream(const AFlux: TStream); + procedure AddItem(const AValue: TPdfObjet); + public + constructor CreateStream; + destructor Destroy; override; + end; TPdfFonte = class(TPdfObjet) - private - FTxtFont: Integer; - FTxtSize: string; - protected - procedure WriteFonte(const AFlux: TStream); - function WriteFonteStream(const FFlux: TMemoryStream; const AFlux: TStream): Int64; - public - constructor CreateFonte(const AFont: Integer; const ASize: string); - destructor Destroy; override; - end; + private + FTxtFont: integer; + FTxtSize: string; + protected + procedure WriteFonte(const AFlux: TStream); + function WriteFonteStream(const FFlux: TMemoryStream; const AFlux: TStream): int64; + public + constructor CreateFonte(const AFont: integer; const ASize: string); + destructor Destroy; override; + end; TPdfText = class(TPdfObjet) - private - FTxtPosX: Single; - FTxtPosY: Single; - FTxtText: TPdfString; - protected - procedure WriteText(const AFlux: TStream); - public - constructor CreateText(const APosX,APosY: Single; const AText: string); - destructor Destroy; override; - end; + private + FTxtPosX: single; + FTxtPosY: single; + FTxtText: TPdfString; + protected + procedure WriteText(const AFlux: TStream); + public + constructor CreateText(const APosX, APosY: single; const AText: string); + destructor Destroy; override; + end; TPdfLigne = class(TPdfObjet) - private - FEpais: Single; - FStaX: Single; - FStaY: Single; - FEndX: Single; - FEndY: Single; - protected - procedure WriteLigne(const AFlux: TStream); - public - constructor CreateLigne(const AEpais,AStaX,AStaY,AEndX,AEndY: Single); - destructor Destroy; override; - end; + private + FEpais: single; + FStaX: single; + FStaY: single; + FEndX: single; + FEndY: single; + protected + procedure WriteLigne(const AFlux: TStream); + public + constructor CreateLigne(const AEpais, AStaX, AStaY, AEndX, AEndY: single); + destructor Destroy; override; + end; TPdfRectangle = class(TPdfObjet) - private - FEpais: Single; - FRecX: Single; - FRecY: Single; - FRecW: Single; - FRecH: Single; - FFill: Boolean; - FStroke: Boolean; - protected - procedure WriteRectangle(const AFlux: TStream); - public - constructor CreateRectangle(const AEpais,APosX,APosY,AWidth,AHeight: Single; const AFill,AStroke: Boolean); - destructor Destroy; override; - end; + private + FEpais: single; + FRecX: single; + FRecY: single; + FRecW: single; + FRecH: single; + FFill: Boolean; + FStroke: Boolean; + protected + procedure WriteRectangle(const AFlux: TStream); + public + constructor CreateRectangle(const AEpais, APosX, APosY, AWidth, AHeight: single; const AFill, AStroke: Boolean); + destructor Destroy; override; + end; - TRefPos= record - X: Single; - Y: Single; - end; + TRefPos = record + X: single; + Y: single; + end; T_Points = array of TRefPos; TPdfSurface = class(TPdfObjet) - private - FPoints: T_Points; - protected - procedure WriteSurface(const AFlux: TStream); - public - constructor CreateSurface(const APoints: T_Points); - destructor Destroy; override; - end; + private + FPoints: T_Points; + protected + procedure WriteSurface(const AFlux: TStream); + public + constructor CreateSurface(const APoints: T_Points); + destructor Destroy; override; + end; TPdfImage = class(TPdfObjet) - private - FNumber: Integer; - FLeft: Single; - FBottom: Single; - FWidth: Integer; - FHeight: Integer; - protected - function WriteImageStream(const ANumber: Integer; AFlux: TStream): Int64; - procedure WriteImage(const AFlux: TStream); - public - constructor CreateImage(const ALeft,ABottom: Single; AWidth,AHeight,ANumber: Integer); - destructor Destroy; override; - end; + private + FNumber: integer; + FLeft: single; + FBottom: single; + FWidth: integer; + FHeight: integer; + protected + function WriteImageStream(const ANumber: integer; AFlux: TStream): int64; + procedure WriteImage(const AFlux: TStream); + public + constructor CreateImage(const ALeft, ABottom: single; AWidth, AHeight, ANumber: integer); + destructor Destroy; override; + end; TPdfLineStyle = class(TPdfObjet) - private - FDash: TfpgLineStyle; - FPhase: Integer; - protected - procedure WriteLineStyle(const AFlux: TStream); - public - constructor CreateLineStyle(ADash: TfpgLineStyle; APhase: Integer); - destructor Destroy; override; - end; + private + FDash: TfpgLineStyle; + FPhase: integer; + protected + procedure WriteLineStyle(const AFlux: TStream); + public + constructor CreateLineStyle(ADash: TfpgLineStyle; APhase: integer); + destructor Destroy; override; + end; TPdfColor = class(TPdfObjet) - private - FRed: string; - FGreen: string; - FBlue: string; - FStroke: Boolean; - protected - procedure WriteColor(const AFlux: TStream); - public - constructor CreateColor(const AStroke: Boolean; AColor: TfpgColor); - destructor Destroy; override; - end; + private + FRed: string; + FGreen: string; + FBlue: string; + FStroke: Boolean; + protected + procedure WriteColor(const AFlux: TStream); + public + constructor CreateColor(const AStroke: Boolean; AColor: TfpgColor); + destructor Destroy; override; + end; TPdfDicElement = class(TObject) - private - FKey: TPdfName; - FValue: TPdfObjet; - protected - procedure WriteDicElement(const AFlux: TStream); - public - constructor CreateDicElement(const AKey: string; const AValue: TPdfObjet); - destructor Destroy; override; - end; + private + FKey: TPdfName; + FValue: TPdfObjet; + protected + procedure WriteDicElement(const AFlux: TStream); + public + constructor CreateDicElement(const AKey: string; const AValue: TPdfObjet); + destructor Destroy; override; + end; TPdfDictionary = class(TPdfObjet) - private - FElement: TList; // list of TPdfDicElement - protected - procedure AddElement(const AKey: string; const AValue: TPdfObjet); - function ElementParCle(const AValue: string): Integer; - procedure WriteDictionary(const AObjet: Integer; const AFlux: TStream); - public - constructor CreateDictionary; - destructor Destroy; override; - end; + private + FElement: TList; // list of TPdfDicElement + protected + procedure AddElement(const AKey: string; const AValue: TPdfObjet); + function ElementParCle(const AValue: string): integer; + procedure WriteDictionary(const AObjet: integer; const AFlux: TStream); + public + constructor CreateDictionary; + destructor Destroy; override; + end; TPdfXRef = class(TObject) - private - FOffset: Integer; - FObjet: TPdfDictionary; - FStream: TPdfStream; - protected - procedure WriteXRef(const AFlux: TStream); - public - constructor CreateXRef; - destructor Destroy; override; - property Offset: Integer read FOffset write FOffset; - end; + private + FOffset: integer; + FObjet: TPdfDictionary; + FStream: TPdfStream; + protected + procedure WriteXRef(const AFlux: TStream); + public + constructor CreateXRef; + destructor Destroy; override; + property Offset: integer read FOffset write FOffset; + end; - TPageLayout= (lSingle,lTwo,lContinuous); + TPageLayout = (lSingle, lTwo, lContinuous); TPdfDocument = class(TObject) - private - FPreferences: Boolean; - FPageLayout: TPageLayout; - FZoomValue: string; - FXRefObjets: TList; // list of TPdfXRef - protected - function ElementParNom(const AValue: string): Integer; - procedure WriteXRefTable(const AFlux: TStream); - procedure WriteObjet(const AObjet: Integer; const AFlux: TStream); - procedure CreateRefTable; - procedure CreateTrailer; - function CreateCatalog: Integer; - procedure CreateInfo; - procedure CreatePreferences; - function CreatePages(Parent: Integer): Integer; - function CreatePage(Parent,Haut,Larg,PageNum: Integer): Integer; - function CreateOutlines: Integer; - function CreateOutline(Parent,SectNo,PageNo: Integer; SectTitre: string): Integer; - procedure CreateStdFont(NomFonte: string; NumFonte: Integer); - function LoadFont(NomFonte: string): string; - procedure CreateTtfFont(const NumFonte: Integer); - procedure CreateTp1Font(const NumFonte: Integer); - procedure CreateFontDescriptor(const NumFonte: Integer); - procedure CreateFontWidth; - procedure CreateFontFile(const NumFonte: Integer); - procedure CreateImage(ImgWidth,ImgHeight,NumImg: Integer); - function CreateContents: Integer; - procedure CreateStream(NumeroPage,PageNum: Integer); - public - constructor CreateDocument(const ALayout: TPageLayout= lSingle; const AZoom: string= '100'; const APreferences: Boolean= True); - destructor Destroy; override; - procedure WriteDocument(const AFlux: TStream); - property PageLayout: TPageLayout read FPageLayout write FPageLayout default lSingle; - end; + private + FPreferences: Boolean; + FPageLayout: TPageLayout; + FZoomValue: string; + FXRefObjets: TList; // list of TPdfXRef + protected + function ElementParNom(const AValue: string): integer; + procedure WriteXRefTable(const AFlux: TStream); + procedure WriteObjet(const AObjet: integer; const AFlux: TStream); + procedure CreateRefTable; + procedure CreateTrailer; + function CreateCatalog: integer; + procedure CreateInfo; + procedure CreatePreferences; + function CreatePages(Parent: integer): integer; + function CreatePage(Parent, Haut, Larg, PageNum: integer): integer; + function CreateOutlines: integer; + function CreateOutline(Parent, SectNo, PageNo: integer; SectTitre: string): integer; + procedure CreateStdFont(NomFonte: string; NumFonte: integer); + function LoadFont(NomFonte: string): string; + procedure CreateTtfFont(const NumFonte: integer); + procedure CreateTp1Font(const NumFonte: integer); + procedure CreateFontDescriptor(const NumFonte: integer); + procedure CreateFontWidth; + procedure CreateFontFile(const NumFonte: integer); + procedure CreateImage(ImgWidth, ImgHeight, NumImg: integer); + function CreateContents: integer; + procedure CreateStream(NumeroPage, PageNum: integer); + public + constructor CreateDocument(const ALayout: TPageLayout = lSingle; const AZoom: string = '100'; const APreferences: Boolean = True); + destructor Destroy; override; + procedure WriteDocument(const AFlux: TStream); + property PageLayout: TPageLayout read FPageLayout write FPageLayout default lSingle; + end; TFontDef = record FType: string; @@ -310,34 +312,35 @@ type FEncoding: string; FFile: string; FOriginalSize: string; - FDiffs: widestring; - FCharWidth: widestring; - end; + FDiffs: WideString; + FCharWidth: WideString; + end; const - CRLF= #13#10; - PDF_VERSION= '%PDF-1.3'; - PDF_FILE_END= '%%EOF'; - PDF_MAX_GEN_NUM= 65535; + CRLF = #13#10; + PDF_VERSION = '%PDF-1.3'; + PDF_FILE_END = '%%EOF'; + PDF_MAX_GEN_NUM = 65535; PDF_UNICODE_HEADER = 'FEFF001B%s001B'; PDF_LANG_STRING = 'fr'; var Document: TPdfDocument; - OldDecSeparator: Char; + OldDecSeparator: char; Outline: Boolean; FontDirectory: string; implementation uses - U_Report, U_Command; + U_Report, + U_Command; var Trailer: TPdfDictionary; CurrentColor: string; CurrentWidth: string; - Catalogue: Integer; + Catalogue: integer; FontDef: TFontDef; Flux: TMemoryStream; FontFiles: array of string; @@ -348,86 +351,80 @@ function InsertEscape(const AValue: string): string; var Chaine: string; begin -Result:= ''; -Chaine:= AValue; -if Pos('\',Chaine)> 0 -then - Chaine:= AnsiReplaceStr(Chaine,'\','\\'); -if Pos('(',Chaine)> 0 -then - Chaine:= AnsiReplaceStr(Chaine,'(','\('); -if Pos(')',Chaine)> 0 -then - Chaine:= AnsiReplaceStr(Chaine,')','\)'); -Result:= Chaine; -//while Pos('\',Chaine)> 0 do -// begin -// Result:= Result+Copy(Chaine,1,Pred(Pos('\',Chaine)))+'\\'; -// Chaine:= Copy(Chaine,Succ(Pos('\',Chaine)),Length(Chaine)-Pos('\',Chaine)); -// end; -//Chaine:= Result+Chaine; -//Result:= ''; -//while Pos('(',Chaine)> 0 do -// begin -// Result:= Result+Copy(Chaine,1,Pred(Pos('(',Chaine)))+'\('; -// Chaine:= Copy(Chaine,Succ(Pos('(',Chaine)),Length(Chaine)-Pos('(',Chaine)); -// end; -//Chaine:= Result+Chaine; -//Result:= ''; -//while Pos(')',Chaine)> 0 do -// begin -// Result:= Result+Copy(Chaine,1,Pred(Pos(')',Chaine)))+'\)'; -// Chaine:= Copy(Chaine,Succ(Pos(')',Chaine)),Length(Chaine)-Pos(')',Chaine)); -// end; -//Result:= Result+Chaine; + Result := ''; + Chaine := AValue; + if Pos('\', Chaine) > 0 then + Chaine := AnsiReplaceStr(Chaine, '\', '\\'); + if Pos('(', Chaine) > 0 then + Chaine := AnsiReplaceStr(Chaine, '(', '\('); + if Pos(')', Chaine) > 0 then + Chaine := AnsiReplaceStr(Chaine, ')', '\)'); + Result := Chaine; + //while Pos('\',Chaine)> 0 do + // begin + // Result:= Result+Copy(Chaine,1,Pred(Pos('\',Chaine)))+'\\'; + // Chaine:= Copy(Chaine,Succ(Pos('\',Chaine)),Length(Chaine)-Pos('\',Chaine)); + // end; + //Chaine:= Result+Chaine; + //Result:= ''; + //while Pos('(',Chaine)> 0 do + // begin + // Result:= Result+Copy(Chaine,1,Pred(Pos('(',Chaine)))+'\('; + // Chaine:= Copy(Chaine,Succ(Pos('(',Chaine)),Length(Chaine)-Pos('(',Chaine)); + // end; + //Chaine:= Result+Chaine; + //Result:= ''; + //while Pos(')',Chaine)> 0 do + // begin + // Result:= Result+Copy(Chaine,1,Pred(Pos(')',Chaine)))+'\)'; + // Chaine:= Copy(Chaine,Succ(Pos(')',Chaine)),Length(Chaine)-Pos(')',Chaine)); + // end; + //Result:= Result+Chaine; end; procedure WriteChaine(const Valeur: string; AFlux: TStream); begin -AFlux.Write(PChar(Valeur)^,Length(Valeur)); + AFlux.Write(PChar(Valeur)^, Length(Valeur)); end; -function IntToChaine(const Valeur: Integer; const Long: Integer): string; +function IntToChaine(const Valeur: integer; const Long: integer): string; var Chaine: string; - Cpt: Integer; + Cpt: integer; begin -Result:= ''; -Chaine:= IntToStr(Valeur); -if Length(Chaine)< Long -then - for Cpt:= Succ(Length(Chaine)) to Long do - Result:= Result+'0'; -Result:= Result+Chaine; + Result := ''; + Chaine := IntToStr(Valeur); + if Length(Chaine) < Long then + for Cpt := Succ(Length(Chaine)) to Long do + Result := Result + '0'; + Result := Result + Chaine; end; function DateToPdfDate(const ADate: TDateTime): string; begin -Result:= FormatDateTime('"D:"yyyymmddhhnnss',ADate); + Result := FormatDateTime('"D:"yyyymmddhhnnss', ADate); end; function ExtractBaseFontName(const AValue: string): string; var - FontName,Chaine1,Chaine2: string; + FontName, Chaine1, Chaine2: string; begin -FontName:= Copy(AValue,1,Pred(Pos('-',AValue))); -if Pos(':',AValue)> 0 -then + FontName := Copy(AValue, 1, Pred(Pos('-', AValue))); + if Pos(':', AValue) > 0 then begin - Chaine1:= Copy(AValue,Succ(Pos(':',AValue)),Length(AValue)-Pos(':',AValue)); - Chaine1:= Uppercase(Chaine1[1])+Copy(Chaine1,2,Pred(Length(Chaine1))); - if Pos(':',Chaine1)> 0 - then + Chaine1 := Copy(AValue, Succ(Pos(':', AValue)), Length(AValue) - Pos(':', AValue)); + Chaine1 := Uppercase(Chaine1[1]) + Copy(Chaine1, 2, Pred(Length(Chaine1))); + if Pos(':', Chaine1) > 0 then begin - Chaine2:= Copy(Chaine1,Succ(Pos(':',Chaine1)),Length(Chaine1)-Pos(':',Chaine1)); - Chaine2:= Uppercase(Chaine2[1])+Copy(Chaine2,2,Pred(Length(Chaine2))); - Chaine1:= Copy(Chaine1,1,Pred(Pos(':',Chaine1))); - Chaine1:= Uppercase(Chaine1[1])+Copy(Chaine1,2,Pred(Length(Chaine1))); - Chaine1:= Chaine1+Chaine2; + Chaine2 := Copy(Chaine1, Succ(Pos(':', Chaine1)), Length(Chaine1) - Pos(':', Chaine1)); + Chaine2 := Uppercase(Chaine2[1]) + Copy(Chaine2, 2, Pred(Length(Chaine2))); + Chaine1 := Copy(Chaine1, 1, Pred(Pos(':', Chaine1))); + Chaine1 := Uppercase(Chaine1[1]) + Copy(Chaine1, 2, Pred(Length(Chaine1))); + Chaine1 := Chaine1 + Chaine2; end; - Chaine1:= '-'+Chaine1; + Chaine1 := '-' + Chaine1; end; -Result:= FontName+Chaine1; + Result := FontName + Chaine1; end; // object methods @@ -439,791 +436,723 @@ end; destructor TPdfObjet.Destroy; begin -inherited; + inherited; end; procedure TPdfBoolean.WriteBoolean(const AFlux: TStream); begin -if FValue -then - WriteChaine('true',AFlux) -else - WriteChaine('false',AFlux); + if FValue then + WriteChaine('true', AFlux) + else + WriteChaine('false', AFlux); end; constructor TPdfBoolean.CreateBoolean(const AValue: Boolean); begin -inherited Create; -FValue:= AValue; + inherited Create; + FValue := AValue; end; destructor TPdfBoolean.Destroy; begin -inherited; + inherited; end; procedure TPdfInteger.WriteInteger(const AFlux: TStream); begin -WriteChaine(IntToStr(FValue), AFlux); + WriteChaine(IntToStr(FValue), AFlux); end; procedure TPdfInteger.IncrementeInteger; begin -FValue:= FValue+1; + FValue := FValue + 1; end; -constructor TPdfInteger.CreateInteger(const AValue: Integer); +constructor TPdfInteger.CreateInteger(const AValue: integer); begin -inherited Create; -FValue:= AValue; + inherited Create; + FValue := AValue; end; destructor TPdfInteger.Destroy; begin -inherited; + inherited; end; procedure TPdfReference.WriteReference(const AFlux: TStream); begin -WriteChaine(IntToStr(FValue)+' 0 R',AFlux); + WriteChaine(IntToStr(FValue) + ' 0 R', AFlux); end; -constructor TPdfReference.CreateReference(const AValue: Integer); +constructor TPdfReference.CreateReference(const AValue: integer); begin -inherited Create; -FValue:= AValue; + inherited Create; + FValue := AValue; end; destructor TPdfReference.Destroy; begin -inherited; + inherited; end; procedure TPdfName.WriteName(const AFlux: TStream); begin -if FValue<> '' -then - if Pos('Length1',FValue)> 0 - then - WriteChaine('/Length1',AFlux) - else - WriteChaine('/'+FValue,AFlux); + if FValue <> '' then + if Pos('Length1', FValue) > 0 then + WriteChaine('/Length1', AFlux) + else + WriteChaine('/' + FValue, AFlux); end; constructor TPdfName.CreateName(const AValue: string); begin -inherited Create; -FValue:= AValue; + inherited Create; + FValue := AValue; end; destructor TPdfName.Destroy; begin -inherited; + inherited; end; procedure TPdfString.WriteString(const AFlux: TStream); begin -WriteChaine('('+Utf8ToAnsi(FValue)+')',AFlux); + WriteChaine('(' + Utf8ToAnsi(FValue) + ')', AFlux); end; constructor TPdfString.CreateString(const AValue: string); begin -inherited Create; -FValue:= AValue; -if (Pos('(',FValue)> 0) or (Pos(')',FValue)> 0) or (Pos('\',FValue)> 0) -then - FValue:= InsertEscape(FValue); + inherited Create; + FValue := AValue; + if (Pos('(', FValue) > 0) or (Pos(')', FValue) > 0) or (Pos('\', FValue) > 0) then + FValue := InsertEscape(FValue); end; destructor TPdfString.Destroy; begin -inherited; + inherited; end; procedure TPdfArray.WriteArray(const AFlux: TStream); var - Cpt: Integer; + Cpt: integer; begin -WriteChaine('[',AFlux); -for Cpt:= 0 to Pred(FArray.Count) do + WriteChaine('[', AFlux); + for Cpt := 0 to Pred(FArray.Count) do begin - if Cpt> 0 - then - WriteChaine(' ',AFlux); - if TPdfObjet(FArray[Cpt]) is TPdfInteger - then - TPdfInteger(FArray[Cpt]).WriteInteger(AFlux); - if TPdfObjet(FArray[Cpt]) is TPdfReference - then - TPdfReference(FArray[Cpt]).WriteReference(AFlux); - if TPdfObjet(FArray[Cpt]) is TPdfName - then - TPdfName(FArray[Cpt]).WriteName(AFlux); + if Cpt > 0 then + WriteChaine(' ', AFlux); + if TPdfObjet(FArray[Cpt]) is TPdfInteger then + TPdfInteger(FArray[Cpt]).WriteInteger(AFlux); + if TPdfObjet(FArray[Cpt]) is TPdfReference then + TPdfReference(FArray[Cpt]).WriteReference(AFlux); + if TPdfObjet(FArray[Cpt]) is TPdfName then + TPdfName(FArray[Cpt]).WriteName(AFlux); end; -WriteChaine(']',AFlux); + WriteChaine(']', AFlux); end; procedure TPdfArray.AddItem(const AValue: TPdfObjet); begin -FArray.Add(AValue); + FArray.Add(AValue); end; constructor TPdfArray.CreateArray; begin -inherited Create; -FArray:= TList.Create; + inherited Create; + FArray := TList.Create; end; destructor TPdfArray.Destroy; var - Cpt: Integer; -begin -if FArray.Count> 0 -then - for Cpt:= 0 to Pred(FArray.Count) do - if TPdfObjet(FArray[Cpt]) is TPdfInteger - then - TPdfInteger(FArray[Cpt]).Free - else - if TPdfObjet(FArray[Cpt]) is TPdfReference - then + Cpt: integer; +begin + if FArray.Count > 0 then + for Cpt := 0 to Pred(FArray.Count) do + if TPdfObjet(FArray[Cpt]) is TPdfInteger then + TPdfInteger(FArray[Cpt]).Free + else if TPdfObjet(FArray[Cpt]) is TPdfReference then TPdfReference(FArray[Cpt]).Free - else - if TPdfObjet(FArray[Cpt]) is TPdfName - then - TPdfName(FArray[Cpt]).Free; -FArray.Free; -inherited; + else if TPdfObjet(FArray[Cpt]) is TPdfName then + TPdfName(FArray[Cpt]).Free; + FArray.Free; + inherited; end; procedure TPdfStream.WriteStream(const AFlux: TStream); var - Cpt: Integer; + Cpt: integer; begin -for Cpt:= 0 to Pred(FStream.Count) do + for Cpt := 0 to Pred(FStream.Count) do begin - if TPdfObjet(FStream[Cpt]) is TPdfFonte - then - TPdfFonte(FStream[Cpt]).WriteFonte(AFlux); - if TPdfObjet(FStream[Cpt]) is TPdfColor - then - TPdfColor(FStream[Cpt]).WriteColor(AFlux); - if TPdfObjet(FStream[Cpt]) is TPdfText - then - TPdfText(FStream[Cpt]).WriteText(AFlux); - if TPdfObjet(FStream[Cpt]) is TPdfRectangle - then - TPdfRectangle(FStream[Cpt]).WriteRectangle(AFlux); - if TPdfObjet(FStream[Cpt]) is TPdfLigne - then - TPdfLigne(FStream[Cpt]).WriteLigne(AFlux); - if TPdfObjet(FStream[Cpt]) is TPdfLineStyle - then - TPdfLineStyle(FStream[Cpt]).WriteLineStyle(AFlux); - if TPdfObjet(FStream[Cpt]) is TPdfSurface - then - TPdfSurface(FStream[Cpt]).WriteSurface(AFlux); - if TPdfObjet(FStream[Cpt]) is TPdfImage - then - TPdfImage(FStream[Cpt]).WriteImage(AFlux); + if TPdfObjet(FStream[Cpt]) is TPdfFonte then + TPdfFonte(FStream[Cpt]).WriteFonte(AFlux); + if TPdfObjet(FStream[Cpt]) is TPdfColor then + TPdfColor(FStream[Cpt]).WriteColor(AFlux); + if TPdfObjet(FStream[Cpt]) is TPdfText then + TPdfText(FStream[Cpt]).WriteText(AFlux); + if TPdfObjet(FStream[Cpt]) is TPdfRectangle then + TPdfRectangle(FStream[Cpt]).WriteRectangle(AFlux); + if TPdfObjet(FStream[Cpt]) is TPdfLigne then + TPdfLigne(FStream[Cpt]).WriteLigne(AFlux); + if TPdfObjet(FStream[Cpt]) is TPdfLineStyle then + TPdfLineStyle(FStream[Cpt]).WriteLineStyle(AFlux); + if TPdfObjet(FStream[Cpt]) is TPdfSurface then + TPdfSurface(FStream[Cpt]).WriteSurface(AFlux); + if TPdfObjet(FStream[Cpt]) is TPdfImage then + TPdfImage(FStream[Cpt]).WriteImage(AFlux); end; end; procedure TPdfStream.AddItem(const AValue: TPdfObjet); begin -FStream.Add(AValue); + FStream.Add(AValue); end; constructor TPdfStream.CreateStream; begin -inherited Create; -FStream:= TList.Create; + inherited Create; + FStream := TList.Create; end; destructor TPdfStream.Destroy; var - Cpt: Integer; -begin -if FStream.Count> 0 -then - for Cpt:= 0 to Pred(FStream.Count) do - if TPdfObjet(FStream[Cpt]) is TPdfFonte - then - TPdfFonte(FStream[Cpt]).Free - else - if TPdfObjet(FStream[Cpt]) is TPdfColor - then + Cpt: integer; +begin + if FStream.Count > 0 then + begin + for Cpt := 0 to Pred(FStream.Count) do + begin + if TPdfObjet(FStream[Cpt]) is TPdfFonte then + TPdfFonte(FStream[Cpt]).Free + else if TPdfObjet(FStream[Cpt]) is TPdfColor then TPdfColor(FStream[Cpt]).Free - else - if TPdfObjet(FStream[Cpt]) is TPdfText - then - TPdfText(FStream[Cpt]).Free - else - if TPdfObjet(FStream[Cpt]) is TPdfRectangle - then - TPdfRectangle(FStream[Cpt]).Free - else - if TPdfObjet(FStream[Cpt]) is TPdfLigne - then - TPdfLigne(FStream[Cpt]).Free - else - if TPdfObjet(FStream[Cpt]) is TPdfLineStyle - then - TPdfLineStyle(FStream[Cpt]).Free - else - if TPdfObjet(FStream[Cpt]) is TPdfSurface - then - TPdfSurface(FStream[Cpt]).Free - else - if TPdfObjet(FStream[Cpt]) is TPdfImage - then - TPdfImage(FStream[Cpt]).Free; -FStream.Free; -inherited; + else if TPdfObjet(FStream[Cpt]) is TPdfText then + TPdfText(FStream[Cpt]).Free + else if TPdfObjet(FStream[Cpt]) is TPdfRectangle then + TPdfRectangle(FStream[Cpt]).Free + else if TPdfObjet(FStream[Cpt]) is TPdfLigne then + TPdfLigne(FStream[Cpt]).Free + else if TPdfObjet(FStream[Cpt]) is TPdfLineStyle then + TPdfLineStyle(FStream[Cpt]).Free + else if TPdfObjet(FStream[Cpt]) is TPdfSurface then + TPdfSurface(FStream[Cpt]).Free + else if TPdfObjet(FStream[Cpt]) is TPdfImage then + TPdfImage(FStream[Cpt]).Free; + end; + end; + FStream.Free; + inherited; end; procedure TPdfFonte.WriteFonte(const AFlux: TStream); begin -WriteChaine('/F'+IntToStr(FTxtFont)+' '+FTxtSize+' Tf'+CRLF,AFlux); + WriteChaine('/F' + IntToStr(FTxtFont) + ' ' + FTxtSize + ' Tf' + CRLF, AFlux); end; -function TPdfFonte.WriteFonteStream(const FFlux: TMemoryStream; const AFlux: TStream): Int64; +function TPdfFonte.WriteFonteStream(const FFlux: TMemoryStream; const AFlux: TStream): int64; var - BeginFlux,EndFlux: Int64; + BeginFlux, EndFlux: int64; begin -WriteChaine(CRLF+'stream'+CRLF,AFlux); -BeginFlux:= AFlux.Position; -FFlux.SaveToStream(AFlux); -EndFlux:= AFlux.Position; -Result:= EndFlux-BeginFlux; -WriteChaine(CRLF,AFlux); -WriteChaine('endstream',AFlux); + WriteChaine(CRLF + 'stream' + CRLF, AFlux); + BeginFlux := AFlux.Position; + FFlux.SaveToStream(AFlux); + EndFlux := AFlux.Position; + Result := EndFlux - BeginFlux; + WriteChaine(CRLF, AFlux); + WriteChaine('endstream', AFlux); end; -constructor TPdfFonte.CreateFonte(const AFont: Integer; const ASize: string); +constructor TPdfFonte.CreateFonte(const AFont: integer; const ASize: string); begin -inherited Create; -FTxtFont:= AFont; -FTxtSize:= ASize; + inherited Create; + FTxtFont := AFont; + FTxtSize := ASize; end; destructor TPdfFonte.Destroy; begin -inherited; + inherited; end; procedure TPdfText.WriteText(const AFlux: TStream); begin -WriteChaine('BT'+CRLF,AFlux); -WriteChaine(FormatFloat('0.##',FTxtPosX)+' '+FormatFloat('0.##',FTxtPosY)+' Td'+CRLF,AFlux); -TPdfString(FTxtText).WriteString(AFlux); -WriteChaine(' Tj'+CRLF,AFlux); -WriteChaine('ET'+CRLF,AFlux); + WriteChaine('BT' + CRLF, AFlux); + WriteChaine(FormatFloat('0.##', FTxtPosX) + ' ' + FormatFloat('0.##', FTxtPosY) + ' Td' + CRLF, AFlux); + TPdfString(FTxtText).WriteString(AFlux); + WriteChaine(' Tj' + CRLF, AFlux); + WriteChaine('ET' + CRLF, AFlux); end; -constructor TPdfText.CreateText(const APosX,APosY: Single; const AText: string); +constructor TPdfText.CreateText(const APosX, APosY: single; const AText: string); begin -inherited Create; -FTxtPosX:= APosX; -FTxtPosY:= APosY; -FTxtText:= TPdfString.CreateString(AText); + inherited Create; + FTxtPosX := APosX; + FTxtPosY := APosY; + FTxtText := TPdfString.CreateString(AText); end; destructor TPdfText.Destroy; begin -FTxtText.Free; -inherited; + FTxtText.Free; + inherited; end; procedure TPdfLigne.WriteLigne(const AFlux: TStream); begin -if (FormatFloat('0.##',FEpais)+' w')<> CurrentWidth -then + if (FormatFloat('0.##', FEpais) + ' w') <> CurrentWidth then begin - WriteChaine('1 J'+CRLF,AFlux); - WriteChaine(FormatFloat('0.##',FEpais)+' w'+CRLF,AFlux); - CurrentWidth:= FormatFloat('0.##',FEpais)+' w'; + WriteChaine('1 J' + CRLF, AFlux); + WriteChaine(FormatFloat('0.##', FEpais) + ' w' + CRLF, AFlux); + CurrentWidth := FormatFloat('0.##', FEpais) + ' w'; end; -WriteChaine(FormatFloat('0.##',FStaX)+' '+FormatFloat('0.##',FStaY)+' m'+CRLF,AFlux); -WriteChaine(FormatFloat('0.##',FEndX)+' '+FormatFloat('0.##',FEndY)+' l'+CRLF,AFlux); -WriteChaine('S'+CRLF,AFlux); + WriteChaine(FormatFloat('0.##', FStaX) + ' ' + FormatFloat('0.##', FStaY) + ' m' + CRLF, AFlux); + WriteChaine(FormatFloat('0.##', FEndX) + ' ' + FormatFloat('0.##', FEndY) + ' l' + CRLF, AFlux); + WriteChaine('S' + CRLF, AFlux); end; -constructor TPdfLigne.CreateLigne(const AEpais,AStaX,AStaY,AEndX,AEndY: Single); +constructor TPdfLigne.CreateLigne(const AEpais, AStaX, AStaY, AEndX, AEndY: single); begin -inherited Create; -FEpais:= AEpais; -FStaX:= AStaX; -FStaY:= AStaY; -FEndX:= AEndX; -FEndY:= AEndY; + inherited Create; + FEpais := AEpais; + FStaX := AStaX; + FStaY := AStaY; + FEndX := AEndX; + FEndY := AEndY; end; destructor TPdfLigne.Destroy; begin -inherited; + inherited; end; procedure TPdfRectangle.WriteRectangle(const AFlux: TStream); begin -if FStroke -then - if (FormatFloat('0.##',FEpais)+' w')<> CurrentWidth - then + if FStroke then + begin + if (FormatFloat('0.##', FEpais) + ' w') <> CurrentWidth then begin - WriteChaine('1 J'+CRLF,AFlux); - WriteChaine(FormatFloat('0.##',FEpais)+' w'+CRLF,AFlux); - CurrentWidth:= FormatFloat('0.##',FEpais)+' w'; + WriteChaine('1 J' + CRLF, AFlux); + WriteChaine(FormatFloat('0.##', FEpais) + ' w' + CRLF, AFlux); + CurrentWidth := FormatFloat('0.##', FEpais) + ' w'; end; -WriteChaine(FormatFloat('0.##',FRecX)+' '+FormatFloat('0.##',FRecY)+' '+FormatFloat('0.##',FRecW)+' '+FormatFloat('0.##',FRecH)+' re'+CRLF,AFlux); -if FStroke -then - WriteChaine('S'+CRLF,AFlux); -if FFill -then - WriteChaine('f'+CRLF,AFlux); + end; + WriteChaine(FormatFloat('0.##', FRecX) + ' ' + FormatFloat('0.##', FRecY) + ' ' + FormatFloat('0.##', FRecW) + ' ' + FormatFloat('0.##', FRecH) + ' re' + CRLF, AFlux); + if FStroke then + WriteChaine('S' + CRLF, AFlux); + if FFill then + WriteChaine('f' + CRLF, AFlux); end; -constructor TPdfRectangle.CreateRectangle(const AEpais,APosX,APosY,AWidth,AHeight: Single; const AFill,AStroke: Boolean); +constructor TPdfRectangle.CreateRectangle(const AEpais, APosX, APosY, AWidth, AHeight: single; const AFill, AStroke: Boolean); begin -inherited Create; -FEpais:= AEpais; -FRecX:= APosX; -FRecY:= APosY; -FRecW:= AWidth; -FRecH:= AHeight; -FFill:= AFill; -FStroke:= AStroke; + inherited Create; + FEpais := AEpais; + FRecX := APosX; + FRecY := APosY; + FRecW := AWidth; + FRecH := AHeight; + FFill := AFill; + FStroke := AStroke; end; destructor TPdfRectangle.Destroy; begin -inherited; + inherited; end; procedure TPdfSurface.WriteSurface(const AFlux: TStream); var - Cpt: Integer; + Cpt: integer; begin -WriteChaine(FormatFloat('0.##',FPoints[0].X)+' '+FormatFloat('0.##',FPoints[0].Y)+' m'+CRLF,AFlux); -for Cpt:= 1 to Pred(Length(FPoints)) do - WriteChaine(FormatFloat('0.##',FPoints[Cpt].X)+' '+FormatFloat('0.##',FPoints[Cpt].Y)+' l'+CRLF,AFlux); -WriteChaine('h'+CRLF,AFlux); -WriteChaine('f'+CRLF,AFlux); + WriteChaine(FormatFloat('0.##', FPoints[0].X) + ' ' + FormatFloat('0.##', FPoints[0].Y) + ' m' + CRLF, AFlux); + for Cpt := 1 to Pred(Length(FPoints)) do + WriteChaine(FormatFloat('0.##', FPoints[Cpt].X) + ' ' + FormatFloat('0.##', FPoints[Cpt].Y) + ' l' + CRLF, AFlux); + WriteChaine('h' + CRLF, AFlux); + WriteChaine('f' + CRLF, AFlux); end; constructor TPdfSurface.CreateSurface(const APoints: T_Points); begin -inherited Create; -FPoints:= APoints; + inherited Create; + FPoints := APoints; end; destructor TPdfSurface.Destroy; begin -inherited; + inherited; end; -function TPdfImage.WriteImageStream(const ANumber: Integer; AFlux: TStream): Int64; +function TPdfImage.WriteImageStream(const ANumber: integer; AFlux: TStream): int64; var - CptW,CptH: Integer; - BeginFlux,EndFlux: Int64; + CptW, CptH: integer; + BeginFlux, EndFlux: int64; begin -WriteChaine(CRLF+'stream'+CRLF,AFlux); -BeginFlux:= AFlux.Position; -for CptH:= 0 to Pred(TfpgImage(Images[ANumber]).Height) do - for CptW:= 0 to Pred(TfpgImage(Images[ANumber]).Width) do + WriteChaine(CRLF + 'stream' + CRLF, AFlux); + BeginFlux := AFlux.Position; + for CptH := 0 to Pred(TfpgImage(Images[ANumber]).Height) do + begin + for CptW := 0 to Pred(TfpgImage(Images[ANumber]).Width) do begin - AFlux.WriteByte(fpgGetRed(TfpgImage(Images[ANumber]).Colors[CptW,CptH])); - AFlux.WriteByte(fpgGetGreen(TfpgImage(Images[ANumber]).Colors[CptW,CptH])); - AFlux.WriteByte(fpgGetBlue(TfpgImage(Images[ANumber]).Colors[CptW,CptH])); + AFlux.WriteByte(fpgGetRed(TfpgImage(Images[ANumber]).Colors[CptW, CptH])); + AFlux.WriteByte(fpgGetGreen(TfpgImage(Images[ANumber]).Colors[CptW, CptH])); + AFlux.WriteByte(fpgGetBlue(TfpgImage(Images[ANumber]).Colors[CptW, CptH])); end; -EndFlux:= AFlux.Position; -Result:= EndFlux-BeginFlux; -WriteChaine(CRLF,AFlux); -WriteChaine('endstream',AFlux); + end; + EndFlux := AFlux.Position; + Result := EndFlux - BeginFlux; + WriteChaine(CRLF, AFlux); + WriteChaine('endstream', AFlux); end; procedure TPdfImage.WriteImage(const AFlux: TStream); begin -WriteChaine('q'+CRLF,AFlux); -WriteChaine(IntToStr(FWidth)+' 0 0 '+IntToStr(FHeight)+' '+FormatFloat('0.##',FLeft)+' ' - +FormatFloat('0.##',FBottom)+' cm'+CRLF,AFlux); -WriteChaine('/I'+IntToStr(FNumber)+' Do '+CRLF,AFlux); -WriteChaine('Q'+CRLF,AFlux); + WriteChaine('q' + CRLF, AFlux); + WriteChaine(IntToStr(FWidth) + ' 0 0 ' + IntToStr(FHeight) + ' ' + FormatFloat('0.##', FLeft) + ' ' + FormatFloat('0.##', FBottom) + ' cm' + CRLF, AFlux); + WriteChaine('/I' + IntToStr(FNumber) + ' Do ' + CRLF, AFlux); + WriteChaine('Q' + CRLF, AFlux); end; -constructor TPdfImage.CreateImage(const ALeft,ABottom: Single; AWidth,AHeight,ANumber: Integer); +constructor TPdfImage.CreateImage(const ALeft, ABottom: single; AWidth, AHeight, ANumber: integer); begin -inherited Create; -FNumber:= ANumber; -FLeft:= ALeft; -FBottom:= ABottom; -FWidth:= AWidth; -FHeight:= AHeight; + inherited Create; + FNumber := ANumber; + FLeft := ALeft; + FBottom := ABottom; + FWidth := AWidth; + FHeight := AHeight; end; destructor TPdfImage.Destroy; begin -inherited; + inherited; end; procedure TPdfLineStyle.WriteLineStyle(const AFlux: TStream); begin -WriteChaine('[',AFlux); -case FDash of - lsDash: - WriteChaine('5 5',AFlux); - lsDot: - WriteChaine('2 2',AFlux); - lsDashDot: - WriteChaine('5 2 2 2',AFlux); - lsDashDotDot: - WriteChaine('5 2 2 2 2 2',AFlux); + WriteChaine('[', AFlux); + case FDash of + lsDash: + WriteChaine('5 5', AFlux); + lsDot: + WriteChaine('2 2', AFlux); + lsDashDot: + WriteChaine('5 2 2 2', AFlux); + lsDashDotDot: + WriteChaine('5 2 2 2 2 2', AFlux); end; -WriteChaine('] '+IntToStr(FPhase)+' d'+CRLF,AFlux); + WriteChaine('] ' + IntToStr(FPhase) + ' d' + CRLF, AFlux); end; -constructor TPdfLineStyle.CreateLineStyle(ADash: TfpgLineStyle; APhase: Integer); +constructor TPdfLineStyle.CreateLineStyle(ADash: TfpgLineStyle; APhase: integer); begin -inherited Create; -FDash:= ADash; -FPhase:= APhase; + inherited Create; + FDash := ADash; + FPhase := APhase; end; destructor TPdfLineStyle.Destroy; begin -inherited; + inherited; end; procedure TPdfColor.WriteColor(const AFlux: TStream); begin -if FStroke -then + if FStroke then begin - if (FRed+' '+FGreen+' '+FBlue+' rg')<> CurrentColor - then + if (FRed + ' ' + FGreen + ' ' + FBlue + ' rg') <> CurrentColor then begin - WriteChaine(FRed+' '+FGreen+' '+FBlue+' rg'+CRLF,AFlux); - CurrentColor:= FRed+' '+FGreen+' '+FBlue+' rg'; + WriteChaine(FRed + ' ' + FGreen + ' ' + FBlue + ' rg' + CRLF, AFlux); + CurrentColor := FRed + ' ' + FGreen + ' ' + FBlue + ' rg'; end; end -else - if (FRed+' '+FGreen+' '+FBlue+' RG')<> CurrentColor - then - begin - WriteChaine(FRed+' '+FGreen+' '+FBlue+' RG'+CRLF,AFlux); - CurrentColor:= FRed+' '+FGreen+' '+FBlue+' RG'; - end; + else if (FRed + ' ' + FGreen + ' ' + FBlue + ' RG') <> CurrentColor then + begin + WriteChaine(FRed + ' ' + FGreen + ' ' + FBlue + ' RG' + CRLF, AFlux); + CurrentColor := FRed + ' ' + FGreen + ' ' + FBlue + ' RG'; + end; end; constructor TPdfColor.CreateColor(const AStroke: Boolean; AColor: TfpgColor); begin inherited Create; - FBlue := FormatFloat('0.##', fpgGetBlue(AColor)/256); - FGreen := FormatFloat('0.##', fpgGetGreen(AColor)/256); - FRed := FormatFloat('0.##', fpgGetRed(AColor)/256); + FBlue := FormatFloat('0.##', fpgGetBlue(AColor) / 256); + FGreen := FormatFloat('0.##', fpgGetGreen(AColor) / 256); + FRed := FormatFloat('0.##', fpgGetRed(AColor) / 256); FStroke := AStroke; end; destructor TPdfColor.Destroy; begin -inherited + inherited; end; procedure TPdfDicElement.WriteDicElement(const AFlux: TStream); begin -FKey.WriteName(AFlux); -WriteChaine(' ',AFlux); -if FValue is TPdfBoolean -then - TPdfBoolean(FValue).WriteBoolean(AFlux); -if FValue is TPdfInteger -then - TPdfInteger(FValue).WriteInteger(AFlux); -if FValue is TPdfReference -then - TPdfReference(FValue).WriteReference(AFlux); -if FValue is TPdfName -then - TPdfName(FValue).WriteName(AFlux); -if FValue is TPdfString -then - TPdfString(FValue).WriteString(AFlux); -if FValue is TPdfArray -then - TPdfArray(FValue).WriteArray(AFlux); -if FValue is TPdfDictionary -then - TPdfDictionary(FValue).WriteDictionary(-1,AFlux); -WriteChaine(CRLF,AFlux); + FKey.WriteName(AFlux); + WriteChaine(' ', AFlux); + if FValue is TPdfBoolean then + TPdfBoolean(FValue).WriteBoolean(AFlux); + if FValue is TPdfInteger then + TPdfInteger(FValue).WriteInteger(AFlux); + if FValue is TPdfReference then + TPdfReference(FValue).WriteReference(AFlux); + if FValue is TPdfName then + TPdfName(FValue).WriteName(AFlux); + if FValue is TPdfString then + TPdfString(FValue).WriteString(AFlux); + if FValue is TPdfArray then + TPdfArray(FValue).WriteArray(AFlux); + if FValue is TPdfDictionary then + TPdfDictionary(FValue).WriteDictionary(-1, AFlux); + WriteChaine(CRLF, AFlux); end; constructor TPdfDicElement.CreateDicElement(const AKey: string; const AValue: TPdfObjet); begin -inherited Create; -FKey:= TPdfName.CreateName(AKey); -FValue:= AValue; + inherited Create; + FKey := TPdfName.CreateName(AKey); + FValue := AValue; end; destructor TPdfDicElement.Destroy; begin -FKey.Free; -if FValue is TPdfBoolean -then - TPdfBoolean(FValue).Free -else - if FValue is TPdfDictionary - then + FKey.Free; + if FValue is TPdfBoolean then + TPdfBoolean(FValue).Free + else if FValue is TPdfDictionary then TPdfDictionary(FValue).Free - else - if FValue is TPdfInteger - then - TPdfInteger(FValue).Free - else - if FValue is TPdfName - then - TPdfName(FValue).Free - else - if FValue is TPdfReference - then - TPdfReference(FValue).Free - else - if FValue is TPdfString - then - TPdfString(FValue).Free - else - if FValue is TPdfArray - then - TPdfArray(FValue).Free; -inherited; + else if FValue is TPdfInteger then + TPdfInteger(FValue).Free + else if FValue is TPdfName then + TPdfName(FValue).Free + else if FValue is TPdfReference then + TPdfReference(FValue).Free + else if FValue is TPdfString then + TPdfString(FValue).Free + else if FValue is TPdfArray then + TPdfArray(FValue).Free; + inherited; end; procedure TPdfDictionary.AddElement(const AKey: string; const AValue: TPdfObjet); var DicElement: TPdfDicElement; begin -DicElement:= TPdfDicElement.CreateDicElement(AKey,AValue); -FElement.Add(DicElement); + DicElement := TPdfDicElement.CreateDicElement(AKey, AValue); + FElement.Add(DicElement); end; -function TPdfDictionary.ElementParCle(const AValue: string): Integer; +function TPdfDictionary.ElementParCle(const AValue: string): integer; var - Cpt: Integer; + Cpt: integer; begin -Result:= -1; -for Cpt:= 0 to Pred(FElement.Count) do - if TPdfDicElement(FElement[Cpt]).FKey.FValue= AValue - then + Result := -1; + for Cpt := 0 to Pred(FElement.Count) do + if TPdfDicElement(FElement[Cpt]).FKey.FValue = AValue then begin - Result:= Cpt; - Exit; + Result := Cpt; + Exit; end; end; -procedure TPdfDictionary.WriteDictionary(const AObjet: Integer; const AFlux: TStream); +procedure TPdfDictionary.WriteDictionary(const AObjet: integer; const AFlux: TStream); var Long: TPdfInteger; - Cpt,NumImg,NumFnt: Integer; + Cpt, NumImg, NumFnt: integer; Value: string; begin -if TPdfName(TPdfDicElement(FElement[0]).FKey).FValue= '' -then - TPdfDicElement(FElement[0]).WriteDicElement(AFlux) // write a charwidth array of a font -else + if TPdfName(TPdfDicElement(FElement[0]).FKey).FValue = '' then + TPdfDicElement(FElement[0]).WriteDicElement(AFlux) // write a charwidth array of a font + else begin - WriteChaine('<<'+CRLF,AFlux); - if FElement.Count> 0 - then - for Cpt:= 0 to Pred(FElement.Count) do - TPdfDicElement(FElement[Cpt]).WriteDicElement(AFlux); - NumImg:= -1; - NumFnt:= -1; - if FElement.Count> 0 - then - for Cpt:= 0 to Pred(FElement.Count) do - if AObjet> -1 - then + WriteChaine('<<' + CRLF, AFlux); + if FElement.Count > 0 then + for Cpt := 0 to Pred(FElement.Count) do + TPdfDicElement(FElement[Cpt]).WriteDicElement(AFlux); + NumImg := -1; + NumFnt := -1; + if FElement.Count > 0 then + begin + for Cpt := 0 to Pred(FElement.Count) do + begin + if AObjet > -1 then begin - if (TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue= 'Name') - then - if (TPdfObjet(TPdfDicElement(FElement[Cpt]).FValue) is TPdfName) - and (TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue[1]= 'I') - then + if (TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue = 'Name') then + begin + if (TPdfObjet(TPdfDicElement(FElement[Cpt]).FValue) is TPdfName) and (TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue[1] = 'I') then begin - NumImg:= StrToInt(Copy(TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue,2,Length(TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue)-1)); - Flux:= TMemoryStream.Create; - Flux.Position:= 0; -// write image stream length in xobject dictionary - Long:= TPdfInteger.CreateInteger(TPdfImage(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).WriteImageStream(NumImg,Flux)); - TPdfDictionary(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).AddElement('Length',Long); - TPdfDicElement(FElement[Pred(FElement.Count)]).WriteDicElement(AFlux); - Flux.Free; - WriteChaine('>>',AFlux); -// write image stream in xobject dictionary - TPdfImage(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).WriteImageStream(NumImg,AFlux); + NumImg := StrToInt(Copy(TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue, 2, Length(TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue) - 1)); + Flux := TMemoryStream.Create; + Flux.Position := 0; + // write image stream length in xobject dictionary + Long := TPdfInteger.CreateInteger(TPdfImage(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).WriteImageStream(NumImg, Flux)); + TPdfDictionary(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).AddElement('Length', Long); + TPdfDicElement(FElement[Pred(FElement.Count)]).WriteDicElement(AFlux); + Flux.Free; + WriteChaine('>>', AFlux); + // write image stream in xobject dictionary + TPdfImage(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).WriteImageStream(NumImg, AFlux); end; - if Pos('Length1',TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue)> 0 - then + end; + if Pos('Length1', TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue) > 0 then begin - Flux:= TMemoryStream.Create; - Value:= TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue; - NumFnt:= StrToInt(Copy(Value,Succ(Pos(' ',Value)),Length(Value)-Pos(' ',Value))); - Flux.LoadFromFile(FontFiles[NumFnt]); -// write fontfile stream length in xobject dictionary - Long:= TPdfInteger.CreateInteger(Flux.Size); - TPdfDictionary(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).AddElement('Length',Long); - TPdfDicElement(FElement[Pred(FElement.Count)]).WriteDicElement(AFlux); - WriteChaine('>>',AFlux); -// write fontfile stream in xobject dictionary - TPdfFonte(TPdfXRef(Document.FXRefObjets[NumFnt]).FObjet).WriteFonteStream(Flux,AFlux); - Flux.Free; + Flux := TMemoryStream.Create; + Value := TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue; + NumFnt := StrToInt(Copy(Value, Succ(Pos(' ', Value)), Length(Value) - Pos(' ', Value))); + Flux.LoadFromFile(FontFiles[NumFnt]); + // write fontfile stream length in xobject dictionary + Long := TPdfInteger.CreateInteger(Flux.Size); + TPdfDictionary(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).AddElement('Length', Long); + TPdfDicElement(FElement[Pred(FElement.Count)]).WriteDicElement(AFlux); + WriteChaine('>>', AFlux); + // write fontfile stream in xobject dictionary + TPdfFonte(TPdfXRef(Document.FXRefObjets[NumFnt]).FObjet).WriteFonteStream(Flux, AFlux); + Flux.Free; end; end; - if (NumImg= -1) and (NumFnt= -1) - then - WriteChaine('>>',AFlux); - end; + end; { for Cpt... } + end; { if FElement.Count... } + if (NumImg = -1) and (NumFnt = -1) then + WriteChaine('>>', AFlux); + end; { if/else } end; constructor TPdfDictionary.CreateDictionary; begin -inherited Create; -FElement:= TList.Create; + inherited Create; + FElement := TList.Create; end; destructor TPdfDictionary.Destroy; var Cpt: integer; begin -if FElement.Count> 0 -then - for Cpt:= 0 to Pred(FElement.Count) do - TPdfDicElement(FElement[Cpt]).Free; -FElement.Free; -inherited; + if FElement.Count > 0 then + for Cpt := 0 to Pred(FElement.Count) do + TPdfDicElement(FElement[Cpt]).Free; + FElement.Free; + inherited; end; procedure TPdfXRef.WriteXRef(const AFlux: TStream); begin -WriteChaine(IntToChaine(FOffset,10)+' '+IntToChaine(0,5)+' n'+CRLF,AFlux); + WriteChaine(IntToChaine(FOffset, 10) + ' ' + IntToChaine(0, 5) + ' n' + CRLF, AFlux); end; constructor TPdfXRef.CreateXRef; begin -inherited Create; -FOffset:= 0; -FObjet:= TpdfDictionary.CreateDictionary; -FStream:= nil; + inherited Create; + FOffset := 0; + FObjet := TpdfDictionary.CreateDictionary; + FStream := nil; end; destructor TPdfXRef.Destroy; begin -FObjet.Free; -FStream.Free; -inherited; + FObjet.Free; + FStream.Free; + inherited; end; -function TPdfDocument.ElementParNom(const AValue: string): Integer; +function TPdfDocument.ElementParNom(const AValue: string): integer; var - Cpt: Integer; + Cpt: integer; begin -for Cpt:= 1 to Pred(FXRefObjets.Count) do - if TPdfName(TPdfDicElement(TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet).FElement[0]).FValue).FValue= AValue - then - Result:= Cpt; + for Cpt := 1 to Pred(FXRefObjets.Count) do + if TPdfName(TPdfDicElement(TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet).FElement[0]).FValue).FValue = AValue then + Result := Cpt; end; procedure TPdfDocument.WriteXRefTable(const AFlux: TStream); var - Cpt: Integer; + Cpt: integer; begin -if FXRefObjets.Count> 1 -then - for Cpt:= 1 to Pred(FXRefObjets.Count) do - TPdfXRef(FXRefObjets[Cpt]).WriteXRef(AFlux); + if FXRefObjets.Count > 1 then + for Cpt := 1 to Pred(FXRefObjets.Count) do + TPdfXRef(FXRefObjets[Cpt]).WriteXRef(AFlux); end; -procedure TPdfDocument.WriteObjet(const AObjet: Integer; const AFlux: TStream); +procedure TPdfDocument.WriteObjet(const AObjet: integer; const AFlux: TStream); var Long: TPdfInteger; Flux: TMemoryStream; begin -WriteChaine(IntToStr(AObjet)+' 0 obj'+CRLF,AFlux); -if TPdfXRef(FXRefObjets[AObjet]).FStream= nil -then - TPdfDictionary(TPdfXRef(FXRefObjets[AObjet]).FObjet).WriteDictionary(AObjet,AFlux) -else + WriteChaine(IntToStr(AObjet) + ' 0 obj' + CRLF, AFlux); + if TPdfXRef(FXRefObjets[AObjet]).FStream = nil then + TPdfDictionary(TPdfXRef(FXRefObjets[AObjet]).FObjet).WriteDictionary(AObjet, AFlux) + else begin - Flux:= TMemoryStream.Create; - Flux.Position:= 0; - CurrentColor:= ''; - CurrentWidth:= ''; - TPdfXRef(FXRefObjets[AObjet]).FStream.WriteStream(Flux); -// write stream length element in contents dictionary - Long:= TPdfInteger.CreateInteger(Flux.Size); - TPdfDictionary(TPdfXRef(FXRefObjets[AObjet]).FObjet).AddElement('Length',Long); - Flux.Free; - TPdfXRef(FXRefObjets[AObjet]).FObjet.WriteDictionary(-1,AFlux); -// write stream in contents dictionary - CurrentColor:= ''; - CurrentWidth:= ''; - WriteChaine(CRLF+'stream'+CRLF,AFlux); - TPdfXRef(FXRefObjets[AObjet]).FStream.WriteStream(AFlux); - WriteChaine('endstream',AFlux); + Flux := TMemoryStream.Create; + Flux.Position := 0; + CurrentColor := ''; + CurrentWidth := ''; + TPdfXRef(FXRefObjets[AObjet]).FStream.WriteStream(Flux); + // write stream length element in contents dictionary + Long := TPdfInteger.CreateInteger(Flux.Size); + TPdfDictionary(TPdfXRef(FXRefObjets[AObjet]).FObjet).AddElement('Length', Long); + Flux.Free; + TPdfXRef(FXRefObjets[AObjet]).FObjet.WriteDictionary(-1, AFlux); + // write stream in contents dictionary + CurrentColor := ''; + CurrentWidth := ''; + WriteChaine(CRLF + 'stream' + CRLF, AFlux); + TPdfXRef(FXRefObjets[AObjet]).FStream.WriteStream(AFlux); + WriteChaine('endstream', AFlux); end; -WriteChaine(CRLF+'endobj'+CRLF+CRLF,AFlux); + WriteChaine(CRLF + 'endobj' + CRLF + CRLF, AFlux); end; procedure TPdfDocument.CreateRefTable; var XRefObjet: TPdfXRef; begin -FXRefObjets:= TList.Create; -// add first xref entry -XRefObjet:= TPdfXRef.CreateXRef; -FXRefObjets.Add(XRefObjet); + FXRefObjets := TList.Create; + // add first xref entry + XRefObjet := TPdfXRef.CreateXRef; + FXRefObjets.Add(XRefObjet); end; procedure TPdfDocument.CreateTrailer; var XRefObjets: TPdfInteger; begin -Trailer:= TPdfDictionary.CreateDictionary; -// add size trailer element -XRefObjets:= TPdfInteger.CreateInteger(FXRefObjets.Count); -Trailer.AddElement('Size',XRefObjets); + Trailer := TPdfDictionary.CreateDictionary; + // add size trailer element + XRefObjets := TPdfInteger.CreateInteger(FXRefObjets.Count); + Trailer.AddElement('Size', XRefObjets); end; -function TPdfDocument.CreateCatalog: Integer; +function TPdfDocument.CreateCatalog: integer; var Catalog: TPdfXRef; XRefObjets: TPdfReference; Nom: TPdfName; Table: TPdfArray; begin -// add xref entry -Catalog:= TPdfXRef.CreateXRef; -FXRefObjets.Add(Catalog); -// add root trailer element -XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); -Trailer.AddElement('Root',XRefObjets); -// add type element to catalog dictionary -Nom:= TPdfName.CreateName('Catalog'); -Catalog.FObjet.AddElement('Type',Nom); -// add pagelayout element to catalog dictionary -case FPageLayout of - lSingle: - Nom:= TPdfName.CreateName('SinglePage'); - lTwo: - Nom:= TPdfName.CreateName('TwoColumnLeft'); - lContinuous: - Nom:= TPdfName.CreateName('OneColumn'); + // add xref entry + Catalog := TPdfXRef.CreateXRef; + FXRefObjets.Add(Catalog); + // add root trailer element + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + Trailer.AddElement('Root', XRefObjets); + // add type element to catalog dictionary + Nom := TPdfName.CreateName('Catalog'); + Catalog.FObjet.AddElement('Type', Nom); + // add pagelayout element to catalog dictionary + case FPageLayout of + lSingle: + Nom := TPdfName.CreateName('SinglePage'); + lTwo: + Nom := TPdfName.CreateName('TwoColumnLeft'); + lContinuous: + Nom := TPdfName.CreateName('OneColumn'); end; -Catalog.FObjet.AddElement('PageLayout',Nom); -// add openaction element to catalog dictionary -Table:= TPdfArray.CreateArray; -Catalog.FObjet.AddElement('OpenAction',Table); -Result:= Pred(FXRefObjets.Count); + Catalog.FObjet.AddElement('PageLayout', Nom); + // add openaction element to catalog dictionary + Table := TPdfArray.CreateArray; + Catalog.FObjet.AddElement('OpenAction', Table); + Result := Pred(FXRefObjets.Count); end; procedure TPdfDocument.CreateInfo; @@ -1232,28 +1161,28 @@ var XRefObjets: TPdfReference; Nom: TPdfString; begin -// add xref entry -Info:= TPdfXRef.CreateXRef; -FXRefObjets.Add(Info); -// add info trailer element -XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); -Trailer.AddElement('Info',XRefObjets); -TPdfInteger(TPdfDicElement(Trailer.FElement[Trailer.ElementParCle('Size')]).FValue).FValue:= FXRefObjets.Count; -// add title element to info dictionary -Nom:= TPdfString.CreateString(Infos.Titre); -Info.FObjet.AddElement('Title',Nom); -// add author element to info dictionary -Nom:= TPdfString.CreateString(Infos.Auteur); -Info.FObjet.AddElement('Author',Nom); -// add creator element to info dictionary -Nom:= TPdfString.CreateString(ApplicationName); -Info.FObjet.AddElement('Creator',Nom); -// add producer element to info dictionary -Nom:= TPdfString.CreateString('fpGUI/FPC'); -Info.FObjet.AddElement('Producer',Nom); -// add creationdate element to info dictionary -Nom:= TPdfString.CreateString(DateToPdfDate(Now)); -Info.FObjet.AddElement('CreationDate',Nom); + // add xref entry + Info := TPdfXRef.CreateXRef; + FXRefObjets.Add(Info); + // add info trailer element + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + Trailer.AddElement('Info', XRefObjets); + TPdfInteger(TPdfDicElement(Trailer.FElement[Trailer.ElementParCle('Size')]).FValue).FValue := FXRefObjets.Count; + // add title element to info dictionary + Nom := TPdfString.CreateString(Infos.Titre); + Info.FObjet.AddElement('Title', Nom); + // add author element to info dictionary + Nom := TPdfString.CreateString(Infos.Auteur); + Info.FObjet.AddElement('Author', Nom); + // add creator element to info dictionary + Nom := TPdfString.CreateString(ApplicationName); + Info.FObjet.AddElement('Creator', Nom); + // add producer element to info dictionary + Nom := TPdfString.CreateString('fpGUI/FPC'); + Info.FObjet.AddElement('Producer', Nom); + // add creationdate element to info dictionary + Nom := TPdfString.CreateString(DateToPdfDate(Now)); + Info.FObjet.AddElement('CreationDate', Nom); end; procedure TPdfDocument.CreatePreferences; @@ -1263,21 +1192,21 @@ var Nom: TPdfName; Preference: TPdfBoolean; begin -// add xref entry -Viewer:= TPdfXRef.CreateXRef; -FXRefObjets.Add(Viewer); -// add type element to preferences dictionary -Nom:= TPdfName.CreateName('ViewerPreferences'); -Viewer.FObjet.AddElement('Type',Nom); -// add preference element to preferences dictionary -Preference:= TPdfBoolean.CreateBoolean(True); -Viewer.FObjet.AddElement('FitWindow',Preference); -// add preferences reference to catalog dictionary -XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); -TPdfDictionary(TPdfXRef(FXRefObjets[ElementParNom('Catalog')]).FObjet).AddElement('ViewerPreferences',XRefObjets) -end; - -function TPdfDocument.CreatePages(Parent: Integer): Integer; + // add xref entry + Viewer := TPdfXRef.CreateXRef; + FXRefObjets.Add(Viewer); + // add type element to preferences dictionary + Nom := TPdfName.CreateName('ViewerPreferences'); + Viewer.FObjet.AddElement('Type', Nom); + // add preference element to preferences dictionary + Preference := TPdfBoolean.CreateBoolean(True); + Viewer.FObjet.AddElement('FitWindow', Preference); + // add preferences reference to catalog dictionary + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + TPdfDictionary(TPdfXRef(FXRefObjets[ElementParNom('Catalog')]).FObjet).AddElement('ViewerPreferences', XRefObjets); +end; + +function TPdfDocument.CreatePages(Parent: integer): integer; var Pages: TPdfXRef; XRefObjets: TPdfReference; @@ -1286,41 +1215,40 @@ var Table: TPdfArray; Count: TPdfInteger; begin -// add xref entry -Pages:= TPdfXRef.CreateXRef; -FXRefObjets.Add(Pages); -// add type element to pages dictionary -Nom:= TPdfName.CreateName('Pages'); -Pages.FObjet.AddElement('Type',Nom); -// add parent reference to pages dictionary if pages is not the root of the page tree -if Parent> 0 -then + // add xref entry + Pages := TPdfXRef.CreateXRef; + FXRefObjets.Add(Pages); + // add type element to pages dictionary + Nom := TPdfName.CreateName('Pages'); + Pages.FObjet.AddElement('Type', Nom); + // add parent reference to pages dictionary if pages is not the root of the page tree + if Parent > 0 then begin - XRefObjets:= TPdfReference.CreateReference(Parent); - Pages.FObjet.AddElement('Parent',XRefObjets); - // increment count in parent pages dictionary - Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[Parent]).FObjet); - TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger; - // add kid reference in parent pages dictionary - XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); - TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Kids')]).FValue).AddItem(XRefObjets); + XRefObjets := TPdfReference.CreateReference(Parent); + Pages.FObjet.AddElement('Parent', XRefObjets); + // increment count in parent pages dictionary + Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[Parent]).FObjet); + TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger; + // add kid reference in parent pages dictionary + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Kids')]).FValue).AddItem(XRefObjets); end -else + else begin - // add pages reference to catalog dictionary - XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); - TPdfDictionary(TPdfXRef(FXRefObjets[ElementParNom('Catalog')]).FObjet).AddElement('Pages',XRefObjets) + // add pages reference to catalog dictionary + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + TPdfDictionary(TPdfXRef(FXRefObjets[ElementParNom('Catalog')]).FObjet).AddElement('Pages', XRefObjets); end; -// add kids element to pages dictionary -Table:= TPdfArray.CreateArray; -Pages.FObjet.AddElement('Kids',Table); -// add count element to pages dictionary -Count:= TPdfInteger.CreateInteger(0); -Pages.FObjet.AddElement('Count',Count); -Result:= Pred(FXRefObjets.Count); + // add kids element to pages dictionary + Table := TPdfArray.CreateArray; + Pages.FObjet.AddElement('Kids', Table); + // add count element to pages dictionary + Count := TPdfInteger.CreateInteger(0); + Pages.FObjet.AddElement('Count', Count); + Result := Pred(FXRefObjets.Count); end; -function TPdfDocument.CreatePage(Parent,Haut,Larg,PageNum: Integer): Integer; +function TPdfDocument.CreatePage(Parent, Haut, Larg, PageNum: integer): integer; var Page: TPdfXRef; XRefObjets: TPdfReference; @@ -1328,92 +1256,93 @@ var Dictionaire: TPdfDictionary; Table: TPdfArray; Coord: TPdfInteger; - Cpt: Integer; -begin -// add xref entry -Page:= TPdfXRef.CreateXRef; -FXRefObjets.Add(Page); -// add type element to page dictionary -Nom:= TPdfName.CreateName('Page'); -Page.FObjet.AddElement('Type',Nom); -// add parent reference to page dictionary -XRefObjets:= TPdfReference.CreateReference(Parent); -Page.FObjet.AddElement('Parent',XRefObjets); -// increment count in parent pages dictionary -Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[Parent]).FObjet); -TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger; -// add kid reference in parent pages dictionary -XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); -TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Kids')]).FValue).AddItem(XRefObjets); -// add mediabox element to page dictionary -Table:= TPdfArray.CreateArray; -Page.FObjet.AddElement('MediaBox',Table); -// add coordinates in page mediabox -Dictionaire:= TPdfDictionary(TPdfXRef(Page).FObjet); -Coord:= TPdfInteger.CreateInteger(0); -TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('MediaBox')]).FValue).AddItem(Coord); -Coord:= TPdfInteger.CreateInteger(0); -TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('MediaBox')]).FValue).AddItem(Coord); -Coord:= TPdfInteger.CreateInteger(Larg); -TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('MediaBox')]).FValue).AddItem(Coord); -Coord:= TPdfInteger.CreateInteger(Haut); -TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('MediaBox')]).FValue).AddItem(Coord); -// add resources element to page dictionary -Dictionaire:= TPdfDictionary.CreateDictionary; -Page.FObjet.AddElement('Resources',Dictionaire); -// add procset element in resources element to page dictionary -Table:= TPdfArray.CreateArray; -TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue).AddElement('ProcSet',Table); -// add font element in resources element to page dictionary -if Fonts.Count> 0 -then + Cpt: integer; +begin + // add xref entry + Page := TPdfXRef.CreateXRef; + FXRefObjets.Add(Page); + // add type element to page dictionary + Nom := TPdfName.CreateName('Page'); + Page.FObjet.AddElement('Type', Nom); + // add parent reference to page dictionary + XRefObjets := TPdfReference.CreateReference(Parent); + Page.FObjet.AddElement('Parent', XRefObjets); + // increment count in parent pages dictionary + Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[Parent]).FObjet); + TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger; + // add kid reference in parent pages dictionary + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Kids')]).FValue).AddItem(XRefObjets); + // add mediabox element to page dictionary + Table := TPdfArray.CreateArray; + Page.FObjet.AddElement('MediaBox', Table); + // add coordinates in page mediabox + Dictionaire := TPdfDictionary(TPdfXRef(Page).FObjet); + Coord := TPdfInteger.CreateInteger(0); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('MediaBox')]).FValue).AddItem(Coord); + Coord := TPdfInteger.CreateInteger(0); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('MediaBox')]).FValue).AddItem(Coord); + Coord := TPdfInteger.CreateInteger(Larg); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('MediaBox')]).FValue).AddItem(Coord); + Coord := TPdfInteger.CreateInteger(Haut); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('MediaBox')]).FValue).AddItem(Coord); + // add resources element to page dictionary + Dictionaire := TPdfDictionary.CreateDictionary; + Page.FObjet.AddElement('Resources', Dictionaire); + // add procset element in resources element to page dictionary + Table := TPdfArray.CreateArray; + TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue).AddElement('ProcSet', Table); + // add font element in resources element to page dictionary + if Fonts.Count > 0 then begin - Dictionaire:= TPdfDictionary.CreateDictionary; - TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue).AddElement('Font',Dictionaire); + Dictionaire := TPdfDictionary.CreateDictionary; + TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue).AddElement('Font', Dictionaire); end; -for Cpt:= 0 to Pred(PdfPage.Count) do - if TPdfElement(PdfPage[Cpt]) is TPdfImg - then - if TPdfImg(PdfPage[Cpt]).PageId= PageNum - then + for Cpt := 0 to Pred(PdfPage.Count) do + begin + if TPdfElement(PdfPage[Cpt]) is TPdfImg then + begin + if TPdfImg(PdfPage[Cpt]).PageId = PageNum then begin -// add xobject element in resources element to page dictionary - Dictionaire:= TPdfDictionary.CreateDictionary; - TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue).AddElement('XObject',Dictionaire); - Break; + // add xobject element in resources element to page dictionary + Dictionaire := TPdfDictionary.CreateDictionary; + TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue).AddElement('XObject', Dictionaire); + Break; end; -// add pdf element in procset array to page dictionary -Dictionaire:= TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue); -Nom:= TPdfName.CreateName('PDF'); -TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('ProcSet')]).FValue).AddItem(Nom); -// add text element in procset array to page dictionary -Nom:= TPdfName.CreateName('Text'); -TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('ProcSet')]).FValue).AddItem(Nom); -// add image element in procset array to page dictionary -Nom:= TPdfName.CreateName('ImageC'); -TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('ProcSet')]).FValue).AddItem(Nom); -Result:= Pred(FXRefObjets.Count); -end; - -function TPdfDocument.CreateOutlines: Integer; + end; + end; + // add pdf element in procset array to page dictionary + Dictionaire := TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue); + Nom := TPdfName.CreateName('PDF'); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('ProcSet')]).FValue).AddItem(Nom); + // add text element in procset array to page dictionary + Nom := TPdfName.CreateName('Text'); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('ProcSet')]).FValue).AddItem(Nom); + // add image element in procset array to page dictionary + Nom := TPdfName.CreateName('ImageC'); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('ProcSet')]).FValue).AddItem(Nom); + Result := Pred(FXRefObjets.Count); +end; + +function TPdfDocument.CreateOutlines: integer; var Outlines: TPdfXRef; Nom: TPdfName; Count: TPdfInteger; begin -// add xref entry -Outlines:= TPdfXRef.CreateXRef; -FXRefObjets.Add(Outlines); -// add type element to outlines dictionary -Nom:= TPdfName.CreateName('Outlines'); -Outlines.FObjet.AddElement('Type',Nom); -// add count element to outlines dictionary -Count:= TPdfInteger.CreateInteger(0); -Outlines.FObjet.AddElement('Count',Count); -Result:= Pred(FXRefObjets.Count); + // add xref entry + Outlines := TPdfXRef.CreateXRef; + FXRefObjets.Add(Outlines); + // add type element to outlines dictionary + Nom := TPdfName.CreateName('Outlines'); + Outlines.FObjet.AddElement('Type', Nom); + // add count element to outlines dictionary + Count := TPdfInteger.CreateInteger(0); + Outlines.FObjet.AddElement('Count', Count); + Result := Pred(FXRefObjets.Count); end; -function TPdfDocument.CreateOutline(Parent,SectNo,PageNo: Integer; SectTitre: string): Integer; +function TPdfDocument.CreateOutline(Parent, SectNo, PageNo: integer; SectTitre: string): integer; var Outline: TPdfXRef; XRefObjets: TPdfReference; @@ -1421,223 +1350,204 @@ var Count: TPdfInteger; Table: TPdfArray; begin -// add xref entry -Outline:= TPdfXRef.CreateXRef; -FXRefObjets.Add(Outline); -// add title element to outline dictionary -if PageNo> -1 -then - if SectTitre<> '' - then - Titre:= TPdfString.CreateString(SectTitre+' Page '+IntToStr(PageNo)) - else - Titre:= TPdfString.CreateString('Section '+IntToStr(SectNo)+' Page '+IntToStr(PageNo)) -else - if SectTitre<> '' - then - Titre:= TPdfString.CreateString(SectTitre) + // add xref entry + Outline := TPdfXRef.CreateXRef; + FXRefObjets.Add(Outline); + // add title element to outline dictionary + if PageNo > -1 then + begin + if SectTitre <> '' then + Titre := TPdfString.CreateString(SectTitre + ' Page ' + IntToStr(PageNo)) + else + Titre := TPdfString.CreateString('Section ' + IntToStr(SectNo) + ' Page ' + IntToStr(PageNo)) + end else - Titre:= TPdfString.CreateString('Section '+IntToStr(SectNo)); -Outline.FObjet.AddElement('Title',Titre); -// add parent reference to outline dictionary -XRefObjets:= TPdfReference.CreateReference(Parent); -Outline.FObjet.AddElement('Parent',XRefObjets); -// add count element to outline dictionary -Count:= TPdfInteger.CreateInteger(0); -Outline.FObjet.AddElement('Count',Count); -// add dest element to outline dictionary -Table:= TPdfArray.CreateArray; -Outline.FObjet.AddElement('Dest',Table); -Result:= Pred(FXRefObjets.Count); -end; - -procedure TPdfDocument.CreateStdFont(NomFonte: string; NumFonte: Integer); + begin + if SectTitre <> '' then + Titre := TPdfString.CreateString(SectTitre) + else + Titre := TPdfString.CreateString('Section ' + IntToStr(SectNo)); + end; + Outline.FObjet.AddElement('Title', Titre); + // add parent reference to outline dictionary + XRefObjets := TPdfReference.CreateReference(Parent); + Outline.FObjet.AddElement('Parent', XRefObjets); + // add count element to outline dictionary + Count := TPdfInteger.CreateInteger(0); + Outline.FObjet.AddElement('Count', Count); + // add dest element to outline dictionary + Table := TPdfArray.CreateArray; + Outline.FObjet.AddElement('Dest', Table); + Result := Pred(FXRefObjets.Count); +end; + +procedure TPdfDocument.CreateStdFont(NomFonte: string; NumFonte: integer); var Fontes: TPdfXRef; XRefObjets: TPdfReference; Nom: TPdfName; Dictionaire: TPdfDictionary; - Cpt: Integer; -begin -if Pos('Italic',NomFonte)> 0 -then - NomFonte:= Copy(NomFonte,1,Pred(Pos('Italic',NomFonte)))+'Oblique'; -// AnsiReplaceText(NomFonte,'Italic','Oblique'); -// add xref entry -Fontes:= TPdfXRef.CreateXRef; -FXRefObjets.Add(Fontes); -// add type element to font dictionary -Nom:= TPdfName.CreateName('Font'); -Fontes.FObjet.AddElement('Type',Nom); -// add subtype element to font dictionary -Nom:= TPdfName.CreateName('Type1'); -Fontes.FObjet.AddElement('Subtype',Nom); -// add encoding element to font dictionary -Nom:= TPdfName.CreateName('WinAnsiEncoding'); -Fontes.FObjet.AddElement('Encoding',Nom); -// add firstchar element to font dictionary -Nom:= TPdfName.CreateName('32'); -//Nom:= TPdfName.CreateName('0'); -Fontes.FObjet.AddElement('FirstChar',Nom); -// add lastchar element to font dictionary -Nom:= TPdfName.CreateName('255'); -Fontes.FObjet.AddElement('LastChar',Nom); -// add basefont element to font dictionary -Nom:= TPdfName.CreateName(NomFonte); -Fontes.FObjet.AddElement('BaseFont',Nom); -// add name element to font dictionary -Nom:= TPdfName.CreateName('F'+IntToStr(NumFonte)); -Fontes.FObjet.AddElement('Name',Nom); -// add font reference to all page dictionary -for Cpt:= 1 to Pred(FXRefObjets.Count) do + Cpt: integer; +begin + if Pos('Italic', NomFonte) > 0 then + NomFonte := Copy(NomFonte, 1, Pred(Pos('Italic', NomFonte))) + 'Oblique'; + // AnsiReplaceText(NomFonte,'Italic','Oblique'); + // add xref entry + Fontes := TPdfXRef.CreateXRef; + FXRefObjets.Add(Fontes); + // add type element to font dictionary + Nom := TPdfName.CreateName('Font'); + Fontes.FObjet.AddElement('Type', Nom); + // add subtype element to font dictionary + Nom := TPdfName.CreateName('Type1'); + Fontes.FObjet.AddElement('Subtype', Nom); + // add encoding element to font dictionary + Nom := TPdfName.CreateName('WinAnsiEncoding'); + Fontes.FObjet.AddElement('Encoding', Nom); + // add firstchar element to font dictionary + Nom := TPdfName.CreateName('32'); + //Nom:= TPdfName.CreateName('0'); + Fontes.FObjet.AddElement('FirstChar', Nom); + // add lastchar element to font dictionary + Nom := TPdfName.CreateName('255'); + Fontes.FObjet.AddElement('LastChar', Nom); + // add basefont element to font dictionary + Nom := TPdfName.CreateName(NomFonte); + Fontes.FObjet.AddElement('BaseFont', Nom); + // add name element to font dictionary + Nom := TPdfName.CreateName('F' + IntToStr(NumFonte)); + Fontes.FObjet.AddElement('Name', Nom); + // add font reference to all page dictionary + for Cpt := 1 to Pred(FXRefObjets.Count) do begin - Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet); - if Dictionaire.FElement.Count> 0 - then - if TPdfName(TPdfDicElement(Dictionaire.FElement[0]).FValue).FValue= 'Page' - then + Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet); + if Dictionaire.FElement.Count > 0 then + if TPdfName(TPdfDicElement(Dictionaire.FElement[0]).FValue).FValue = 'Page' then begin - Dictionaire:= TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Resources')]).FValue); - Dictionaire:= TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Font')]).FValue); - XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); - Dictionaire.AddElement(TPdfName(Nom).FValue,XRefObjets); + Dictionaire := TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Resources')]).FValue); + Dictionaire := TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Font')]).FValue); + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + Dictionaire.AddElement(TPdfName(Nom).FValue, XRefObjets); end; end; -SetLength(FontFiles,Succ(Length(FontFiles))); -FontFiles[NumFonte]:= ''; + SetLength(FontFiles, Succ(Length(FontFiles))); + FontFiles[NumFonte] := ''; end; function TPdfDocument.LoadFont(NomFonte: string): string; var FileTxt: TextFile; - Ligne: widestring; + Ligne: WideString; begin -if FileExists(FontDirectory+NomFonte+'.fnt') -then + if FileExists(FontDirectory + NomFonte + '.fnt') then begin - AssignFile(FileTxt,FontDirectory+NomFonte+'.fnt'); - Reset(FileTxt); - while not Eof(FileTxt) do + AssignFile(FileTxt, FontDirectory + NomFonte + '.fnt'); + Reset(FileTxt); + while not EOF(FileTxt) do begin - Readln(FileTxt,Ligne); - if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'FontType' - then - FontDef.FType:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); - if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'FontName' - then - FontDef.FName:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); - if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'Ascent' - then - FontDef.FAscent:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); - if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'Descent' - then - FontDef.FDescent:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); - if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'CapHeight' - then - FontDef.FCapHeight:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); - if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'Flags' - then - FontDef.FFlags:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); - if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'FontBBox' - then - FontDef.FFontBBox:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); - if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'ItalicAngle' - then - FontDef.FItalicAngle:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); - if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'StemV' - then - FontDef.FStemV:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); - if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'MissingWidth' - then - FontDef.FMissingWidth:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); - if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'Encoding' - then - FontDef.FEncoding:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); - if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'FontFile' - then - FontDef.FFile:= FontDirectory+Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); - if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'OriginalSize' - then - FontDef.FOriginalSize:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); - if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'Diffs' - then - FontDef.FDiffs:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); - if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'CharWidth' - then - FontDef.FCharWidth:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + Readln(FileTxt, Ligne); + if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'FontType' then + FontDef.FType := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne)); + if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'FontName' then + FontDef.FName := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne)); + if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'Ascent' then + FontDef.FAscent := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne)); + if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'Descent' then + FontDef.FDescent := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne)); + if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'CapHeight' then + FontDef.FCapHeight := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne)); + if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'Flags' then + FontDef.FFlags := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne)); + if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'FontBBox' then + FontDef.FFontBBox := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne)); + if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'ItalicAngle' then + FontDef.FItalicAngle := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne)); + if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'StemV' then + FontDef.FStemV := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne)); + if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'MissingWidth' then + FontDef.FMissingWidth := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne)); + if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'Encoding' then + FontDef.FEncoding := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne)); + if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'FontFile' then + FontDef.FFile := FontDirectory + Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne)); + if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'OriginalSize' then + FontDef.FOriginalSize := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne)); + if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'Diffs' then + FontDef.FDiffs := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne)); + if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'CharWidth' then + FontDef.FCharWidth := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne)); end; - Result:= FontDef.FType; + Result := FontDef.FType; end -else - ShowMessage('Font file '+NomFonte+'.fnt not found'); + else + { TODO: Localize this message } + ShowMessage('Font file ' + NomFonte + '.fnt not found'); end; -procedure TPdfDocument.CreateTtfFont(const NumFonte: Integer); +procedure TPdfDocument.CreateTtfFont(const NumFonte: integer); var Fontes: TPdfXRef; XRefObjets: TPdfReference; Nom: TPdfName; Dictionaire: TPdfDictionary; Value: TPdfInteger; - Cpt: Integer; -begin -// add xref entry -Fontes:= TPdfXRef.CreateXRef; -FXRefObjets.Add(Fontes); -// add type element to font dictionary -Nom:= TPdfName.CreateName('Font'); -Fontes.FObjet.AddElement('Type',Nom); -// add subtype element to font dictionary -Nom:= TPdfName.CreateName(FontDef.FType); -Fontes.FObjet.AddElement('Subtype',Nom); -// add encoding element to font dictionary -Nom:= TPdfName.CreateName('WinAnsiEncoding'); -Fontes.FObjet.AddElement('Encoding',Nom); -// add firstchar element to font dictionary -Value:= TPdfInteger.CreateInteger(32); -Fontes.FObjet.AddElement('FirstChar',Value); -// add lastchar element to font dictionary -Value:= TPdfInteger.CreateInteger(255); -Fontes.FObjet.AddElement('LastChar',Value); -// add basefont element to font dictionary -Nom:= TPdfName.CreateName(FontDef.FName); -Fontes.FObjet.AddElement('BaseFont',Nom); -// add name element to font dictionary -Nom:= TPdfName.CreateName('F'+IntToStr(NumFonte)); -Fontes.FObjet.AddElement('Name',Nom); -// add font reference to all page dictionary -for Cpt:= 1 to Pred(FXRefObjets.Count) do + Cpt: integer; +begin + // add xref entry + Fontes := TPdfXRef.CreateXRef; + FXRefObjets.Add(Fontes); + // add type element to font dictionary + Nom := TPdfName.CreateName('Font'); + Fontes.FObjet.AddElement('Type', Nom); + // add subtype element to font dictionary + Nom := TPdfName.CreateName(FontDef.FType); + Fontes.FObjet.AddElement('Subtype', Nom); + // add encoding element to font dictionary + Nom := TPdfName.CreateName('WinAnsiEncoding'); + Fontes.FObjet.AddElement('Encoding', Nom); + // add firstchar element to font dictionary + Value := TPdfInteger.CreateInteger(32); + Fontes.FObjet.AddElement('FirstChar', Value); + // add lastchar element to font dictionary + Value := TPdfInteger.CreateInteger(255); + Fontes.FObjet.AddElement('LastChar', Value); + // add basefont element to font dictionary + Nom := TPdfName.CreateName(FontDef.FName); + Fontes.FObjet.AddElement('BaseFont', Nom); + // add name element to font dictionary + Nom := TPdfName.CreateName('F' + IntToStr(NumFonte)); + Fontes.FObjet.AddElement('Name', Nom); + // add font reference to all page dictionary + for Cpt := 1 to Pred(FXRefObjets.Count) do begin - Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet); - if Dictionaire.FElement.Count> 0 - then - if TPdfName(TPdfDicElement(Dictionaire.FElement[0]).FValue).FValue= 'Page' - then + Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet); + if Dictionaire.FElement.Count > 0 then + if TPdfName(TPdfDicElement(Dictionaire.FElement[0]).FValue).FValue = 'Page' then begin - Dictionaire:= TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Resources')]).FValue); - Dictionaire:= TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Font')]).FValue); - XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); - Dictionaire.AddElement(TPdfName(Nom).FValue,XRefObjets); + Dictionaire := TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Resources')]).FValue); + Dictionaire := TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Font')]).FValue); + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + Dictionaire.AddElement(TPdfName(Nom).FValue, XRefObjets); end; end; -CreateFontDescriptor(NumFonte); -// add fontdescriptor reference to font dictionary -XRefObjets:= TPdfReference.CreateReference(FXRefObjets.Count-2); -Fontes.FObjet.AddElement('FontDescriptor',XRefObjets); -CreateFontWidth; -// add fontwidth reference to font dictionary -XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); -Fontes.FObjet.AddElement('Widths',XRefObjets); -SetLength(FontFiles,Succ(Length(FontFiles))); -FontFiles[NumFonte]:= FontDef.FFile; + CreateFontDescriptor(NumFonte); + // add fontdescriptor reference to font dictionary + XRefObjets := TPdfReference.CreateReference(FXRefObjets.Count - 2); + Fontes.FObjet.AddElement('FontDescriptor', XRefObjets); + CreateFontWidth; + // add fontwidth reference to font dictionary + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + Fontes.FObjet.AddElement('Widths', XRefObjets); + SetLength(FontFiles, Succ(Length(FontFiles))); + FontFiles[NumFonte] := FontDef.FFile; end; -procedure TPdfDocument.CreateTp1Font(const NumFonte: Integer); +procedure TPdfDocument.CreateTp1Font(const NumFonte: integer); begin end; -procedure TPdfDocument.CreateFontDescriptor(const NumFonte: Integer); +procedure TPdfDocument.CreateFontDescriptor(const NumFonte: integer); var FtDesc: TPdfXRef; XRefObjets: TPdfReference; @@ -1646,51 +1556,51 @@ var Table: TPdfArray; Dictionaire: TPdfDictionary; begin -// add xref entry -FtDesc:= TPdfXRef.CreateXRef; -FXRefObjets.Add(FtDesc); -// add type element to fontdescriptor dictionary -Nom:= TPdfName.CreateName('FontDescriptor'); -FtDesc.FObjet.AddElement('Type',Nom); -// add fontname element to fontdescriptor dictionary -Nom:= TPdfName.CreateName(FontDef.FName); -FtDesc.FObjet.AddElement('FontName',Nom); -// add ascent element to fontdescriptor dictionary -Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FAscent)); -FtDesc.FObjet.AddElement('Ascent',Value); -// add descent element to fontdescriptor dictionary -Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FDescent)); -FtDesc.FObjet.AddElement('Descent',Value); -// add capheight element to fontdescriptor dictionary -Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FCapHeight)); -FtDesc.FObjet.AddElement('CapHeight',Value); -// add flags element to fontdescriptor dictionary -Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FFlags)); -FtDesc.FObjet.AddElement('Flags',Value); -// add fontbbox element to fontdescriptor dictionary -Table:= TPdfArray.CreateArray; -FtDesc.FObjet.AddElement('FontBBox',Table); -// add coordinates in page fontbbox -while Pos(' ',FontDef.FFontBBox)> 0 do + // add xref entry + FtDesc := TPdfXRef.CreateXRef; + FXRefObjets.Add(FtDesc); + // add type element to fontdescriptor dictionary + Nom := TPdfName.CreateName('FontDescriptor'); + FtDesc.FObjet.AddElement('Type', Nom); + // add fontname element to fontdescriptor dictionary + Nom := TPdfName.CreateName(FontDef.FName); + FtDesc.FObjet.AddElement('FontName', Nom); + // add ascent element to fontdescriptor dictionary + Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FAscent)); + FtDesc.FObjet.AddElement('Ascent', Value); + // add descent element to fontdescriptor dictionary + Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FDescent)); + FtDesc.FObjet.AddElement('Descent', Value); + // add capheight element to fontdescriptor dictionary + Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FCapHeight)); + FtDesc.FObjet.AddElement('CapHeight', Value); + // add flags element to fontdescriptor dictionary + Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FFlags)); + FtDesc.FObjet.AddElement('Flags', Value); + // add fontbbox element to fontdescriptor dictionary + Table := TPdfArray.CreateArray; + FtDesc.FObjet.AddElement('FontBBox', Table); + // add coordinates in page fontbbox + while Pos(' ', FontDef.FFontBBox) > 0 do begin - Dictionaire:= TPdfDictionary(TPdfXRef(FtDesc).FObjet); - Value:= TPdfInteger.CreateInteger(StrToInt(Copy(FontDef.FFontBBox,1,Pred(Pos(' ',FontDef.FFontBBox))))); - TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('FontBBox')]).FValue).AddItem(Value); - FontDef.FFontBBox:= Copy(FontDef.FFontBBox,Succ(Pos(' ',FontDef.FFontBBox)),Length(FontDef.FFontBBox)-Pos(' ',FontDef.FFontBBox));; + Dictionaire := TPdfDictionary(TPdfXRef(FtDesc).FObjet); + Value := TPdfInteger.CreateInteger(StrToInt(Copy(FontDef.FFontBBox, 1, Pred(Pos(' ', FontDef.FFontBBox))))); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('FontBBox')]).FValue).AddItem(Value); + FontDef.FFontBBox := Copy(FontDef.FFontBBox, Succ(Pos(' ', FontDef.FFontBBox)), Length(FontDef.FFontBBox) - Pos(' ', FontDef.FFontBBox)); end; -// add italicangle element to fontdescriptor dictionary -Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FItalicAngle)); -FtDesc.FObjet.AddElement('ItalicAngle',Value); -// add stemv element to fontdescriptor dictionary -Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FStemV)); -FtDesc.FObjet.AddElement('StemV',Value); -// add missingwidth element to fontdescriptor dictionary -Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FMissingWidth)); -FtDesc.FObjet.AddElement('MissingWidth',Value); -CreateFontFile(NumFonte); -// add fontfilereference to fontdescriptor dictionary -XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); -FtDesc.FObjet.AddElement('FontFile2',XRefObjets); + // add italicangle element to fontdescriptor dictionary + Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FItalicAngle)); + FtDesc.FObjet.AddElement('ItalicAngle', Value); + // add stemv element to fontdescriptor dictionary + Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FStemV)); + FtDesc.FObjet.AddElement('StemV', Value); + // add missingwidth element to fontdescriptor dictionary + Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FMissingWidth)); + FtDesc.FObjet.AddElement('MissingWidth', Value); + CreateFontFile(NumFonte); + // add fontfilereference to fontdescriptor dictionary + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + FtDesc.FObjet.AddElement('FontFile2', XRefObjets); end; procedure TPdfDocument.CreateFontWidth; @@ -1700,113 +1610,112 @@ var Table: TPdfArray; Dictionaire: TPdfDictionary; begin -// add xref entry -FtDesc:= TPdfXRef.CreateXRef; -FXRefObjets.Add(FtDesc); -// add element to fontwidth dictionary -Table:= TPdfArray.CreateArray; -FtDesc.FObjet.AddElement('',Table); -// add width values in fontwidth array -while Pos(' ',FontDef.FCharWidth)> 0 do + // add xref entry + FtDesc := TPdfXRef.CreateXRef; + FXRefObjets.Add(FtDesc); + // add element to fontwidth dictionary + Table := TPdfArray.CreateArray; + FtDesc.FObjet.AddElement('', Table); + // add width values in fontwidth array + while Pos(' ', FontDef.FCharWidth) > 0 do begin - Dictionaire:= TPdfDictionary(TPdfXRef(FtDesc).FObjet); - Value:= TPdfInteger.CreateInteger(StrToInt(Copy(FontDef.FCharWidth,1,Pred(Pos(' ',FontDef.FCharWidth))))); - TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('')]).FValue).AddItem(Value); - FontDef.FCharWidth:= Copy(FontDef.FCharWidth,Succ(Pos(' ',FontDef.FCharWidth)),Length(FontDef.FCharWidth)-Pos(' ',FontDef.FCharWidth));; + Dictionaire := TPdfDictionary(TPdfXRef(FtDesc).FObjet); + Value := TPdfInteger.CreateInteger(StrToInt(Copy(FontDef.FCharWidth, 1, Pred(Pos(' ', FontDef.FCharWidth))))); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('')]).FValue).AddItem(Value); + FontDef.FCharWidth := Copy(FontDef.FCharWidth, Succ(Pos(' ', FontDef.FCharWidth)), Length(FontDef.FCharWidth) - Pos(' ', FontDef.FCharWidth)); end; end; -procedure TPdfDocument.CreateFontFile(const NumFonte: Integer); +procedure TPdfDocument.CreateFontFile(const NumFonte: integer); var FtDesc: TPdfXRef; Nom: TPdfName; Value: TPdfInteger; begin -// add xref entry -FtDesc:= TPdfXRef.CreateXRef; -FXRefObjets.Add(FtDesc); -// add filter element to fontfile dictionary -Nom:= TPdfName.CreateName('FlateDecode'); -FtDesc.FObjet.AddElement('Filter',Nom); -// add length1 element to fontfile dictionary -Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FOriginalSize)); -FtDesc.FObjet.AddElement('Length1 '+IntToStr(NumFonte),Value); + // add xref entry + FtDesc := TPdfXRef.CreateXRef; + FXRefObjets.Add(FtDesc); + // add filter element to fontfile dictionary + Nom := TPdfName.CreateName('FlateDecode'); + FtDesc.FObjet.AddElement('Filter', Nom); + // add length1 element to fontfile dictionary + Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FOriginalSize)); + FtDesc.FObjet.AddElement('Length1 ' + IntToStr(NumFonte), Value); end; -procedure TPdfDocument.CreateImage(ImgWidth,ImgHeight,NumImg: Integer); +procedure TPdfDocument.CreateImage(ImgWidth, ImgHeight, NumImg: integer); var Images: TPdfXRef; XRefObjets: TPdfReference; Nom: TPdfName; Dictionaire: TPdfDictionary; Long: TPdfInteger; - Cpt: Integer; -begin -// add xref entry -Images:= TPdfXRef.CreateXRef; -FXRefObjets.Add(Images); -// add type element to image dictionary -Nom:= TPdfName.CreateName('XObject'); -Images.FObjet.AddElement('Type',Nom); -// add subtype element to image dictionary -Nom:= TPdfName.CreateName('Image'); -Images.FObjet.AddElement('Subtype',Nom); -// add width element to image dictionary -Long:= TPdfInteger.CreateInteger(ImgWidth); -Images.FObjet.AddElement('Width',Long); -// add height element to image dictionary -Long:= TPdfInteger.CreateInteger(ImgHeight); -Images.FObjet.AddElement('Height',Long); -// add color space element to image dictionary -Nom:= TPdfName.CreateName('DeviceRGB'); -Images.FObjet.AddElement('ColorSpace',Nom); -// add bits per component element to image dictionary -Long:= TPdfInteger.CreateInteger(8); -Images.FObjet.AddElement('BitsPerComponent',Long); -// add name element to image dictionary -Nom:= TPdfName.CreateName('I'+IntToStr(NumImg)); -Images.FObjet.AddElement('Name',Nom); -// add image reference to page dictionary -for Cpt:= 1 to Pred(FXRefObjets.Count) do + Cpt: integer; +begin + // add xref entry + Images := TPdfXRef.CreateXRef; + FXRefObjets.Add(Images); + // add type element to image dictionary + Nom := TPdfName.CreateName('XObject'); + Images.FObjet.AddElement('Type', Nom); + // add subtype element to image dictionary + Nom := TPdfName.CreateName('Image'); + Images.FObjet.AddElement('Subtype', Nom); + // add width element to image dictionary + Long := TPdfInteger.CreateInteger(ImgWidth); + Images.FObjet.AddElement('Width', Long); + // add height element to image dictionary + Long := TPdfInteger.CreateInteger(ImgHeight); + Images.FObjet.AddElement('Height', Long); + // add color space element to image dictionary + Nom := TPdfName.CreateName('DeviceRGB'); + Images.FObjet.AddElement('ColorSpace', Nom); + // add bits per component element to image dictionary + Long := TPdfInteger.CreateInteger(8); + Images.FObjet.AddElement('BitsPerComponent', Long); + // add name element to image dictionary + Nom := TPdfName.CreateName('I' + IntToStr(NumImg)); + Images.FObjet.AddElement('Name', Nom); + // add image reference to page dictionary + for Cpt := 1 to Pred(FXRefObjets.Count) do begin - Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet); - if Dictionaire.FElement.Count> 0 - then - if TPdfName(TPdfDicElement(Dictionaire.FElement[0]).FValue).FValue= 'Page' - then + Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet); + if Dictionaire.FElement.Count > 0 then + begin + if TPdfName(TPdfDicElement(Dictionaire.FElement[0]).FValue).FValue = 'Page' then begin - Dictionaire:= TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Resources')]).FValue); - if Dictionaire.ElementParCle('XObject')> -1 - then + Dictionaire := TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Resources')]).FValue); + if Dictionaire.ElementParCle('XObject') > -1 then begin - Dictionaire:= TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('XObject')]).FValue); - XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); - Dictionaire.AddElement(TPdfName(Nom).FValue,XRefObjets); + Dictionaire := TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('XObject')]).FValue); + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + Dictionaire.AddElement(TPdfName(Nom).FValue, XRefObjets); end; end; + end; end; end; -function TPdfDocument.CreateContents: Integer; +function TPdfDocument.CreateContents: integer; var Contents: TPdfXRef; XRefObjets: TPdfReference; Stream: TPdfStream; begin -// add xref entry -Contents:= TPdfXRef.CreateXRef; -FXRefObjets.Add(Contents); -Stream:= TPdfStream.CreateStream; -TPdfXRef(FXRefObjets[Pred(FXRefObjets.Count)]).FStream:= Stream; -// add contents reference to page dictionary -XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); -TPdfDictionary(TPdfXRef(FXRefObjets[Pred(Pred(FXRefObjets.Count))]).FObjet).AddElement('Contents',XRefObjets); -Result:= Pred(FXRefObjets.Count); + // add xref entry + Contents := TPdfXRef.CreateXRef; + FXRefObjets.Add(Contents); + Stream := TPdfStream.CreateStream; + TPdfXRef(FXRefObjets[Pred(FXRefObjets.Count)]).FStream := Stream; + // add contents reference to page dictionary + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + TPdfDictionary(TPdfXRef(FXRefObjets[Pred(Pred(FXRefObjets.Count))]).FObjet).AddElement('Contents', XRefObjets); + Result := Pred(FXRefObjets.Count); end; -procedure TPdfDocument.CreateStream(NumeroPage,PageNum: Integer); +procedure TPdfDocument.CreateStream(NumeroPage, PageNum: integer); var - Cpt: Integer; + Cpt: integer; Txt: TPdfText; Clr: TPdfColor; Fnt: TPdfFonte; @@ -1816,304 +1725,293 @@ var Sty: TPdfLineStyle; Img: TPdfImage; begin -for Cpt:= 0 to Pred(PdfPage.Count) do + for Cpt := 0 to Pred(PdfPage.Count) do begin - if TPdfElement(PdfPage[Cpt]) is TPdfTexte - then - if TPdfTexte(PdfPage[Cpt]).PageId= NumeroPage - then - with TPdfTexte(PdfPage[Cpt]) do + if TPdfElement(PdfPage[Cpt]) is TPdfTexte then + begin + if TPdfTexte(PdfPage[Cpt]).PageId = NumeroPage then + begin + with TPdfTexte(PdfPage[Cpt]) do begin - if FontName> -1 - then + if FontName > -1 then begin - Fnt:= TPdfFonte.CreateFonte(FontName,FontSize); -// adjust font size to display device - Fnt.FTxtSize:= IntToStr(Round((StrToInt(FontSize)*fpgApplication.Screen_dpi_y) div 72)); - TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Fnt); - Clr:= TPdfColor.CreateColor(True,Couleur); - TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr); + Fnt := TPdfFonte.CreateFonte(FontName, FontSize); + // adjust font size to display device + Fnt.FTxtSize := IntToStr(Round((StrToInt(FontSize) * fpgApplication.Screen_dpi_y) div 72)); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Fnt); + Clr := TPdfColor.CreateColor(True, Couleur); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr); end; - Txt:= TPdfText.CreateText(TextPosX,TextPosY,Writting); - TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Txt); + Txt := TPdfText.CreateText(TextPosX, TextPosY, Writting); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Txt); end; - if TPdfElement(PdfPage[Cpt]) is TPdfRect - then - if TPdfRect(PdfPage[Cpt]).PageId= NumeroPage - then - with TPdfRect(PdfPage[Cpt]) do + end; + end; + if TPdfElement(PdfPage[Cpt]) is TPdfRect then + begin + if TPdfRect(PdfPage[Cpt]).PageId = NumeroPage then + begin + with TPdfRect(PdfPage[Cpt]) do begin - Clr:= TPdfColor.CreateColor(True,RectColor); - TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr); - if RectStroke - then + Clr := TPdfColor.CreateColor(True, RectColor); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr); + if RectStroke then begin - Sty:= TPdfLineStyle.CreateLineStyle(RectLineStyle,0); - TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Sty); + Sty := TPdfLineStyle.CreateLineStyle(RectLineStyle, 0); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Sty); end; - Rct:= TPdfRectangle.CreateRectangle(RectThickness,RectLeft,RectBottom,RectWidth,RectHeight,RectFill,RectStroke); - TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Rct); + Rct := TPdfRectangle.CreateRectangle(RectThickness, RectLeft, RectBottom, RectWidth, RectHeight, RectFill, RectStroke); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Rct); end; - if TPdfElement(PdfPage[Cpt]) is TPdfLine - then - if TPdfLine(PdfPage[Cpt]).PageId= NumeroPage - then - with TPdfLine(PdfPage[Cpt]) do + end; + end; + if TPdfElement(PdfPage[Cpt]) is TPdfLine then + begin + if TPdfLine(PdfPage[Cpt]).PageId = NumeroPage then + begin + with TPdfLine(PdfPage[Cpt]) do begin - Clr:= TPdfColor.CreateColor(False,LineColor); - TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr); - Sty:= TPdfLineStyle.CreateLineStyle(LineStyle,0); - TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Sty); - Lin:= TPdfLigne.CreateLigne(LineThikness,LineBeginX,LineBeginY,LineEndX,LineEndY); - TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Lin); + Clr := TPdfColor.CreateColor(False, LineColor); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr); + Sty := TPdfLineStyle.CreateLineStyle(LineStyle, 0); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Sty); + Lin := TPdfLigne.CreateLigne(LineThikness, LineBeginX, LineBeginY, LineEndX, LineEndY); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Lin); end; - if TPdfElement(PdfPage[Cpt]) is TPdfSurf - then - if TPdfSurf(PdfPage[Cpt]).PageId= NumeroPage - then - with TPdfSurf(PdfPage[Cpt]) do + end; + end; + if TPdfElement(PdfPage[Cpt]) is TPdfSurf then + begin + if TPdfSurf(PdfPage[Cpt]).PageId = NumeroPage then + begin + with TPdfSurf(PdfPage[Cpt]) do begin - Clr:= TPdfColor.CreateColor(True,SurfColor); - TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr); - Srf:= TPdfSurface.CreateSurface(Points); - TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Srf); + Clr := TPdfColor.CreateColor(True, SurfColor); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr); + Srf := TPdfSurface.CreateSurface(Points); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Srf); end; - if TPdfElement(PdfPage[Cpt]) is TPdfImg - then - if TPdfImg(PdfPage[Cpt]).PageId= NumeroPage - then - with TPdfImg(PdfPage[Cpt]) do + end; + end; + if TPdfElement(PdfPage[Cpt]) is TPdfImg then + begin + if TPdfImg(PdfPage[Cpt]).PageId = NumeroPage then + begin + with TPdfImg(PdfPage[Cpt]) do begin - Img:= TPdfImage.CreateImage(ImgLeft,ImgBottom,ImgWidth,ImgHeight,ImgNumber); - TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Img); + Img := TPdfImage.CreateImage(ImgLeft, ImgBottom, ImgWidth, ImgHeight, ImgNumber); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Img); end; - end; + end; + end; + end; { for Cpt... } end; constructor TPdfDocument.CreateDocument(const ALayout: TPageLayout; const AZoom: string; const APreferences: Boolean); var - Cpt,CptSect,CptPage,NumFont,TreeRoot,ParentPage,PageNum,NumPage: Integer; - OutlineRoot,ParentOutline,PageOutline,NextOutline,NextSect,NewPage,PrevOutline,PrevSect: Integer; + Cpt, CptSect, CptPage, NumFont, TreeRoot, ParentPage, PageNum, NumPage: integer; + OutlineRoot, ParentOutline, PageOutline, NextOutline, NextSect, NewPage, PrevOutline, PrevSect: integer; Dictionaire: TPdfDictionary; XRefObjets: TPdfReference; Nom: TPdfName; - FontName,FtName: string; -begin -inherited Create; -FPreferences:= APreferences; -FPageLayout:= ALayout; -FZoomValue:= AZoom; -CreateRefTable; -CreateTrailer; -Catalogue:= CreateCatalog; -CreateInfo; -CreatePreferences; -ParentPage:= 0; -ParentOutline:= 0; -if Sections.Count> 1 -then + FontName, FtName: string; +begin + inherited Create; + FPreferences := APreferences; + FPageLayout := ALayout; + FZoomValue := AZoom; + CreateRefTable; + CreateTrailer; + Catalogue := CreateCatalog; + CreateInfo; + CreatePreferences; + ParentPage := 0; + ParentOutline := 0; + if Sections.Count > 1 then begin - if Outline - then + if Outline then begin - OutlineRoot:= CreateOutlines; - // add outline reference to catalog dictionary - XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); - TPdfDictionary(TPdfXRef(FXRefObjets[Catalogue]).FObjet).AddElement('Outlines',XRefObjets); - // add useoutline element to catalog dictionary - Nom:= TPdfName.CreateName('UseOutlines'); - TPdfDictionary(TPdfXRef(FXRefObjets[Catalogue]).FObjet).AddElement('PageMode',Nom); + OutlineRoot := CreateOutlines; + // add outline reference to catalog dictionary + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + TPdfDictionary(TPdfXRef(FXRefObjets[Catalogue]).FObjet).AddElement('Outlines', XRefObjets); + // add useoutline element to catalog dictionary + Nom := TPdfName.CreateName('UseOutlines'); + TPdfDictionary(TPdfXRef(FXRefObjets[Catalogue]).FObjet).AddElement('PageMode', Nom); end; - TreeRoot:= CreatePages(ParentPage); + TreeRoot := CreatePages(ParentPage); end; -NumPage:= 0; // page number identical to the call to PrintPage -for CptSect:= 0 to Pred(Sections.Count) do + NumPage := 0; // page number identical to the call to PrintPage + for CptSect := 0 to Pred(Sections.Count) do begin - if Sections.Count> 1 - then + if Sections.Count > 1 then begin - if Outline - then + if Outline then begin - ParentOutline:= CreateOutline(OutlineRoot,Succ(CptSect),-1,T_Section(Sections[CptSect]).Title); - Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[OutlineRoot]).FObjet); - TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger; - if CptSect= 0 - then + ParentOutline := CreateOutline(OutlineRoot, Succ(CptSect), -1, T_Section(Sections[CptSect]).Title); + Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[OutlineRoot]).FObjet); + TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger; + if CptSect = 0 then begin - XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); - TPdfDictionary(TPdfXRef(FXRefObjets[OutlineRoot]).FObjet).AddElement('First',XRefObjets); - NextSect:= ParentOutline; - PrevSect:= Pred(FXRefObjets.Count); + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + TPdfDictionary(TPdfXRef(FXRefObjets[OutlineRoot]).FObjet).AddElement('First', XRefObjets); + NextSect := ParentOutline; + PrevSect := Pred(FXRefObjets.Count); end - else + else begin - XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); - TPdfDictionary(TPdfXRef(FXRefObjets[NextSect]).FObjet).AddElement('Next',XRefObjets); - XRefObjets:= TPdfReference.CreateReference(PrevSect); - TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet).AddElement('Prev',XRefObjets); - NextSect:= ParentOutline; - if CptSect< Pred(Sections.Count) - then - PrevSect:= Pred(FXRefObjets.Count); + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + TPdfDictionary(TPdfXRef(FXRefObjets[NextSect]).FObjet).AddElement('Next', XRefObjets); + XRefObjets := TPdfReference.CreateReference(PrevSect); + TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet).AddElement('Prev', XRefObjets); + NextSect := ParentOutline; + if CptSect < Pred(Sections.Count) then + PrevSect := Pred(FXRefObjets.Count); end; - if CptSect= Pred(Sections.Count) - then + if CptSect = Pred(Sections.Count) then begin - XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); - TPdfDictionary(TPdfXRef(FXRefObjets[OutlineRoot]).FObjet).AddElement('Last',XRefObjets); + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + TPdfDictionary(TPdfXRef(FXRefObjets[OutlineRoot]).FObjet).AddElement('Last', XRefObjets); end; end; - ParentPage:= CreatePages(TreeRoot); + ParentPage := CreatePages(TreeRoot); end - else - ParentPage:= CreatePages(ParentPage); - for CptPage:= 0 to Pred(T_Section(Sections[CptSect]).Pages.Count) do + else + ParentPage := CreatePages(ParentPage); + for CptPage := 0 to Pred(T_Section(Sections[CptSect]).Pages.Count) do begin - with T_Section(Sections[CptSect]) do - NewPage:= CreatePage(ParentPage,Paper.H,Paper.W,Succ(NumPage)); - // add zoom factor to catalog dictionary - if (CptSect= 0) and (CptPage= 0) - then + with T_Section(Sections[CptSect]) do + NewPage := CreatePage(ParentPage, Paper.H, Paper.W, Succ(NumPage)); + // add zoom factor to catalog dictionary + if (CptSect = 0) and (CptPage = 0) then begin - XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); - Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[ElementParNom('Catalog')]).FObjet); - TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('OpenAction')]).FValue).AddItem(XRefObjets); - Nom:= TPdfName.CreateName('XYZ null null '+FormatFloat('0.##',StrToInt(FZoomValue)/100)); - TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('OpenAction')]).FValue).AddItem(Nom); + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[ElementParNom('Catalog')]).FObjet); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('OpenAction')]).FValue).AddItem(XRefObjets); + Nom := TPdfName.CreateName('XYZ null null ' + FormatFloat('0.##', StrToInt(FZoomValue) / 100)); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('OpenAction')]).FValue).AddItem(Nom); end; - Inc(NumPage); - PageNum:= CreateContents; // pagenum = object number in the pdf file - CreateStream(NumPage,PageNum); - if (Sections.Count> 1) and Outline - then + Inc(NumPage); + PageNum := CreateContents; // pagenum = object number in the pdf file + CreateStream(NumPage, PageNum); + if (Sections.Count > 1) and Outline then begin - PageOutline:= CreateOutline(ParentOutline,Succ(CptSect),Succ(Cptpage),T_Section(Sections[CptSect]).Title); - Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet); - TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger; - // add page reference to outline destination - Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[PageOutline]).FObjet); - XRefObjets:= TPdfReference.CreateReference(NewPage); - TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Dest')]).FValue).AddItem(XRefObjets); - // add display control name to outline destination - Nom:= TPdfName.CreateName('Fit'); - TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Dest')]).FValue).AddItem(Nom); - if CptPage= 0 - then - begin - XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); - TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet).AddElement('First',XRefObjets); - NextOutline:= PageOutline; - PrevOutline:= Pred(FXRefObjets.Count); - // add page reference to parent outline destination - Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet); - XRefObjets:= TPdfReference.CreateReference(NewPage); + PageOutline := CreateOutline(ParentOutline, Succ(CptSect), Succ(Cptpage), T_Section(Sections[CptSect]).Title); + Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet); + TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger; + // add page reference to outline destination + Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[PageOutline]).FObjet); + XRefObjets := TPdfReference.CreateReference(NewPage); TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Dest')]).FValue).AddItem(XRefObjets); // add display control name to outline destination - Nom:= TPdfName.CreateName('Fit'); + Nom := TPdfName.CreateName('Fit'); TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Dest')]).FValue).AddItem(Nom); + if CptPage = 0 then + begin + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet).AddElement('First', XRefObjets); + NextOutline := PageOutline; + PrevOutline := Pred(FXRefObjets.Count); + // add page reference to parent outline destination + Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet); + XRefObjets := TPdfReference.CreateReference(NewPage); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Dest')]).FValue).AddItem(XRefObjets); + // add display control name to outline destination + Nom := TPdfName.CreateName('Fit'); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Dest')]).FValue).AddItem(Nom); end - else + else begin - XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); - TPdfDictionary(TPdfXRef(FXRefObjets[NextOutline]).FObjet).AddElement('Next',XRefObjets); - XRefObjets:= TPdfReference.CreateReference(PrevOutline); - TPdfDictionary(TPdfXRef(FXRefObjets[PageOutline]).FObjet).AddElement('Prev',XRefObjets); - NextOutline:= PageOutline; - if CptPage< Pred(T_Section(Sections[CptSect]).Pages.Count) - then - PrevOutline:= Pred(FXRefObjets.Count); + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + TPdfDictionary(TPdfXRef(FXRefObjets[NextOutline]).FObjet).AddElement('Next', XRefObjets); + XRefObjets := TPdfReference.CreateReference(PrevOutline); + TPdfDictionary(TPdfXRef(FXRefObjets[PageOutline]).FObjet).AddElement('Prev', XRefObjets); + NextOutline := PageOutline; + if CptPage < Pred(T_Section(Sections[CptSect]).Pages.Count) then + PrevOutline := Pred(FXRefObjets.Count); end; - if CptPage= Pred(T_Section(Sections[CptSect]).Pages.Count) - then + if CptPage = Pred(T_Section(Sections[CptSect]).Pages.Count) then begin - XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); - TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet).AddElement('Last',XRefObjets); + XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet).AddElement('Last', XRefObjets); end; end; end; end; -if Sections.Count> 1 -then + if Sections.Count > 1 then begin - // update count in root parent pages dictionary - Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[TreeRoot]).FObjet); - TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).Value:= T_Section(Sections[CptSect]).TotPages; + // update count in root parent pages dictionary + Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[TreeRoot]).FObjet); + TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).Value := T_Section(Sections[CptSect]).TotPages; end; -if FontDirectory= '' -then - FontDirectory:= ExtractFilePath(Paramstr(0)); -// select the font type -NumFont:= 0; -if Fonts.Count> 0 -then - for Cpt:= 0 to Pred(Fonts.Count) do + if FontDirectory = '' then + FontDirectory := ExtractFilePath(ParamStr(0)); + // select the font type + NumFont := 0; + if Fonts.Count > 0 then + begin + for Cpt := 0 to Pred(Fonts.Count) do begin - FontName:= ExtractBaseFontName(T_Font(Fonts[Cpt]).GetFont.FontDesc); - if Pos('-',FontName)> 0 - then - FtName:= Copy(FontName,1,Pred(Pos('-',FontName))) - else - FtName:= FontName; - if (Lowercase(FtName)= 'courier') or (Lowercase(FtName)= 'helvetica') or (Lowercase(FtName)= 'times') - then + FontName := ExtractBaseFontName(T_Font(Fonts[Cpt]).GetFont.FontDesc); + if Pos('-', FontName) > 0 then + FtName := Copy(FontName, 1, Pred(Pos('-', FontName))) + else + FtName := FontName; + if (Lowercase(FtName) = 'courier') or (Lowercase(FtName) = 'helvetica') or (Lowercase(FtName) = 'times') then begin - FontName:= Uppercase(FontName[1])+Copy(FontName,2,Pred(Length(FontName))); - CreateStdFont(FontName,NumFont); + FontName := Uppercase(FontName[1]) + Copy(FontName, 2, Pred(Length(FontName))); + CreateStdFont(FontName, NumFont); end - else - if LoadFont(FontName)= 'TrueType' - then + else if LoadFont(FontName) = 'TrueType' then CreateTtfFont(NumFont) else CreateTp1Font(NumFont); // not implemented yet - Inc(NumFont); + Inc(NumFont); end; -if Images.Count> 0 -then - for Cpt:= 0 to Pred(Images.Count) do - CreateImage(TfpgImage(Images[Cpt]).Width,TfpgImage(Images[Cpt]).Height,Cpt); -TPdfInteger(TPdfDicElement(Trailer.FElement[Trailer.ElementParCle('Size')]).FValue).FValue:= FXRefObjets.Count; + end; + if Images.Count > 0 then + for Cpt := 0 to Pred(Images.Count) do + CreateImage(TfpgImage(Images[Cpt]).Width, TfpgImage(Images[Cpt]).Height, Cpt); + TPdfInteger(TPdfDicElement(Trailer.FElement[Trailer.ElementParCle('Size')]).FValue).FValue := FXRefObjets.Count; end; destructor TPdfDocument.Destroy; var - Cpt: Integer; + Cpt: integer; begin -Trailer.Free; -if FXRefObjets.Count> 0 -then - for Cpt:= 0 to Pred(FXRefObjets.Count) do - TPdfXRef(FXRefObjets[Cpt]).Free; -FXRefObjets.Free; -inherited; + Trailer.Free; + if FXRefObjets.Count > 0 then + for Cpt := 0 to Pred(FXRefObjets.Count) do + TPdfXRef(FXRefObjets[Cpt]).Free; + FXRefObjets.Free; + inherited; end; procedure TPdfDocument.WriteDocument(const AFlux: TStream); var - Cpt,XRefPos: Integer; + Cpt, XRefPos: integer; begin -AFlux.Position:= 0; -WriteChaine(PDF_VERSION+CRLF,AFlux); -// write numbered indirect objects -for Cpt:= 1 to Pred(FXRefObjets.Count) do + AFlux.Position := 0; + WriteChaine(PDF_VERSION + CRLF, AFlux); + // write numbered indirect objects + for Cpt := 1 to Pred(FXRefObjets.Count) do begin - XRefPos:= AFlux.Position; - WriteObjet(Cpt,AFlux); - TPdfXRef(FXRefObjets[Cpt]).Offset:= XRefPos; + XRefPos := AFlux.Position; + WriteObjet(Cpt, AFlux); + TPdfXRef(FXRefObjets[Cpt]).Offset := XRefPos; end; -XRefPos:= AFlux.Position; -// write xref table -WriteChaine('xref'+CRLF+'0 '+IntToStr(FXRefObjets.Count)+CRLF,AFlux); -with TPdfXRef(FXRefObjets[0]) do - WriteChaine(IntToChaine(Offset,10)+' '+IntToChaine(PDF_MAX_GEN_NUM,5)+' f'+CRLF,AFlux); -WriteXRefTable(AFlux); -// write trailer -WriteChaine('trailer'+CRLF,AFlux); -Trailer.WriteDictionary(-1,AFlux); -// write offset of last xref table -WriteChaine(CRLF+'startxref'+CRLF+IntToStr(XRefPos)+CRLF,AFlux); -WriteChaine(PDF_FILE_END,AFlux); + XRefPos := AFlux.Position; + // write xref table + WriteChaine('xref' + CRLF + '0 ' + IntToStr(FXRefObjets.Count) + CRLF, AFlux); + with TPdfXRef(FXRefObjets[0]) do + WriteChaine(IntToChaine(Offset, 10) + ' ' + IntToChaine(PDF_MAX_GEN_NUM, 5) + ' f' + CRLF, AFlux); + WriteXRefTable(AFlux); + // write trailer + WriteChaine('trailer' + CRLF, AFlux); + Trailer.WriteDictionary(-1, AFlux); + // write offset of last xref table + WriteChaine(CRLF + 'startxref' + CRLF + IntToStr(XRefPos) + CRLF, AFlux); + WriteChaine(PDF_FILE_END, AFlux); end; end. diff --git a/src/reportengine/u_report.pas b/src/reportengine/u_report.pas index 87204034..a1263927 100644 --- a/src/reportengine/u_report.pas +++ b/src/reportengine/u_report.pas @@ -26,455 +26,447 @@ unit U_Report; interface uses - Classes, SysUtils, StrUtils, - fpg_base, fpg_main, - fpg_panel, fpg_dialogs, fpg_imgfmt_bmp, fpg_imgfmt_jpg, - U_Command, U_Pdf; + Classes, + SysUtils, + StrUtils, + fpg_base, + fpg_main, + fpg_panel, + fpg_dialogs, + fpg_imgfmt_bmp, + fpg_imgfmt_jpg, + U_Command, + U_Pdf; type - TPaperType= (A4,Letter,Legal,Executive,Comm10,Monarch,DL,C5,B5); - TOrient= (oPortrait,oLandscape); - TMeasureUnit = (msMM,msInch); - TPreparation= (ppPrepare,ppVisualize,ppPdfFile); + TPaperType = (A4, Letter, Legal, Executive, Comm10, Monarch, DL, C5, B5); + TOrient = (oPortrait, oLandscape); + TMeasureUnit = (msMM, msInch); + TPreparation = (ppPrepare, ppVisualize, ppPdfFile); T_Report = class(TObject) - private - OldSeparator: Char; - FVersion: Char; - FPaper: TPaper; - FPaperType: TPaperType; - FOrientation: TOrient; - FCurrentMargin: TDimensions; - FMeasureUnit: TMeasureUnit; - FPreparation: TPreparation; - FVisualization: Boolean; - FCanvas: TfpgCanvas; - FCurrentFont: Integer; - FCurrentLineSpace: Integer; - FCurrentColor: Integer; - FNmSection: Integer; - FNmPage: Integer; - FNmPageSect: Integer; - FPosRef: TRefPos; // absolute writting position - FHeaderHeight: Single; // end of text vertical position in the header - FPageHeight: Single; // end of text vertical position in the page - FFooterHeight: Single; // beginning of text vertical position in the footer - FGroup: Boolean; - FDefaultFile: string; - function Dim2Pixels(Value: Single): Single; - function Pixels2Dim(Value: Single): Single; - function AddLineBreaks(const Txt: TfpgString; AMaxLineWidth: integer; AFnt: TfpgFont): string; - function TxtHeight(AWid: Integer; const ATxt: TfpgString; AFnt: TfpgFont; ALSpace: Integer= 2): Integer; - function Convert2Alpha(Valeur: Integer): string; - function GetPaperHeight: Integer; - function GetPaperWidth: Integer; - procedure Bv_VisuPaint(Sender: TObject); - procedure PrepareFormat; - procedure CreateVisu; - procedure PrintPage(PageNumero: Integer); - procedure ShiftFooterLines(Shift: Single); - procedure ShiftPageLines(Shift: Single); - procedure ShiftGroup(Shift: Single); - function WriteText(PosX,PosY: Single; Column,Text,FontNum,BkColorNum,BordNum,SpLine: Integer; - TxtFlags: TfpgTextFlags; Zone: TZone): Single; - function WriteNumber(PosX,PosY: Single; Column,TextNum,TextTot,FontNum,BkColorNum,BordNum,SpLine: Integer; - TxtFlags: TfpgTextFlags; Total,Alpha: Boolean; Zone: TZone; SPNum: TSectPageNum): Single; - function InsertSpace(PosY: Single; Column: Integer; SpaceHeight: Single; BkColorNum: Integer; Zone: TZone): Single; - procedure LineEnd(Zone: TZone); - procedure DrawAFrame(StyLine: Integer; Zone: TZone); - procedure DrawALine(XBegin,YBegin,XEnd,YEnd: Single; StyLine: Integer); - procedure DrawAHorizLine(XBegin,YBegin: Single; Column: Integer; XEnd: Single; StyLine: Integer; Zone: TZone); - procedure PaintSurface(Points: T_Points; Couleur: TfpgColor); - procedure PaintImage(PosX,PosY: Single; Column,ImgNum: Integer; Zone: TZone); - function GetSectionTitle: string; - procedure SetSectionTitle(ATitle: string); - public - constructor Create; - destructor Destroy; override; - procedure BeginWrite(IniOrientation: TOrient= oPortrait; IniPaperType: TPaperType= A4; - IniMeasure: TMeasureUnit= msMM; IniVersion: Char= 'F'; IniVisu: Boolean= True); - // starts preview and printing process with initializations - // IniOrientation = paper orientation >> oPortrait or oLandscape - // IniPaperType = (A4, Letter,Legal,Executive,Comm10,Monarch,DL,C5,B5) - // IniMeasure = millimeters (msMM) or inches (msInches) - // IniVersion = version française 'F' or version English 'E', or other, to come - // IniVisu = True (Preview) or False (direct printing or PDF generation) - procedure EndWrite; - procedure WriteDocument; - procedure PagePreview; - procedure Section(MgLeft,MgRight,MgTop,MgBottom: Single; BackPos: Single= 0; - IniOrientation: TOrient= oPortrait); - // new section with initialization of margins - // BackPos = additional margin which can be necessary when frames are drawn - // IniOrientation = paper orientation >> oPortrait or oLandscape - procedure Page; - // new page in the current section - function BackColor(FdColor: TfpgColor): Integer; - // returns the number allocated to the color - // FdColor = background color - function Font(FtNom: string; FtColor: TfpgColor): Integer; - // returns the number allocated to the font - // FtNom = FontDesc of the font - // FtColor = font color - function LineStyle(StThick: Single; StColor: Tfpgcolor; StStyle: TfpgLineStyle): Integer; - // returns the number allocated to the line style - // StThick = thickness of the line in pixels - // StColor = line color - // StStyle = line style - function Border(BdFlags: TBorderFlags; BdStyle: Integer): Integer; - // returns the number allocated to the border - // BdFlags = position of the border (bdTop,bdBottom,bdLeft,bdRight) - // BdStyle = border line style: thickness, color, style - function Column(ClnPos,ClnWidth: Single; ClnMargin: Single= 0; ClnColor: TfpgColor= clWhite): Integer; - // returns the number allocated to the column - // ClnPos = left position in numeric value in the measurement unit (msMM or msInch) - // ClnWidth = width in numeric value in the measurement unit (msMM or msInch) - // ClnMargin = left and right margins in numeric value in the measurement unit (msMM or msInch) - // ClnColor = column background color - procedure WriteHeader(Horiz,Verti: Single; Text: string; ColNum: Integer= 0; FontNum: Integer= 0; - LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1); - // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) - // or numeric value in the measurement unit (msMM or msInch) - // Verti = line position in column (lnCourante,lnFin) - // or numeric value in the measurement unit (msMM or msInch) - // Text = text to be written - // ColNum = column reference, default between left and right margins - // FontNum = font reference - // LineSpNum = space between lines reference - // BkColorNum = background color reference, if > -1, replaces the column background color if any - // BordNum = border reference, if > -1 - function WritePage(Horiz,Verti: Single; Text: string; ColNum: Integer= 0; FontNum: Integer= 0; - LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1): Single; - // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) - // or numeric value in the measurement unit (msMM or msInch) - // Verti = line position in column (lnCourante,lnFin) - // or numeric value in the measurement unit (msMM or msInch) - // Text = text to be written - // ColNum = column reference, default between left and right margins - // FontNum = font reference - // LineSpNum = space between lines reference - // BkColorNum = background color reference, if > -1, replaces the column background color if any - // BordNum = border reference, if > -1 - procedure WriteFooter(Horiz,Verti: Single; Text: string; ColNum: Integer= 0; FontNum: Integer= 0; - LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1); - // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) - // or numeric value in the measurement unit (msMM or msInch) - // Verti = line position in column (lnCourante,lnFin) - // or numeric value in the measurement unit (msMM or msInch) - // Text = text to be written - // ColNum = column reference, default between left and right margins - // FontNum = font reference - // LineSpNum = space between lines reference - // BkColorNum = background color reference, if > -1, replaces the column background color if any - // BordNum = border reference, if > -1 - procedure NumSectionHeader(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= ''; - Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; - LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1); - // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) - // or numeric value in the measurement unit (msMM or msInch) - // Verti = line position in column (lnCourante,lnFin) - // or numeric value in the measurement unit (msMM or msInch) - // TexteSection = text to be written before the section number - // TextTot = text to be written before the number of sections - // Total= True => displays the number of sections - // Alpha= True => displays the number of sections using letters in alphabetic order - // ColNum = column reference, default between left and right margins - // FontNum = font reference - // LineSpNum = space between lines reference - // BkColorNum = background color reference, if > -1, replaces the column background color if any - // BordNum = border reference, if > -1 - procedure NumSectionFooter(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= ''; - Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; - LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1); - // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) - // or numeric value in the measurement unit (msMM or msInch) - // Verti = line position in column (lnCourante,lnFin) - // or numeric value in the measurement unit (msMM or msInch) - // TexteSection = text to be written before the section number - // TextTot = text to be written before the number of sections - // Total= True => displays the number of sections - // Alpha= True => displays the number of sections using letters in alphabetic order - // ColNum = column reference, default between left and right margins - // FontNum = font reference - // LineSpNum = space between lines reference - // BkColorNum = background color reference, if > -1, replaces the column background color if any - // BordNum = border reference, if > -1 - procedure NumPageHeader(Horiz,Verti: Single; TextePage: string= ''; TextTot: string= ''; - Total: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; LineSpNum: Integer= 0; - BkColorNum: Integer= -1; BordNum: Integer= -1); - // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) - // or numeric value in the measurement unit (msMM or msInch) - // Verti = line position in column (lnCourante,lnFin) - // or numeric value in the measurement unit (msMM or msInch) - // TextePage = text to be written before the page number in the document - // TextTot = text to be written before the number of pages of the document - // Total= True > displays the number of pages of the document - // ColNum = column reference, default between left and right margins - // FontNum = font reference - // LineSpNum = space between lines reference - // BkColorNum = background color reference, if > -1, replaces the column background color if any - // BordNum = border reference, if > -1 - procedure NumPageFooter(Horiz,Verti: Single; TextePage: string= ''; TextTot: string= ''; - Total: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; LineSpNum: Integer= 0; - BkColorNum: Integer= -1; BordNum: Integer= -1); - // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) - // or numeric value in the measurement unit (msMM or msInch) - // Verti = line position in column (lnCourante,lnFin) - // or numeric value in the measurement unit (msMM or msInch) - // TextePage = text to be written before the page number in the document - // TextTot = text to be written before the number of pages of the document - // Total= True > displays the number of pages of the document - // ColNum = column reference, default between left and right margins - // FontNum = font reference - // LineSpNum = space between lines reference - // BkColorNum = background color reference, if > -1, replaces the column background color if any - // BordNum = border reference, if > -1 - procedure NumPageSectionHeader(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= ''; - Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; - LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1); - // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) - // or numeric value in the measurement unit (msMM or msInch) - // Verti = line position in column (lnCourante,lnFin) - // or numeric value in the measurement unit (msMM or msInch) - // TextePage = text to ba written before the page number in the section - // TextTot = text to be written before the number of pages of the section - // Total= True > displays the number of pages of the section - // ColNum = column reference, default between left and right margins - // FontNum = font reference - // LineSpNum = space between lines reference - // BkColorNum = background color reference, if > -1, replaces the column background color if any - // BordNum = border reference, if > -1 - procedure NumPageSectionFooter(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= ''; - Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; - LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1); - // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) - // or numeric value in the measurement unit (msMM or msInch) - // Verti = line position in column (lnCourante,lnFin) - // or numeric value in the measurement unit (msMM or msInch) - // TextePage = text to ba written before the page number in the section - // TextTot = text to be written before the number of pages of the section - // Total= True > displays the number of pages of the section - // ColNum = column reference, default between left and right margins - // FontNum = font reference - // LineSpNum = space between lines reference - // BkColorNum = background color reference, if > -1, replaces the column background color if any - // BordNum = border reference, if > -1 - procedure HorizLineHeader(SpBefore,SpAfter: Single; ColNum: Integer= 0; StyleNum: Integer= 0); - // SpBefore = empty space before the horizontal line : numeric value in the measurement unit (msMM or msInch) - // SpAfter = empty space after the horizontal line : numeric value in the measurement unit (msMM or msInch) - // ColNum = column reference, default between left and right margins - // StyleNum = reference of the line style - procedure HorizLinePage(SpBefore,SpAfter: Single; ColNum: Integer= 0; StyleNum: Integer= 0); - // SpBefore = empty space before the horizontal line : numeric value in the measurement unit (msMM or msInch) - // SpAfter = empty space after the horizontal line : numeric value in the measurement unit (msMM or msInch) - // ColNum = column reference, default between left and right margins - // StyleNum = reference of the line style - procedure HorizLineFooter(SpBefore,SpAfter: Single; ColNum: Integer= 0; StyleNum: Integer= 0); - // SpBefore = empty space before the horizontal line : numeric value in the measurement unit (msMM or msInch) - // SpAfter = empty space after the horizontal line : numeric value in the measurement unit (msMM or msInch) - // ColNum = column reference, default between left and right margins - // StyleNum = reference of the line style - procedure SpaceHeader(Verti: Single; ColNum: Integer= 0; BkColorNum: Integer= -1); - // Verti = height of the empty space : numeric value in the measurement unit (msMM or msInch) - // ColNum = column reference, default between left and right margins - // BkColorNum = background color reference, if > -1, replaces the column background color if any - procedure SpacePage(Verti: Single; ColNum: Integer= 0; BkColorNum: Integer= -1); - // Verti = height of the empty space : numeric value in the measurement unit (msMM or msInch) - // ColNum = column reference, default between left and right margins - // BkColorNum = background color reference, if > -1, replaces the column background color if any - procedure SpaceFooter(Verti: Single; ColNum: Integer= 0; BkColorNum: Integer= -1); - // Verti = height of the empty space : numeric value in the measurement unit (msMM or msInch) - // ColNum = column reference, default between left and right margins - // BkColorNum = background color reference, if > -1, replaces the column background color if any - function LineSpace(SpSup,SpInt,SpInf: Single): Integer; - // SpSup = space between lines, top : numeric value in the measurement unit (msMM or msInch) - // SpInt = space between lines, internal if wrapping : numeric value in the measurement unit (msMM or msInch) - // SpInf = space between lines, botom : numeric value in the measurement unit (msMM or msInch) - procedure BeginGroup(PageJump: Boolean= False); - // PageJump = True >> forces new page before the group - // = False >> does not create a new page if the whole group can stand on the same page as the preceding text - procedure EndGroup(PageJump: Boolean= False); - // PageJump = True >> forces new page after the group - // = False >> lets continue on the same page after the group - procedure ColorColChange(ColNum: Integer; ColColor: TfpgColor); - // Changes the background color of a column - // ColNum = column reference - // ColColor = new background color for the column - procedure FrameMargins(AStyle: Integer); - // draw a frame at the page margins - // AStyle = reference of the line style of the frame - procedure FrameHeader(AStyle: Integer); - // draw a frame at the limits of the header - // AStyle = reference of the line style of the frame - procedure FramePage(AStyle: Integer); - // draw a frame at the page limits : left and right margins, header bottom and footer top - // AStyle = reference of the line style of the frame - procedure FrameFooter(AStyle: Integer); - // draw a frame at the limits of the footer - // AStyle = reference of the line style of the frame - procedure LinePage(XBegin,YBegin,XEnd,YEnd: Single; AStyle: Integer); - // draw a line at absolute position - // XBegin = horizontal position of starting point in numeric value in the measurement unit (msMM or msInch) - // YBegin = vertical position of starting point in numeric value in the measurement unit (msMM or msInch) - // XEnd = horizontal position of ending point in numeric value in the measurement unit (msMM or msInch) - // YEnd = vertical position of ending point in numeric value in the measurement unit (msMM or msInch) - // AStyle = reference of the line style of the line - procedure SurfPage(XLimits,YLimits: array of Single; AColor: TfpgColor); - // draw a coloured surface inside the defined limit points - // XLimits = list of horizontal positions of limit points - // YLimits = list of vertical positions of limit points - // AColor = colour to be painted within the limits - procedure ImageHeader(Horiz,Verti: Single; ImgFileName: string; ColNum: Integer= 0; Scale: Integer= 1); - // draw a bmp or jpg image at the defined position - // Horiz = horizontal position in numeric value in the measurement unit (msMM or msInch) - // Verti = vertical position in numeric value in the measurement unit (msMM or msInch) - // ImgFileName = name of the image file - // ColNum = column reference, default between left and right margins - // Scale = 1 for full size - // 2 for 1/2 size - // 3 for 1/3 size - // 4 for 1/4 size - procedure ImagePage(Horiz,Verti: Single; ImgFileName: string; ColNum: Integer= 0; Scale: Integer= 1); - // draw a bmp or jpg image at the defined position - // Horiz = horizontal position in numeric value in the measurement unit (msMM or msInch) - // Verti = vertical position in numeric value in the measurement unit (msMM or msInch) - // ImgFileName = name of the image file - // ColNum = column reference, default between left and right margins - // Scale = 1 for full size - // 2 for 1/2 size - // 3 for 1/3 size - // 4 for 1/4 size - procedure ImageFooter(Horiz,Verti: Single; ImgFileName: string; ColNum: Integer= 0; Scale: Integer= 1); - // draw a bmp or jpg image at the defined position - // Horiz = horizontal position in numeric value in the measurement unit (msMM or msInch) - // Verti = vertical position in numeric value in the measurement unit (msMM or msInch) - // ImgFileName = name of the image file - // ColNum = column reference, default between left and right margins - // Scale = 1 for full size - // 2 for 1/2 size - // 3 for 1/3 size - // 4 for 1/4 size - property Language: Char read FVersion write FVersion; - property Visualiser: Boolean read FVisualization write FVisualization; - property NumSection: Integer read FNmSection write FNmSection; - property NumPage: Integer read FNmPage write FNmPage; - property NumPageSection: Integer read FNmPageSect write FNmPageSect; - property PaperHeight: Integer read GetPaperHeight; - property PagerWidth: Integer read GetPaperWidth; - property DefaultFile: string read FDefaultFile write FDefaultFile; - property CurrentColor: Integer read FCurrentColor write FCurrentColor; - property SectionTitle: string read GetSectionTitle write SetSectionTitle; - end; + private + OldSeparator: char; + FVersion: char; + FPaper: TPaper; + FPaperType: TPaperType; + FOrientation: TOrient; + FCurrentMargin: TDimensions; + FMeasureUnit: TMeasureUnit; + FPreparation: TPreparation; + FVisualization: Boolean; + FCanvas: TfpgCanvas; + FCurrentFont: integer; + FCurrentLineSpace: integer; + FCurrentColor: integer; + FNmSection: integer; + FNmPage: integer; + FNmPageSect: integer; + FPosRef: TRefPos; // absolute writting position + FHeaderHeight: single; // end of text vertical position in the header + FPageHeight: single; // end of text vertical position in the page + FFooterHeight: single; // beginning of text vertical position in the footer + FGroup: Boolean; + FDefaultFile: string; + function Dim2Pixels(Value: single): single; + function Pixels2Dim(Value: single): single; + function AddLineBreaks(const Txt: TfpgString; AMaxLineWidth: integer; AFnt: TfpgFont): string; + function TxtHeight(AWid: integer; const ATxt: TfpgString; AFnt: TfpgFont; ALSpace: integer = 2): integer; + function Convert2Alpha(Valeur: integer): string; + function GetPaperHeight: integer; + function GetPaperWidth: integer; + procedure Bv_VisuPaint(Sender: TObject); + procedure PrepareFormat; + procedure CreateVisu; + procedure PrintPage(PageNumero: integer); + procedure ShiftFooterLines(Shift: single); + procedure ShiftPageLines(Shift: single); + procedure ShiftGroup(Shift: single); + function WriteText(PosX, PosY: single; Column, Text, FontNum, BkColorNum, BordNum, SpLine: integer; TxtFlags: TfpgTextFlags; Zone: TZone): single; + function WriteNumber(PosX, PosY: single; Column, TextNum, TextTot, FontNum, BkColorNum, BordNum, SpLine: integer; TxtFlags: TfpgTextFlags; Total, Alpha: Boolean; Zone: TZone; SPNum: TSectPageNum): single; + function InsertSpace(PosY: single; Column: integer; SpaceHeight: single; BkColorNum: integer; Zone: TZone): single; + procedure LineEnd(Zone: TZone); + procedure DrawAFrame(StyLine: integer; Zone: TZone); + procedure DrawALine(XBegin, YBegin, XEnd, YEnd: single; StyLine: integer); + procedure DrawAHorizLine(XBegin, YBegin: single; Column: integer; XEnd: single; StyLine: integer; Zone: TZone); + procedure PaintSurface(Points: T_Points; Couleur: TfpgColor); + procedure PaintImage(PosX, PosY: single; Column, ImgNum: integer; Zone: TZone); + function GetSectionTitle: string; + procedure SetSectionTitle(ATitle: string); + public + constructor Create; + destructor Destroy; override; + procedure BeginWrite(IniOrientation: TOrient = oPortrait; IniPaperType: TPaperType = A4; IniMeasure: TMeasureUnit = msMM; IniVersion: char = 'F'; IniVisu: Boolean = True); + // starts preview and printing process with initializations + // IniOrientation = paper orientation >> oPortrait or oLandscape + // IniPaperType = (A4, Letter,Legal,Executive,Comm10,Monarch,DL,C5,B5) + // IniMeasure = millimeters (msMM) or inches (msInches) + // IniVersion = version française 'F' or version English 'E', or other, to come + // IniVisu = True (Preview) or False (direct printing or PDF generation) + procedure EndWrite; + procedure WriteDocument; + procedure PagePreview; + procedure Section(MgLeft, MgRight, MgTop, MgBottom: single; BackPos: single = 0; IniOrientation: TOrient = oPortrait); + // new section with initialization of margins + // BackPos = additional margin which can be necessary when frames are drawn + // IniOrientation = paper orientation >> oPortrait or oLandscape + procedure Page; + // new page in the current section + function BackColor(FdColor: TfpgColor): integer; + // returns the number allocated to the color + // FdColor = background color + function Font(FtNom: string; FtColor: TfpgColor): integer; + // returns the number allocated to the font + // FtNom = FontDesc of the font + // FtColor = font color + function LineStyle(StThick: single; StColor: TfpgColor; StStyle: TfpgLineStyle): integer; + // returns the number allocated to the line style + // StThick = thickness of the line in pixels + // StColor = line color + // StStyle = line style + function Border(BdFlags: TBorderFlags; BdStyle: integer): integer; + // returns the number allocated to the border + // BdFlags = position of the border (bdTop,bdBottom,bdLeft,bdRight) + // BdStyle = border line style: thickness, color, style + function Column(ClnPos, ClnWidth: single; ClnMargin: single = 0; ClnColor: TfpgColor = clWhite): integer; + // returns the number allocated to the column + // ClnPos = left position in numeric value in the measurement unit (msMM or msInch) + // ClnWidth = width in numeric value in the measurement unit (msMM or msInch) + // ClnMargin = left and right margins in numeric value in the measurement unit (msMM or msInch) + // ClnColor = column background color + procedure WriteHeader(Horiz, Verti: single; Text: string; ColNum: integer = 0; FontNum: integer = 0; LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); + // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) + // or numeric value in the measurement unit (msMM or msInch) + // Verti = line position in column (lnCourante,lnFin) + // or numeric value in the measurement unit (msMM or msInch) + // Text = text to be written + // ColNum = column reference, default between left and right margins + // FontNum = font reference + // LineSpNum = space between lines reference + // BkColorNum = background color reference, if > -1, replaces the column background color if any + // BordNum = border reference, if > -1 + function WritePage(Horiz, Verti: single; Text: string; ColNum: integer = 0; FontNum: integer = 0; LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1): single; + // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) + // or numeric value in the measurement unit (msMM or msInch) + // Verti = line position in column (lnCourante,lnFin) + // or numeric value in the measurement unit (msMM or msInch) + // Text = text to be written + // ColNum = column reference, default between left and right margins + // FontNum = font reference + // LineSpNum = space between lines reference + // BkColorNum = background color reference, if > -1, replaces the column background color if any + // BordNum = border reference, if > -1 + procedure WriteFooter(Horiz, Verti: single; Text: string; ColNum: integer = 0; FontNum: integer = 0; LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); + // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) + // or numeric value in the measurement unit (msMM or msInch) + // Verti = line position in column (lnCourante,lnFin) + // or numeric value in the measurement unit (msMM or msInch) + // Text = text to be written + // ColNum = column reference, default between left and right margins + // FontNum = font reference + // LineSpNum = space between lines reference + // BkColorNum = background color reference, if > -1, replaces the column background color if any + // BordNum = border reference, if > -1 + procedure NumSectionHeader(Horiz, Verti: single; TexteSect: string = ''; TextTot: string = ''; Total: Boolean = False; Alpha: Boolean = False; ColNum: integer = 0; FontNum: integer = 0; + LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); + // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) + // or numeric value in the measurement unit (msMM or msInch) + // Verti = line position in column (lnCourante,lnFin) + // or numeric value in the measurement unit (msMM or msInch) + // TexteSection = text to be written before the section number + // TextTot = text to be written before the number of sections + // Total= True => displays the number of sections + // Alpha= True => displays the number of sections using letters in alphabetic order + // ColNum = column reference, default between left and right margins + // FontNum = font reference + // LineSpNum = space between lines reference + // BkColorNum = background color reference, if > -1, replaces the column background color if any + // BordNum = border reference, if > -1 + procedure NumSectionFooter(Horiz, Verti: single; TexteSect: string = ''; TextTot: string = ''; Total: Boolean = False; Alpha: Boolean = False; ColNum: integer = 0; FontNum: integer = 0; + LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); + // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) + // or numeric value in the measurement unit (msMM or msInch) + // Verti = line position in column (lnCourante,lnFin) + // or numeric value in the measurement unit (msMM or msInch) + // TexteSection = text to be written before the section number + // TextTot = text to be written before the number of sections + // Total= True => displays the number of sections + // Alpha= True => displays the number of sections using letters in alphabetic order + // ColNum = column reference, default between left and right margins + // FontNum = font reference + // LineSpNum = space between lines reference + // BkColorNum = background color reference, if > -1, replaces the column background color if any + // BordNum = border reference, if > -1 + procedure NumPageHeader(Horiz, Verti: single; TextePage: string = ''; TextTot: string = ''; Total: Boolean = False; ColNum: integer = 0; FontNum: integer = 0; LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); + // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) + // or numeric value in the measurement unit (msMM or msInch) + // Verti = line position in column (lnCourante,lnFin) + // or numeric value in the measurement unit (msMM or msInch) + // TextePage = text to be written before the page number in the document + // TextTot = text to be written before the number of pages of the document + // Total= True > displays the number of pages of the document + // ColNum = column reference, default between left and right margins + // FontNum = font reference + // LineSpNum = space between lines reference + // BkColorNum = background color reference, if > -1, replaces the column background color if any + // BordNum = border reference, if > -1 + procedure NumPageFooter(Horiz, Verti: single; TextePage: string = ''; TextTot: string = ''; Total: Boolean = False; ColNum: integer = 0; FontNum: integer = 0; LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); + // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) + // or numeric value in the measurement unit (msMM or msInch) + // Verti = line position in column (lnCourante,lnFin) + // or numeric value in the measurement unit (msMM or msInch) + // TextePage = text to be written before the page number in the document + // TextTot = text to be written before the number of pages of the document + // Total= True > displays the number of pages of the document + // ColNum = column reference, default between left and right margins + // FontNum = font reference + // LineSpNum = space between lines reference + // BkColorNum = background color reference, if > -1, replaces the column background color if any + // BordNum = border reference, if > -1 + procedure NumPageSectionHeader(Horiz, Verti: single; TexteSect: string = ''; TextTot: string = ''; Total: Boolean = False; Alpha: Boolean = False; ColNum: integer = 0; FontNum: integer = 0; + LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); + // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) + // or numeric value in the measurement unit (msMM or msInch) + // Verti = line position in column (lnCourante,lnFin) + // or numeric value in the measurement unit (msMM or msInch) + // TextePage = text to ba written before the page number in the section + // TextTot = text to be written before the number of pages of the section + // Total= True > displays the number of pages of the section + // ColNum = column reference, default between left and right margins + // FontNum = font reference + // LineSpNum = space between lines reference + // BkColorNum = background color reference, if > -1, replaces the column background color if any + // BordNum = border reference, if > -1 + procedure NumPageSectionFooter(Horiz, Verti: single; TexteSect: string = ''; TextTot: string = ''; Total: Boolean = False; Alpha: Boolean = False; ColNum: integer = 0; FontNum: integer = 0; + LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); + // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight) + // or numeric value in the measurement unit (msMM or msInch) + // Verti = line position in column (lnCourante,lnFin) + // or numeric value in the measurement unit (msMM or msInch) + // TextePage = text to ba written before the page number in the section + // TextTot = text to be written before the number of pages of the section + // Total= True > displays the number of pages of the section + // ColNum = column reference, default between left and right margins + // FontNum = font reference + // LineSpNum = space between lines reference + // BkColorNum = background color reference, if > -1, replaces the column background color if any + // BordNum = border reference, if > -1 + procedure HorizLineHeader(SpBefore, SpAfter: single; ColNum: integer = 0; StyleNum: integer = 0); + // SpBefore = empty space before the horizontal line : numeric value in the measurement unit (msMM or msInch) + // SpAfter = empty space after the horizontal line : numeric value in the measurement unit (msMM or msInch) + // ColNum = column reference, default between left and right margins + // StyleNum = reference of the line style + procedure HorizLinePage(SpBefore, SpAfter: single; ColNum: integer = 0; StyleNum: integer = 0); + // SpBefore = empty space before the horizontal line : numeric value in the measurement unit (msMM or msInch) + // SpAfter = empty space after the horizontal line : numeric value in the measurement unit (msMM or msInch) + // ColNum = column reference, default between left and right margins + // StyleNum = reference of the line style + procedure HorizLineFooter(SpBefore, SpAfter: single; ColNum: integer = 0; StyleNum: integer = 0); + // SpBefore = empty space before the horizontal line : numeric value in the measurement unit (msMM or msInch) + // SpAfter = empty space after the horizontal line : numeric value in the measurement unit (msMM or msInch) + // ColNum = column reference, default between left and right margins + // StyleNum = reference of the line style + procedure SpaceHeader(Verti: single; ColNum: integer = 0; BkColorNum: integer = -1); + // Verti = height of the empty space : numeric value in the measurement unit (msMM or msInch) + // ColNum = column reference, default between left and right margins + // BkColorNum = background color reference, if > -1, replaces the column background color if any + procedure SpacePage(Verti: single; ColNum: integer = 0; BkColorNum: integer = -1); + // Verti = height of the empty space : numeric value in the measurement unit (msMM or msInch) + // ColNum = column reference, default between left and right margins + // BkColorNum = background color reference, if > -1, replaces the column background color if any + procedure SpaceFooter(Verti: single; ColNum: integer = 0; BkColorNum: integer = -1); + // Verti = height of the empty space : numeric value in the measurement unit (msMM or msInch) + // ColNum = column reference, default between left and right margins + // BkColorNum = background color reference, if > -1, replaces the column background color if any + function LineSpace(SpSup, SpInt, SpInf: single): integer; + // SpSup = space between lines, top : numeric value in the measurement unit (msMM or msInch) + // SpInt = space between lines, internal if wrapping : numeric value in the measurement unit (msMM or msInch) + // SpInf = space between lines, botom : numeric value in the measurement unit (msMM or msInch) + procedure BeginGroup(PageJump: Boolean = False); + // PageJump = True >> forces new page before the group + // = False >> does not create a new page if the whole group can stand on the same page as the preceding text + procedure EndGroup(PageJump: Boolean = False); + // PageJump = True >> forces new page after the group + // = False >> lets continue on the same page after the group + procedure ColorColChange(ColNum: integer; ColColor: TfpgColor); + // Changes the background color of a column + // ColNum = column reference + // ColColor = new background color for the column + procedure FrameMargins(AStyle: integer); + // draw a frame at the page margins + // AStyle = reference of the line style of the frame + procedure FrameHeader(AStyle: integer); + // draw a frame at the limits of the header + // AStyle = reference of the line style of the frame + procedure FramePage(AStyle: integer); + // draw a frame at the page limits : left and right margins, header bottom and footer top + // AStyle = reference of the line style of the frame + procedure FrameFooter(AStyle: integer); + // draw a frame at the limits of the footer + // AStyle = reference of the line style of the frame + procedure LinePage(XBegin, YBegin, XEnd, YEnd: single; AStyle: integer); + // draw a line at absolute position + // XBegin = horizontal position of starting point in numeric value in the measurement unit (msMM or msInch) + // YBegin = vertical position of starting point in numeric value in the measurement unit (msMM or msInch) + // XEnd = horizontal position of ending point in numeric value in the measurement unit (msMM or msInch) + // YEnd = vertical position of ending point in numeric value in the measurement unit (msMM or msInch) + // AStyle = reference of the line style of the line + procedure SurfPage(XLimits, YLimits: array of single; AColor: TfpgColor); + // draw a coloured surface inside the defined limit points + // XLimits = list of horizontal positions of limit points + // YLimits = list of vertical positions of limit points + // AColor = colour to be painted within the limits + procedure ImageHeader(Horiz, Verti: single; ImgFileName: string; ColNum: integer = 0; Scale: integer = 1); + // draw a bmp or jpg image at the defined position + // Horiz = horizontal position in numeric value in the measurement unit (msMM or msInch) + // Verti = vertical position in numeric value in the measurement unit (msMM or msInch) + // ImgFileName = name of the image file + // ColNum = column reference, default between left and right margins + // Scale = 1 for full size + // 2 for 1/2 size + // 3 for 1/3 size + // 4 for 1/4 size + procedure ImagePage(Horiz, Verti: single; ImgFileName: string; ColNum: integer = 0; Scale: integer = 1); + // draw a bmp or jpg image at the defined position + // Horiz = horizontal position in numeric value in the measurement unit (msMM or msInch) + // Verti = vertical position in numeric value in the measurement unit (msMM or msInch) + // ImgFileName = name of the image file + // ColNum = column reference, default between left and right margins + // Scale = 1 for full size + // 2 for 1/2 size + // 3 for 1/3 size + // 4 for 1/4 size + procedure ImageFooter(Horiz, Verti: single; ImgFileName: string; ColNum: integer = 0; Scale: integer = 1); + // draw a bmp or jpg image at the defined position + // Horiz = horizontal position in numeric value in the measurement unit (msMM or msInch) + // Verti = vertical position in numeric value in the measurement unit (msMM or msInch) + // ImgFileName = name of the image file + // ColNum = column reference, default between left and right margins + // Scale = 1 for full size + // 2 for 1/2 size + // 3 for 1/3 size + // 4 for 1/4 size + property Language: char read FVersion write FVersion; + property Visualiser: Boolean read FVisualization write FVisualization; + property NumSection: integer read FNmSection write FNmSection; + property NumPage: integer read FNmPage write FNmPage; + property NumPageSection: integer read FNmPageSect write FNmPageSect; + property PaperHeight: integer read GetPaperHeight; + property PagerWidth: integer read GetPaperWidth; + property DefaultFile: string read FDefaultFile write FDefaultFile; + property CurrentColor: integer read FCurrentColor write FCurrentColor; + property SectionTitle: string read GetSectionTitle write SetSectionTitle; + end; // classes for interface with PDF generation TPdfElement = class - end; + end; - TPdfTexte= class(TPdfElement) - private - FPage: Integer; - FFont: Integer; - FSize: string; - FPosX: Single; - FPosY: Single; - FWidth: Single; - FText: string; - FColor: TfpgColor; - public - property PageId: Integer read FPage write FPage; - property FontName: Integer read FFont write FFont; - property FontSize: string read FSize write FSize; - property TextPosX: Single read FPosX write FPosX; - property TextPosY: Single read FPosY write FPosY; - property TextWidt: Single read FWidth write FWidth; - property Writting: string read FText write FText; - property Couleur: TfpgColor read FColor write FColor; - end; + TPdfTexte = class(TPdfElement) + private + FPage: integer; + FFont: integer; + FSize: string; + FPosX: single; + FPosY: single; + FWidth: single; + FText: string; + FColor: TfpgColor; + public + property PageId: integer read FPage write FPage; + property FontName: integer read FFont write FFont; + property FontSize: string read FSize write FSize; + property TextPosX: single read FPosX write FPosX; + property TextPosY: single read FPosY write FPosY; + property TextWidt: single read FWidth write FWidth; + property Writting: string read FText write FText; + property Couleur: TfpgColor read FColor write FColor; + end; TPdfRect = class(TPdfElement) - private - FPage: Integer; - FThick: Single; - FLeft: Single; - FBottom: Single; - FHeight: Single; - FWidth: Single; - FColor: TfpgColor; - FFill: Boolean; - FStroke: Boolean; - FLineStyle: TfpgLineStyle; - protected - public - property PageId: Integer read FPage write FPage; - property RectThickness: Single read FThick write FThick; - property RectLeft: Single read FLeft write FLeft; - property RectBottom: Single read FBottom write FBottom; - property RectHeight: Single read FHeight write FHeight; - property RectWidth: Single read FWidth write FWidth; - property RectColor: TfpgColor read FColor write FColor; - property RectFill: Boolean read FFill write FFill; - property RectStroke: Boolean read FStroke write FStroke; - property RectLineStyle: TfpgLineStyle read FLineStyle write FLineStyle; - end; + private + FPage: integer; + FThick: single; + FLeft: single; + FBottom: single; + FHeight: single; + FWidth: single; + FColor: TfpgColor; + FFill: Boolean; + FStroke: Boolean; + FLineStyle: TfpgLineStyle; + protected + public + property PageId: integer read FPage write FPage; + property RectThickness: single read FThick write FThick; + property RectLeft: single read FLeft write FLeft; + property RectBottom: single read FBottom write FBottom; + property RectHeight: single read FHeight write FHeight; + property RectWidth: single read FWidth write FWidth; + property RectColor: TfpgColor read FColor write FColor; + property RectFill: Boolean read FFill write FFill; + property RectStroke: Boolean read FStroke write FStroke; + property RectLineStyle: TfpgLineStyle read FLineStyle write FLineStyle; + end; TPdfLine = class(TPdfElement) - private - FPage: Integer; - FThick: Single; - FBeginX: Single; - FBeginY: Single; - FEndX: Single; - FEndY: Single; - FColor: TfpgColor; - FStyle: TfpgLineStyle; - protected - public - property PageId: Integer read FPage write FPage; - property LineThikness: Single read FThick write FThick; - property LineBeginX: Single read FBeginX write FBeginX; - property LineBeginY: Single read FBeginY write FBeginY; - property LineEndX: Single read FEndX write FEndX; - property LineEndY: Single read FEndY write FEndY; - property LineColor: TfpgColor read FColor write FColor; - property LineStyle: TfpgLineStyle read FStyle write FStyle; - end; + private + FPage: integer; + FThick: single; + FBeginX: single; + FBeginY: single; + FEndX: single; + FEndY: single; + FColor: TfpgColor; + FStyle: TfpgLineStyle; + protected + public + property PageId: integer read FPage write FPage; + property LineThikness: single read FThick write FThick; + property LineBeginX: single read FBeginX write FBeginX; + property LineBeginY: single read FBeginY write FBeginY; + property LineEndX: single read FEndX write FEndX; + property LineEndY: single read FEndY write FEndY; + property LineColor: TfpgColor read FColor write FColor; + property LineStyle: TfpgLineStyle read FStyle write FStyle; + end; TPdfSurf = class(TPdfElement) - private - FPage: Integer; - FPoints: T_Points; - FColor: TfpgColor; - protected - public - property PageId: Integer read FPage write FPage; - property Points: T_Points read FPoints; - property SurfColor: TfpgColor read FColor write FColor; - end; + private + FPage: integer; + FPoints: T_Points; + FColor: TfpgColor; + protected + public + property PageId: integer read FPage write FPage; + property Points: T_Points read FPoints; + property SurfColor: TfpgColor read FColor write FColor; + end; TPdfImg = class(TPdfElement) - private - FPage: Integer; - FNumber: Integer; - FLeft: Single; - FBottom: Single; - FWidth: Integer; - FHeight: Integer; - protected - public - property PageId: Integer read FPage write FPage; - property ImgNumber: Integer read FNumber write FNumber; - property ImgLeft: Single read FLeft write FLeft; - property ImgBottom: Single read FBottom write FBottom; - property ImgWidth: Integer read FWidth write FWidth; - property ImgHeight: Integer read FHeight write FHeight; - end; + private + FPage: integer; + FNumber: integer; + FLeft: single; + FBottom: single; + FWidth: integer; + FHeight: integer; + protected + public + property PageId: integer read FPage write FPage; + property ImgNumber: integer read FNumber write FNumber; + property ImgLeft: single read FLeft write FLeft; + property ImgBottom: single read FBottom write FBottom; + property ImgWidth: integer read FWidth write FWidth; + property ImgHeight: integer read FHeight write FHeight; + end; var Infos: record Titre: string; Auteur: string; - end; + end; PdfPage: TList; PdfTexte: TPdfTexte; @@ -484,15 +476,15 @@ var PdfImg: TPdfImg; const - PPI= 72; - FontDefaut= 0; - ColDefaut= -2; - lnCurrent= -1; - lnEnd= -2; -// cnSuite= -1; - cnLeft= -2; - cnCenter= -3; - cnRight= -4; + PPI = 72; + FontDefaut = 0; + ColDefaut = -2; + lnCurrent = -1; + lnEnd = -2; + // cnSuite= -1; + cnLeft = -2; + cnCenter = -3; + cnRight = -4; implementation @@ -500,257 +492,250 @@ uses U_Visu; const - InchToMM= 25.4; + InchToMM = 25.4; -function T_Report.Dim2Pixels(Value: Single): Single; +function T_Report.Dim2Pixels(Value: single): single; begin -if FMeasureUnit= msMM -then - Result:= Value*PPI/InchToMM -else - Result:= Value*PPI; + if FMeasureUnit = msMM then + Result := Value * PPI / InchToMM + else + Result := Value * PPI; end; -function T_Report.Pixels2Dim(Value: Single): Single; +function T_Report.Pixels2Dim(Value: single): single; begin -if FMeasureUnit= msMM -then - Result:= Value*InchToMM/PPI -else - Result:= Value/PPI; + if FMeasureUnit = msMM then + Result := Value * InchToMM / PPI + else + Result := Value / PPI; end; function T_Report.AddLineBreaks(const Txt: TfpgString; AMaxLineWidth: integer; AFnt: TfpgFont): string; var - i,n,ls: integer; + i, n, ls: integer; sub: string; - lw,tw: integer; + lw, tw: integer; begin -Result:= ''; -ls:= Length(Txt); -lw:= 0; -i:= 1; -while i<= ls do + Result := ''; + ls := Length(Txt); + lw := 0; + i := 1; + while i <= ls do begin - if (Txt[i] in txtWordDelims) - then // read the delimeter only + if (Txt[i] in txtWordDelims) then // read the delimeter only begin - sub:= Txt[i]; - Inc(i); + sub := Txt[i]; + Inc(i); end - else // read the whole word + else // read the whole word begin - n:= PosSetEx(txtWordDelims,Txt,i); - if n> 0 - then + n := PosSetEx(txtWordDelims, Txt, i); + if n > 0 then begin - sub:= Copy(Txt,i,n-i); - i:= n; + sub := Copy(Txt, i, n - i); + i := n; end - else + else begin - sub:= Copy(Txt,i,MaxInt); - i:= ls+1; + sub := Copy(Txt, i, MaxInt); + i := ls + 1; end; end; - tw:= AFnt.TextWidth(sub); // wrap if needed - if (lw+tw> aMaxLineWidth) and (lw> 0) - then + tw := AFnt.TextWidth(sub); // wrap if needed + if (lw + tw > aMaxLineWidth) and (lw > 0) then begin - lw:= tw; - Result:= TrimRight(Result)+sLineBreak; + lw := tw; + Result := TrimRight(Result) + sLineBreak; end - else - Inc(lw,tw); - Result:= Result+sub; + else + Inc(lw, tw); + Result := Result + sub; end; end; -function T_Report.TxtHeight(AWid: Integer; const ATxt: TfpgString; AFnt: TfpgFont; ALSpace: Integer= 2): Integer; +function T_Report.TxtHeight(AWid: integer; const ATxt: TfpgString; AFnt: TfpgFont; ALSpace: integer = 2): integer; var - Cpt: Integer; + Cpt: integer; Wraplst: TStringList; begin -Wraplst:= TStringList.Create; -Wraplst.Text := ATxt; -for Cpt:= 0 to Pred(Wraplst.Count) do - Wraplst[Cpt] := AddLineBreaks(Wraplst[Cpt],AWid,AFnt); -Wraplst.Text := Wraplst.Text; -Result:= (AFnt.Height*Wraplst.Count)+(ALSpace*Pred(Wraplst.Count)); -WrapLst.Free; + Wraplst := TStringList.Create; + Wraplst.Text := ATxt; + for Cpt := 0 to Pred(Wraplst.Count) do + Wraplst[Cpt] := AddLineBreaks(Wraplst[Cpt], AWid, AFnt); + Wraplst.Text := Wraplst.Text; + Result := (AFnt.Height * Wraplst.Count) + (ALSpace * Pred(Wraplst.Count)); + WrapLst.Free; end; -function T_Report.Convert2Alpha(Valeur: Integer): string; +function T_Report.Convert2Alpha(Valeur: integer): string; var - Cpt: Byte; + Cpt: byte; begin -Result:= ''; -Cpt:= 0; -repeat - if Valeur> 26 - then + Result := ''; + Cpt := 0; + repeat + if Valeur > 26 then begin - Valeur:= Valeur-26; - Inc(Cpt); - Result:= Chr(Cpt+64); + Valeur := Valeur - 26; + Inc(Cpt); + Result := Chr(Cpt + 64); end - else + else begin - Result:= Chr(Valeur+64); - Valeur:= 0; + Result := Chr(Valeur + 64); + Valeur := 0; end; -until Valeur< 1; + until Valeur < 1; end; -function T_Report.GetPaperHeight: Integer; +function T_Report.GetPaperHeight: integer; begin -Result:= FPaper.H; + Result := FPaper.H; end; -function T_Report.GetPaperWidth: Integer; +function T_Report.GetPaperWidth: integer; begin -Result:= FPaper.W; + Result := FPaper.W; end; procedure T_Report.Bv_VisuPaint(Sender: TObject); begin -PrintPage(NumPage); + PrintPage(NumPage); end; procedure T_Report.PrepareFormat; var - TempH,TempW: Integer; - TempT,TempL,TempR,TempB: Single; + TempH, TempW: integer; + TempT, TempL, TempR, TempB: single; begin -with FPaper do + with FPaper do begin - case FPaperType of - A4: + case FPaperType of + A4: begin - H:= 842; - W:= 595; - with Printable do + H := 842; + W := 595; + with Printable do begin - T:= 10; - L:= 11; - R:= 586; - B:= 822; + T := 10; + L := 11; + R := 586; + B := 822; end; end; - Letter: + Letter: begin - H:= 792; - W:= 612; - with Printable do + H := 792; + W := 612; + with Printable do begin - T:= 13; - L:= 13; - R:= 599; - B:= 780; + T := 13; + L := 13; + R := 599; + B := 780; end; end; - Legal: + Legal: begin - H:= 1008; - W:= 612; - with Printable do + H := 1008; + W := 612; + with Printable do begin - T:= 13; - L:= 13; - R:= 599; - B:= 996; + T := 13; + L := 13; + R := 599; + B := 996; end; end; - Executive: + Executive: begin - H:= 756; - W:= 522; - with Printable do + H := 756; + W := 522; + with Printable do begin - T:= 14; - L:= 13; - R:= 508; - B:= 744; + T := 14; + L := 13; + R := 508; + B := 744; end; end; - Comm10: + Comm10: begin - H:= 684; - W:= 297; - with Printable do + H := 684; + W := 297; + with Printable do begin - T:= 13; - L:= 13; - R:= 284; - B:= 672; + T := 13; + L := 13; + R := 284; + B := 672; end; end; - Monarch: + Monarch: begin - H:= 540; - W:= 279; - with Printable do + H := 540; + W := 279; + with Printable do begin - T:= 13; - L:= 13; - R:= 266; - B:= 528; + T := 13; + L := 13; + R := 266; + B := 528; end; end; - DL: + DL: begin - H:= 624; - W:= 312; - with Printable do + H := 624; + W := 312; + with Printable do begin - T:= 14; - L:= 13; - R:= 297; - B:= 611; + T := 14; + L := 13; + R := 297; + B := 611; end; end; - C5: + C5: begin - H:= 649; - W:= 459; - with Printable do + H := 649; + W := 459; + with Printable do begin - T:= 13; - L:= 13; - R:= 446; - B:= 637; + T := 13; + L := 13; + R := 446; + B := 637; end; end; - B5: + B5: begin - H:= 708; - W:= 499; - with Printable do + H := 708; + W := 499; + with Printable do begin - T:= 14; - L:= 13; - R:= 485; - B:= 696; + T := 14; + L := 13; + R := 485; + B := 696; end; end; end; - if FOrientation= oLandscape - then + if FOrientation = oLandscape then begin - TempH:= H; - TempW:= W; - H:= TempW; - W:= TempH; - with Printable do + TempH := H; + TempW := W; + H := TempW; + W := TempH; + with Printable do begin - TempT:= T; - TempL:= L; - TempR:= R; - TempB:= B; - T:= TempL; - L:= TempT; - R:= TempB; - B:= TempR; + TempT := T; + TempL := L; + TempR := R; + TempB := B; + T := TempL; + L := TempT; + R := TempB; + B := TempR; end; end; end; @@ -758,2325 +743,2090 @@ end; procedure T_Report.CreateVisu; begin -F_Visu:= TF_Visu.Create(nil, self); -with F_Visu do + F_Visu := TF_Visu.Create(nil, self); + with F_Visu do begin - Bv_Visu:= CreateBevel(F_Visu,(F_Visu.Width-FPaper.W) div 2,((F_Visu.Height+50-FPaper.H) div 2), - FPaper.W,FPaper.H,bsBox,bsRaised); - Bv_Visu.BackgroundColor:= clWhite; - Bv_Visu.OnPaint:= @Bv_VisuPaint; + Bv_Visu := CreateBevel(F_Visu, (F_Visu.Width - FPaper.W) div 2, ((F_Visu.Height + 50 - FPaper.H) div 2), + FPaper.W, FPaper.H, bsBox, bsRaised); + Bv_Visu.BackgroundColor := clWhite; + Bv_Visu.OnPaint := @Bv_VisuPaint; end; end; -procedure T_Report.PrintPage(PageNumero: Integer); +procedure T_Report.PrintPage(PageNumero: integer); var - CptSect,CptPage,CptCmd: Integer; + CptSect, CptPage, CptCmd: integer; ThePage: T_Page; Cmd: T_Command; begin -CptSect:= 0; -repeat - Inc(CptSect); - CptPage:= 0; - with T_Section(Sections[Pred(CptSect)]) do - repeat - Inc(CptPage); - ThePage:= T_Page(Pages.Items[Pred(CptPage)]); - until (ThePage.PagesTot= PageNumero) or (CptPage= Pages.Count); -until (ThePage.PagesTot= PageNumero) or (CptSect= Sections.Count); -NumPage:= PageNumero; -NumSection:= CptSect; -NumPageSection:= ThePage.PagesSect; -with T_Section(Sections[Pred(NumSection)]) do + CptSect := 0; + repeat + Inc(CptSect); + CptPage := 0; + with T_Section(Sections[Pred(CptSect)]) do + repeat + Inc(CptPage); + ThePage := T_Page(Pages.Items[Pred(CptPage)]); + until (ThePage.PagesTot = PageNumero) or (CptPage = Pages.Count); + until (ThePage.PagesTot = PageNumero) or (CptSect = Sections.Count); + NumPage := PageNumero; + NumSection := CptSect; + NumPageSection := ThePage.PagesSect; + with T_Section(Sections[Pred(NumSection)]) do begin - if CmdHeader.Count> 0 - then - for CptCmd:= 0 to Pred(CmdHeader.Count) do + if CmdHeader.Count > 0 then + for CptCmd := 0 to Pred(CmdHeader.Count) do begin - Cmd:= T_Command(CmdHeader.Items[CptCmd]); - if Cmd is T_WriteText - then - with Cmd as T_WriteText do - WriteText(GetPosX,GetPosY,GetColumn,GetText,GetFont,GetBackColor,GetBorder,GetLineSpace,GetFlags,ZHeader); - if Cmd is T_Number - then - with Cmd as T_Number do - WriteNumber(GetPosX,GetPosY,GetColumn,GetTextNum,GetTextTot,GetFont,GetBackColor,GetBorder,GetLineSpace, - GetFlags,GetTotal,GetAlpha,zHeader,GetTypeNum); - if Cmd is T_Space - then - with Cmd as T_Space do - InsertSpace(GetPosY,GetColumn,GetHeight,GetBackColor,zHeader); - if Cmd is T_Line - then - with Cmd as T_Line do - DrawALine(GetPosX,GetPosY,GetEndX,GetEndY,GetStyle); - if Cmd is T_Image - then - with Cmd as T_Image do - PaintImage(GetPosX,GetPosY,GetColumn,GetImage,zHeader); + Cmd := T_Command(CmdHeader.Items[CptCmd]); + if Cmd is T_WriteText then + with Cmd as T_WriteText do + WriteText(GetPosX, GetPosY, GetColumn, GetText, GetFont, GetBackColor, GetBorder, GetLineSpace, GetFlags, ZHeader); + if Cmd is T_Number then + with Cmd as T_Number do + WriteNumber(GetPosX, GetPosY, GetColumn, GetTextNum, GetTextTot, GetFont, GetBackColor, GetBorder, GetLineSpace, + GetFlags, GetTotal, GetAlpha, zHeader, GetTypeNum); + if Cmd is T_Space then + with Cmd as T_Space do + InsertSpace(GetPosY, GetColumn, GetHeight, GetBackColor, zHeader); + if Cmd is T_Line then + with Cmd as T_Line do + DrawALine(GetPosX, GetPosY, GetEndX, GetEndY, GetStyle); + if Cmd is T_Image then + with Cmd as T_Image do + PaintImage(GetPosX, GetPosY, GetColumn, GetImage, zHeader); end; - if GetCmdPage(NumPageSection).Count> 0 - then - for CptCmd:= 0 to Pred(GetCmdPage(NumPageSection).Count) do + if GetCmdPage(NumPageSection).Count > 0 then + for CptCmd := 0 to Pred(GetCmdPage(NumPageSection).Count) do begin - Cmd:= T_Command(GetCmdPage(NumPageSection).Items[CptCmd]); - if Cmd is T_WriteText - then - with Cmd as T_WriteText do - WriteText(GetPosX,GetPosY,GetColumn,GetText,GetFont,GetBackColor,GetBorder,GetLineSpace,GetFlags,ZPage); - if Cmd is T_Space - then - with Cmd as T_Space do - InsertSpace(GetPosY,GetColumn,GetHeight,GetBackColor,zPage); - if Cmd is T_Line - then - with Cmd as T_Line do - DrawALine(GetPosX,GetPosY,GetEndX,GetEndY,GetStyle); - if Cmd is T_Surface - then - with Cmd as T_Surface do - PaintSurface(GetPoints,GetColor); - if Cmd is T_Image - then - with Cmd as T_Image do - PaintImage(GetPosX,GetPosY,GetColumn,GetImage,zPage); + Cmd := T_Command(GetCmdPage(NumPageSection).Items[CptCmd]); + if Cmd is T_WriteText then + with Cmd as T_WriteText do + WriteText(GetPosX, GetPosY, GetColumn, GetText, GetFont, GetBackColor, GetBorder, GetLineSpace, GetFlags, ZPage); + if Cmd is T_Space then + with Cmd as T_Space do + InsertSpace(GetPosY, GetColumn, GetHeight, GetBackColor, zPage); + if Cmd is T_Line then + with Cmd as T_Line do + DrawALine(GetPosX, GetPosY, GetEndX, GetEndY, GetStyle); + if Cmd is T_Surface then + with Cmd as T_Surface do + PaintSurface(GetPoints, GetColor); + if Cmd is T_Image then + with Cmd as T_Image do + PaintImage(GetPosX, GetPosY, GetColumn, GetImage, zPage); end; - if CmdFooter.Count> 0 - then - for CptCmd:= 0 to Pred(CmdFooter.Count) do + if CmdFooter.Count > 0 then + for CptCmd := 0 to Pred(CmdFooter.Count) do begin - Cmd:= T_Command(CmdFooter.Items[CptCmd]); - if Cmd is T_WriteText - then - with Cmd as T_WriteText do - WriteText(GetPosX,GetPosY,GetColumn,GetText,GetFont,GetBackColor,GetBorder,GetLineSpace,GetFlags,ZFooter); - if Cmd is T_Number - then - with Cmd as T_Number do - WriteNumber(GetPosX,GetPosY,GetColumn,GetTextNum,GetTextTot,GetFont,GetBackColor,GetBorder,GetLineSpace, - GetFlags,GetTotal,GetAlpha,zFooter,GetTypeNum); - if Cmd is T_Space - then - with Cmd as T_Space do - InsertSpace(GetPosY,GetColumn,GetHeight,GetBackColor,zFooter); - if Cmd is T_Line - then - with Cmd as T_Line do - DrawALine(GetPosX,GetPosY,GetEndX,GetEndY,GetStyle); - if Cmd is T_Image - then - with Cmd as T_Image do - PaintImage(GetPosX,GetPosY,GetColumn,GetImage,zFooter); + Cmd := T_Command(CmdFooter.Items[CptCmd]); + if Cmd is T_WriteText then + with Cmd as T_WriteText do + WriteText(GetPosX, GetPosY, GetColumn, GetText, GetFont, GetBackColor, GetBorder, GetLineSpace, GetFlags, ZFooter); + if Cmd is T_Number then + with Cmd as T_Number do + WriteNumber(GetPosX, GetPosY, GetColumn, GetTextNum, GetTextTot, GetFont, GetBackColor, GetBorder, GetLineSpace, + GetFlags, GetTotal, GetAlpha, zFooter, GetTypeNum); + if Cmd is T_Space then + with Cmd as T_Space do + InsertSpace(GetPosY, GetColumn, GetHeight, GetBackColor, zFooter); + if Cmd is T_Line then + with Cmd as T_Line do + DrawALine(GetPosX, GetPosY, GetEndX, GetEndY, GetStyle); + if Cmd is T_Image then + with Cmd as T_Image do + PaintImage(GetPosX, GetPosY, GetColumn, GetImage, zFooter); end; - if CmdFrames.Count> 0 - then - for CptCmd:= 0 to Pred(CmdFrames.Count) do + if CmdFrames.Count > 0 then + for CptCmd := 0 to Pred(CmdFrames.Count) do begin - Cmd:= T_Command(CmdFrames.Items[CptCmd]); - if Cmd is T_Frame - then - with Cmd as T_Frame do - DrawAFrame(GetStyle,GetZone); + Cmd := T_Command(CmdFrames.Items[CptCmd]); + if Cmd is T_Frame then + with Cmd as T_Frame do + DrawAFrame(GetStyle, GetZone); end; end; end; -procedure T_Report.ShiftFooterLines(Shift: Single); +procedure T_Report.ShiftFooterLines(Shift: single); var - Cpt: Integer; + Cpt: integer; Cmd: T_Command; begin -with T_Section(Sections[Pred(NumSection)]) do - if CmdFooter.Count> 0 - then - for Cpt:= 0 to Pred(CmdFooter.Count) do + with T_Section(Sections[Pred(NumSection)]) do + begin + if CmdFooter.Count > 0 then + begin + for Cpt := 0 to Pred(CmdFooter.Count) do begin - Cmd:= T_Command(CmdFooter.Items[Cpt]); - if Cmd is T_WriteText - then - with Cmd as T_WriteText do - SetPosY(GetPosY-Shift); - if Cmd is T_Number - then - with Cmd as T_Number do - SetPosY(GetPosY-Shift); - if Cmd is T_Space - then - with Cmd as T_Space do - SetPosY(GetPosY-Shift); + Cmd := T_Command(CmdFooter.Items[Cpt]); + if Cmd is T_WriteText then + with Cmd as T_WriteText do + SetPosY(GetPosY - Shift); + if Cmd is T_Number then + with Cmd as T_Number do + SetPosY(GetPosY - Shift); + if Cmd is T_Space then + with Cmd as T_Space do + SetPosY(GetPosY - Shift); end; + end; + end; end; -procedure T_Report.ShiftPageLines(Shift: Single); +procedure T_Report.ShiftPageLines(Shift: single); var - Cpt: Integer; + Cpt: integer; Cmd: T_Command; begin -with VWriteLine do - for Cpt:= 0 to Pred(Commands.Count) do + with VWriteLine do + begin + for Cpt := 0 to Pred(Commands.Count) do begin - Cmd:= T_Command(Commands.Items[Cpt]); - if Cmd is T_WriteText - then - with Cmd as T_WriteText do - SetPosY(GetPosY-Shift); + Cmd := T_Command(Commands.Items[Cpt]); + if Cmd is T_WriteText then + with Cmd as T_WriteText do + SetPosY(GetPosY - Shift); end; + end; end; -procedure T_Report.ShiftGroup(Shift: Single); +procedure T_Report.ShiftGroup(Shift: single); var - Cpt: Integer; + Cpt: integer; Cmd: T_Command; begin -with VGroup do - for Cpt:= 0 to Pred(Commands.Count) do + with VGroup do + begin + for Cpt := 0 to Pred(Commands.Count) do begin - Cmd:= T_Command(Commands.Items[Cpt]); - if Cmd is T_WriteText - then - with Cmd as T_WriteText do - SetPosY(GetPosY-Shift); + Cmd := T_Command(Commands.Items[Cpt]); + if Cmd is T_WriteText then + with Cmd as T_WriteText do + SetPosY(GetPosY - Shift); end; + end; end; -function T_Report.WriteText(PosX,PosY: Single; Column,Text,FontNum,BkColorNum,BordNum,SpLine: Integer; - TxtFlags: TfpgTextFlags; Zone: TZone): Single; +function T_Report.WriteText(PosX, PosY: single; Column, Text, FontNum, BkColorNum, BordNum, SpLine: integer; TxtFlags: TfpgTextFlags; Zone: TZone): single; var - PosH,PosV,LnSpInt,LnSpSup,LnSpInf,ThickLine: Single; - HTxt,HeighTxt,Half,ColorLine,Cpt: Integer; - EndOfLine,UseCurFont: Boolean; + PosH, PosV, LnSpInt, LnSpSup, LnSpInf, ThickLine: single; + HTxt, HeighTxt, Half, ColorLine, Cpt: integer; + EndOfLine, UseCurFont: Boolean; Fnt: TfpgFont; StyleLine: TfpgLineStyle; Wraplst: TStringList; begin -with T_Section(Sections[Pred(NumSection)]) do + with T_Section(Sections[Pred(NumSection)]) do begin - EndOfLine:= False; - if FPreparation= ppPrepare - then - if FCurrentFont<> FontNum - then + EndOfLine := False; + if FPreparation = ppPrepare then + begin + if FCurrentFont <> FontNum then begin - FCurrentFont:= FontNum; - UseCurFont:= False; + FCurrentFont := FontNum; + UseCurFont := False; end - else - UseCurFont:= True; - Fnt:= T_Font(Fonts[FontNum]).GetFont; - if LineSpaces.Count= 0 - then - LineSpace(0,0,0); - if FCurrentLineSpace<> SpLine - then - FCurrentLineSpace:= SpLine; - with T_LineSpace(LineSpaces[FCurrentLineSpace]) do + else + UseCurFont := True; + end; + Fnt := T_Font(Fonts[FontNum]).GetFont; + if LineSpaces.Count = 0 then + LineSpace(0, 0, 0); + if FCurrentLineSpace <> SpLine then + FCurrentLineSpace := SpLine; + with T_LineSpace(LineSpaces[FCurrentLineSpace]) do begin - LnSpSup:= GetSup; - LnSpInt:= GetInt; - LnSpInf:= GetInf; + LnSpSup := GetSup; + LnSpInt := GetInt; + LnSpInf := GetInf; end; - if Column= -2 - then - Column:= DefaultCol; - if Column> -1 - then - HeighTxt:= TxtHeight(Round(T_Column(Columns[Column]).GetTextWidth),Texts[Text],Fnt,Round(LnSpInt))+Round(LnSpSup+LnSpInf) - else - HeighTxt:= TxtHeight(Paper.W,Texts[Text],Fnt,Round(LnSpInt))+Round(LnSpSup+LnSpInf); - if (Column> -1) and (BordNum> -1) - then - Half:= Round(T_LineStyle(LineStyles[T_Border(Borders[BordNum]).GetStyle]).GetThick) div 2 - else - Half:= 0; - case FPreparation of - ppPrepare: + if Column = -2 then + Column := DefaultCol; + if Column > -1 then + HeighTxt := TxtHeight(Round(T_Column(Columns[Column]).GetTextWidth), Texts[Text], Fnt, Round(LnSpInt)) + Round(LnSpSup + LnSpInf) + else + HeighTxt := TxtHeight(Paper.W, Texts[Text], Fnt, Round(LnSpInt)) + Round(LnSpSup + LnSpInf); + if (Column > -1) and (BordNum > -1) then + Half := Round(T_LineStyle(LineStyles[T_Border(Borders[BordNum]).GetStyle]).GetThick) div 2 + else + Half := 0; + case FPreparation of + ppPrepare: begin - if NbPages= 0 - then - Page; - if Column> -1 - then + if NbPages = 0 then + Page; + if Column > -1 then begin - HTxt:= VWriteLine.LineHeight; - if HTxt< HeighTxt - then - HTxt:= HeighTxt; + HTxt := VWriteLine.LineHeight; + if HTxt < HeighTxt then + HTxt := HeighTxt; end - else - if HTxt< Fnt.Height - then - HTxt:= Fnt.Height; - case Zone of - zHeader: - FPosRef.Y:= FCurrentMargin.T+FHeaderHeight; - zPage: - FPosRef.Y:= FCurrentMargin.T+FHeaderHeight+FPageHeight; - zFooter: + else if HTxt < Fnt.Height then + HTxt := Fnt.Height; + case Zone of + zHeader: + FPosRef.Y := FCurrentMargin.T + FHeaderHeight; + zPage: + FPosRef.Y := FCurrentMargin.T + FHeaderHeight + FPageHeight; + zFooter: begin - FPosRef.Y:= FCurrentMargin.B-HTxt; - FFooterHeight:= FFooterHeight+HTxt; - ShiftFooterLines(HTxt); + FPosRef.Y := FCurrentMargin.B - HTxt; + FFooterHeight := FFooterHeight + HTxt; + ShiftFooterLines(HTxt); end; end; - if PosY= lnCurrent - then - PosV:= FPosRef.Y+LnSpSup - else + if PosY = lnCurrent then + PosV := FPosRef.Y + LnSpSup + else begin - EndOfLine:= True; - if PosY= lnEnd - then + EndOfLine := True; + if PosY = lnEnd then begin - PosV:= FPosRef.Y+LnSpSup; - case Zone of - zHeader: - FPosRef.Y:= FPosRef.Y+HTxt; - zPage: - begin - if FPosRef.Y+HTxt> FCurrentMargin.B-FFooterHeight - then - if FGroup - then + PosV := FPosRef.Y + LnSpSup; + case Zone of + zHeader: + FPosRef.Y := FPosRef.Y + HTxt; + zPage: + if FPosRef.Y + HTxt > FCurrentMargin.B - FFooterHeight then + if FGroup then begin - if VGroup.GroupeHeight+HTxt< FCurrentMargin.B-FCurrentMargin.T-FHeaderHeight-FFooterHeight - then + if VGroup.GroupeHeight + HTxt < FCurrentMargin.B - FCurrentMargin.T - FHeaderHeight - FFooterHeight then begin - Page; - if VGroup.Commands.Count> 0 - then + Page; + if VGroup.Commands.Count > 0 then begin - FPosRef.Y:= FCurrentMargin.T+FHeaderHeight; - ShiftGroup(T_WriteText(VGroup.Commands[0]).GetPosY-FPosRef.Y); - FPosRef.Y:= FPosRef.Y+VGroup.GroupeHeight+Succ(Half); - if VWriteLine.Commands.Count> 0 - then - ShiftPageLines(T_WriteText(VWriteLine.Commands[0]).GetPosY-FPosRef.Y); - PosV:= FPosRef.Y+LnSpSup; - FPosRef.Y:= FPosRef.Y+HTxt+Succ(Half); + FPosRef.Y := FCurrentMargin.T + FHeaderHeight; + ShiftGroup(T_WriteText(VGroup.Commands[0]).GetPosY - FPosRef.Y); + FPosRef.Y := FPosRef.Y + VGroup.GroupeHeight + Succ(Half); + if VWriteLine.Commands.Count > 0 then + ShiftPageLines(T_WriteText(VWriteLine.Commands[0]).GetPosY - FPosRef.Y); + PosV := FPosRef.Y + LnSpSup; + FPosRef.Y := FPosRef.Y + HTxt + Succ(Half); end - else + else begin - if VWriteLine.Commands.Count> 0 - then - ShiftPageLines(T_WriteText(VWriteLine.Commands[0]).GetPosY-FPosRef.Y); - PosV:= FPosRef.Y+LnSpSup; - FPosRef.Y:= FPosRef.Y+HTxt+Succ(Half); + if VWriteLine.Commands.Count > 0 then + ShiftPageLines(T_WriteText(VWriteLine.Commands[0]).GetPosY - FPosRef.Y); + PosV := FPosRef.Y + LnSpSup; + FPosRef.Y := FPosRef.Y + HTxt + Succ(Half); end; end - else + else begin - LoadCmdGroupToPage; -// VGroup.Commands.Clear; - Page; - FPosRef.Y:= FCurrentMargin.T+FHeaderHeight; - if VWriteLine.Commands.Count> 0 - then - ShiftPageLines(T_WriteText(VWriteLine.Commands[0]).GetPosY-FPosRef.Y); - PosV:= FPosRef.Y+LnSpSup; - FPosRef.Y:= FPosRef.Y+HTxt+Succ(Half); + LoadCmdGroupToPage; + // VGroup.Commands.Clear; + Page; + FPosRef.Y := FCurrentMargin.T + FHeaderHeight; + if VWriteLine.Commands.Count > 0 then + ShiftPageLines(T_WriteText(VWriteLine.Commands[0]).GetPosY - FPosRef.Y); + PosV := FPosRef.Y + LnSpSup; + FPosRef.Y := FPosRef.Y + HTxt + Succ(Half); end; end - else + else begin - Page; - FPosRef.Y:= FCurrentMargin.T+FHeaderHeight; - if VWriteLine.Commands.Count> 0 - then - ShiftPageLines(T_WriteText(VWriteLine.Commands[0]).GetPosY-FPosRef.Y); - PosV:= FPosRef.Y+LnSpSup; - FPosRef.Y:= FPosRef.Y+HTxt+Succ(Half); + Page; + FPosRef.Y := FCurrentMargin.T + FHeaderHeight; + if VWriteLine.Commands.Count > 0 then + ShiftPageLines(T_WriteText(VWriteLine.Commands[0]).GetPosY - FPosRef.Y); + PosV := FPosRef.Y + LnSpSup; + FPosRef.Y := FPosRef.Y + HTxt + Succ(Half); end - else - FPosRef.Y:= FPosRef.Y+HTxt; - end; + else + FPosRef.Y := FPosRef.Y + HTxt; end; - if BordNum> -1 - then - with T_Border(Borders[BordNum]) do - if bfBottom in GetFlags - then - FPosRef.Y:= FPosRef.Y+1; + if BordNum > -1 then + with T_Border(Borders[BordNum]) do + if bfBottom in GetFlags then + FPosRef.Y := FPosRef.Y + 1; end - else + else begin - PosV:= PosY; - FPosRef.Y:= PosV+LnSpInf; + PosV := PosY; + FPosRef.Y := PosV + LnSpInf; end; - case Zone of - zHeader: - FHeaderHeight:= FPosRef.Y-FCurrentMargin.T; - zPage: - FPageHeight:= FPosRef.Y-FHeaderHeight-FCurrentMargin.T; + case Zone of + zHeader: + FHeaderHeight := FPosRef.Y - FCurrentMargin.T; + zPage: + FPageHeight := FPosRef.Y - FHeaderHeight - FCurrentMargin.T; end; end; - //if PosX= cnSuite - //then + //if PosX= cnSuite + //then //PosH:= FPosRef.X - //else - if Column= -1 - then - if PosX> 0 - then - PosH:= PosX + //else + if Column = -1 then + if PosX > 0 then + PosH := PosX else - begin - PosH:= T_Column(Columns[ColDefaut]).GetTextPos; - if (txtRight in TxtFlags) - then - PosH:= PosH+T_Column(Columns[ColDefaut]).ColWidth-Fnt.TextWidth(Texts[Text])-T_Column(Columns[ColDefaut]).ColMargin; - if (txtHCenter in TxtFlags) - then - PosH:= PosH+(T_Column(Columns[ColDefaut]).ColWidth-Fnt.TextWidth(Texts[Text]))/2; - end - else - if PosX> 0 - then - begin - if (PosX< T_Column(Columns[Column]).GetTextPos) - or (PosX> (T_Column(Columns[Column]).GetTextPos+T_Column(Columns[Column]).GetTextWidth)) - then - PosH:= T_Column(Columns[Column]).GetTextPos - else - PosH:= PosX; - end + begin + PosH := T_Column(Columns[ColDefaut]).GetTextPos; + if (txtRight in TxtFlags) then + PosH := PosH + T_Column(Columns[ColDefaut]).ColWidth - Fnt.TextWidth(Texts[Text]) - T_Column(Columns[ColDefaut]).ColMargin; + if (txtHCenter in TxtFlags) then + PosH := PosH + (T_Column(Columns[ColDefaut]).ColWidth - Fnt.TextWidth(Texts[Text])) / 2; + end + else if PosX > 0 then + begin + if (PosX < T_Column(Columns[Column]).GetTextPos) or (PosX > (T_Column(Columns[Column]).GetTextPos + T_Column(Columns[Column]).GetTextWidth)) then + PosH := T_Column(Columns[Column]).GetTextPos else - begin - PosH:= T_Column(Columns[Column]).GetTextPos; - if (txtRight in TxtFlags) - then - PosH:= PosH+T_Column(Columns[Column]).ColWidth-Fnt.TextWidth(Texts[Text])-T_Column(Columns[Column]).ColMargin; - if (txtHCenter in TxtFlags) - then - PosH:= PosH+(T_Column(Columns[Column]).ColWidth-Fnt.TextWidth(Texts[Text]))/2; - end; - FPosRef.X:= PosH+Fnt.TextWidth(Texts[Text]+' '); - VWriteLine.LoadText(PosH,PosV,Column,Text,FontNum,HTxt,BkColorNum,BordNum,SpLine,UseCurFont,TxtFlags); - Result:= Pixels2Dim(FPosRef.Y); - if EndOfLine - then + PosH := PosX; + end + else begin - HTxt:= 0; - LineEnd(Zone); + PosH := T_Column(Columns[Column]).GetTextPos; + if (txtRight in TxtFlags) then + PosH := PosH + T_Column(Columns[Column]).ColWidth - Fnt.TextWidth(Texts[Text]) - T_Column(Columns[Column]).ColMargin; + if (txtHCenter in TxtFlags) then + PosH := PosH + (T_Column(Columns[Column]).ColWidth - Fnt.TextWidth(Texts[Text])) / 2; + end; + FPosRef.X := PosH + Fnt.TextWidth(Texts[Text] + ' '); + VWriteLine.LoadText(PosH, PosV, Column, Text, FontNum, HTxt, BkColorNum, BordNum, SpLine, UseCurFont, TxtFlags); + Result := Pixels2Dim(FPosRef.Y); + if EndOfLine then + begin + HTxt := 0; + LineEnd(Zone); end; end; - ppVisualize: - with FCanvas do + ppVisualize: + begin + with FCanvas do begin - Font:= T_Font(Fonts[FontNum]).GetFont; - SetTextColor(T_Font(Fonts[FontNum]).GetColor); - if Column> -1 - then - with T_Column(Columns[Column]) do + Font := T_Font(Fonts[FontNum]).GetFont; + SetTextColor(T_Font(Fonts[FontNum]).GetColor); + if Column > -1 then + with T_Column(Columns[Column]) do begin - if BkColorNum> -1 - then - SetColor(T_BackColor(BackColors[BkColorNum]).GetColor) - else - SetColor(GetColor); - FillRectangle(Round(ColPos),Round(PosY-LnSpSup),Round(ColWidth),HeighTxt); - if BordNum> -1 - then - with T_Border(Borders[BordNum]) do + if BkColorNum > -1 then + SetColor(T_BackColor(BackColors[BkColorNum]).GetColor) + else + SetColor(GetColor); + FillRectangle(Round(ColPos), Round(PosY - LnSpSup), Round(ColWidth), HeighTxt); + if BordNum > -1 then + with T_Border(Borders[BordNum]) do begin - SetLineStyle(Round(T_LineStyle(LineStyles[GetStyle]).GetThick),T_LineStyle(LineStyles[GetStyle]).GetStyle); - SetColor(T_LineStyle(LineStyles[GetStyle]).GetColor); - if bfLeft in GetFlags - then - DrawLine(Round(ColPos)+Half,Round(PosY-LnSpSup),Round(ColPos)+Half,Round(PosY-LnSpSup)+HeighTxt); - if bfRight in GetFlags - then - DrawLine(Round(ColPos+ColWidth)-Succ(Half),Round(PosY-LnSpSup),Round(ColPos+ColWidth)-Succ(Half),Round(PosY-LnSpSup)+HeighTxt); - if bfTop in GetFlags - then - DrawLine(Round(ColPos),Round(PosY-LnSpSup)+Half,Round(ColPos+ColWidth),Round(PosY-LnSpSup)+Half); - if bfBottom in GetFlags - then - DrawLine(Round(ColPos),Round(PosY-LnSpSup)+HeighTxt-Half,Round(ColPos+ColWidth),Round(PosY-LnSpSup)+HeighTxt-Half); + SetLineStyle(Round(T_LineStyle(LineStyles[GetStyle]).GetThick), T_LineStyle(LineStyles[GetStyle]).GetStyle); + SetColor(T_LineStyle(LineStyles[GetStyle]).GetColor); + if bfLeft in GetFlags then + DrawLine(Round(ColPos) + Half, Round(PosY - LnSpSup), Round(ColPos) + Half, Round(PosY - LnSpSup) + HeighTxt); + if bfRight in GetFlags then + DrawLine(Round(ColPos + ColWidth) - Succ(Half), Round(PosY - LnSpSup), Round(ColPos + ColWidth) - Succ(Half), Round(PosY - LnSpSup) + HeighTxt); + if bfTop in GetFlags then + DrawLine(Round(ColPos), Round(PosY - LnSpSup) + Half, Round(ColPos + ColWidth), Round(PosY - LnSpSup) + Half); + if bfBottom in GetFlags then + DrawLine(Round(ColPos), Round(PosY - LnSpSup) + HeighTxt - Half, Round(ColPos + ColWidth), Round(PosY - LnSpSup) + HeighTxt - Half); end; - DrawText(Round(GetTextPos),Round(PosY),Round(GetTextWidth),0,Texts[Text],TxtFlags,Round(LnSpInt)); + DrawText(Round(GetTextPos), Round(PosY), Round(GetTextWidth), 0, Texts[Text], TxtFlags, Round(LnSpInt)); end - else - DrawText(Round(PosX),Round(PosY)-Fnt.Ascent,Round(Paper.W-PosX),0,Texts[Text],TxtFlags); + else + DrawText(Round(PosX), Round(PosY) - Fnt.Ascent, Round(Paper.W - PosX), 0, Texts[Text], TxtFlags); end; - ppPdfFile: - if Column> -1 - then - with T_Column(Columns[Column]) do + end; + ppPdfFile: + begin + if Column > -1 then + with T_Column(Columns[Column]) do begin - if (GetColor<> clWhite) or (BkColorNum> -1) - then + if (GetColor <> clWhite) or (BkColorNum > -1) then begin - PdfRect:= TPdfRect.Create; - with PdfRect do + PdfRect := TPdfRect.Create; + with PdfRect do begin - PageId:= NumPage; - FLeft:= ColPos; - FBottom:= Paper.H-PosY+LnSpSup-HeighTxt; - FHeight:= HeighTxt; - FWidth:= ColWidth; - if BkColorNum> -1 - then - FColor:= T_BackColor(BackColors[BkColorNum]).GetColor - else - FColor:= GetColor; - FFill:= True; - FStroke:= False; + PageId := NumPage; + FLeft := ColPos; + FBottom := Paper.H - PosY + LnSpSup - HeighTxt; + FHeight := HeighTxt; + FWidth := ColWidth; + if BkColorNum > -1 then + FColor := T_BackColor(BackColors[BkColorNum]).GetColor + else + FColor := GetColor; + FFill := True; + FStroke := False; end; - PdfPage.Add(PdfRect); + PdfPage.Add(PdfRect); end; - if BordNum> -1 - then - with T_Border(Borders[BordNum]) do + if BordNum > -1 then + with T_Border(Borders[BordNum]) do begin - StyleLine:= T_LineStyle(LineStyles[GetStyle]).GetStyle; - ColorLine:= T_LineStyle(LineStyles[GetStyle]).GetColor; - ThickLine:= T_LineStyle(LineStyles[GetStyle]).GetThick; - if bfLeft in GetFlags - then + StyleLine := T_LineStyle(LineStyles[GetStyle]).GetStyle; + ColorLine := T_LineStyle(LineStyles[GetStyle]).GetColor; + ThickLine := T_LineStyle(LineStyles[GetStyle]).GetThick; + if bfLeft in GetFlags then begin - PdfLine:= TPdfLine.Create; - with PdfLine do + PdfLine := TPdfLine.Create; + with PdfLine do begin - PageId:= NumPage; - FBeginX:= ColPos; - FBeginY:= Paper.H-PosY+LnSpSup; - FEndX:= ColPos; - FEndY:= Paper.H-PosY+LnSpSup-HeighTxt; - FStyle:= StyleLine; - FColor:= ColorLine; - FThick:= ThickLine; + PageId := NumPage; + FBeginX := ColPos; + FBeginY := Paper.H - PosY + LnSpSup; + FEndX := ColPos; + FEndY := Paper.H - PosY + LnSpSup - HeighTxt; + FStyle := StyleLine; + FColor := ColorLine; + FThick := ThickLine; end; - PdfPage.Add(PdfLine); + PdfPage.Add(PdfLine); end; - if bfRight in GetFlags - then + if bfRight in GetFlags then begin - PdfLine:= TPdfLine.Create; - with PdfLine do + PdfLine := TPdfLine.Create; + with PdfLine do begin - PageId:= NumPage; - FBeginX:= ColPos+ColWidth; - FBeginY:= Paper.H-PosY+LnSpSup; - FEndX:= ColPos+ColWidth; - FEndY:= Paper.H-PosY+LnSpSup-HeighTxt; - FStyle:= StyleLine; - FColor:= ColorLine; - FThick:= ThickLine; + PageId := NumPage; + FBeginX := ColPos + ColWidth; + FBeginY := Paper.H - PosY + LnSpSup; + FEndX := ColPos + ColWidth; + FEndY := Paper.H - PosY + LnSpSup - HeighTxt; + FStyle := StyleLine; + FColor := ColorLine; + FThick := ThickLine; end; - PdfPage.Add(PdfLine); + PdfPage.Add(PdfLine); end; - if bfTop in GetFlags - then + if bfTop in GetFlags then begin - PdfLine:= TPdfLine.Create; - with PdfLine do + PdfLine := TPdfLine.Create; + with PdfLine do begin - PageId:= NumPage; - FBeginX:= ColPos; - FBeginY:= Paper.H-PosY+LnSpSup; - FEndX:= ColPos+ColWidth; - FEndY:= Paper.H-PosY+LnSpSup; - FStyle:= StyleLine; - FColor:= ColorLine; - FThick:= ThickLine; + PageId := NumPage; + FBeginX := ColPos; + FBeginY := Paper.H - PosY + LnSpSup; + FEndX := ColPos + ColWidth; + FEndY := Paper.H - PosY + LnSpSup; + FStyle := StyleLine; + FColor := ColorLine; + FThick := ThickLine; end; - PdfPage.Add(PdfLine); + PdfPage.Add(PdfLine); end; - if bfBottom in GetFlags - then + if bfBottom in GetFlags then begin - PdfLine:= TPdfLine.Create; - with PdfLine do + PdfLine := TPdfLine.Create; + with PdfLine do begin - PageId:= NumPage; - FBeginX:= ColPos; - FBeginY:= Paper.H-PosY+LnSpSup-HeighTxt; - FEndX:= ColPos+ColWidth; - FEndY:= Paper.H-PosY+LnSpSup-HeighTxt; - FStyle:= StyleLine; - FColor:= ColorLine; - FThick:= ThickLine; + PageId := NumPage; + FBeginX := ColPos; + FBeginY := Paper.H - PosY + LnSpSup - HeighTxt; + FEndX := ColPos + ColWidth; + FEndY := Paper.H - PosY + LnSpSup - HeighTxt; + FStyle := StyleLine; + FColor := ColorLine; + FThick := ThickLine; end; - PdfPage.Add(PdfLine); + PdfPage.Add(PdfLine); end; end; - if Fnt.TextWidth(Texts[Text])< GetTextWidth - then + if Fnt.TextWidth(Texts[Text]) < GetTextWidth then begin - PdfTexte:= TPdfTexte.Create; - with PdfTexte do + PdfTexte := TPdfTexte.Create; + with PdfTexte do begin - PageId:= NumPage; - FFont:= FontNum; - FSize:= T_Font(Fonts[FontNum]).GetSize; - FColor:= T_Font(Fonts[FontNum]).GetColor; - TextPosX:= GetTextPos; - if (txtRight in TxtFlags) - then - TextPosX:= ColPos+ColWidth-ColMargin-Fnt.TextWidth(Texts[Text]); - if (txtHCenter in TxtFlags) - then - TextPosX:= GetTextPos+(ColWidth-Fnt.TextWidth(Texts[Text]))/2; - TextPosY:= Paper.H-PosY-Fnt.Ascent; - TextWidt:= ColWidth; - Writting:= Texts[Text]; + PageId := NumPage; + FFont := FontNum; + FSize := T_Font(Fonts[FontNum]).GetSize; + FColor := T_Font(Fonts[FontNum]).GetColor; + TextPosX := GetTextPos; + if (txtRight in TxtFlags) then + TextPosX := ColPos + ColWidth - ColMargin - Fnt.TextWidth(Texts[Text]); + if (txtHCenter in TxtFlags) then + TextPosX := GetTextPos + (ColWidth - Fnt.TextWidth(Texts[Text])) / 2; + TextPosY := Paper.H - PosY - Fnt.Ascent; + TextWidt := ColWidth; + Writting := Texts[Text]; end; - PdfPage.Add(PdfTexte); + PdfPage.Add(PdfTexte); end - else + else begin - Wraplst:= TStringList.Create; - Wraplst.Text:= Texts[Text]; - for Cpt:= 0 to Pred(Wraplst.Count) do - Wraplst[Cpt]:= AddLineBreaks(Wraplst[Cpt],Round(GetTextWidth),Fnt); - Wraplst.Text:= Wraplst.Text; - for Cpt:= 0 to Pred(Wraplst.Count) do + Wraplst := TStringList.Create; + Wraplst.Text := Texts[Text]; + for Cpt := 0 to Pred(Wraplst.Count) do + Wraplst[Cpt] := AddLineBreaks(Wraplst[Cpt], Round(GetTextWidth), Fnt); + Wraplst.Text := Wraplst.Text; + for Cpt := 0 to Pred(Wraplst.Count) do begin - PdfTexte:= TPdfTexte.Create; + PdfTexte := TPdfTexte.Create; with PdfTexte do - begin - PageId:= NumPage; - FFont:= FontNum; - FSize:= T_Font(Fonts[FontNum]).GetSize; - FColor:= T_Font(Fonts[FontNum]).GetColor; - TextPosX:= GetTextPos; - if (txtRight in TxtFlags) - then - TextPosX:= ColPos+ColWidth-ColMargin-Fnt.TextWidth(Wraplst[Cpt]); - if (txtHCenter in TxtFlags) - then - TextPosX:= GetTextPos+(ColWidth-Fnt.TextWidth(Wraplst[Cpt]))/2; - TextPosY:= Paper.H-PosY-Fnt.Ascent-(Fnt.Height+LnSpInt)*Cpt; - TextWidt:= ColWidth; - Writting:= Wraplst[Cpt]; - end; + begin + PageId := NumPage; + FFont := FontNum; + FSize := T_Font(Fonts[FontNum]).GetSize; + FColor := T_Font(Fonts[FontNum]).GetColor; + TextPosX := GetTextPos; + if (txtRight in TxtFlags) then + TextPosX := ColPos + ColWidth - ColMargin - Fnt.TextWidth(Wraplst[Cpt]); + if (txtHCenter in TxtFlags) then + TextPosX := GetTextPos + (ColWidth - Fnt.TextWidth(Wraplst[Cpt])) / 2; + TextPosY := Paper.H - PosY - Fnt.Ascent - (Fnt.Height + LnSpInt) * Cpt; + TextWidt := ColWidth; + Writting := Wraplst[Cpt]; + end; PdfPage.Add(PdfTexte); end; - WrapLst.Free; + WrapLst.Free; end; end - else - if Fnt.TextWidth(Texts[Text])< Paper.W-PosX - then - begin - PdfTexte:= TPdfTexte.Create; + else if Fnt.TextWidth(Texts[Text]) < Paper.W - PosX then + begin + PdfTexte := TPdfTexte.Create; with PdfTexte do - begin - PageId:= NumPage; - FFont:= FontNum; - FSize:= T_Font(Fonts[FontNum]).GetSize; - FColor:= T_Font(Fonts[FontNum]).GetColor; - FPosX:= PosX; - FPosY:= Paper.H-PosY; - FWidth:= Paper.W; - FText:= Texts[Text]; - end; + begin + PageId := NumPage; + FFont := FontNum; + FSize := T_Font(Fonts[FontNum]).GetSize; + FColor := T_Font(Fonts[FontNum]).GetColor; + FPosX := PosX; + FPosY := Paper.H - PosY; + FWidth := Paper.W; + FText := Texts[Text]; + end; PdfPage.Add(PdfTexte); - end + end else + begin + Wraplst := TStringList.Create; + Wraplst.Text := Texts[Text]; + for Cpt := 0 to Pred(Wraplst.Count) do + Wraplst[Cpt] := AddLineBreaks(Wraplst[Cpt], Round(Paper.W - PosX), Fnt); + Wraplst.Text := Wraplst.Text; + for Cpt := 0 to Pred(Wraplst.Count) do begin - Wraplst:= TStringList.Create; - Wraplst.Text:= Texts[Text]; - for Cpt:= 0 to Pred(Wraplst.Count) do - Wraplst[Cpt]:= AddLineBreaks(Wraplst[Cpt],Round(Paper.W-PosX),Fnt); - Wraplst.Text:= Wraplst.Text; - for Cpt:= 0 to Pred(Wraplst.Count) do - begin - PdfTexte:= TPdfTexte.Create; + PdfTexte := TPdfTexte.Create; with PdfTexte do - begin - PageId:= NumPage; - FFont:= FontNum; - FSize:= T_Font(Fonts[FontNum]).GetSize; - FColor:= T_Font(Fonts[FontNum]).GetColor; - FPosX:= PosX; - FPosY:= Paper.H-PosY-Fnt.Ascent-(Fnt.Height+LnSpInt)*Cpt; - FWidth:= Paper.W; - FText:= Wraplst[Cpt]; - end; - PdfPage.Add(PdfTexte); + begin + PageId := NumPage; + FFont := FontNum; + FSize := T_Font(Fonts[FontNum]).GetSize; + FColor := T_Font(Fonts[FontNum]).GetColor; + FPosX := PosX; + FPosY := Paper.H - PosY - Fnt.Ascent - (Fnt.Height + LnSpInt) * Cpt; + FWidth := Paper.W; + FText := Wraplst[Cpt]; end; - WrapLst.Free; + PdfPage.Add(PdfTexte); end; + WrapLst.Free; + end; + end; end; end; end; -function T_Report.WriteNumber(PosX,PosY: Single; Column,TextNum,TextTot,FontNum,BkColorNum,BordNum,SpLine: Integer; - TxtFlags: TfpgTextFlags; Total,Alpha: Boolean; Zone: TZone; SPNum: TSectPageNum): Single; +function T_Report.WriteNumber(PosX, PosY: single; Column, TextNum, TextTot, FontNum, BkColorNum, BordNum, SpLine: integer; TxtFlags: TfpgTextFlags; Total, Alpha: Boolean; Zone: TZone; SPNum: TSectPageNum): single; function BuildChaine: string; var NumAlpha: string; begin - case SPNum of - PageNum: - if Total - then - Result:= Texts[TextNum]+' '+IntToStr(NumPage)+' '+Texts[TextTot]+' ' - +IntToStr(T_Section(Sections[Pred(Sections.Count)]).TotPages) - else - Result:= Texts[TextNum]+' '+IntToStr(NumPage); - SectNum: + case SPNum of + PageNum: begin - if Alpha - then - NumAlpha:= Convert2Alpha(NumSection) - else - NumAlpha:= IntToStr(NumSection); - if Total - then - Result:= Texts[TextNum]+' '+NumAlpha+' '+Texts[TextTot]+' '+IntToStr(Sections.Count) - else - Result:= Texts[TextNum]+' '+NumAlpha; + if Total then + Result := Texts[TextNum] + ' ' + IntToStr(NumPage) + ' ' + Texts[TextTot] + ' ' + IntToStr(T_Section(Sections[Pred(Sections.Count)]).TotPages) + else + Result := Texts[TextNum] + ' ' + IntToStr(NumPage); end; - PSectNum: + SectNum: begin - if Alpha - then - NumAlpha:= Convert2Alpha(NumPageSection) - else - NumAlpha:= IntToStr(NumPageSection); - if Total - then - Result:= Texts[TextNum]+' '+NumAlpha+' '+Texts[TextTot]+' ' - +IntToStr(T_Section(Sections[Pred(NumSection)]).NbPages) - else - Result:= Texts[TextNum]+' '+NumAlpha; + if Alpha then + NumAlpha := Convert2Alpha(NumSection) + else + NumAlpha := IntToStr(NumSection); + if Total then + Result := Texts[TextNum] + ' ' + NumAlpha + ' ' + Texts[TextTot] + ' ' + IntToStr(Sections.Count) + else + Result := Texts[TextNum] + ' ' + NumAlpha; + end; + PSectNum: + begin + if Alpha then + NumAlpha := Convert2Alpha(NumPageSection) + else + NumAlpha := IntToStr(NumPageSection); + if Total then + Result := Texts[TextNum] + ' ' + NumAlpha + ' ' + Texts[TextTot] + ' ' + IntToStr(T_Section(Sections[Pred(NumSection)]).NbPages) + else + Result := Texts[TextNum] + ' ' + NumAlpha; end; end; end; var - PosH,PosV,LnSpInt,LnSpSup,LnSpInf,ThickLine: Single; - HTxt,HeighTxt,Half,ColorLine: Integer; - EndOfLine,UseCurFont: Boolean; + PosH, PosV, LnSpInt, LnSpSup, LnSpInf, ThickLine: single; + HTxt, HeighTxt, Half, ColorLine: integer; + EndOfLine, UseCurFont: Boolean; Fnt: TfpgFont; StyleLine: TfpgLineStyle; Chaine: string; begin -with T_Section(Sections[Pred(NumSection)]) do + with T_Section(Sections[Pred(NumSection)]) do begin - EndOfLine:= False; - if FPreparation= ppPrepare - then - if FCurrentFont<> FontNum - then + EndOfLine := False; + if FPreparation = ppPrepare then + begin + if FCurrentFont <> FontNum then begin - FCurrentFont:= FontNum; - UseCurFont:= False; + FCurrentFont := FontNum; + UseCurFont := False; end - else - UseCurFont:= True; - Fnt:= T_Font(Fonts[FontNum]).GetFont; - if LineSpaces.Count= 0 - then - LineSpace(0,0,0); - if FCurrentLineSpace<> SpLine - then - FCurrentLineSpace:= SpLine; - with T_LineSpace(LineSpaces[FCurrentLineSpace]) do + else + UseCurFont := True; + end; + Fnt := T_Font(Fonts[FontNum]).GetFont; + if LineSpaces.Count = 0 then + LineSpace(0, 0, 0); + if FCurrentLineSpace <> SpLine then + FCurrentLineSpace := SpLine; + with T_LineSpace(LineSpaces[FCurrentLineSpace]) do begin - LnSpSup:= GetSup; - LnSpInt:= GetInt; - LnSpInf:= GetInf; + LnSpSup := GetSup; + LnSpInt := GetInt; + LnSpInf := GetInf; end; - if Column= -2 - then - Column:= DefaultCol; - if Column> -1 - then - HeighTxt:= TxtHeight(Round(T_Column(Columns[Column]).GetTextWidth),Texts[TextNum]+' 0 '+Texts[TextTot]+' 0',Fnt,Round(LnSpInt))+Round(LnSpSup+LnSpInf) - else - HeighTxt:= TxtHeight(Paper.W,Texts[TextNum]+' 0 '+Texts[TextTot]+' 0',Fnt,Round(LnSpInt))+Round(LnSpSup+LnSpInf); - if (Column> -1) and (BordNum> -1) - then - Half:= Round(T_LineStyle(LineStyles[T_Border(Borders[BordNum]).GetStyle]).GetThick) div 2; - case FPreparation of - ppPrepare: + if Column = -2 then + Column := DefaultCol; + if Column > -1 then + HeighTxt := TxtHeight(Round(T_Column(Columns[Column]).GetTextWidth), Texts[TextNum] + ' 0 ' + Texts[TextTot] + ' 0', Fnt, Round(LnSpInt)) + Round(LnSpSup + LnSpInf) + else + HeighTxt := TxtHeight(Paper.W, Texts[TextNum] + ' 0 ' + Texts[TextTot] + ' 0', Fnt, Round(LnSpInt)) + Round(LnSpSup + LnSpInf); + if (Column > -1) and (BordNum > -1) then + Half := Round(T_LineStyle(LineStyles[T_Border(Borders[BordNum]).GetStyle]).GetThick) div 2; + case FPreparation of + ppPrepare: begin - if NbPages= 0 - then - Page; - if Column> -1 - then + if NbPages = 0 then + Page; + if Column > -1 then begin - HTxt:= VWriteLine.LineHeight; - if HTxt< HeighTxt - then - HTxt:= HeighTxt; + HTxt := VWriteLine.LineHeight; + if HTxt < HeighTxt then + HTxt := HeighTxt; end - else - if HTxt< Fnt.Height - then - HTxt:= Fnt.Height; - case Zone of - zHeader: - FPosRef.Y:= FCurrentMargin.T+FHeaderHeight; - zFooter: + else if HTxt < Fnt.Height then + HTxt := Fnt.Height; + case Zone of + zHeader: + FPosRef.Y := FCurrentMargin.T + FHeaderHeight; + zFooter: begin - FPosRef.Y:= FCurrentMargin.B-HTxt; - FFooterHeight:= FFooterHeight+HTxt; - ShiftFooterLines(HTxt); + FPosRef.Y := FCurrentMargin.B - HTxt; + FFooterHeight := FFooterHeight + HTxt; + ShiftFooterLines(HTxt); end; end; - if PosY= lnCurrent - then - PosV:= FPosRef.Y+LnSpSup - else + if PosY = lnCurrent then + PosV := FPosRef.Y + LnSpSup + else begin - EndOfLine:= True; - if PosY= lnEnd - then + EndOfLine := True; + if PosY = lnEnd then begin - PosV:= FPosRef.Y+LnSpSup; - case Zone of - zHeader: - FPosRef.Y:= FPosRef.Y+HTxt; + PosV := FPosRef.Y + LnSpSup; + case Zone of + zHeader: + FPosRef.Y := FPosRef.Y + HTxt; end; - if BordNum> -1 - then - with T_Border(Borders[BordNum]) do - if bfBottom in GetFlags - then - FPosRef.Y:= FPosRef.Y+1; + if BordNum > -1 then + with T_Border(Borders[BordNum]) do + if bfBottom in GetFlags then + FPosRef.Y := FPosRef.Y + 1; end - else + else begin - PosV:= PosY; - FPosRef.Y:= PosV+LnSpInf; + PosV := PosY; + FPosRef.Y := PosV + LnSpInf; end; - case Zone of - zHeader: - FHeaderHeight:= FPosRef.Y-FCurrentMargin.T; + case Zone of + zHeader: + FHeaderHeight := FPosRef.Y - FCurrentMargin.T; end; end; - if Column= -1 - then - if PosX> 0 - then - PosH:= PosX + if Column = -1 then + if PosX > 0 then + PosH := PosX else - begin - PosH:= T_Column(Columns[ColDefaut]).GetTextPos-T_Column(Columns[0]).ColMargin; - if (txtRight in TxtFlags) - then - if Total - then - PosH:= PosH+T_Column(Columns[ColDefaut]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 '+Texts[TextTot]+' 0 ')-T_Column(Columns[ColDefaut]).ColMargin + begin + PosH := T_Column(Columns[ColDefaut]).GetTextPos - T_Column(Columns[0]).ColMargin; + if (txtRight in TxtFlags) then + if Total then + PosH := PosH + T_Column(Columns[ColDefaut]).ColWidth - Fnt.TextWidth(Texts[TextNum] + ' 0 ' + Texts[TextTot] + ' 0 ') - T_Column(Columns[ColDefaut]).ColMargin else - PosH:= PosH+T_Column(Columns[ColDefaut]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 ')-T_Column(Columns[ColDefaut]).ColMargin; - if (txtHCenter in TxtFlags) - then - if Total - then - PosH:= PosH+(T_Column(Columns[ColDefaut]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 '+Texts[TextTot]+' 0 '))/2 + PosH := PosH + T_Column(Columns[ColDefaut]).ColWidth - Fnt.TextWidth(Texts[TextNum] + ' 0 ') - T_Column(Columns[ColDefaut]).ColMargin; + if (txtHCenter in TxtFlags) then + if Total then + PosH := PosH + (T_Column(Columns[ColDefaut]).ColWidth - Fnt.TextWidth(Texts[TextNum] + ' 0 ' + Texts[TextTot] + ' 0 ')) / 2 else - PosH:= PosH+(T_Column(Columns[ColDefaut]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 '))/2; - end + PosH := PosH + (T_Column(Columns[ColDefaut]).ColWidth - Fnt.TextWidth(Texts[TextNum] + ' 0 ')) / 2; + end + else if PosX > 0 then + if (PosX < T_Column(Columns[Column]).GetTextPos) or (PosX > (T_Column(Columns[Column]).GetTextPos + T_Column(Columns[Column]).GetTextWidth)) then + PosH := T_Column(Columns[Column]).GetTextPos + else + PosH := PosX else - if PosX> 0 - then - if (PosX< T_Column(Columns[Column]).GetTextPos) - or (PosX> (T_Column(Columns[Column]).GetTextPos+T_Column(Columns[Column]).GetTextWidth)) - then - PosH:= T_Column(Columns[Column]).GetTextPos + begin + PosH := T_Column(Columns[Column]).GetTextPos - T_Column(Columns[Column]).ColMargin; + if (txtRight in TxtFlags) then + if Total then + PosH := PosH + T_Column(Columns[Column]).ColWidth - Fnt.TextWidth(Texts[TextNum] + ' 0 ' + Texts[TextTot] + ' 0 ') - T_Column(Columns[Column]).ColMargin else - PosH:= PosX - else - begin - PosH:= T_Column(Columns[Column]).GetTextPos-T_Column(Columns[Column]).ColMargin; - if (txtRight in TxtFlags) - then - if Total - then - PosH:= PosH+T_Column(Columns[Column]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 '+Texts[TextTot]+' 0 ')-T_Column(Columns[Column]).ColMargin - else - PosH:= PosH+T_Column(Columns[Column]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 ')-T_Column(Columns[Column]).ColMargin; - if (txtHCenter in TxtFlags) - then - if Total - then - PosH:= PosH+(T_Column(Columns[Column]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 '+Texts[TextTot]+' 0 '))/2 - else - PosH:= PosH+(T_Column(Columns[Column]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 '))/2; - end; - FPosRef.X:= PosH+Fnt.TextWidth(Texts[TextNum]+' 0 '+Texts[TextTot]+' 0 '); - VWriteLine.LoadNumber(PosH,PosV,Column,TextNum,TextTot,FontNum,HTxt,BkColorNum,BordNum,SpLine,UseCurFont,TxtFlags,Total,Alpha,SPNum); - Result:= Pixels2Dim(FPosRef.Y); - if EndOfLine - then + PosH := PosH + T_Column(Columns[Column]).ColWidth - Fnt.TextWidth(Texts[TextNum] + ' 0 ') - T_Column(Columns[Column]).ColMargin; + if (txtHCenter in TxtFlags) then + if Total then + PosH := PosH + (T_Column(Columns[Column]).ColWidth - Fnt.TextWidth(Texts[TextNum] + ' 0 ' + Texts[TextTot] + ' 0 ')) / 2 + else + PosH := PosH + (T_Column(Columns[Column]).ColWidth - Fnt.TextWidth(Texts[TextNum] + ' 0 ')) / 2; + end; + FPosRef.X := PosH + Fnt.TextWidth(Texts[TextNum] + ' 0 ' + Texts[TextTot] + ' 0 '); + VWriteLine.LoadNumber(PosH, PosV, Column, TextNum, TextTot, FontNum, HTxt, BkColorNum, BordNum, SpLine, UseCurFont, TxtFlags, Total, Alpha, SPNum); + Result := Pixels2Dim(FPosRef.Y); + if EndOfLine then begin - HTxt:= 0; - LineEnd(Zone); + HTxt := 0; + LineEnd(Zone); end; end; - ppVisualize: - with FCanvas do + ppVisualize: + begin + with FCanvas do begin - Chaine:= BuildChaine; - Font:= T_Font(Fonts[FontNum]).GetFont; - SetTextColor(T_Font(Fonts[FontNum]).GetColor); - if Column> -1 - then - with T_Column(Columns[Column]) do + Chaine := BuildChaine; + Font := T_Font(Fonts[FontNum]).GetFont; + SetTextColor(T_Font(Fonts[FontNum]).GetColor); + if Column > -1 then + with T_Column(Columns[Column]) do begin - if BkColorNum> -1 - then - SetColor(T_BackColor(BackColors[BkColorNum]).GetColor) - else - SetColor(GetColor); - FillRectangle(Round(ColPos),Round(PosY-LnSpSup),Round(ColWidth),HeighTxt); - if BordNum> -1 - then - with T_Border(Borders[BordNum]) do + if BkColorNum > -1 then + SetColor(T_BackColor(BackColors[BkColorNum]).GetColor) + else + SetColor(GetColor); + FillRectangle(Round(ColPos), Round(PosY - LnSpSup), Round(ColWidth), HeighTxt); + if BordNum > -1 then + with T_Border(Borders[BordNum]) do begin - SetLineStyle(Round(T_LineStyle(LineStyles[GetStyle]).GetThick),T_LineStyle(LineStyles[GetStyle]).GetStyle); - SetColor(T_LineStyle(LineStyles[GetStyle]).GetColor); - if bfLeft in GetFlags - then - DrawLine(Round(ColPos)+Half,Round(PosY-LnSpSup),Round(ColPos)+Half,Round(PosY-LnSpSup)+HeighTxt); - if bfRight in GetFlags - then - DrawLine(Round(ColPos+ColWidth)-Half,Round(PosY-LnSpSup),Round(ColPos+ColWidth)-Half,Round(PosY-LnSpSup)+HeighTxt); - if bfTop in GetFlags - then - DrawLine(Round(ColPos),Round(PosY-LnSpSup)+Half,Round(ColPos+ColWidth),Round(PosY-LnSpSup)+Half); - if bfBottom in GetFlags - then - DrawLine(Round(ColPos),Round(PosY-LnSpSup)+HeighTxt-Succ(Half),Round(ColPos+ColWidth),Round(PosY-LnSpSup)+HeighTxt-Succ(Half)); + SetLineStyle(Round(T_LineStyle(LineStyles[GetStyle]).GetThick), T_LineStyle(LineStyles[GetStyle]).GetStyle); + SetColor(T_LineStyle(LineStyles[GetStyle]).GetColor); + if bfLeft in GetFlags then + DrawLine(Round(ColPos) + Half, Round(PosY - LnSpSup), Round(ColPos) + Half, Round(PosY - LnSpSup) + HeighTxt); + if bfRight in GetFlags then + DrawLine(Round(ColPos + ColWidth) - Half, Round(PosY - LnSpSup), Round(ColPos + ColWidth) - Half, Round(PosY - LnSpSup) + HeighTxt); + if bfTop in GetFlags then + DrawLine(Round(ColPos), Round(PosY - LnSpSup) + Half, Round(ColPos + ColWidth), Round(PosY - LnSpSup) + Half); + if bfBottom in GetFlags then + DrawLine(Round(ColPos), Round(PosY - LnSpSup) + HeighTxt - Succ(Half), Round(ColPos + ColWidth), Round(PosY - LnSpSup) + HeighTxt - Succ(Half)); end; - DrawText(Round(GetTextPos),Round(PosY),Round(GetTextWidth),0,Chaine,TxtFlags,Round(LnSpInt)); + DrawText(Round(GetTextPos), Round(PosY), Round(GetTextWidth), 0, Chaine, TxtFlags, Round(LnSpInt)); end - else - DrawText(Round(PosX),Round(PosY),Chaine,TxtFlags); + else + DrawText(Round(PosX), Round(PosY), Chaine, TxtFlags); end; - ppPdfFile: + end; + ppPdfFile: begin - Chaine:= BuildChaine; - if Column> -1 - then + Chaine := BuildChaine; + if Column > -1 then with T_Column(Columns[Column]) do + begin + if (GetColor <> clWhite) or (BkColorNum > -1) then begin - if (GetColor<> clWhite) or (BkColorNum> -1) - then - begin - PdfRect:= TPdfRect.Create; + PdfRect := TPdfRect.Create; with PdfRect do - begin - PageId:= NumPage; - FLeft:= ColPos; - FBottom:= Paper.H-PosY+LnSpSup-HeighTxt; - FHeight:= HeighTxt; - FWidth:= ColWidth; - if BkColorNum> -1 - then - FColor:= T_BackColor(BackColors[BkColorNum]).GetColor + begin + PageId := NumPage; + FLeft := ColPos; + FBottom := Paper.H - PosY + LnSpSup - HeighTxt; + FHeight := HeighTxt; + FWidth := ColWidth; + if BkColorNum > -1 then + FColor := T_BackColor(BackColors[BkColorNum]).GetColor else - FColor:= GetColor; - FFill:= True; - FStroke:= False; - end; - PdfPage.Add(PdfRect); + FColor := GetColor; + FFill := True; + FStroke := False; end; - if BordNum> -1 - then + PdfPage.Add(PdfRect); + end; + if BordNum > -1 then with T_Border(Borders[BordNum]) do + begin + StyleLine := T_LineStyle(LineStyles[GetStyle]).GetStyle; + ColorLine := T_LineStyle(LineStyles[GetStyle]).GetColor; + ThickLine := T_LineStyle(LineStyles[GetStyle]).GetThick; + if bfLeft in GetFlags then begin - StyleLine:= T_LineStyle(LineStyles[GetStyle]).GetStyle; - ColorLine:= T_LineStyle(LineStyles[GetStyle]).GetColor; - ThickLine:= T_LineStyle(LineStyles[GetStyle]).GetThick; - if bfLeft in GetFlags - then - begin - PdfLine:= TPdfLine.Create; + PdfLine := TPdfLine.Create; with PdfLine do - begin - PageId:= NumPage; - FBeginX:= ColPos; - FBeginY:= Paper.H-PosY+LnSpSup; - FEndX:= ColPos; - FEndY:= Paper.H-PosY+LnSpSup-HeighTxt; - FStyle:= StyleLine; - FColor:= ColorLine; - FThick:= ThickLine; - end; - PdfPage.Add(PdfLine); - end; - if bfRight in GetFlags - then begin - PdfLine:= TPdfLine.Create; - with PdfLine do - begin - PageId:= NumPage; - FBeginX:= ColPos+ColWidth; - FBeginY:= Paper.H-PosY+LnSpSup; - FEndX:= ColPos+ColWidth; - FEndY:= Paper.H-PosY+LnSpSup-HeighTxt; - FStyle:= StyleLine; - FColor:= ColorLine; - FThick:= ThickLine; - end; - PdfPage.Add(PdfLine); + PageId := NumPage; + FBeginX := ColPos; + FBeginY := Paper.H - PosY + LnSpSup; + FEndX := ColPos; + FEndY := Paper.H - PosY + LnSpSup - HeighTxt; + FStyle := StyleLine; + FColor := ColorLine; + FThick := ThickLine; end; - if bfTop in GetFlags - then - begin - PdfLine:= TPdfLine.Create; - with PdfLine do - begin - PageId:= NumPage; - FBeginX:= ColPos; - FBeginY:= Paper.H-PosY+LnSpSup; - FEndX:= ColPos+ColWidth; - FEndY:= Paper.H-PosY+LnSpSup; - FStyle:= StyleLine; - FColor:= ColorLine; - FThick:= ThickLine; - end; PdfPage.Add(PdfLine); - end; - if bfBottom in GetFlags - then + end; + if bfRight in GetFlags then + begin + PdfLine := TPdfLine.Create; + with PdfLine do begin - PdfLine:= TPdfLine.Create; + PageId := NumPage; + FBeginX := ColPos + ColWidth; + FBeginY := Paper.H - PosY + LnSpSup; + FEndX := ColPos + ColWidth; + FEndY := Paper.H - PosY + LnSpSup - HeighTxt; + FStyle := StyleLine; + FColor := ColorLine; + FThick := ThickLine; + end; + PdfPage.Add(PdfLine); + end; + if bfTop in GetFlags then + begin + PdfLine := TPdfLine.Create; with PdfLine do - begin - PageId:= NumPage; - FBeginX:= ColPos; - FBeginY:= Paper.H-PosY+LnSpSup-HeighTxt; - FEndX:= ColPos+ColWidth; - FEndY:= Paper.H-PosY+LnSpSup-HeighTxt; - FStyle:= StyleLine; - FColor:= ColorLine; - FThick:= ThickLine; - end; + begin + PageId := NumPage; + FBeginX := ColPos; + FBeginY := Paper.H - PosY + LnSpSup; + FEndX := ColPos + ColWidth; + FEndY := Paper.H - PosY + LnSpSup; + FStyle := StyleLine; + FColor := ColorLine; + FThick := ThickLine; + end; PdfPage.Add(PdfLine); + end; + if bfBottom in GetFlags then + begin + PdfLine := TPdfLine.Create; + with PdfLine do + begin + PageId := NumPage; + FBeginX := ColPos; + FBeginY := Paper.H - PosY + LnSpSup - HeighTxt; + FEndX := ColPos + ColWidth; + FEndY := Paper.H - PosY + LnSpSup - HeighTxt; + FStyle := StyleLine; + FColor := ColorLine; + FThick := ThickLine; end; + PdfPage.Add(PdfLine); end; - PdfTexte:= TPdfTexte.Create; - with PdfTexte do - begin - PageId:= NumPage; - FFont:= FontNum; - FSize:= T_Font(Fonts[FontNum]).GetSize; - FColor:= T_Font(Fonts[FontNum]).GetColor; - TextPosX:= GetTextPos; - if (txtRight in TxtFlags) - then - TextPosX:= ColPos+ColWidth-ColMargin-Fnt.TextWidth(Chaine); - if (txtHCenter in TxtFlags) - then - TextPosX:= GetTextPos+(ColWidth-Fnt.TextWidth(Chaine))/2; - TextPosY:= Paper.H-PosY-Fnt.Ascent; - TextWidt:= ColWidth; - Writting:= Chaine; end; + PdfTexte := TPdfTexte.Create; + with PdfTexte do + begin + PageId := NumPage; + FFont := FontNum; + FSize := T_Font(Fonts[FontNum]).GetSize; + FColor := T_Font(Fonts[FontNum]).GetColor; + TextPosX := GetTextPos; + if (txtRight in TxtFlags) then + TextPosX := ColPos + ColWidth - ColMargin - Fnt.TextWidth(Chaine); + if (txtHCenter in TxtFlags) then + TextPosX := GetTextPos + (ColWidth - Fnt.TextWidth(Chaine)) / 2; + TextPosY := Paper.H - PosY - Fnt.Ascent; + TextWidt := ColWidth; + Writting := Chaine; + end; PdfPage.Add(PdfTexte); - end + end else - begin - PdfTexte:= TPdfTexte.Create; + begin + PdfTexte := TPdfTexte.Create; with PdfTexte do - begin - PageId:= NumPage; - FFont:= FontNum; - FSize:= T_Font(Fonts[FontNum]).GetSize; - FColor:= T_Font(Fonts[FontNum]).GetColor; - FPosX:= PosX; - FPosY:= PosY-Fnt.Ascent; - FWidth:= Paper.W; - FText:= Chaine; - end; - PdfPage.Add(PdfTexte); + begin + PageId := NumPage; + FFont := FontNum; + FSize := T_Font(Fonts[FontNum]).GetSize; + FColor := T_Font(Fonts[FontNum]).GetColor; + FPosX := PosX; + FPosY := PosY - Fnt.Ascent; + FWidth := Paper.W; + FText := Chaine; end; + PdfPage.Add(PdfTexte); end; + end; end; end; end; -function T_Report.InsertSpace(PosY: Single; Column: Integer; SpaceHeight: Single; BkColorNum: Integer; Zone: TZone): Single; +function T_Report.InsertSpace(PosY: single; Column: integer; SpaceHeight: single; BkColorNum: integer; Zone: TZone): single; var - PosV: Single; + PosV: single; begin -with T_Section(Sections[Pred(NumSection)]) do + with T_Section(Sections[Pred(NumSection)]) do begin - if PosY> -1 - then - PosV:= PosY - else - PosV:= FPosRef.Y; - if Column= -2 - then - Column:= DefaultCol; - case FPreparation of - ppPrepare: + if PosY > -1 then + PosV := PosY + else + PosV := FPosRef.Y; + if Column = -2 then + Column := DefaultCol; + case FPreparation of + ppPrepare: begin - case Zone of - zHeader: + case Zone of + zHeader: begin - FPosRef.Y:= FCurrentMargin.T+FHeaderHeight; - FPosRef.Y:= FPosRef.Y+SpaceHeight; - FHeaderHeight:= FPosRef.Y-FCurrentMargin.T; - LoadSpaceHeader(PosV,Column,SpaceHeight,BkColorNum); + FPosRef.Y := FCurrentMargin.T + FHeaderHeight; + FPosRef.Y := FPosRef.Y + SpaceHeight; + FHeaderHeight := FPosRef.Y - FCurrentMargin.T; + LoadSpaceHeader(PosV, Column, SpaceHeight, BkColorNum); end; - zPage: + zPage: begin - FPosRef.Y:= FCurrentMargin.T+FHeaderHeight+FPageHeight; - if FPosRef.Y+SpaceHeight> FCurrentMargin.B-FFooterHeight - then + FPosRef.Y := FCurrentMargin.T + FHeaderHeight + FPageHeight; + if FPosRef.Y + SpaceHeight > FCurrentMargin.B - FFooterHeight then begin - FPosRef.Y:= FCurrentMargin.T+FHeaderHeight; - Page; + FPosRef.Y := FCurrentMargin.T + FHeaderHeight; + Page; end - else - FPosRef.Y:= FPosRef.Y+SpaceHeight; - FPageHeight:= FPosRef.Y-FHeaderHeight-FCurrentMargin.T; - LoadSpacePage(PosV,Column,SpaceHeight,BkColorNum); + else + FPosRef.Y := FPosRef.Y + SpaceHeight; + FPageHeight := FPosRef.Y - FHeaderHeight - FCurrentMargin.T; + LoadSpacePage(PosV, Column, SpaceHeight, BkColorNum); end; - zFooter: + zFooter: begin - FPosRef.Y:= FCurrentMargin.B-SpaceHeight; - FFooterHeight:= FFooterHeight+SpaceHeight; - PosV:= FPosRef.Y; - ShiftFooterLines(SpaceHeight); - LoadSpaceFooter(PosV,Column,SpaceHeight,BkColorNum); + FPosRef.Y := FCurrentMargin.B - SpaceHeight; + FFooterHeight := FFooterHeight + SpaceHeight; + PosV := FPosRef.Y; + ShiftFooterLines(SpaceHeight); + LoadSpaceFooter(PosV, Column, SpaceHeight, BkColorNum); end; end; - if FGroup - then - LoadSpaceGroup(SpaceHeight); - Result:= Pixels2Dim(FPosRef.Y); - LineEnd(Zone); + if FGroup then + LoadSpaceGroup(SpaceHeight); + Result := Pixels2Dim(FPosRef.Y); + LineEnd(Zone); end; - ppVisualize: - with FCanvas,T_Column(Columns[Column]) do + ppVisualize: + begin + with FCanvas, T_Column(Columns[Column]) do begin - if BkColorNum> -1 - then - SetColor(T_BackColor(BackColors[BkColorNum]).GetColor) - else - SetColor(GetColor); - FillRectangle(Round(ColPos),Round(PosV),Round(ColWidth),Round(SpaceHeight)); + if BkColorNum > -1 then + SetColor(T_BackColor(BackColors[BkColorNum]).GetColor) + else + SetColor(GetColor); + FillRectangle(Round(ColPos), Round(PosV), Round(ColWidth), Round(SpaceHeight)); end; - ppPdfFile: + end; + ppPdfFile: begin - if Column> -1 - then - with T_Column(Columns[Column]) do + if Column > -1 then + with T_Column(Columns[Column]) do begin - if (GetColor<> clWhite) or (BkColorNum> -1) - then + if (GetColor <> clWhite) or (BkColorNum > -1) then begin - PdfRect:= TPdfRect.Create; - with PdfRect do + PdfRect := TPdfRect.Create; + with PdfRect do begin - PageId:= NumPage; - FLeft:= ColPos; - FBottom:= Paper.H-PosY-SpaceHeight; - FHeight:= SpaceHeight; - FWidth:= ColWidth; - if BkColorNum> -1 - then - FColor:= T_BackColor(BackColors[BkColorNum]).GetColor - else - FColor:= GetColor; - FFill:= True; - FStroke:= False; + PageId := NumPage; + FLeft := ColPos; + FBottom := Paper.H - PosY - SpaceHeight; + FHeight := SpaceHeight; + FWidth := ColWidth; + if BkColorNum > -1 then + FColor := T_BackColor(BackColors[BkColorNum]).GetColor + else + FColor := GetColor; + FFill := True; + FStroke := False; end; - PdfPage.Add(PdfRect); + PdfPage.Add(PdfRect); end; - end; - end; - end; - end; + end; { with } + end; { ppPdfFile label } + end; { case } + end; { with } end; procedure T_Report.LineEnd(Zone: TZone); begin -with T_Section(Sections[Pred(NumSection)]) do - case Zone of - zHeader: - LoadCmdHeader; - zPage: - if FGroup - then - LoadCmdGroup - else - LoadCmdPage; - zFooter: - LoadCmdFooter; + with T_Section(Sections[Pred(NumSection)]) do + begin + case Zone of + zHeader: + LoadCmdHeader; + zPage: + if FGroup then + LoadCmdGroup + else + LoadCmdPage; + zFooter: + LoadCmdFooter; end; + end; end; -procedure T_Report.DrawAFrame(StyLine: Integer; Zone: TZone); +procedure T_Report.DrawAFrame(StyLine: integer; Zone: TZone); var - Half,MarginL,MarginR,MarginT,MarginB,HeaderH,FooterH: Integer; + Half, MarginL, MarginR, MarginT, MarginB, HeaderH, FooterH: integer; begin -with T_Section(Sections[Pred(NumSection)]) do - case FPreparation of - ppPrepare: - LoadFrame(StyLine,Zone); - ppVisualize: - with FCanvas do + with T_Section(Sections[Pred(NumSection)]) do + begin + case FPreparation of + ppPrepare: + LoadFrame(StyLine, Zone); + ppVisualize: + begin + with FCanvas do begin - with T_LineStyle(LineStyles[StyLine]) do + with T_LineStyle(LineStyles[StyLine]) do begin - SetLineStyle(Round(GetThick),GetStyle); - Half:= Round(GetThick) div 2; - SetColor(GetColor); + SetLineStyle(Round(GetThick), GetStyle); + Half := Round(GetThick) div 2; + SetColor(GetColor); end; - with FCurrentMargin do + with FCurrentMargin do begin - MarginL:= Round(L); - MarginR:= Round(R); - MarginT:= Round(T); - MarginB:= Round(B); - HeaderH:= Round(FHeaderHeight); - FooterH:= Round(FFooterHeight); - case Zone of - zHeader: + MarginL := Round(L); + MarginR := Round(R); + MarginT := Round(T); + MarginB := Round(B); + HeaderH := Round(FHeaderHeight); + FooterH := Round(FFooterHeight); + case Zone of + zHeader: begin - DrawLine(MarginL+Half,MarginT,MarginL+Half,MarginT+HeaderH); // left - DrawLine(MarginR-Half,MarginT,MarginR-Half,MarginT+HeaderH); // right - DrawLine(MarginL,MarginT+Half,MarginR,MarginT+Half); // top - DrawLine(MarginL,MarginT+HeaderH-Half,MarginR,MarginT+HeaderH-Half); // bottom + DrawLine(MarginL + Half, MarginT, MarginL + Half, MarginT + HeaderH); // left + DrawLine(MarginR - Half, MarginT, MarginR - Half, MarginT + HeaderH); // right + DrawLine(MarginL, MarginT + Half, MarginR, MarginT + Half); // top + DrawLine(MarginL, MarginT + HeaderH - Half, MarginR, MarginT + HeaderH - Half); // bottom end; - zPage: + zPage: begin - DrawLine(MarginL+Half,MarginT+HeaderH,MarginL+Half,MarginB-FooterH); // left - DrawLine(MarginR-Half,MarginT+HeaderH,MarginR-Half,MarginB-FooterH); // right - DrawLine(MarginL,MarginT+HeaderH-Half,MarginR,MarginT+HeaderH-Half); // top - DrawLine(MarginL,MarginB-FooterH+Half,MarginR,MarginB-FooterH+Half); // bottom + DrawLine(MarginL + Half, MarginT + HeaderH, MarginL + Half, MarginB - FooterH); // left + DrawLine(MarginR - Half, MarginT + HeaderH, MarginR - Half, MarginB - FooterH); // right + DrawLine(MarginL, MarginT + HeaderH - Half, MarginR, MarginT + HeaderH - Half); // top + DrawLine(MarginL, MarginB - FooterH + Half, MarginR, MarginB - FooterH + Half); // bottom end; - zFooter: + zFooter: begin - DrawLine(MarginL+Half,MarginB-FooterH,MarginL+Half,MarginB); // left - DrawLine(MarginR-Half,MarginB-FooterH,MarginR-Half,MarginB); // right - DrawLine(MarginL,MarginB-FooterH+Half,MarginR,MarginB-FooterH+Half); // top - DrawLine(MarginL,MarginB-Half,MarginR,MarginB-Half); // bottom + DrawLine(MarginL + Half, MarginB - FooterH, MarginL + Half, MarginB); // left + DrawLine(MarginR - Half, MarginB - FooterH, MarginR - Half, MarginB); // right + DrawLine(MarginL, MarginB - FooterH + Half, MarginR, MarginB - FooterH + Half); // top + DrawLine(MarginL, MarginB - Half, MarginR, MarginB - Half); // bottom end; - zMargins: + zMargins: begin - DrawLine(MarginL+Half,MarginT,MarginL+Half,MarginB-Succ(Half)); // left - DrawLine(MarginR-Half,MarginT,MarginR-Half,MarginB-Succ(Half)); // right - DrawLine(MarginL,MarginT+Half,MarginR,MarginT+Half); // top - DrawLine(MarginL,MarginB-Half,MarginR,MarginB-Half); // bottom + DrawLine(MarginL + Half, MarginT, MarginL + Half, MarginB - Succ(Half)); // left + DrawLine(MarginR - Half, MarginT, MarginR - Half, MarginB - Succ(Half)); // right + DrawLine(MarginL, MarginT + Half, MarginR, MarginT + Half); // top + DrawLine(MarginL, MarginB - Half, MarginR, MarginB - Half); // bottom end; - end; - end; - end; - ppPdfFile: + end; { case } + end; { with FCurrentMargin } + end; { with FCanvas } + end; + ppPdfFile: begin - PdfRect:= TPdfRect.Create; - with PdfRect do + PdfRect := TPdfRect.Create; + with PdfRect do begin - PageId:= NumPage; - with T_LineStyle(LineStyles[StyLine]) do + PageId := NumPage; + with T_LineStyle(LineStyles[StyLine]) do begin - FThick:= GetThick; - FColor:= GetColor; - FLineStyle:= GetStyle; + FThick := GetThick; + FColor := GetColor; + FLineStyle := GetStyle; end; - with FCurrentMargin do - case Zone of - zHeader: + with FCurrentMargin do + case Zone of + zHeader: begin - FLeft:= L; - FBottom:= Paper.H-T-FHeaderHeight; - FHeight:= FHeaderHeight; - FWidth:= R-L; + FLeft := L; + FBottom := Paper.H - T - FHeaderHeight; + FHeight := FHeaderHeight; + FWidth := R - L; end; - zPage: + zPage: begin - FLeft:= L; - FBottom:= Paper.H-B+FFooterHeight; - FHeight:= B-T-FHeaderHeight-FFooterHeight; - FWidth:= R-L; + FLeft := L; + FBottom := Paper.H - B + FFooterHeight; + FHeight := B - T - FHeaderHeight - FFooterHeight; + FWidth := R - L; end; - zFooter: + zFooter: begin - FLeft:= L; - FBottom:= Paper.H-B; - FHeight:= FFooterHeight; - FWidth:= R-L; + FLeft := L; + FBottom := Paper.H - B; + FHeight := FFooterHeight; + FWidth := R - L; end; - zMargins: + zMargins: begin - FLeft:= L; - FBottom:= Paper.H-B; - FHeight:= B-T; - FWidth:= R-L; + FLeft := L; + FBottom := Paper.H - B; + FHeight := B - T; + FWidth := R - L; end; end; - FFill:= False; - FStroke:= True; - PdfPage.Add(PdfRect); - end; + FFill := False; + FStroke := True; + PdfPage.Add(PdfRect); + end; { with PdfRect } end; - end; + end; { case FPreparation } + end; { with T_Section... } end; -procedure T_Report.DrawALine(XBegin,YBegin,XEnd,YEnd: Single; StyLine: Integer); +procedure T_Report.DrawALine(XBegin, YBegin, XEnd, YEnd: single; StyLine: integer); begin -with T_Section(Sections[Pred(NumSection)]) do - case FPreparation of - ppPrepare: - LoadLine(XBegin,YBegin,ColDefaut,XEnd,YEnd,StyLine); - ppVisualize: - with FCanvas do + with T_Section(Sections[Pred(NumSection)]) do + begin + case FPreparation of + ppPrepare: + LoadLine(XBegin, YBegin, ColDefaut, XEnd, YEnd, StyLine); + ppVisualize: + with FCanvas do begin - with T_LineStyle(LineStyles[StyLine]) do + with T_LineStyle(LineStyles[StyLine]) do begin - SetLineStyle(Round(GetThick),GetStyle); - SetColor(GetColor); + SetLineStyle(Round(GetThick), GetStyle); + SetColor(GetColor); end; - DrawLine(Round(XBegin),Round(YBegin),Round(XEnd),Round(YEnd)); + DrawLine(Round(XBegin), Round(YBegin), Round(XEnd), Round(YEnd)); end; - ppPdfFile: + ppPdfFile: begin - PdfLine:= TPdfLine.Create; - with PdfLine do + PdfLine := TPdfLine.Create; + with PdfLine do begin - PageId:= NumPage; - FBeginX:= XBegin; - FBeginY:= Paper.H-YBegin; - FEndX:= XEnd; - FEndY:= Paper.H-YEnd; - FStyle:= T_LineStyle(LineStyles[StyLine]).GetStyle;; - FColor:= T_LineStyle(LineStyles[StyLine]).GetColor; - FThick:= T_LineStyle(LineStyles[StyLine]).GetThick; + PageId := NumPage; + FBeginX := XBegin; + FBeginY := Paper.H - YBegin; + FEndX := XEnd; + FEndY := Paper.H - YEnd; + FStyle := T_LineStyle(LineStyles[StyLine]).GetStyle; + ; + FColor := T_LineStyle(LineStyles[StyLine]).GetColor; + FThick := T_LineStyle(LineStyles[StyLine]).GetThick; end; - PdfPage.Add(PdfLine); + PdfPage.Add(PdfLine); end; - end; + end; { case FPreparation } + end; { with T_Section... } end; -procedure T_Report.DrawAHorizLine(XBegin,YBegin: Single; Column: Integer; XEnd: Single; StyLine: Integer; Zone: TZone); +procedure T_Report.DrawAHorizLine(XBegin, YBegin: single; Column: integer; XEnd: single; StyLine: integer; Zone: TZone); var - PosV: Single; + PosV: single; begin -with T_Section(Sections[Pred(NumSection)]) do - case FPreparation of - ppPrepare: + with T_Section(Sections[Pred(NumSection)]) do + begin + case FPreparation of + ppPrepare: begin - case Zone of - zHeader: + case Zone of + zHeader: begin - FPosRef.Y:= FCurrentMargin.T+FHeaderHeight; - PosV:= FPosRef.Y+XBegin; - FPosRef.Y:= FPosRef.Y+XBegin+YBegin+T_LineStyle(LineStyles[StyLine]).GetThick; - FHeaderHeight:= FPosRef.Y-FCurrentMargin.T; - with T_Column(Columns[Column]) do - LoadLineHorizHeader(ColPos,PosV,Column,ColPos+ColWidth,PosV,StyLine); + FPosRef.Y := FCurrentMargin.T + FHeaderHeight; + PosV := FPosRef.Y + XBegin; + FPosRef.Y := FPosRef.Y + XBegin + YBegin + T_LineStyle(LineStyles[StyLine]).GetThick; + FHeaderHeight := FPosRef.Y - FCurrentMargin.T; + with T_Column(Columns[Column]) do + LoadLineHorizHeader(ColPos, PosV, Column, ColPos + ColWidth, PosV, StyLine); end; - zPage: + zPage: begin - FPosRef.Y:= FCurrentMargin.T+FHeaderHeight+FPageHeight; - PosV:= FPosRef.Y+XBegin; - FPosRef.Y:= FPosRef.Y+XBegin+YBegin+T_LineStyle(LineStyles[StyLine]).GetThick; - FPageHeight:= FPosRef.Y-FHeaderHeight-FCurrentMargin.T; - with T_Column(Columns[Column]) do - LoadLineHorizPage(ColPos,PosV,Column,ColPos+ColWidth,PosV,StyLine); + FPosRef.Y := FCurrentMargin.T + FHeaderHeight + FPageHeight; + PosV := FPosRef.Y + XBegin; + FPosRef.Y := FPosRef.Y + XBegin + YBegin + T_LineStyle(LineStyles[StyLine]).GetThick; + FPageHeight := FPosRef.Y - FHeaderHeight - FCurrentMargin.T; + with T_Column(Columns[Column]) do + LoadLineHorizPage(ColPos, PosV, Column, ColPos + ColWidth, PosV, StyLine); end; - zFooter: + zFooter: begin - FPosRef.Y:= FCurrentMargin.B-XBegin; - PosV:= FPosRef.Y; - FPosRef.Y:= FPosRef.Y-YBegin-T_LineStyle(LineStyles[StyLine]).GetThick; - FFooterHeight:= FFooterHeight+XBegin+YBegin+T_LineStyle(LineStyles[StyLine]).GetThick; - ShiftFooterLines(XBegin+YBegin+T_LineStyle(LineStyles[StyLine]).GetThick); - with T_Column(Columns[Column]) do - LoadLineHorizFooter(ColPos,PosV,Column,ColPos+ColWidth,PosV,StyLine); + FPosRef.Y := FCurrentMargin.B - XBegin; + PosV := FPosRef.Y; + FPosRef.Y := FPosRef.Y - YBegin - T_LineStyle(LineStyles[StyLine]).GetThick; + FFooterHeight := FFooterHeight + XBegin + YBegin + T_LineStyle(LineStyles[StyLine]).GetThick; + ShiftFooterLines(XBegin + YBegin + T_LineStyle(LineStyles[StyLine]).GetThick); + with T_Column(Columns[Column]) do + LoadLineHorizFooter(ColPos, PosV, Column, ColPos + ColWidth, PosV, StyLine); end; end; - if FGroup - then - LoadLineHorizGroupe(T_LineStyle(LineStyles[StyLine]).GetThick); + if FGroup then + LoadLineHorizGroupe(T_LineStyle(LineStyles[StyLine]).GetThick); end; - ppVisualize: - with FCanvas do + ppVisualize: + begin + with FCanvas do begin - with T_LineStyle(LineStyles[StyLine]) do + with T_LineStyle(LineStyles[StyLine]) do begin - SetLineStyle(Round(GetThick),GetStyle); - SetColor(GetColor); + SetLineStyle(Round(GetThick), GetStyle); + SetColor(GetColor); end; - DrawLine(Round(XBegin),Round(YBegin),Round(XEnd),Round(YBegin)); + DrawLine(Round(XBegin), Round(YBegin), Round(XEnd), Round(YBegin)); end; - ppPdfFile: + end; + ppPdfFile: begin - PdfLine:= TPdfLine.Create; - with PdfLine do + PdfLine := TPdfLine.Create; + with PdfLine do begin - PageId:= NumPage; - FBeginX:= XBegin; - FBeginY:= Paper.H-YBegin; - FEndX:= XEnd; - FEndY:= Paper.H-YBegin; - FStyle:= T_LineStyle(LineStyles[StyLine]).GetStyle;; - FColor:= T_LineStyle(LineStyles[StyLine]).GetColor; - FThick:= T_LineStyle(LineStyles[StyLine]).GetThick; + PageId := NumPage; + FBeginX := XBegin; + FBeginY := Paper.H - YBegin; + FEndX := XEnd; + FEndY := Paper.H - YBegin; + FStyle := T_LineStyle(LineStyles[StyLine]).GetStyle; + ; + FColor := T_LineStyle(LineStyles[StyLine]).GetColor; + FThick := T_LineStyle(LineStyles[StyLine]).GetThick; end; - PdfPage.Add(PdfLine); + PdfPage.Add(PdfLine); end; - end; + end; { case FPreparation } + end; { with T_Section... } end; procedure T_Report.PaintSurface(Points: T_Points; Couleur: TfpgColor); var OldColor: TfpgColor; - Cpt: Integer; + Cpt: integer; Pts: array of TPoint; begin -with T_Section(Sections[Pred(NumSection)]) do - case FPreparation of - ppPrepare: - LoadSurf(Points,Couleur); - ppVisualize: + with T_Section(Sections[Pred(NumSection)]) do + begin + case FPreparation of + ppPrepare: + LoadSurf(Points, Couleur); + ppVisualize: begin - OldColor:= FCanvas.Color; - FCanvas.SetColor(Couleur); - SetLength(Pts,Length(Points)); - for Cpt:= 0 to Pred(Length(Pts)) do + OldColor := FCanvas.Color; + FCanvas.SetColor(Couleur); + SetLength(Pts, Length(Points)); + for Cpt := 0 to Pred(Length(Pts)) do begin - Pts[Cpt].X:= Round(Points[Cpt].X); - Pts[Cpt].Y:= Round(Points[Cpt].Y); + Pts[Cpt].X := Round(Points[Cpt].X); + Pts[Cpt].Y := Round(Points[Cpt].Y); end; - FCanvas.DrawPolygon(Pts); - FCanvas.SetColor(OldColor); + FCanvas.DrawPolygon(Pts); + FCanvas.SetColor(OldColor); end; - ppPdfFile: + ppPdfFile: begin - PdfSurf:= TPdfSurf.Create; - SetLength(PdfSurf.FPoints,Length(Points)); - for Cpt:= 0 to Pred(Length(Points)) do + PdfSurf := TPdfSurf.Create; + SetLength(PdfSurf.FPoints, Length(Points)); + for Cpt := 0 to Pred(Length(Points)) do begin - PdfSurf.FPoints[Cpt].X:= Points[Cpt].X; - PdfSurf.FPoints[Cpt].Y:= Paper.H-Points[Cpt].Y; + PdfSurf.FPoints[Cpt].X := Points[Cpt].X; + PdfSurf.FPoints[Cpt].Y := Paper.H - Points[Cpt].Y; end; - with PdfSurf do + with PdfSurf do begin - PageId:= NumPage; - //SetLength(FPoints,Length(Points)); - //for Cpt:= 0 to Pred(Length(Points)) do // weird behaviour: points gets length= 0 inside the with clause ! - // begin - // FPoints[Cpt].X:= Points[Cpt].X; - // FPoints[Cpt].Y:= Paper.H-Points[Cpt].Y; - // end; - FColor:= Couleur; + PageId := NumPage; + //SetLength(FPoints,Length(Points)); + //for Cpt:= 0 to Pred(Length(Points)) do // weird behaviour: points gets length= 0 inside the with clause ! + // begin + // FPoints[Cpt].X:= Points[Cpt].X; + // FPoints[Cpt].Y:= Paper.H-Points[Cpt].Y; + // end; + FColor := Couleur; end; - PdfPage.Add(PdfSurf); + PdfPage.Add(PdfSurf); end; - end; + end; { case FPreparation } + end; { with T_Section... } end; -procedure T_Report.PaintImage(PosX,PosY: Single; Column,ImgNum: Integer; Zone: TZone); +procedure T_Report.PaintImage(PosX, PosY: single; Column, ImgNum: integer; Zone: TZone); begin -with T_Section(Sections[Pred(NumSection)]) do - case FPreparation of - ppPrepare: + with T_Section(Sections[Pred(NumSection)]) do + begin + case FPreparation of + ppPrepare: begin - if Column> -1 - then - PosX:= T_Column(Columns[Column]).ColPos+PosX; - case Zone of - zHeader: + if Column > -1 then + PosX := T_Column(Columns[Column]).ColPos + PosX; + case Zone of + zHeader: begin - PosY:= FCurrentMargin.T+PosY; - LoadImgHeader(PosX,PosY,Column,ImgNum); + PosY := FCurrentMargin.T + PosY; + LoadImgHeader(PosX, PosY, Column, ImgNum); end; - zPage: + zPage: begin - PosY:= FCurrentMargin.T+FHeaderHeight+PosY; - LoadImgPage(PosX,PosY,Column,ImgNum); + PosY := FCurrentMargin.T + FHeaderHeight + PosY; + LoadImgPage(PosX, PosY, Column, ImgNum); end; - zFooter: + zFooter: begin - PosY:= FCurrentMargin.B-FFooterHeight+PosY; - LoadImgFooter(PosX,PosY,Column,ImgNum); + PosY := FCurrentMargin.B - FFooterHeight + PosY; + LoadImgFooter(PosX, PosY, Column, ImgNum); end; end; end; - ppVisualize: - FCanvas.DrawImage(Round(PosX),Round(PosY),TfpgImage(Images[ImgNum])); - ppPdfFile: + ppVisualize: + FCanvas.DrawImage(Round(PosX), Round(PosY), TfpgImage(Images[ImgNum])); + ppPdfFile: begin - PdfImg:= TPdfImg.Create; - with PdfImg do + PdfImg := TPdfImg.Create; + with PdfImg do begin - PageId:= NumPage; - ImgNumber:= ImgNum; - ImgLeft:= PosX; - ImgBottom:= Paper.H-PosY-TfpgImage(Images[ImgNum]).Height; - ImgWidth:= TfpgImage(Images[ImgNum]).Width; - ImgHeight:= TfpgImage(Images[ImgNum]).Height; + PageId := NumPage; + ImgNumber := ImgNum; + ImgLeft := PosX; + ImgBottom := Paper.H - PosY - TfpgImage(Images[ImgNum]).Height; + ImgWidth := TfpgImage(Images[ImgNum]).Width; + ImgHeight := TfpgImage(Images[ImgNum]).Height; end; - PdfPage.Add(PdfImg); + PdfPage.Add(PdfImg); end; - end; + end; { case FPreparation } + end; { with T_Section... } end; function T_Report.GetSectionTitle: string; begin -Result:= T_Section(Sections[Pred(Sections.Count)]).Title; + Result := T_Section(Sections[Pred(Sections.Count)]).Title; end; procedure T_Report.SetSectionTitle(ATitle: string); begin -T_Section(Sections[Pred(Sections.Count)]).Title:= ATitle; + T_Section(Sections[Pred(Sections.Count)]).Title := ATitle; end; { public methods } constructor T_Report.Create; begin -inherited Create; -OldSeparator:= DecimalSeparator; -DecimalSeparator:= '.'; -Sections:= TList.Create; -Fonts:= TList.Create; -Columns:= TList.Create; -LineSpaces:= TList.Create; -BackColors:= TList.Create; -LineStyles:= TList.Create; -Borders:= TList.Create; -Images:= TList.Create; -ImageNames:= TStringList.Create; -Texts:= TStringList.Create; -VWriteLine:= T_WriteLine.Create; -PdfPage:= TList.Create; -Outline:= False; + inherited Create; + OldSeparator := DecimalSeparator; + DecimalSeparator := '.'; + Sections := TList.Create; + Fonts := TList.Create; + Columns := TList.Create; + LineSpaces := TList.Create; + BackColors := TList.Create; + LineStyles := TList.Create; + Borders := TList.Create; + Images := TList.Create; + ImageNames := TStringList.Create; + Texts := TStringList.Create; + VWriteLine := T_WriteLine.Create; + PdfPage := TList.Create; + Outline := False; end; destructor T_Report.Destroy; var - Cpt: Integer; -begin -if Sections.Count> 0 -then - for Cpt:= 0 to Pred(Sections.Count) do - T_Section(Sections[Cpt]).Free; -Sections.Free; -if Fonts.Count> 0 -then - for Cpt:= 0 to Pred(Fonts.Count) do - T_Font(Fonts[Cpt]).Free; -Fonts.Free; -if Columns.Count> 0 -then - for Cpt:= 0 to Pred(Columns.Count) do - T_Column(Columns[Cpt]).Free; -Columns.Free; -if LineSpaces.Count> 0 -then - for Cpt:= 0 to Pred(LineSpaces.Count) do - T_LineSpace(LineSpaces[Cpt]).Free; -LineSpaces.Free; -if BackColors.Count> 0 -then - for Cpt:= 0 to Pred(BackColors.Count) do - T_BackColor(BackColors[Cpt]).Free; -BackColors.Free; -if LineStyles.Count> 0 -then - for Cpt:= 0 to Pred(LineStyles.Count) do - T_LineStyle(LineStyles[Cpt]).Free; -LineStyles.Free; -if Borders.Count> 0 -then - for Cpt:= 0 to Pred(Borders.Count) do - T_Border(Borders[Cpt]).Free; -Borders.Free; -if Images.Count> 0 -then - for Cpt:= 0 to Pred(Images.Count) do - TfpgImage(Images[Cpt]).Free; -Images.Free; -ImageNames.Free; -Texts.Free; -VWriteLine.Free; -if PdfPage.Count> 0 -then - for Cpt:= 0 to Pred(PdfPage.Count) do - if TPdfElement(PdfPage[Cpt]) is TPdfTexte - then - TPdfTexte(PdfPage[Cpt]).Free - else - if TPdfElement(PdfPage[Cpt]) is TPdfRect - then + Cpt: integer; +begin + if Sections.Count > 0 then + for Cpt := 0 to Pred(Sections.Count) do + T_Section(Sections[Cpt]).Free; + Sections.Free; + if Fonts.Count > 0 then + for Cpt := 0 to Pred(Fonts.Count) do + T_Font(Fonts[Cpt]).Free; + Fonts.Free; + if Columns.Count > 0 then + for Cpt := 0 to Pred(Columns.Count) do + T_Column(Columns[Cpt]).Free; + Columns.Free; + if LineSpaces.Count > 0 then + for Cpt := 0 to Pred(LineSpaces.Count) do + T_LineSpace(LineSpaces[Cpt]).Free; + LineSpaces.Free; + if BackColors.Count > 0 then + for Cpt := 0 to Pred(BackColors.Count) do + T_BackColor(BackColors[Cpt]).Free; + BackColors.Free; + if LineStyles.Count > 0 then + for Cpt := 0 to Pred(LineStyles.Count) do + T_LineStyle(LineStyles[Cpt]).Free; + LineStyles.Free; + if Borders.Count > 0 then + for Cpt := 0 to Pred(Borders.Count) do + T_Border(Borders[Cpt]).Free; + Borders.Free; + if Images.Count > 0 then + for Cpt := 0 to Pred(Images.Count) do + TfpgImage(Images[Cpt]).Free; + Images.Free; + ImageNames.Free; + Texts.Free; + VWriteLine.Free; + if PdfPage.Count > 0 then + begin + for Cpt := 0 to Pred(PdfPage.Count) do + begin + if TPdfElement(PdfPage[Cpt]) is TPdfTexte then + TPdfTexte(PdfPage[Cpt]).Free + else if TPdfElement(PdfPage[Cpt]) is TPdfRect then TPdfRect(PdfPage[Cpt]).Free - else - if TPdfElement(PdfPage[Cpt]) is TPdfLine - then - TPdfLine(PdfPage[Cpt]).Free - else - if TPdfElement(PdfPage[Cpt]) is TPdfSurf - then - TPdfSurf(PdfPage[Cpt]).Free - else - if TPdfElement(PdfPage[Cpt]) is TPdfImg - then - TPdfImg(PdfPage[Cpt]).Free; -PdfPage.Free; -DecimalSeparator:= OldSeparator; -inherited; -end; - -procedure T_Report.BeginWrite(IniOrientation: TOrient= oPortrait; IniPaperType: TPaperType= A4; - IniMeasure: TMeasureUnit= msMM; IniVersion: Char= 'F'; IniVisu: Boolean= True); -begin -FVersion:= IniVersion; -FOrientation:= IniOrientation; -FPaperType:= IniPaperType; -FMeasureUnit:= IniMeasure; -FPreparation:= ppPrepare; -FVisualization:= IniVisu; -PrepareFormat; -if IniVisu -then - CreateVisu; -FCurrentFont:= -1; -FCurrentLineSpace:= -1; -FGroup:= False; -with FPaper do - VColumn:= T_Column.Create(Printable.L,Printable.R-Printable.L,0,clWhite); -Columns.Add(VColumn); + else if TPdfElement(PdfPage[Cpt]) is TPdfLine then + TPdfLine(PdfPage[Cpt]).Free + else if TPdfElement(PdfPage[Cpt]) is TPdfSurf then + TPdfSurf(PdfPage[Cpt]).Free + else if TPdfElement(PdfPage[Cpt]) is TPdfImg then + TPdfImg(PdfPage[Cpt]).Free; + end; + end; + PdfPage.Free; + DecimalSeparator := OldSeparator; + inherited; +end; + +procedure T_Report.BeginWrite(IniOrientation: TOrient = oPortrait; IniPaperType: TPaperType = A4; IniMeasure: TMeasureUnit = msMM; IniVersion: char = 'F'; IniVisu: Boolean = True); +begin + FVersion := IniVersion; + FOrientation := IniOrientation; + FPaperType := IniPaperType; + FMeasureUnit := IniMeasure; + FPreparation := ppPrepare; + FVisualization := IniVisu; + PrepareFormat; + if IniVisu then + CreateVisu; + FCurrentFont := -1; + FCurrentLineSpace := -1; + FGroup := False; + with FPaper do + VColumn := T_Column.Create(Printable.L, Printable.R - Printable.L, 0, clWhite); + Columns.Add(VColumn); end; procedure T_Report.EndWrite; var - Cpt: Integer; + Cpt: integer; begin -FPreparation:= ppPdfFile; -if Sections.Count> 0 -then - for Cpt:= 1 to Sections.Count do + FPreparation := ppPdfFile; + if Sections.Count > 0 then + begin + for Cpt := 1 to Sections.Count do begin - NumSection:= Cpt; - if T_Section(Sections[Pred(NumSection)]).TotPages> 0 - then + NumSection := Cpt; + if T_Section(Sections[Pred(NumSection)]).TotPages > 0 then begin - NumPageSection:= 1; - NumPage:= 1; + NumPageSection := 1; + NumPage := 1; end; end -else - Exit; -for Cpt:= 1 to T_Section(Sections[Pred(NumSection)]).TotPages do - PrintPage(Cpt); -if FVisualization -then + end + else + Exit; + for Cpt := 1 to T_Section(Sections[Pred(NumSection)]).TotPages do + PrintPage(Cpt); + if FVisualization then begin - FPreparation:= ppVisualize; - try - WriteDocument; - F_Visu.ShowModal; - finally - F_Visu.Free; + FPreparation := ppVisualize; + try + WriteDocument; + F_Visu.ShowModal; + finally + F_Visu.Free; end; end; end; procedure T_Report.WriteDocument; begin -if FVisualization -then - FCanvas:= Bv_Visu.Canvas; + if FVisualization then + FCanvas := Bv_Visu.Canvas; end; procedure T_Report.PagePreview; begin -FVisualization:= not FVisualization; -if FVisualization -then - FCanvas:= Bv_Visu.Canvas; + FVisualization := not FVisualization; + if FVisualization then + FCanvas := Bv_Visu.Canvas; end; -procedure T_Report.Section(MgLeft,MgRight,MgTop,MgBottom: Single; BackPos: Single; - IniOrientation: TOrient= oPortrait); +procedure T_Report.Section(MgLeft, MgRight, MgTop, MgBottom: single; BackPos: single; IniOrientation: TOrient = oPortrait); var - CMargin: Single; + CMargin: single; begin -case FPreparation of - ppPrepare: + case FPreparation of + ppPrepare: begin - FOrientation:= IniOrientation; - PrepareFormat; - with FCurrentMargin,FPaper do + FOrientation := IniOrientation; + PrepareFormat; + with FCurrentMargin, FPaper do begin - if Dim2Pixels(MgLeft)> Printable.L - then - L:= Dim2Pixels(MgLeft) - else - L:= Printable.L; - if (W-Dim2Pixels(MgRight))< Printable.R - then - R:= W-Dim2Pixels(MgRight) - else - R:= Printable.R; - if Dim2Pixels(MgTop)> Printable.T - then - T:= Dim2Pixels(MgTop) - else - T:= Printable.T; - if (H-Dim2Pixels(MgBottom))< Printable.B - then - B:= H-Dim2Pixels(MgBottom) - else - B:= Printable.B; + if Dim2Pixels(MgLeft) > Printable.L then + L := Dim2Pixels(MgLeft) + else + L := Printable.L; + if (W - Dim2Pixels(MgRight)) < Printable.R then + R := W - Dim2Pixels(MgRight) + else + R := Printable.R; + if Dim2Pixels(MgTop) > Printable.T then + T := Dim2Pixels(MgTop) + else + T := Printable.T; + if (H - Dim2Pixels(MgBottom)) < Printable.B then + B := H - Dim2Pixels(MgBottom) + else + B := Printable.B; end; - FPosRef.X:= FCurrentMargin.L; - FHeaderHeight:= 0; - FPageHeight:= 0; - FFooterHeight:= 0; - NumSection:= NumSection+1; - VSection:= T_Section.Create(FPaper,FCurrentMargin,NumSection); - Sections.Add(VSection); - CMargin:= Dim2Pixels(BackPos); - VColumn:= T_Column.Create(FCurrentMargin.L,FCurrentMargin.R-FCurrentMargin.L,CMargin,clWhite); - T_Section(Sections[Pred(Sections.Count)]).DefaultCol:= Columns.Add(VColumn); + FPosRef.X := FCurrentMargin.L; + FHeaderHeight := 0; + FPageHeight := 0; + FFooterHeight := 0; + NumSection := NumSection + 1; + VSection := T_Section.Create(FPaper, FCurrentMargin, NumSection); + Sections.Add(VSection); + CMargin := Dim2Pixels(BackPos); + VColumn := T_Column.Create(FCurrentMargin.L, FCurrentMargin.R - FCurrentMargin.L, CMargin, clWhite); + T_Section(Sections[Pred(Sections.Count)]).DefaultCol := Columns.Add(VColumn); end; end; end; procedure T_Report.Page; begin -if FPreparation= ppPrepare -then + if FPreparation = ppPrepare then begin - NumPage:= NumPage+1; - T_Section(Sections[Pred(Sections.Count)]).LoadPage(NumPage); - FPosRef.Y:= FCurrentMargin.T+FHeaderHeight; - FPageHeight:= 0; + NumPage := NumPage + 1; + T_Section(Sections[Pred(Sections.Count)]).LoadPage(NumPage); + FPosRef.Y := FCurrentMargin.T + FHeaderHeight; + FPageHeight := 0; end; end; -function T_Report.BackColor(FdColor: TfpgColor): Integer; +function T_Report.BackColor(FdColor: TfpgColor): integer; begin -VBackColor:= T_BackColor.Create(FdColor); -Result:= BackColors.Add(VBackColor); + VBackColor := T_BackColor.Create(FdColor); + Result := BackColors.Add(VBackColor); end; -function T_Report.Font(FtNom: string; FtColor: TfpgColor): Integer; +function T_Report.Font(FtNom: string; FtColor: TfpgColor): integer; begin -VFont:= T_Font.Create(FtNom,FtColor); -Result:= Fonts.Add(VFont); + VFont := T_Font.Create(FtNom, FtColor); + Result := Fonts.Add(VFont); end; -function T_Report.LineStyle(StThick: Single; StColor: Tfpgcolor; StStyle: TfpgLineStyle): Integer; +function T_Report.LineStyle(StThick: single; StColor: TfpgColor; StStyle: TfpgLineStyle): integer; begin -VLineStyle:= T_LineStyle.Create(StThick,StColor,StStyle); -Result:= LineStyles.Add(VLineStyle); + VLineStyle := T_LineStyle.Create(StThick, StColor, StStyle); + Result := LineStyles.Add(VLineStyle); end; -function T_Report.Border(BdFlags: TBorderFlags; BdStyle: Integer): Integer; +function T_Report.Border(BdFlags: TBorderFlags; BdStyle: integer): integer; begin -VBorder:= T_Border.Create(BdFlags,BdStyle); -Result:= Borders.Add(VBorder); + VBorder := T_Border.Create(BdFlags, BdStyle); + Result := Borders.Add(VBorder); end; -//function T_Report.Border(BdFlags: TBorderFlags; StFlags: array of Integer): Integer; -//begin -//VBorder:= T_Border.Create(BdFlags,BdStyle); -//Result:= Borders.Add(VBorder); -//end; + //function T_Report.Border(BdFlags: TBorderFlags; StFlags: array of Integer): Integer; + //begin + //VBorder:= T_Border.Create(BdFlags,BdStyle); + //Result:= Borders.Add(VBorder); + //end; -function T_Report.Column(ClnPos,ClnWidth: Single; ClnMargin: Single= 0; ClnColor: TfpgColor= clWhite): Integer; +function T_Report.Column(ClnPos, ClnWidth: single; ClnMargin: single = 0; ClnColor: TfpgColor = clWhite): integer; var - CPos,CWidth,CMargin: Single; + CPos, CWidth, CMargin: single; begin -CPos:= Dim2Pixels(ClnPos); -CWidth:= Dim2Pixels(ClnWidth); -CMargin:= Dim2Pixels(ClnMargin); -VColumn:= T_Column.Create(CPos,CWidth,CMargin,ClnColor); -Result:= Columns.Add(VColumn); + CPos := Dim2Pixels(ClnPos); + CWidth := Dim2Pixels(ClnWidth); + CMargin := Dim2Pixels(ClnMargin); + VColumn := T_Column.Create(CPos, CWidth, CMargin, ClnColor); + Result := Columns.Add(VColumn); end; -procedure T_Report.WriteHeader(Horiz,Verti: Single; Text: string; ColNum: Integer= 0; FontNum: Integer= 0; - LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1); +procedure T_Report.WriteHeader(Horiz, Verti: single; Text: string; ColNum: integer = 0; FontNum: integer = 0; LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); var - RefText: Integer; + RefText: integer; Flags: TfpgTextFlags; begin -Flags:= [txtWrap]; -if Horiz< 0 -then + Flags := [txtWrap]; + if Horiz < 0 then begin - if Horiz= cnLeft - then - Include(Flags,txtLeft); - if Horiz= cnCenter - then - Include(Flags,txtHCenter); - if Horiz= cnRight - then - Include(Flags,txtRight); + if Horiz = cnLeft then + Include(Flags, txtLeft); + if Horiz = cnCenter then + Include(Flags, txtHCenter); + if Horiz = cnRight then + Include(Flags, txtRight); end -else - Horiz:= Dim2Pixels(Horiz); -if Verti> 0 -then - Verti:= Dim2Pixels(Verti); -RefText:= Texts.IndexOf(Text); -if RefText= -1 -then - RefText:= Texts.Add(Text); -WriteText(Horiz,Verti,ColNum,RefText,FontNum,BkColorNum,BordNum,LineSpNum,Flags,zHeader); -end; - -function T_Report.WritePage(Horiz,Verti: Single; Text: string; ColNum: Integer= 0; FontNum: Integer= 0; - LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1): Single; + else + Horiz := Dim2Pixels(Horiz); + if Verti > 0 then + Verti := Dim2Pixels(Verti); + RefText := Texts.IndexOf(Text); + if RefText = -1 then + RefText := Texts.Add(Text); + WriteText(Horiz, Verti, ColNum, RefText, FontNum, BkColorNum, BordNum, LineSpNum, Flags, zHeader); +end; + +function T_Report.WritePage(Horiz, Verti: single; Text: string; ColNum: integer = 0; FontNum: integer = 0; LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1): single; var - RefText: Integer; + RefText: integer; Flags: TfpgTextFlags; begin -Flags:= [txtWrap]; -if Horiz< 0 -then + Flags := [txtWrap]; + if Horiz < 0 then begin - if Horiz= cnLeft - then - Include(Flags,txtLeft); - if Horiz= cnCenter - then - Include(Flags,txtHCenter); - if Horiz= cnRight - then - Include(Flags,txtRight); + if Horiz = cnLeft then + Include(Flags, txtLeft); + if Horiz = cnCenter then + Include(Flags, txtHCenter); + if Horiz = cnRight then + Include(Flags, txtRight); end -else - Horiz:= Dim2Pixels(Horiz); -if Verti> 0 -then - Verti:= Dim2Pixels(Verti); -RefText:= Texts.IndexOf(Text); -if RefText= -1 -then - RefText:= Texts.Add(Text); -Result:= WriteText(Horiz,Verti,ColNum,RefText,FontNum,BkColorNum,BordNum,LineSpNum,Flags,ZPage); -end; - -procedure T_Report.WriteFooter(Horiz,Verti: Single; Text: string; ColNum: Integer= 0; FontNum: Integer= 0; - LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1); + else + Horiz := Dim2Pixels(Horiz); + if Verti > 0 then + Verti := Dim2Pixels(Verti); + RefText := Texts.IndexOf(Text); + if RefText = -1 then + RefText := Texts.Add(Text); + Result := WriteText(Horiz, Verti, ColNum, RefText, FontNum, BkColorNum, BordNum, LineSpNum, Flags, ZPage); +end; + +procedure T_Report.WriteFooter(Horiz, Verti: single; Text: string; ColNum: integer = 0; FontNum: integer = 0; LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); var - RefText: Integer; + RefText: integer; Flags: TfpgTextFlags; begin -Flags:= [txtWrap]; -if Horiz< 0 -then + Flags := [txtWrap]; + if Horiz < 0 then begin - if Horiz= cnLeft - then - Include(Flags,txtLeft); - if Horiz= cnCenter - then - Include(Flags,txtHCenter); - if Horiz= cnRight - then - Include(Flags,txtRight); + if Horiz = cnLeft then + Include(Flags, txtLeft); + if Horiz = cnCenter then + Include(Flags, txtHCenter); + if Horiz = cnRight then + Include(Flags, txtRight); end -else - Horiz:= Dim2Pixels(Horiz); -if Verti> 0 -then - Verti:= Dim2Pixels(Verti); -RefText:= Texts.IndexOf(Text); -if RefText= -1 -then - RefText:= Texts.Add(Text); -WriteText(Horiz,Verti,ColNum,RefText,FontNum,BkColorNum,BordNum,LineSpNum,Flags,zFooter); -end; - -procedure T_Report.NumSectionHeader(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= ''; - Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; - LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1); + else + Horiz := Dim2Pixels(Horiz); + if Verti > 0 then + Verti := Dim2Pixels(Verti); + RefText := Texts.IndexOf(Text); + if RefText = -1 then + RefText := Texts.Add(Text); + WriteText(Horiz, Verti, ColNum, RefText, FontNum, BkColorNum, BordNum, LineSpNum, Flags, zFooter); +end; + +procedure T_Report.NumSectionHeader(Horiz, Verti: single; TexteSect: string = ''; TextTot: string = ''; Total: Boolean = False; Alpha: Boolean = False; ColNum: integer = 0; FontNum: integer = 0; + LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); var - RefTextPage,RefTextTot: Integer; + RefTextPage, RefTextTot: integer; Flags: TfpgTextFlags; begin -Flags:= []; -if Horiz< 0 -then + Flags := []; + if Horiz < 0 then begin - if Horiz= cnLeft - then - Include(Flags,txtLeft); - if Horiz= cnCenter - then - Include(Flags,txtHCenter); - if Horiz= cnRight - then - Include(Flags,txtRight); + if Horiz = cnLeft then + Include(Flags, txtLeft); + if Horiz = cnCenter then + Include(Flags, txtHCenter); + if Horiz = cnRight then + Include(Flags, txtRight); end -else - Horiz:= Dim2Pixels(Horiz); -if Verti> 0 -then - Verti:= Dim2Pixels(Verti); -RefTextPage:= Texts.IndexOf(TexteSect); -if RefTextPage= -1 -then - RefTextPage:= Texts.Add(TexteSect); -RefTextTot:= Texts.IndexOf(TextTot); -if RefTextTot= -1 -then - RefTextTot:= Texts.Add(TextTot); -WriteNumber(Horiz,Verti,ColNum,RefTextPage,RefTextTot,FontNum,BkColorNum,BordNum,LineSpNum,Flags,Total,Alpha,zHeader,SectNum); -end; - -procedure T_Report.NumSectionFooter(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= ''; - Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; - LineSpNum: Integer= 0;BkColorNum: Integer= -1; BordNum: Integer= -1); + else + Horiz := Dim2Pixels(Horiz); + if Verti > 0 then + Verti := Dim2Pixels(Verti); + RefTextPage := Texts.IndexOf(TexteSect); + if RefTextPage = -1 then + RefTextPage := Texts.Add(TexteSect); + RefTextTot := Texts.IndexOf(TextTot); + if RefTextTot = -1 then + RefTextTot := Texts.Add(TextTot); + WriteNumber(Horiz, Verti, ColNum, RefTextPage, RefTextTot, FontNum, BkColorNum, BordNum, LineSpNum, Flags, Total, Alpha, zHeader, SectNum); +end; + +procedure T_Report.NumSectionFooter(Horiz, Verti: single; TexteSect: string = ''; TextTot: string = ''; Total: Boolean = False; Alpha: Boolean = False; ColNum: integer = 0; FontNum: integer = 0; + LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); var - RefTextPage,RefTextTot: Integer; + RefTextPage, RefTextTot: integer; Flags: TfpgTextFlags; begin -Flags:= []; -if Horiz< 0 -then + Flags := []; + if Horiz < 0 then begin - if Horiz= cnLeft - then - Include(Flags,txtLeft); - if Horiz= cnCenter - then - Include(Flags,txtHCenter); - if Horiz= cnRight - then - Include(Flags,txtRight); + if Horiz = cnLeft then + Include(Flags, txtLeft); + if Horiz = cnCenter then + Include(Flags, txtHCenter); + if Horiz = cnRight then + Include(Flags, txtRight); end -else - Horiz:= Dim2Pixels(Horiz); -if Verti> 0 -then - Verti:= Dim2Pixels(Verti); -RefTextPage:= Texts.IndexOf(TexteSect); -if RefTextPage= -1 -then - RefTextPage:= Texts.Add(TexteSect); -RefTextTot:= Texts.IndexOf(TextTot); -if RefTextTot= -1 -then - RefTextTot:= Texts.Add(TextTot); -WriteNumber(Horiz,Verti,ColNum,RefTextPage,RefTextTot,FontNum,BkColorNum,BordNum,LineSpNum,Flags,Total,Alpha,zFooter,SectNum); -end; - -procedure T_Report.NumPageHeader(Horiz,Verti: Single; TextePage: string= ''; TextTot: string= ''; - Total: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; LineSpNum: Integer= 0; - BkColorNum: Integer= -1; BordNum: Integer= -1); + else + Horiz := Dim2Pixels(Horiz); + if Verti > 0 then + Verti := Dim2Pixels(Verti); + RefTextPage := Texts.IndexOf(TexteSect); + if RefTextPage = -1 then + RefTextPage := Texts.Add(TexteSect); + RefTextTot := Texts.IndexOf(TextTot); + if RefTextTot = -1 then + RefTextTot := Texts.Add(TextTot); + WriteNumber(Horiz, Verti, ColNum, RefTextPage, RefTextTot, FontNum, BkColorNum, BordNum, LineSpNum, Flags, Total, Alpha, zFooter, SectNum); +end; + +procedure T_Report.NumPageHeader(Horiz, Verti: single; TextePage: string = ''; TextTot: string = ''; Total: Boolean = False; ColNum: integer = 0; FontNum: integer = 0; LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); var - RefTextPage,RefTextTot: Integer; + RefTextPage, RefTextTot: integer; Flags: TfpgTextFlags; begin -Flags:= []; -if Horiz< 0 -then + Flags := []; + if Horiz < 0 then begin - if Horiz= cnLeft - then - Include(Flags,txtLeft); - if Horiz= cnCenter - then - Include(Flags,txtHCenter); - if Horiz= cnRight - then - Include(Flags,txtRight); + if Horiz = cnLeft then + Include(Flags, txtLeft); + if Horiz = cnCenter then + Include(Flags, txtHCenter); + if Horiz = cnRight then + Include(Flags, txtRight); end -else - Horiz:= Dim2Pixels(Horiz); -if Verti> 0 -then - Verti:= Dim2Pixels(Verti); -RefTextPage:= Texts.IndexOf(TextePage); -if RefTextPage= -1 -then - RefTextPage:= Texts.Add(TextePage); -RefTextTot:= Texts.IndexOf(TextTot); -if RefTextTot= -1 -then - RefTextTot:= Texts.Add(TextTot); -WriteNumber(Horiz,Verti,ColNum,RefTextPage,RefTextTot,FontNum,BkColorNum,BordNum,LineSpNum,Flags,Total,False,zHeader,PageNum); -end; - -procedure T_Report.NumPageFooter(Horiz,Verti: Single; TextePage: string= ''; TextTot: string= ''; - Total: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; LineSpNum: Integer= 0; - BkColorNum: Integer= -1; BordNum: Integer= -1); + else + Horiz := Dim2Pixels(Horiz); + if Verti > 0 then + Verti := Dim2Pixels(Verti); + RefTextPage := Texts.IndexOf(TextePage); + if RefTextPage = -1 then + RefTextPage := Texts.Add(TextePage); + RefTextTot := Texts.IndexOf(TextTot); + if RefTextTot = -1 then + RefTextTot := Texts.Add(TextTot); + WriteNumber(Horiz, Verti, ColNum, RefTextPage, RefTextTot, FontNum, BkColorNum, BordNum, LineSpNum, Flags, Total, False, zHeader, PageNum); +end; + +procedure T_Report.NumPageFooter(Horiz, Verti: single; TextePage: string = ''; TextTot: string = ''; Total: Boolean = False; ColNum: integer = 0; FontNum: integer = 0; LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); var - RefTextPage,RefTextTot: Integer; + RefTextPage, RefTextTot: integer; Flags: TfpgTextFlags; begin -Flags:= []; -if Horiz< 0 -then + Flags := []; + if Horiz < 0 then begin - if Horiz= cnLeft - then - Include(Flags,txtLeft); - if Horiz= cnCenter - then - Include(Flags,txtHCenter); - if Horiz= cnRight - then - Include(Flags,txtRight); + if Horiz = cnLeft then + Include(Flags, txtLeft); + if Horiz = cnCenter then + Include(Flags, txtHCenter); + if Horiz = cnRight then + Include(Flags, txtRight); end -else - Horiz:= Dim2Pixels(Horiz); -if Verti> 0 -then - Verti:= Dim2Pixels(Verti); -RefTextPage:= Texts.IndexOf(TextePage); -if RefTextPage= -1 -then - RefTextPage:= Texts.Add(TextePage); -RefTextTot:= Texts.IndexOf(TextTot); -if RefTextTot= -1 -then - RefTextTot:= Texts.Add(TextTot); -WriteNumber(Horiz,Verti,ColNum,RefTextPage,RefTextTot,FontNum,BkColorNum,BordNum,LineSpNum,Flags,Total,False,zFooter,PageNum); -end; - -procedure T_Report.NumPageSectionHeader(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= ''; - Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; - LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1); + else + Horiz := Dim2Pixels(Horiz); + if Verti > 0 then + Verti := Dim2Pixels(Verti); + RefTextPage := Texts.IndexOf(TextePage); + if RefTextPage = -1 then + RefTextPage := Texts.Add(TextePage); + RefTextTot := Texts.IndexOf(TextTot); + if RefTextTot = -1 then + RefTextTot := Texts.Add(TextTot); + WriteNumber(Horiz, Verti, ColNum, RefTextPage, RefTextTot, FontNum, BkColorNum, BordNum, LineSpNum, Flags, Total, False, zFooter, PageNum); +end; + +procedure T_Report.NumPageSectionHeader(Horiz, Verti: single; TexteSect: string = ''; TextTot: string = ''; Total: Boolean = False; Alpha: Boolean = False; ColNum: integer = 0; FontNum: integer = 0; + LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); var - RefTextPage,RefTextTot: Integer; + RefTextPage, RefTextTot: integer; Flags: TfpgTextFlags; begin -Flags:= []; -if Horiz< 0 -then + Flags := []; + if Horiz < 0 then begin - if Horiz= cnLeft - then - Include(Flags,txtLeft); - if Horiz= cnCenter - then - Include(Flags,txtHCenter); - if Horiz= cnRight - then - Include(Flags,txtRight); + if Horiz = cnLeft then + Include(Flags, txtLeft); + if Horiz = cnCenter then + Include(Flags, txtHCenter); + if Horiz = cnRight then + Include(Flags, txtRight); end -else - Horiz:= Dim2Pixels(Horiz); -if Verti> 0 -then - Verti:= Dim2Pixels(Verti); -RefTextPage:= Texts.IndexOf(TexteSect); -if RefTextPage= -1 -then - RefTextPage:= Texts.Add(TexteSect); -RefTextTot:= Texts.IndexOf(TextTot); -if RefTextTot= -1 -then - RefTextTot:= Texts.Add(TextTot); -WriteNumber(Horiz,Verti,ColNum,RefTextPage,RefTextTot,FontNum,BkColorNum,BordNum,LineSpNum,Flags,Total,Alpha,zHeader,PSectNum); -end; - -procedure T_Report.NumPageSectionFooter(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= ''; - Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; - LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1); + else + Horiz := Dim2Pixels(Horiz); + if Verti > 0 then + Verti := Dim2Pixels(Verti); + RefTextPage := Texts.IndexOf(TexteSect); + if RefTextPage = -1 then + RefTextPage := Texts.Add(TexteSect); + RefTextTot := Texts.IndexOf(TextTot); + if RefTextTot = -1 then + RefTextTot := Texts.Add(TextTot); + WriteNumber(Horiz, Verti, ColNum, RefTextPage, RefTextTot, FontNum, BkColorNum, BordNum, LineSpNum, Flags, Total, Alpha, zHeader, PSectNum); +end; + +procedure T_Report.NumPageSectionFooter(Horiz, Verti: single; TexteSect: string = ''; TextTot: string = ''; Total: Boolean = False; Alpha: Boolean = False; ColNum: integer = 0; FontNum: integer = 0; + LineSpNum: integer = 0; BkColorNum: integer = -1; BordNum: integer = -1); var - RefTextPage,RefTextTot: Integer; + RefTextPage, RefTextTot: integer; Flags: TfpgTextFlags; begin -Flags:= []; -if Horiz< 0 -then + Flags := []; + if Horiz < 0 then begin - if Horiz= cnLeft - then - Include(Flags,txtLeft); - if Horiz= cnCenter - then - Include(Flags,txtHCenter); - if Horiz= cnRight - then - Include(Flags,txtRight); + if Horiz = cnLeft then + Include(Flags, txtLeft); + if Horiz = cnCenter then + Include(Flags, txtHCenter); + if Horiz = cnRight then + Include(Flags, txtRight); end -else - Horiz:= Dim2Pixels(Horiz); -if Verti> 0 -then - Verti:= Dim2Pixels(Verti); -RefTextPage:= Texts.IndexOf(TexteSect); -if RefTextPage= -1 -then - RefTextPage:= Texts.Add(TexteSect); -RefTextTot:= Texts.IndexOf(TextTot); -if RefTextTot= -1 -then - RefTextTot:= Texts.Add(TextTot); -WriteNumber(Horiz,Verti,ColNum,RefTextPage,RefTextTot,FontNum,BkColorNum,BordNum,LineSpNum,Flags,Total,Alpha,zFooter,PSectNum); + else + Horiz := Dim2Pixels(Horiz); + if Verti > 0 then + Verti := Dim2Pixels(Verti); + RefTextPage := Texts.IndexOf(TexteSect); + if RefTextPage = -1 then + RefTextPage := Texts.Add(TexteSect); + RefTextTot := Texts.IndexOf(TextTot); + if RefTextTot = -1 then + RefTextTot := Texts.Add(TextTot); + WriteNumber(Horiz, Verti, ColNum, RefTextPage, RefTextTot, FontNum, BkColorNum, BordNum, LineSpNum, Flags, Total, Alpha, zFooter, PSectNum); end; -procedure T_Report.HorizLineHeader(SpBefore,SpAfter: Single; ColNum: Integer= 0; StyleNum: Integer= 0); +procedure T_Report.HorizLineHeader(SpBefore, SpAfter: single; ColNum: integer = 0; StyleNum: integer = 0); begin -DrawAHorizLine(Dim2Pixels(SpBefore),Dim2Pixels(SpAfter),ColNum,-1,StyleNum,zHeader); + DrawAHorizLine(Dim2Pixels(SpBefore), Dim2Pixels(SpAfter), ColNum, -1, StyleNum, zHeader); end; -procedure T_Report.HorizLinePage(SpBefore,SpAfter: Single; ColNum: Integer= 0; StyleNum: Integer= 0); +procedure T_Report.HorizLinePage(SpBefore, SpAfter: single; ColNum: integer = 0; StyleNum: integer = 0); begin -DrawAHorizLine(Dim2Pixels(SpBefore),Dim2Pixels(SpAfter),ColNum,-1,StyleNum,zPage); + DrawAHorizLine(Dim2Pixels(SpBefore), Dim2Pixels(SpAfter), ColNum, -1, StyleNum, zPage); end; -procedure T_Report.HorizLineFooter(SpBefore,SpAfter: Single; ColNum: Integer= 0; StyleNum: Integer= 0); +procedure T_Report.HorizLineFooter(SpBefore, SpAfter: single; ColNum: integer = 0; StyleNum: integer = 0); begin -DrawAHorizLine(Dim2Pixels(SpBefore),Dim2Pixels(SpAfter),ColNum,-1,StyleNum,zFooter); + DrawAHorizLine(Dim2Pixels(SpBefore), Dim2Pixels(SpAfter), ColNum, -1, StyleNum, zFooter); end; -procedure T_Report.SpaceHeader(Verti: Single; ColNum: Integer= 0; BkColorNum: Integer= -1); +procedure T_Report.SpaceHeader(Verti: single; ColNum: integer = 0; BkColorNum: integer = -1); begin -InsertSpace(-1,ColNum,Dim2Pixels(Verti),BkColorNum,zHeader); + InsertSpace(-1, ColNum, Dim2Pixels(Verti), BkColorNum, zHeader); end; -procedure T_Report.SpacePage(Verti: Single; ColNum: Integer= 0; BkColorNum: Integer= -1); +procedure T_Report.SpacePage(Verti: single; ColNum: integer = 0; BkColorNum: integer = -1); begin -InsertSpace(-1,ColNum,Dim2Pixels(Verti),BkColorNum,zPage); + InsertSpace(-1, ColNum, Dim2Pixels(Verti), BkColorNum, zPage); end; -procedure T_Report.SpaceFooter(Verti: Single; ColNum: Integer= 0; BkColorNum: Integer= -1); +procedure T_Report.SpaceFooter(Verti: single; ColNum: integer = 0; BkColorNum: integer = -1); begin -InsertSpace(-1,ColNum,Dim2Pixels(Verti),BkColorNum,zFooter); + InsertSpace(-1, ColNum, Dim2Pixels(Verti), BkColorNum, zFooter); end; -function T_Report.LineSpace(SpSup,SpInt,SpInf: Single): Integer; +function T_Report.LineSpace(SpSup, SpInt, SpInf: single): integer; var - Sup,Int,Inf: Integer; + Sup, Int, Inf: integer; begin -if SpSup> 0 -then - Sup:= Round(Dim2Pixels(SpSup)) -else - Sup:= 0; -if SpInt> 0 -then - Int:= Round(Dim2Pixels(SpInt)) -else - Int:= 0; -if SpInf> 0 -then - Inf:= Round(Dim2Pixels(SpInf)) -else - Inf:= 0; -VLineSpace:= T_LineSpace.Create(Sup,Int,Inf); -Result:= LineSpaces.Add(VLineSpace); + if SpSup > 0 then + Sup := Round(Dim2Pixels(SpSup)) + else + Sup := 0; + if SpInt > 0 then + Int := Round(Dim2Pixels(SpInt)) + else + Int := 0; + if SpInf > 0 then + Inf := Round(Dim2Pixels(SpInf)) + else + Inf := 0; + VLineSpace := T_LineSpace.Create(Sup, Int, Inf); + Result := LineSpaces.Add(VLineSpace); end; -procedure T_Report.BeginGroup(PageJump: Boolean= False); +procedure T_Report.BeginGroup(PageJump: Boolean = False); begin -VGroup:= T_Group.Create; -FGroup:= True; -if PageJump -then - Page; + VGroup := T_Group.Create; + FGroup := True; + if PageJump then + Page; end; -procedure T_Report.EndGroup(PageJump: Boolean= False); +procedure T_Report.EndGroup(PageJump: Boolean = False); begin -T_Section(Sections[Pred(Sections.Count)]).LoadCmdGroupToPage; -FGroup:= False; -VGroup.Free; -if PageJump -then - Page; + T_Section(Sections[Pred(Sections.Count)]).LoadCmdGroupToPage; + FGroup := False; + VGroup.Free; + if PageJump then + Page; end; -procedure T_Report.ColorColChange(ColNum: Integer; ColColor: TfpgColor); +procedure T_Report.ColorColChange(ColNum: integer; ColColor: TfpgColor); begin -T_Column(Columns[ColNum]).SetColColor(ColColor); + T_Column(Columns[ColNum]).SetColColor(ColColor); end; -procedure T_Report.FrameMargins(AStyle: Integer); +procedure T_Report.FrameMargins(AStyle: integer); begin -DrawAFrame(AStyle,zMargins); + DrawAFrame(AStyle, zMargins); end; -procedure T_Report.FrameHeader(AStyle: Integer); +procedure T_Report.FrameHeader(AStyle: integer); begin -DrawAFrame(AStyle,zHeader); + DrawAFrame(AStyle, zHeader); end; -procedure T_Report.FramePage(AStyle: Integer); +procedure T_Report.FramePage(AStyle: integer); begin -DrawAFrame(AStyle,zPage); + DrawAFrame(AStyle, zPage); end; -procedure T_Report.FrameFooter(AStyle: Integer); +procedure T_Report.FrameFooter(AStyle: integer); begin -DrawAFrame(AStyle,zFooter); + DrawAFrame(AStyle, zFooter); end; -procedure T_Report.LinePage(XBegin,YBegin,XEnd,YEnd: Single; AStyle: Integer); +procedure T_Report.LinePage(XBegin, YBegin, XEnd, YEnd: single; AStyle: integer); begin -DrawALine(Dim2Pixels(XBegin),Dim2Pixels(YBegin),Dim2Pixels(XEnd),Dim2Pixels(YEnd),AStyle); + DrawALine(Dim2Pixels(XBegin), Dim2Pixels(YBegin), Dim2Pixels(XEnd), Dim2Pixels(YEnd), AStyle); end; -procedure T_Report.SurfPage(XLimits,YLimits: array of Single; AColor: TfpgColor); +procedure T_Report.SurfPage(XLimits, YLimits: array of single; AColor: TfpgColor); var - Size,Cpt: Integer; + Size, Cpt: integer; Ends: array of TRefPos; begin -if Length(XLimits)< Length(YLimits) -then - Size:= Length(XLimits) -else - if Length(XLimits)> Length(YLimits) - then - Size:= Length(YLimits) + if Length(XLimits) < Length(YLimits) then + Size := Length(XLimits) + else if Length(XLimits) > Length(YLimits) then + Size := Length(YLimits) else - Size:= Length(XLimits); -SetLength(Ends,Size); -for Cpt:= 0 to Pred(Size) do + Size := Length(XLimits); + SetLength(Ends, Size); + for Cpt := 0 to Pred(Size) do begin - Ends[Cpt].X:= Dim2Pixels(XLimits[Cpt]); - Ends[Cpt].Y:= Dim2Pixels(YLimits[Cpt]); + Ends[Cpt].X := Dim2Pixels(XLimits[Cpt]); + Ends[Cpt].Y := Dim2Pixels(YLimits[Cpt]); end; -PaintSurface(Ends,AColor); + PaintSurface(Ends, AColor); end; -procedure T_Report.ImageHeader(Horiz,Verti: Single; ImgFileName: string; ColNum,Scale: Integer); +procedure T_Report.ImageHeader(Horiz, Verti: single; ImgFileName: string; ColNum, Scale: integer); var - RefImage: Integer; + RefImage: integer; Image: TfpgImage; begin -Horiz:= Dim2Pixels(Horiz); -Verti:= Dim2Pixels(Verti); -if FileExists(ImgFileName) -then + Horiz := Dim2Pixels(Horiz); + Verti := Dim2Pixels(Verti); + if FileExists(ImgFileName) then begin - RefImage:= ImageNames.IndexOf(IntToStr(Scale)+ImgFileName); - if RefImage= -1 - then + RefImage := ImageNames.IndexOf(IntToStr(Scale) + ImgFileName); + if RefImage = -1 then begin - if Copy(ImgFileName,Succ(Pos('.',ImgFileName)),3)= 'bmp' - then + if Copy(ImgFileName, Succ(Pos('.', ImgFileName)), 3) = 'bmp' then begin - Image:= LoadImage_BMP(ImgFileName); - Scale:= 1; + Image := LoadImage_BMP(ImgFileName); + Scale := 1; end; - if (Copy(ImgFileName,Succ(Pos('.',ImgFileName)),3)= 'jpg') or (Copy(ImgFileName,Succ(Pos('.',ImgFileName)),4)= 'jpeg') - then - Image:= LoadImage_JPG(ImgFileName,Scale); - RefImage:= ImageNames.Add(IntToStr(Scale)+ImgFileName); - Images.Add(Image); + if (Copy(ImgFileName, Succ(Pos('.', ImgFileName)), 3) = 'jpg') or (Copy(ImgFileName, Succ(Pos('.', ImgFileName)), 4) = 'jpeg') then + Image := LoadImage_JPG(ImgFileName, Scale); + RefImage := ImageNames.Add(IntToStr(Scale) + ImgFileName); + Images.Add(Image); end; - PaintImage(Horiz,Verti,ColNum,RefImage,zHeader); + PaintImage(Horiz, Verti, ColNum, RefImage, zHeader); end -else - if fpgImages.GetImage(ImgFileName)<> nil - then + else if fpgImages.GetImage(ImgFileName) <> nil then + begin + RefImage := ImageNames.IndexOf(IntToStr(Scale) + ImgFileName); + if RefImage = -1 then begin - RefImage:= ImageNames.IndexOf(IntToStr(Scale)+ImgFileName); - if RefImage= -1 - then - begin - Image:= fpgImages.GetImage(ImgFileName); - Scale:= 1; - RefImage:= ImageNames.Add(IntToStr(Scale)+ImgFileName); + Image := fpgImages.GetImage(ImgFileName); + Scale := 1; + RefImage := ImageNames.Add(IntToStr(Scale) + ImgFileName); Images.Add(Image); - end; - PaintImage(Horiz,Verti,ColNum,RefImage,zPage); - end + end; + PaintImage(Horiz, Verti, ColNum, RefImage, zPage); + end else - ShowMessage('Image '+ImgFileName+' is missing'); + { TODO: localize this message } + ShowMessage('Image ' + ImgFileName + ' is missing'); end; -procedure T_Report.ImagePage(Horiz,Verti: Single; ImgFileName: string; ColNum,Scale: Integer); +procedure T_Report.ImagePage(Horiz, Verti: single; ImgFileName: string; ColNum, Scale: integer); var - RefImage: Integer; + RefImage: integer; Image: TfpgImage; begin -Horiz:= Dim2Pixels(Horiz); -Verti:= Dim2Pixels(Verti); -if FileExists(ImgFileName) -then + Horiz := Dim2Pixels(Horiz); + Verti := Dim2Pixels(Verti); + if FileExists(ImgFileName) then begin - RefImage:= ImageNames.IndexOf(IntToStr(Scale)+ImgFileName); - if RefImage= -1 - then + RefImage := ImageNames.IndexOf(IntToStr(Scale) + ImgFileName); + if RefImage = -1 then begin - if Copy(ImgFileName,Succ(Pos('.',ImgFileName)),3)= 'bmp' - then + if Copy(ImgFileName, Succ(Pos('.', ImgFileName)), 3) = 'bmp' then begin - Image:= LoadImage_BMP(ImgFileName); - Scale:= 1; + Image := LoadImage_BMP(ImgFileName); + Scale := 1; end; - if (Copy(ImgFileName,Succ(Pos('.',ImgFileName)),3)= 'jpg') or (Copy(ImgFileName,Succ(Pos('.',ImgFileName)),4)= 'jpeg') - then - Image:= LoadImage_JPG(ImgFileName,Scale); - RefImage:= ImageNames.Add(IntToStr(Scale)+ImgFileName); - Images.Add(Image); + if (Copy(ImgFileName, Succ(Pos('.', ImgFileName)), 3) = 'jpg') or (Copy(ImgFileName, Succ(Pos('.', ImgFileName)), 4) = 'jpeg') then + Image := LoadImage_JPG(ImgFileName, Scale); + RefImage := ImageNames.Add(IntToStr(Scale) + ImgFileName); + Images.Add(Image); end; - PaintImage(Horiz,Verti,ColNum,RefImage,zPage); + PaintImage(Horiz, Verti, ColNum, RefImage, zPage); end -else - if fpgImages.GetImage(ImgFileName)<> nil - then + else if fpgImages.GetImage(ImgFileName) <> nil then + begin + RefImage := ImageNames.IndexOf(IntToStr(Scale) + ImgFileName); + if RefImage = -1 then begin - RefImage:= ImageNames.IndexOf(IntToStr(Scale)+ImgFileName); - if RefImage= -1 - then - begin - Image:= fpgImages.GetImage(ImgFileName); - Scale:= 1; - RefImage:= ImageNames.Add(IntToStr(Scale)+ImgFileName); + Image := fpgImages.GetImage(ImgFileName); + Scale := 1; + RefImage := ImageNames.Add(IntToStr(Scale) + ImgFileName); Images.Add(Image); - end; - PaintImage(Horiz,Verti,ColNum,RefImage,zPage); - end + end; + PaintImage(Horiz, Verti, ColNum, RefImage, zPage); + end else - ShowMessage('Image '+ImgFileName+' is missing'); + { TODO: localize this message } + ShowMessage('Image ' + ImgFileName + ' is missing'); end; -procedure T_Report.ImageFooter(Horiz,Verti: Single; ImgFileName: string; ColNum,Scale: Integer); +procedure T_Report.ImageFooter(Horiz, Verti: single; ImgFileName: string; ColNum, Scale: integer); var - RefImage: Integer; + RefImage: integer; Image: TfpgImage; begin -Horiz:= Dim2Pixels(Horiz); -Verti:= Dim2Pixels(Verti); -if FileExists(ImgFileName) -then + Horiz := Dim2Pixels(Horiz); + Verti := Dim2Pixels(Verti); + if FileExists(ImgFileName) then begin - RefImage:= ImageNames.IndexOf(IntToStr(Scale)+ImgFileName); - if RefImage= -1 - then + RefImage := ImageNames.IndexOf(IntToStr(Scale) + ImgFileName); + if RefImage = -1 then begin - if Copy(ImgFileName,Succ(Pos('.',ImgFileName)),3)= 'bmp' - then + if Copy(ImgFileName, Succ(Pos('.', ImgFileName)), 3) = 'bmp' then begin - Image:= LoadImage_BMP(ImgFileName); - Scale:= 1; + Image := LoadImage_BMP(ImgFileName); + Scale := 1; end; - if (Copy(ImgFileName,Succ(Pos('.',ImgFileName)),3)= 'jpg') or (Copy(ImgFileName,Succ(Pos('.',ImgFileName)),4)= 'jpeg') - then - Image:= LoadImage_JPG(ImgFileName,Scale); - RefImage:= ImageNames.Add(IntToStr(Scale)+ImgFileName); - Images.Add(Image); + if (Copy(ImgFileName, Succ(Pos('.', ImgFileName)), 3) = 'jpg') or (Copy(ImgFileName, Succ(Pos('.', ImgFileName)), 4) = 'jpeg') then + Image := LoadImage_JPG(ImgFileName, Scale); + RefImage := ImageNames.Add(IntToStr(Scale) + ImgFileName); + Images.Add(Image); end; - PaintImage(Horiz,Verti,ColNum,RefImage,zFooter); + PaintImage(Horiz, Verti, ColNum, RefImage, zFooter); end -else - if fpgImages.GetImage(ImgFileName)<> nil - then + else if fpgImages.GetImage(ImgFileName) <> nil then + begin + RefImage := ImageNames.IndexOf(IntToStr(Scale) + ImgFileName); + if RefImage = -1 then begin - RefImage:= ImageNames.IndexOf(IntToStr(Scale)+ImgFileName); - if RefImage= -1 - then - begin - Image:= fpgImages.GetImage(ImgFileName); - Scale:= 1; - RefImage:= ImageNames.Add(IntToStr(Scale)+ImgFileName); + Image := fpgImages.GetImage(ImgFileName); + Scale := 1; + RefImage := ImageNames.Add(IntToStr(Scale) + ImgFileName); Images.Add(Image); - end; - PaintImage(Horiz,Verti,ColNum,RefImage,zPage); - end + end; + PaintImage(Horiz, Verti, ColNum, RefImage, zPage); + end else - ShowMessage('Image '+ImgFileName+' is missing'); + { TODO: localize this message } + ShowMessage('Image ' + ImgFileName + ' is missing'); end; end. |