rm_e_htm.pas

进销存·完整的·有数据库的·非常完整·只得参考

{*****************************************}
{                                         }
{         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;
    FCreateMHTFile: Boolean;

    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;
    FImagesStream: TMemoryStream;

    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(aStream: TStream; AText: string);

    procedure WriteHeader;
    procedure WriteFooter;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure OnEndPage; override;
    procedure OnBeginDoc; override;
    procedure OnEndDoc; 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 CreateMHTFile: Boolean read FCreateMHTFile write FCreateMHTFile;

    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;
    chkCreateMHTFile: 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);
    procedure chkCreateMHTFileClick(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, RM_DsgCtrls;

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

  MIME_ENCODED_LINE_BREAK = 76;
  MIME_DECODED_LINE_BREAK = MIME_ENCODED_LINE_BREAK div 4 * 3;
  MIME_BUFFER_SIZE = MIME_DECODED_LINE_BREAK * 3 * 4 * 4;

  MIME_ENCODE_TABLE: array[0..63] of Byte = (
    065, 066, 067, 068, 069, 070, 071, 072, //  00 - 07
    073, 074, 075, 076, 077, 078, 079, 080, //  08 - 15
    081, 082, 083, 084, 085, 086, 087, 088, //  16 - 23
    089, 090, 097, 098, 099, 100, 101, 102, //  24 - 31
    103, 104, 105, 106, 107, 108, 109, 110, //  32 - 39
    111, 112, 113, 114, 115, 116, 117, 118, //  40 - 47
    119, 120, 121, 122, 048, 049, 050, 051, //  48 - 55
    052, 053, 054, 055, 056, 057, 043, 047); // 56 - 63
  MIME_PAD_CHAR = Byte('=');

type
  PByte4 = ^TByte4;
  TByte4 = packed record
    b1: Byte;
    b2: Byte;
    b3: Byte;
    b4: Byte;
  end;

  PByte3 = ^TByte3;
  TByte3 = packed record
    b1: Byte;
    b2: Byte;
    b3: Byte;
  end;

{ ---------------------------------------------------------------------------- }
{ Stream Encoding & Decoding
{ ---------------------------------------------------------------------------- }

procedure MimeEncodeNoCRLF(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer);
var
  B, InnerLimit, OuterLimit: Cardinal;
  InPtr: PByte3;
  OutPtr: PByte4;
begin
  if InputByteCount = 0 then Exit;

  InPtr := @InputBuffer;
  OutPtr := @OutputBuffer;

  OuterLimit := InputByteCount div 3 * 3;

  InnerLimit := Cardinal(InPtr);
  Inc(InnerLimit, OuterLimit);

  { Last line loop. }
  while Cardinal(InPtr) < InnerLimit do
  begin
      { Read 3 bytes from InputBuffer. }
    B := InPtr^.b1;
    B := B shl 8;
    B := B or InPtr^.b2;
    B := B shl 8;
    B := B or InPtr^.b3;
    Inc(InPtr);
      { Write 4 bytes to OutputBuffer (in reverse order). }
    OutPtr^.b4 := MIME_ENCODE_TABLE[B and $3F];
    B := B shr 6;
    OutPtr^.b3 := MIME_ENCODE_TABLE[B and $3F];
    B := B shr 6;
    OutPtr^.b2 := MIME_ENCODE_TABLE[B and $3F];
    B := B shr 6;
    OutPtr^.b1 := MIME_ENCODE_TABLE[B];
    Inc(OutPtr);
  end;

  { End of data & padding. }
  case InputByteCount - OuterLimit of
    1:
      begin
        B := InPtr^.b1;
        B := B shl 4;
        OutPtr.b2 := MIME_ENCODE_TABLE[B and $3F];
        B := B shr 6;
        OutPtr.b1 := MIME_ENCODE_TABLE[B];
        OutPtr.b3 := MIME_PAD_CHAR; { Pad remaining 2 bytes. }
        OutPtr.b4 := MIME_PAD_CHAR;
      end;
    2:
      begin
        B := InPtr^.b1;
        B := B shl 8;
        B := B or InPtr^.b2;
        B := B shl 2;
        OutPtr.b3 := MIME_ENCODE_TABLE[B and $3F];
        B := B shr 6;
        OutPtr.b2 := MIME_ENCODE_TABLE[B and $3F];
        B := B shr 6;
        OutPtr.b1 := MIME_ENCODE_TABLE[B];
        OutPtr.b4 := MIME_PAD_CHAR; { Pad remaining byte. }
      end;
  end;
end;

procedure MimeEncodeFullLines(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer);
var
  B, InnerLimit, OuterLimit: Cardinal;
  InPtr: PByte3;
  OutPtr: PByte4;
begin
  { Do we have enough input to encode a full line? }
  if InputByteCount < MIME_DECODED_LINE_BREAK then Exit;

  InPtr := @InputBuffer;
  OutPtr := @OutputBuffer;

  InnerLimit := Cardinal(InPtr);
  Inc(InnerLimit, MIME_DECODED_LINE_BREAK);

  OuterLimit := Cardinal(InPtr);
  Inc(OuterLimit, InputByteCount);

  { Multiple line loop. }
  repeat

    { Single line loop. }
    repeat
      { Read 3 bytes from InputBuffer. }
      B := InPtr^.b1;
      B := B shl 8;
      B := B or InPtr^.b2;
      B := B shl 8;
      B := B or InPtr^.b3;
      Inc(InPtr);
      { Write 4 bytes to OutputBuffer (in reverse order). }
      OutPtr^.b4 := MIME_ENCODE_TABLE[B and $3F];
      B := B shr 6;
      OutPtr^.b3 := MIME_ENCODE_TABLE[B and $3F];
      B := B shr 6;
      OutPtr^.b2 := MIME_ENCODE_TABLE[B and $3F];
      B := B shr 6;
      OutPtr^.b1 := MIME_ENCODE_TABLE[B];
      Inc(OutPtr);
    until Cardinal(InPtr) >= InnerLimit;

    { Write line break (CRLF). }
    OutPtr^.b1 := 13;
    OutPtr^.b2 := 10;
    Inc(Cardinal(OutPtr), 2);

    Inc(InnerLimit, MIME_DECODED_LINE_BREAK);
  until InnerLimit > OuterLimit;
end;

function MimeEncodedSize(const InputSize: Cardinal): Cardinal;
begin
  if InputSize > 0 then
    Result := (InputSize + 2) div 3 * 4 + (InputSize - 1) div MIME_DECODED_LINE_BREAK * 2
  else
    Result := InputSize;
end;

procedure MimeEncodeStream(const InputStream: TStream; const OutputStream: TStream);
var
  InputBuffer: array[0..MIME_BUFFER_SIZE - 1] of Byte;
  OutputBuffer: array[0..(MIME_BUFFER_SIZE + 2) div 3 * 4 + MIME_BUFFER_SIZE div MIME_DECODED_LINE_BREAK * 2 - 1] of Byte;
  BytesRead: Cardinal;
  IDelta, ODelta: Cardinal;
begin
  BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));

  while BytesRead = SizeOf(InputBuffer) do
  begin
    MimeEncodeFullLines(InputBuffer, SizeOf(InputBuffer), OutputBuffer);
    OutputStream.Write(OutputBuffer, SizeOf(OutputBuffer));
    BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));
  end;

  MimeEncodeFullLines(InputBuffer, BytesRead, OutputBuffer);

  IDelta := BytesRead div MIME_DECODED_LINE_BREAK; // Number of lines processed.
  ODelta := IDelta * (MIME_ENCODED_LINE_BREAK + 2);
  IDelta := IDelta * MIME_DECODED_LINE_BREAK;
  MimeEncodeNoCRLF(Pointer(Cardinal(@InputBuffer) + IDelta)^, BytesRead - IDelta, Pointer(Cardinal(@OutputBuffer) + ODelta)^);

  OutputStream.Write(OutputBuffer, MimeEncodedSize(BytesRead));
end;

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

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

  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
  FLinkFont.Free;
  FCssClasses.Free;