html表格分页

最近要用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('',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 := '' + clsTDContent.TDtxt + '';
    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 := '';
      tmp1 := tmp1 + '母格';
      for j := sPos to ePos do
      begin
        clsTDContent1 := clsHtmlContent.TDList[j];
        if j = sPos then //第一个单元格,则与母格在同一个中
        begin
          tmp1 := tmp1 + clsTDContent1.Htmltxt;
        end
        else
        begin
          tmp1 := tmp1 + '' + clsTDContent1.Htmltxt;
        end;
        if j = ePos then tmp1 := tmp1 + '';
      end;
      if bIsChange then //防止i=clsHtmlContent.TDList.Count - 1条件成立时,未满足分页
      begin
        tmp2 := '测试' +
                '' +
                '

';
      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;

你可能感兴趣的:(技术)