unit UntMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, PDFlib_com_TLB,
Vcl.OleServer, Vcl.ExtCtrls;
type
TForm2 = class(TForm)
btnNested_tables: TButton;
btnCreatePdf: TButton;
pdf: TPDFLib;
pnl1: TPanel;
pnl2: TPanel;
btnBmp: TButton;
procedure btnNested_tablesClick(Sender: TObject);
procedure btnBmpClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FBitMap: TBitMap;
/// <summary>
/// 根据宽高得到一副位图
/// </summary>
/// <param name="AWidth">宽</param>
/// <param name="AHeight">高</param>
/// <returns>返回文件名</returns>
function getImage(AWidth, AHeight: Integer): string;
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.btnNested_tablesClick(Sender: TObject);
var
p: TPDFLib;
pFont: Integer;
function SubTableTemplate(AValue: Double; var AWidth,AHeight: Double): Integer;
var
fontsize :Double;
margin :Integer;
begin
fontsize := 12.0;
margin := 3;
Result:= p.begin_template_ext(0, 0, '');
var R,C,tbl,image,ww: Integer;
var cellValue,optList,imagefile: string;
tbl:= -1;
for R := 1 to 1 do
begin
for C := 1 to 2 do
begin
// 为模板子表添加一些单元格，并将其放入模板中
if C=1 then
begin
cellValue:= '';
ww:= Round(AValue);
imagefile:= getImage(ww,15);
image := p.load_image('auto', imagefile, '');
if (image = -1) then
raise Exception.Create('错误: ' + p.get_errmsg());
optlist := 'image=' + image.ToString
+ ' colwidth=' + AValue.ToString //+ Format(' margin={0 %d}',[margin])
+ ' fittextline={font=' + pFont.ToString
+ ' fontsize=' + fontsize.ToString + '}';
// + ' matchbox={fillcolor={rgb 0.82 0.4 0.1}}';
end else
begin
cellValue:= Format('%f',[AValue]);
// 为模板子表添加一些单元格，并将其放入模板中
optList :=
'fittextline={font=' + pFont.ToString
+ ' fontsize=' + fontsize.ToString + '} margin=' + margin.ToString;
end;
tbl := p.add_table_cell(tbl, C, R, cellValue, optList);
if (tbl = -1) then
raise Exception.Create('错误: ' + p.get_errmsg());
end;
end;
var subTabOptlist := 'stroke={{line=other linewidth=0}} '
//+ 'fill={{area=table fillcolor={rgb 1 0.9 0.9}}} '
+ 'position={left bottom}';
p.fit_table(tbl, 0, 0, 1000, 1000, subTabOptlist);
// 检索模板子表的宽度和高度 "fillcolor={#FFC0CB})"
AWidth := p.info_table(tbl, 'width');
AHeight := p.info_table(tbl, 'height');
// 在指定模板大小的同时完成模板
p.end_template_ext(AWidth, AHeight);
p.delete_table(tbl, '');
end;
var
// p: TPDFLib;
{searchpath,}outfile,title: string;
taboptlist2: string;
addoptlist1, addoptlist2, fitoptlist1, textoptlist: string;
begin
//searchpath := '../input';
outfile := 'nested_tables.pdf';
title := 'Nested Tables';
var fontsize :Double := 14.0;
var margin :Double := 5.0;
var tabwidth1, tabheight1:Double;
var pagewidth :Double := 800;
var pageheight :Double := 500;
var x,y,yoff: Double;
x:= 20; y := 470; yoff := 10;
var exitcode,gs_blendmode :Integer;
exitcode:= 0; gs_blendmode:=0;
try
p := TPDFLib.Create(nil);
p.set_option('license=0');
p.set_parameter('compatibility', '1.7');
//p.set_option('searchpath={' + searchpath + '}');
// 这意味着我们必须检查load_font（）等的返回值。
p.set_option('errorpolicy=return');
if (p.begin_document(outfile, '') = -1) then
raise Exception.Create('错误：'+p.get_errmsg());
p.set_info('Creator', 'wdj');
p.set_info('Title', title);
p.begin_page_ext(pagewidth, pageheight, '');
pFont := p.load_font('微软雅黑', 'unicode', '');
p.setfont(pFont, 12);
textoptlist := 'fontsize=' + fontsize.ToString
+' font='+ pFont.ToString;
// 输出一些描述性文本
y :=y - yoff * 4;
p.fit_textline('嵌套表、进度条:', x, y, textoptlist);
addoptlist2 :=
'fittextline={font=' + pFont.ToString + ' fontsize=' + fontsize.ToString
+ ' position={left center}} margin=' + margin.ToString
+ ' colwidth=150';
//+ ' rowheight=' + tabheight1.ToString;
var templ: Integer;
var R,C,tbl: Integer;
var cellValue: string;
var rr,value: Double;
Randomize;
// 创建由十行三列组成的外部表
tbl:= -1;
for R := 1 to 10 do
begin
for C := 1 to 3 do
begin
cellValue:= Format('行:%d 列:%d',[R,C]);
if (c=2) then
begin
rr:= Random;
if rr<0.1 then
rr:=0.1;
value:= 300*rr;
//放置子表。调用已用于放置将表格放入模板中
templ:= SubTableTemplate(value,tabwidth1, tabheight1);
addoptlist1 := 'image=' + templ.ToString
+' fitimage={position={left center} fitmethod=meet}'
+ ' fittextline={font=' + pFont.ToString
+ ' fontsize=' + fontsize.ToString
+' } colwidth=400'
//+ Format(' margin=%d',[margin])
+ ' rowheight=' + tabheight1.ToString;
tbl := p.add_table_cell(tbl, C, R, ' ', addoptlist1);
end else
begin
tbl := p.add_table_cell(tbl, C, R, cellValue, addoptlist2);
end;
if (tbl = -1) then
raise Exception.Create('错误: ' + p.get_errmsg());
end;
end;
taboptlist2 := 'stroke={{line=other linewidth=0.1 } '
+ '{line=frame linewidth=1.0 }} ';
//+ 'fill={{area=table fillcolor={rgb 0.9 0.9 1}}} ';
y:= y - yoff;
p.fit_table(tbl, x, 20, pagewidth - x, y, taboptlist2);
p.end_page_ext('');
p.end_document('');
finally
p.DisposeOf;
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
FBitMap:= TBitMap.Create(1,1);
end;
procedure TForm2.FormDestroy(Sender: TObject);
begin
FBitMap.DisposeOf;
end;
function TForm2.getImage(AWidth, AHeight: Integer): string;
begin
//FBitMap:= TBitMap.Create(AWidth, AHeight);
//try
FBitMap.Width := AWidth;
FBitMap.Height:= AHeight;
FBitMap.Canvas.Brush.Color:= clRed;
FBitMap.Canvas.FloodFill(0,0,clRed,TFillStyle.fsBorder);
//Result:=Format('cmei_bmp%dx%d.bmp',[AWidth, AHeight]);
Result:='cmei_bmp.bmp';
FBitMap.SaveToFile(Result);
//finally
// FBitMap.DisposeOf;
// end;
end;
end.
