📄 fr_e_htm.pas

📁 FreeReport 2.34 consists of the report engine, designer and previewer, with capabilities comparable
💻 PAS
字号:

{*****************************************}
{                                         }
{             FastReport v2.3             }
{            HTM export filter            }
{                                         }
{  Copyright (c) 1998-99 by Tzyganenko A. }
{                                         }
{*****************************************}

unit FR_E_HTM;

interface

{$I FR.inc}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Forms, StdCtrls,
  FR_Class, FR_E_TXT;

type
  TfrHTMExport = class(TComponent) // fake component
  end;

  TfrHTMExportFilter = class(TfrTextExportFilter)
  public
    constructor Create(AStream: TStream); override;
    destructor Destroy; override;
    procedure OnEndPage; override;
  end;


implementation

uses FR_Utils, FR_Const;


constructor TfrHTMExportFilter.Create(AStream: TStream);
var
  s: String;
begin
  inherited Create(AStream);
  s := '<HTML>'#13#10'<Body bgColor="#FFFFFF">'#13#10'<Table>'#13#10;
  Stream.Write(s[1], Length(s));
end;

destructor TfrHTMExportFilter.Destroy;
var
  s: String;
begin
  s := '</Table>'#13#10'</Body>'#13#10'</HTML>'#13#10;
  Stream.Write(s[1], Length(s));
  inherited Destroy;
end;

procedure TfrHTMExportFilter.OnEndPage;
var
  i, n: Integer;
  p: PfrTextRec;
  s, s1, s2: String;

  function GetHTMLFontSize(Size: Integer): String;
  begin
    case Size of
      6, 7: Result := '1';
      8, 9: Result := '2';
      14..17: Result := '4';
      18..23: Result := '5';
      24..35: Result := '6'
    else
      Result := '7';
    end;
  end;

  function GetHTMLFontStyle(Style: Integer): String;
  begin
    Result := '';
    if (Style and $1) <> 0 then Result := '<i>';
    if (Style and $2) <> 0 then Result := Result + '<b>';
    if (Style and $4) <> 0 then Result := Result + '<u>';
  end;

begin
  n := Lines.Count - 1;
  while n >= 0 do
  begin
    if Lines[n] <> nil then break;
    Dec(n);
  end;

  for i := 0 to n do
  begin
    p := PfrTextRec(Lines[i]);
    s := '<tr>';
    while p <> nil do
    begin
      s1 := ''; s2 := '';
      if (p^.FontColor = clWhite) or (p^.FontColor = clNone) then
        p^.FontColor := clBlack;
      if p^.FontColor <> clBlack then
      begin
        s1 := IntToHex(p^.FontColor, 6);
        s1 := 'Color="#' + Copy(s1, 5, 2) + Copy(s1, 3, 2) +
          Copy(s1, 1, 2) + '"';
      end;
// most reports is done with font size = 10..13 - treat it as default font
      if not (p^.FontSize in [10..13]) then
        s1 := s1 + ' Size=' + GetHTMLFontSize(p^.FontSize);
      if p^.FontStyle <> 0 then
        s2 := GetHTMLFontStyle(p^.FontStyle);
      if s1 <> '' then s1 := '<Font ' + s1 + '>';
      s := s + '<td>' + s1 + s2 + p^.Text + '</td>';
      p := p^.Next;
    end;
    s := s + '</tr>'#13#10;
    Stream.Write(s[1], Length(s));
  end;
end;


initialization
  frRegisterExportFilter(TfrHTMExportFilter, LoadStr(SHTMFile) + ' (*.htm)', '*.htm');

end.
⌨️ 快捷键说明

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