📄 htmlutil.pas

📁 suite component ace report
💻 PAS
字号:
unit HtmlUtil;

interface

uses classes, sctrep, SysUtils, sctctrl, sctutil
    ,Windows, Messages, Graphics, Controls, Forms, Dialogs;


function MyLabelToText(lb: TSctLabel):String;
function MySort( a, b:Pointer ):Integer;
procedure MyHtmlRun(HtmlFileName:String; MyReport:TSctReport);
procedure MyHtmlOut(HtmlString: String);

var
  F2 : TextFile;
  MyEvent: TSctBandPrintEvent;


procedure MyBandToHtml(Band: TSctBand);

implementation
uses htmform;


procedure MyHtmlRun(HtmlFileName:String; MyReport: TSctReport);
var
  HtmlTitle: String;
  Pos: Integer;
begin
  MyEvent := htmlform.BandToHtml;

  if SctEmpty(MyReport.Page.Description) then HtmlTitle := MyReport.Name
     else HtmlTitle := MyReport.Page.Description;

  {Write the HTML header info}
  AssignFile(F2,HtmlFileName);
  Rewrite(F2);
  Writeln(F2, '<html>');  {Start the HTML document}
  Writeln(F2);
  Writeln(F2, '<head>');
  Writeln(F2, '<title>'+HtmlTitle+'</title>');
  Writeln(F2, '</head>');
  Writeln(F2);
  Writeln(F2, '<body>');  {Start the HTML body}
  Writeln(F2);
  For Pos := 0 to MyReport.Page.bands.Count - 1 do
    TSctBand(MyReport.Page.Bands.Items[Pos]).OnAfterPrint := HtmlForm.BandToHtml;

//  MyReport.Page.PageSetup.Destination := destFile;
  MyReport.Run;
  Writeln(F2);
  Writeln(F2, '</body>');   {End the HTML body}
  Write  (F2, '</html>');   {End the document}
  CloseFile(F2);
end;

procedure MyHtmlOut(HtmlString: String);
begin
  Writeln(F2, HtmlString);
end;

procedure MyBandToHtml(Band: TSctBand);
var
  PgWidth, ThisRow, MaxRow, Spot, Pos, n: Integer;
  LabelList: TList;
  WidthStr: String;
begin
  if not (Band.Labels = nil) then
  begin
    PgWidth := TSctPage(Band.Parent).PageWidth;
    MaxRow := 0;
    LabelList := TList.Create;
    for n := 0 to Band.Labels.Count - 1 do
      begin
        LabelList.Add(Band.Labels.Items[n]);
        if TSctLabel(Band.Labels.Items[n]).Row > MaxRow
            then MaxRow := TSctLabel(Band.Labels.Items[n]).Row;
      end;
    LabelList.Sort(MySort);
    Spot := 0;

    For ThisRow := 0 to MaxRow do
      begin
        Pos := 0;
        Writeln(F2, '<table border="1" width="'+
            IntToStr(PgWidth)+'">');
        while (Spot < LabelList.Count)
              and (TSctLabel(LabelList.Items[Spot]).Row = ThisRow)
          do with TSctLabel(LabelList.Items[Spot]) do
          begin
            if Pos < Left then
              begin
                WidthStr := '  <td width="'+ IntToStr(Left-Pos)+'">'  ;
                Writeln(F2,WidthStr , ' ', '</td>');
                Pos := Left;
              end;
            WidthStr := '  <td width="'+ IntToStr(Width)+'">'  ;
                                          Writeln(F2,WidthStr , MyLabelToText(TSctLabel(LabelList.Items[Spot])), '</td>');
            Pos := Pos + Width;
            Inc(Spot);
          end;
        if Pos < PgWidth then
           Writeln(F2,'<td width="'+ IntToStr(PgWidth-Pos)+'">', ' ', '</td>');
        Writeln(F2, '</table>');  {End the detail line table}
      end;
    end;
end;

function MyLabelToText(lb: TSctLabel): String;
begin
  if lb is TSctTVLabel then
      result := TSctTVLabel(lb).GetDataNow
    else result := 'Other';
end;


function MySort( a, b:Pointer ) : Integer;
begin
//  ShowMessage(TSctLabel(a).Name);
  Result := 10000*(TSctLabel(a).Row - TSctLabel(b).Row)
         + TSctLabel(a).Left - TSctLabel(b).Left;
end;

end.
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -