rm_e_htm.pas

来自「report machine 2.3 功能强大」· PAS 代码 · 共 1,005 行 · 第 1/3 页

{*****************************************}
{                                         }
{         Report Machine v2.0             }
{           Html export filter            }
{                                         }
{*****************************************}

unit RM_e_htm;

interface

{$I RM.INC}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ComCtrls, ExtCtrls, ExtDlgs, RM_Class,
  RM_e_main
{$IFDEF RXGIF}, RxGIF{$ENDIF}
{$IFDEF JPEG}, JPeg{$ENDIF};

const
  CLinkForeColor = $00FF0000; // BGR
  CLinkBackColor = $00FFFFFF; // BGR
  CLinkHoverForeColor = $00FFFFFF; // BGR
  CLinkHoverBackColor = $00FF0000; // BGR

type
 { TRMHTMExport }
  TRMHTMExport = class(TRMMainExportFilter)
  private
    FImgFileNames: TStringList;
    FRepFileNames: TStringList;

    FImageDir: string;
    FImageEncodeDir: string;
    FImageCreateDir: string;
    FAltText: string;
    FLinkTextFirst: string;
    FLinkTextNext: string;
    FLinkTextPrev: string;
    FLinkTextLast: string;
    FLinkFont: TFont;
    FLinkBackColor: TColor;
    FLinkHoverForeColor: TColor;
    FLinkHoverBackColor: TColor;
    FLinkImgSRCFirst: string;
    FLinkImgSRCNext: string;
    FLinkImgSRCPrev: string;
    FLinkImgSRCLast: string;
    FPageEndLines: Boolean;
    FSeparateFilePerPage: Boolean;
    FShowNavigator: Boolean;
    FUseTextLinks: Boolean;

    FSingleFile: Boolean;
    FOptimizeForIE: Boolean;
    FCSSClasses: TStringList;

    FBeforeSaveGraphic: TBeforeSaveGraphicEvent;
    FAfterSaveGraphic: TAfterSaveGraphicEvent;

    function GetImgFileCount: Integer;
    function GetRepFileCount: Integer;
    procedure SetLinkFont(const Value: TFont);
    function SaveBitmapAs(Bmp: TBitmap; ImgFormat: TRMEFImageFormat
{$IFDEF JPEG}; JPEGQuality: TJPEGQualityRange{$ENDIF}; const BaseName: string): string;
    function GetNativeText(const Text: string): string;
    function GetOffsetFromTop: Integer;
    procedure WriteToStream(AText: string);

    procedure WriteHeader;
    procedure WriteFooter;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure OnEndPage; override;
    procedure OnBeginDoc; override;
    property ImgFileCount: Integer read GetImgFileCount;
    property ImgFileNames: TStringList read FImgFileNames;
    property RepFileCount: Integer read GetRepFileCount;
    property RepFileNames: TStringList read FRepFileNames;
    function ShowModal: Word; override;
  published
    property ImageDir: string read FImageDir write FImageDir;
    property LinkTextFirst: string read FLinkTextFirst write FLinkTextFirst;
    property LinkTextNext: string read FLinkTextNext write FLinkTextNext;
    property LinkTextPrev: string read FLinkTextPrev write FLinkTextPrev;
    property LinkTextLast: string read FLinkTextLast write FLinkTextLast;
    property LinkBackColor: TColor read FLinkBackColor write FLinkBackColor default CLinkBackColor;
    property LinkHoverForeColor: TColor read FLinkHoverForeColor write FLinkHoverForeColor default CLinkHoverForeColor;
    property LinkHoverBackColor: TColor read FLinkHoverBackColor write FLinkHoverBackColor default CLinkHoverBackColor;
    property LinkImgSRCFirst: string read FLinkImgSRCFirst write FLinkImgSRCFirst;
    property LinkImgSRCNext: string read FLinkImgSRCNext write FLinkImgSRCNext;
    property LinkImgSRCPrev: string read FLinkImgSRCPrev write FLinkImgSRCPrev;
    property LinkImgSRCLast: string read FLinkImgSRCLast write FLinkImgSRCLast;
    property LinkFont: TFont read FLinkFont write SetLinkFont;
    property PageEndLines: Boolean read FPageEndLines write FPageEndLines default True;
    property SeparateFilePerPage: Boolean read FSeparateFilePerPage write FSeparateFilePerPage default True;
    property ShowNavigator: Boolean read FShowNavigator write FShowNavigator default True;
    property UseTextLinks: Boolean read FUseTextLinks write FUseTextLinks default True;
    property OptimizeForIE: Boolean read FOptimizeForIE write FOptimizeForIE default True;
    property SingleFile: Boolean read FSingleFile write FSingleFile default False;

    property BeforeSaveGraphic: TBeforeSaveGraphicEvent read FBeforeSaveGraphic write FBeforeSaveGraphic;
    property AfterSaveGraphic: TAfterSaveGraphicEvent read FAfterSaveGraphic write FAfterSaveGraphic;
  end;

 { TRMHTMExportForm }
  TRMHTMLExportForm = class(TForm)
    ColorDialog: TColorDialog;
    OpenPictureDialog: TOpenPictureDialog;
    FontDialog: TFontDialog;
    btnOK: TButton;
    btnCancel: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    lblImageFolder: TLabel;
    btnImages: TSpeedButton;
    chkExportFrames: TCheckBox;
    gbExportImages: TGroupBox;
    lblExportImageFormat: TLabel;
    lblJPEGQuality: TLabel;
    cbImageFormat: TComboBox;
    edJPEGQuality: TEdit;
    UpDown1: TUpDown;
    chkExportImages: TCheckBox;
    edImageDirectory: TEdit;
    TabSheet2: TTabSheet;
    chkSingleFile: TCheckBox;
    chkSepFilePerPage: TCheckBox;
    gbShowNavigator: TGroupBox;
    lblBackGroundColor: TLabel;
    lblHoverForeColor: TLabel;
    lblHoverBackColor: TLabel;
    shpBackgroundColor: TShape;
    shpHoverForeColor: TShape;
    shpHoverBackColor: TShape;
    gbUseLinks: TGroupBox;
    pcShowNavigator: TPageControl;
    tsUseTextLinks: TTabSheet;
    lblFirst: TLabel;
    lblLast: TLabel;
    lblNext: TLabel;
    lblPrevious: TLabel;
    lblLinkCaptions: TLabel;
    btnSetFont: TButton;
    edFirst: TEdit;
    edPrevious: TEdit;
    edNext: TEdit;
    edLast: TEdit;
    tsUseGraphicLinks: TTabSheet;
    lblUseGraphicLinksFirst: TLabel;
    lblUseGraphicLinksPrevious: TLabel;
    lblUseGraphicLinksNext: TLabel;
    lblUseGraphicLinksLast: TLabel;
    btnFirst: TSpeedButton;
    btnPrevious: TSpeedButton;
    btnNext: TSpeedButton;
    btnLast: TSpeedButton;
    lblImageSource: TLabel;
    edUseGraphicLinksFirst: TEdit;
    edUseGraphicLinksPrevious: TEdit;
    edUseGraphicLinksLast: TEdit;
    edUseGraphicLinksNext: TEdit;
    rbtnUseTextLinks: TRadioButton;
    rbtnUseGraphicLinks: TRadioButton;
    chkShowNavigator: TCheckBox;
    procedure btnOKClick(Sender: TObject);
    procedure btnImagesClick(Sender: TObject);
    procedure chkShowNavigatorClick(Sender: TObject);
    procedure shpHoverForeColorMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure shpHoverForeColorMouseUp(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure rbtnUseTextLinksClick(Sender: TObject);
    procedure rbtnUseGraphicLinksClick(Sender: TObject);
    procedure btnSetFontClick(Sender: TObject);
    procedure chkExportImagesClick(Sender: TObject);
    procedure cbImageFormatChange(Sender: TObject);
    procedure edJPEGQualityKeyPress(Sender: TObject; var Key: Char);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure chkSingleFileClick(Sender: TObject);
  private
    FExportFilter: TRMExportFilter;
    MousePoint: TPoint;
    procedure Localize;
  protected
    property ExportFilter: TRMExportFilter read FExportFilter write FExportFilter;
  public
  end;

implementation

{$R *.DFM}

uses RM_CmpReg, RM_Const, RM_Utils, FileCtrl;

const
  CPageEndLineWidth = 2;
  CRLF = #13#10;

function RMForceDirs(Dir: string): Boolean;
begin
{$IFDEF Delphi5}
  Result := ForceDirectories(Dir);
{$ELSE}
  ForceDirectories(Dir);
  Result := DirectoryExists(Dir);
{$ENDIF}
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMHTMExport}

constructor TRMHTMExport.Create(AOwner: TComponent);
begin
  inherited;
  RMRegisterExportFilter(Self, RMLoadStr(SHTMFile), '*.htm');

  FRepFileNames := TStringList.Create;
  FImgFileNames := TStringList.Create;

  FImageDir := '';
  FAltText := '';
  FLinkTextFirst := RMLoadStr(rmRes + 1796);
  FLinkTextPrev := RMLoadStr(rmRes + 1795);
  FLinkTextNext := RMLoadStr(rmRes + 1794);
  FLinkTextLast := RMLoadStr(rmRes + 1793);
  FLinkFont := TFont.Create;

  FLinkFont.Size := 18;
  FLinkFont.Color := CLinkForeColor;
  FLinkBackColor := CLinkBackColor;
  FLinkHoverForeColor := CLinkHoverForeColor;
  FLinkHoverBackColor := CLinkHoverBackColor;
  FLinkImgSRCFirst := '';
  FLinkImgSRCNext := '';
  FLinkImgSRCPrev := '';
  FLinkImgSRCLast := '';
  FPageEndLines := True;
  FSeparateFilePerPage := True;
  FShowNavigator := True;
  FUseTextLinks := True;
  FSingleFile := False;

  FCSSClasses :=  TStringList.Create;
  FOptimizeForIE := True;
end;

destructor TRMHTMExport.Destroy;
begin
  FRepFileNames.Free;
  FImgFileNames.Free;
  FLinkFont.Free;
  FCssClasses.Free;
  inherited Destroy;
end;

function TRMHTMExport.GetImgFileCount: Integer;
begin
  Result := FImgFileNames.Count;
end;

function TRMHTMExport.GetRepFileCount: Integer;
begin
  Result := FRepFileNames.Count;
end;

procedure TRMHTMExport.SetLinkFont(const Value: TFont);
begin
  FLinkFont.Assign(Value);
end;

procedure TRMHTMExport.OnBeginDoc;
var
  K: Integer;
  TempDir: string;
begin
  inherited;
  FImgFileNames.Clear;
  FRepFileNames.Clear;

  FRepFileNames.Add(FileName);
  if SeparateFilePerPage or (CurReport.EMFPages.Count <> 1) then
  begin
    for K := 1 to (CurReport.EMFPages.Count - 1) do
      FRepFileNames.Add(ExtractFilePath(FileName) + RMMakeFileName(FileName, 'htm', K + 1));
  end;

  FImageEncodeDir := Trim(ImageDir);
  FImageCreateDir := ExtractFilePath(FileName);
  if FImageEncodeDir <> '' then
  begin
    TempDir := GetCurrentDir;
    SetCurrentDir(FImageCreateDir);
    FImageCreateDir := RMAppendTrailingBackslash(ExpandFileName(FImageEncodeDir));
    if not DirectoryExists(FImageCreateDir) then
      RMForceDirs(FImageCreateDir);
    FImageEncodeDir := RMReplaceString(RMAppendTrailingBackslash(FImageEncodeDir), '\', '/');
    SetCurrentDir(TempDir);
  end;
end;

const
  Bold: array[Boolean] of string = ('', ' bold');
  Italic: array[Boolean] of string = ('', ' italic');

  ANSICodePageIDs: array[0..13] of record
    ISOCode: string;
    WinCode: Integer;
  end = (
    (ISOCode: 'ISO-8859-11'; WinCode: 874), {Thai}
    (ISOCode: 'Windows-932'; WinCode: 932), {Japanese}
    (ISOCode: 'gb2312-80'; WinCode: 936), {Chinese (PRC, Singapore)}
    (ISOCode: 'Windows-949'; WinCode: 949), {Korean}
    (ISOCode: 'csbig5'; WinCode: 950), {Chinese (Taiwan, Hong Kong)}
    (ISOCode: 'ISO-10646'; WinCode: 1200), {Unicode (BMP of ISO 10646)}
    (ISOCode: 'ISO-8859-2'; WinCode: 1250), {Eastern European}
    (ISOCode: 'ISO-8859-5'; WinCode: 1251), {Latin/Cyrillic}
    (ISOCode: 'ISO-8859-1'; WinCode: 1252), {Latin 1 (US, Western Europe)}
    (ISOCode: 'ISO-8859-7'; WinCode: 1253), {Greek}
    (ISOCode: 'ISO-8859-9'; WinCode: 1254), {Turkish}
    (ISOCode: 'ISO-8859-8'; WinCode: 1255), {Hebrew}
    (ISOCode: 'ISO-8859-6'; WinCode: 1256), {Latin/Arabic}
    (ISOCode: 'ISO-8859-13'; WinCode: 1257) {Baltic}
    );

procedure TRMHTMExport.WriteHeader; // html文件头
var
  S: string;

  function GetISOCharSet(WinCP: Integer): string;