html表格分页

最新推荐文章于 2023-09-30 13:23:47 发布

danielinbiti

最新推荐文章于 2023-09-30 13:23:47 发布

阅读量6.4k

点赞数

分类专栏：技术文章标签： html integer string constructor function delphi

本文链接：https://blog.csdn.net/danielinbiti/article/details/624172

版权

技术专栏收录该内容

67 篇文章 0 订阅

订阅专栏

最近要用TPageProducer替换模版，同时还须实现html分页，所见即所得，网上找了半天没发现，于是自己琢磨写了一个。代码用delphi6写，

由于实际需要，所以写例子的时候缩小了实际模型，供大家分享。这里写的例子表格，如果一整行的话肯定很容易控制

   TDContent=class
    TDtxt : String;
    Htmltxt : String;
    Height : Integer;
    NextHeight : Integer;
    constructor Create(aTDtxt : String);
end;

HtmlContent=class
    Content : String;
    Height : Integer;
    TDList : TList;
    constructor Create(aContent : String);
end;
PageHeight : Integer;
    HeadHeight : Integer;
    RestHeight : Integer;
    clsHtmlContent : HtmlContent;
    PageNo : Integer;
    procedure MakeContent; //假设内容
    function CaluHeight(height,NextHeight : Integer) : Integer;   //计算页面高度
    function NeedChangePage(height,NextHeight : Integer) :Boolean; //是否要分页
    procedure SplitPage(allHtml : String); //分离页面
    procedure MakeHtmlCode;//形成html

====实现代码

function TForm1.NeedChangePage(height,NextHeight : Integer) :Boolean; //是否要分页
begin
Result := False;
if RestHeight-height-NextHeight <= 0 then Result := True;
end;

procedure TForm1.SplitPage(allHtml : String);
var
tmppageNo : Integer;
lsSave : TStringList;
sPos,ePos : Integer;
s : String;
begin
lsSave := TStringList.Create;
tmpPageNo := 0;
sPos := 0;
while allHtml <> '' do
begin
    tmpPageNo := tmpPageNo + 1;
    ePos := pos('</BODY>',uppercase(allHtml));
    if ePos > 0 then
    begin
      lsSave.Text := copy(allHtml,sPos,ePos + 6);
      allHtml := copy(allHtml,ePos+7,length(allHtml));
      s := 'e:/test/resulttest' + IntToStr(tmpPageNo) + '.html';
      if fileExists(s) then deleteFIle(s);
      try
        lsSave.SaveToFile(S);
      except
      end;
    end
    else allHtml := '';
end;

end;

procedure TForm1.MakeHtmlCode;
var
i,j : Integer;
clsTDContent,clsTDContent1 : TDContent;
tmp1,tmp2,tmp3 : String;
bIsChange : Boolean;
sPos,ePos : Integer;
begin
tmp3 :='';
sPos := 0;
ePos := 0;
for i := 0 to clsHtmlContent.TDList.Count - 1 do
begin
    bIsChange := False;
    clsTDContent := clsHtmlContent.TDList[i];
    clsTDContent.Htmltxt := '<td height="21" width="25%" colspan="3">' + clsTDContent.TDtxt + '</td>';
    bIsChange := NeedChangePage(clsTDContent.Height,clsTDContent.NextHeight);
    clsTDContent.Height := CaluHeight(clsTDContent.Height,clsTDContent.NextHeight);
    if bIsChange or (i=clsHtmlContent.TDList.Count - 1) then //如果下一页要换页
    begin
      ePos := i;
      tmp1 := '<tr>';
      tmp1 := tmp1 + '<td height=' + IntToStr(42 * (ePos+1)) + ' rowspan=' + IntToStr(ePos-sPos+1) + '>母格</td>';
      for j := sPos to ePos do
      begin
        clsTDContent1 := clsHtmlContent.TDList[j];
        if j = sPos then //第一个单元格，则与母格在同一个<tr>中
        begin
          tmp1 := tmp1 + clsTDContent1.Htmltxt;
        end
        else
        begin
          tmp1 := tmp1 + '</tr><tr>' + clsTDContent1.Htmltxt;
        end;
        if j = ePos then tmp1 := tmp1 + '</tr>';
      end;
      if bIsChange then //防止i=clsHtmlContent.TDList.Count - 1条件成立时，未满足分页
      begin
        tmp2 := '</table></body><head><title>测试</title></head>' +
                '<body>' +
                '<table border="1" cellpadding="0" cellspacing="0" width="650" height="650">';
      end
      else tmp2 := '';
      tmp3 := tmp3 + tmp1;
      if tmp2 <> '' then tmp3 := tmp3 + tmp2;
      sPos := ePos + 1; //变更起点为当前位置的后一个
    end;
end;
clsHtmlContent.Content := tmp3;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
ls : TStringList;
s : String;
begin
ls := TStringList.Create;
PageProducer2.HTMLFile := 'D:/result.html';
MakeContent;//读取内容
MakeHtmlCode;//形成html
ls.Text := PageProducer2.Content;
SplitPage(ls.Text);
{
s := 'e:/test/resulttest.html';
if fileExists(s) then deleteFIle(s);
try
ls.SaveToFile(S);
except
end;
}

end;

procedure TForm1.MakeContent;
var
clsTDContent : TDContent;
i : Integer;
s : String;
begin
PageNo := 1;
clsHtmlContent := HtmlContent.Create('');

for i := 0 to 5 do
begin
    s := 's' + IntToStr(i+1);
    clsTDContent := TDContent.Create(s);
    clsHtmlContent.TDList.Add(clsTDContent);
end;
end;

function TForm1.CaluHeight(height,NextHeight : Integer) : Integer;
var
tryRestHeight : Integer;
begin
tryRestHeight := RestHeight - height;
//如果容的下当前高度
if tryRestHeight >=0 then
begin
    if (tryRestHeight - NextHeight) >= 0 then //如果容不下下一次的高度，则这次全部取完高度
    begin
      RestHeight := tryRestHeight;
      Result := height;
    end
    else
    begin
      Result := RestHeight+50;//要换时，为了抵消掉页面设置小判断时提前分页，而分页时高度需要多设
      RestHeight :=PageHeight;
    end;
end
else Result := tryRestHeight; //否则返回小于0的数
end;