html表格分頁

最後更新：2018-12-04 來源：互聯網

上載者：User

創建阿里雲帳戶，並獲得超過 40 款產品的免費試用版；而企業帳戶則可以享有總值 $1200 的免費試用版。立即註冊！

最近要用TPageProducer替換模版，同時還須實現html分頁，所見即所得 (WYSIWYG)，網上找了半天沒發現，於是自己琢磨寫了一個。代碼用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;

本文章原先以中文撰寫並發佈於 aliyun.com，亦設英文版本，僅作資訊用途。本網站不對文章的準確性，完整性或可靠性或其任何翻譯作出任何明示或暗示的陳述或保證。如對該文章有任何疑慮或投訴，請傳送電郵至 info-contact@alibabacloud.com 並提供相關疑慮或投訴的詳細說明。職員會於 5 個工作天內與您聯絡，一經驗證之後，即會刪除該侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

Get Started for Free

Sales Support

1 on 1 presale consultation

Chat Contact Sales
After-Sales Support

24/7 Technical Support 6 Free Tickets per Quarter Faster Response

Open a Ticket
Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.

Learn More

html表格分頁

聯繫我們

A Free Trial That Lets You Build Big!

Sales Support

After-Sales Support