rm_e_main.pas

这是一个功能强大

{******************************************************}
{                                                      }
{          Report Machine v3.0                         }
{           main export filter                         }
{                                                      }
{         write by whf and jim_waw([e-mail])    }
{******************************************************}

unit RM_e_main;

interface

{$I RM.INC}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Forms, Dialogs, StdCtrls,
  Controls, Comctrls, Math, RM_Common, RM_Class
{$IFDEF RXGIF}, JvGif{$ENDIF}
{$IFDEF JPEG}, JPEG{$ENDIF};

type
  TRMEFImageFormat = (ifGIF, ifJPG, ifBMP);
//  TRMObjType = (rmotMemo, rmotPicture);

  PRMEFTextRec = ^TRMEFTextRec;
  TRMEFTextRec = packed record
    Left, Top: Integer;
    Text: string;
    TextWidth: Integer;
    TextHeight: Integer;
  end;

  { TRMIEMCellStyle }
  TRMIEMCellStyle = class(TObject)
  private
    FFont: TFont;
    FHAlign: TRMHAlign;
    FVAlign: TRMVAlign;
    FFillColor: TColor;
    FLeftFrame: TRMFrameLine;
    FTopFrame: TRMFrameLine;
    FRightFrame: TRMFrameLine;
    FBottomFrame: TRMFrameLine;
    FDisplayFormat: TRMFormat;
  protected
  public
    constructor Create;
    destructor Destroy; override;
    function IsEqual(aSource: TRMIEMCellStyle): Boolean;

    property Font: TFont read FFont write FFont;
    property HAlign: TRMHAlign read FHAlign write FHAlign;
    property VAlign: TRMVAlign read FVAlign write FVAlign;
    property FillColor: TColor read FFillColor write FFillColor;
    property LeftFrame: TRMFrameLine read FLeftFrame write FLeftFrame;
    property TopFrame: TRMFrameLine read FTopFrame write FTopFrame;
    property RightFrame: TRMFrameLine read FRightFrame write FRightFrame;
    property BottomFrame: TRMFrameLine read FBottomFrame write FBottomFrame;
    property DisplayFormat: TRMFormat read FDisplayFormat write FDisplayFormat;
  end;

  { TRMIEMData }
  TRMIEMData = class(TObject)
  private
    FTextList: TList;
    FStartCol, FStartRow, FEndCol, FEndRow: Integer;
    FMemo: TWideStringList;
    FStyleIndex: Integer;
    FCounter: Integer;
    FExportAsNum: Boolean;

    function GetTextList: TList;
    procedure ClearTextList;
    function GetTextListCount: Integer;
    function GetMemo: TWideStringList;
    function GetGraphic: TGraphic;
  protected
    FGraphic: TGraphic;
  public
    Left, Top, Width, Height: Integer;
    Obj: TRMReportView;
    ObjType: TRMExportMode;
    BmpWidth: Integer;
    BmpHeight: Integer;
    TextWidth: Integer;
    ViewIndex: Integer;

    constructor Create;
    destructor Destroy; override;

    property TextList: TList read GetTextList;
    property TextListCount: Integer read GetTextListCount;
    property StartCol: Integer read FStartCol write FStartCol;
    property StartRow: Integer read FStartRow write FStartRow;
    property EndCol: Integer read FEndCol write FEndCol;
    property EndRow: Integer read FEndRow write FEndRow;
    property Memo: TWideStringList read GetMemo;
    property StyleIndex: Integer read FStyleIndex;
    property Graphic: TGraphic read GetGraphic;
    property Counter: Integer read FCounter write FCounter;
    property ExportAsNum: Boolean read FExportAsNum write FExportAsNum;
  end;

  { TRMIEMList }
  TRMIEMList = class(TObject)
  private
    FExportComp: TRMExportFilter;
    FTopOffset: Integer;
    FMaxHeight: Integer;
    FCols, FRows: TList;
    FCells: array of array of Integer;
    FObjList: TList;
    FStyleList: TList;
    FAryPageBreak: array of Integer;

    FExportPrecision: Integer;
    FDrawFrame: Boolean;
    FExportImage: Boolean;
    FExportRtf: Boolean;
    FExportHighQualityPicture: Boolean;

    procedure AddValue(aList: TList; aValue: Integer);

    function GetRowCount: Integer;
    function GetColCount: Integer;
    function GetRowHeight(aIndex: Integer): Integer;
    function GetColWidth(aIndex: Integer): Integer;
    function GetCell(aCol, aRow: Integer): TRMIEMData;
    function GetCellStyle(aCell: TRMIEMData): TRMIEMCellStyle;
    function GetPageBreak(Index: Integer): Integer;
  protected
  public
    constructor Create(aExportComponent: TRMExportFilter);
    destructor Destroy; override;

    procedure Clear(aClearStyle: Boolean);
    procedure AddObject(aReportView: TRMReportView);
    procedure EndPage;
    procedure Prepare;
    function GetCellRowPos(aIndex: Integer): Integer;
    function GetCellColPos(aIndex: Integer): Integer;

    property StyleList: TList read FStyleList;
    property RowCount: Integer read GetRowCount;
    property ColCount: Integer read GetColCount;
    property RowHeight[Index: Integer]: Integer read GetRowHeight;
    property ColWidth[Index: Integer]: Integer read GetColWidth;
    property Cells[Col, Row: Integer]: TRMIEMData read GetCell;
    property CellStyle[aCell: TRMIEMData]: TRMIEMCellStyle read GetCellStyle;
    property ExportPrecision: Integer read FExportPrecision write FExportPrecision;
    property PageBreak[Index: Integer]: Integer read GetPageBreak;

    property DrawFrame: Boolean read FDrawFrame write FDrawFrame;
    property ExportImage: Boolean read FExportImage write FExportImage;
    property ExportRtf: Boolean read FExportRtf write FExportRtf;
    property ExportHighQualityPicture: Boolean read FExportHighQualityPicture write FExportHighQualityPicture;
  end;

  TRMMainExportFilter = class;

  TBeforeSaveGraphicEvent = procedure(Sender: TRMMainExportFilter;
    AViewName: string; var UniqueImage: Boolean; var ReuseImageIndex: Integer;
    AAltText: string) of object;

  TAfterSaveGraphicEvent = procedure(Sender: TRMMainExportFilter;
    AViewName: string; ObjectImageIndex: Integer) of object;

 { TRMMainExportFilter }
  TRMMainExportFilter = class(TRMExportFilter)
  private
    FScaleX, FScaleY: Double;
    FExportFrames, FExportImages: Boolean;
{$IFDEF JPEG}
    FJPEGQuality: TJPEGQualityRange;
{$ENDIF}
    FViewNames: TStringList;
    FPixelFormat: TPixelFormat;
    FNowDataRec: TRMIEMData;
  protected
    CanMangeRotationText: Boolean;
    FDataList: TList;
    FPageNo: Integer;
    FPageWidth: Integer;
    FPageHeight: Integer;
    FExportImageFormat: TRMEFImageFormat;

    procedure SaveBitmapToPicture(aBmp: TBitmap; aImgFormat: TRMEFImageFormat
{$IFDEF JPEG}; aJPEGQuality: TJPEGQualityRange{$ENDIF}; var aPicture: TPicture);

    procedure OnBeginDoc; override;
    procedure OnEndDoc; override;
    procedure OnBeginPage; override;
    procedure OnEndPage; override;
    procedure OnExportPage(const aPage: TRMEndPage); override;
    procedure InternalOnePage(aPage: TRMEndPage); virtual;
    procedure OnText(aDrawRect: TRect; x, y: Integer; const aText: string; View: TRMView); override;
    procedure ClearDataList;
    property PixelFormat: TPixelFormat read FPixelFormat write FPixelFormat default pf24bit;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ScaleX: Double read FScaleX write FScaleX;
    property ScaleY: Double read FScaleY write FScaleY;
    property ExportImages: Boolean read FExportImages write FExportImages default True;
    property ExportFrames: Boolean read FExportFrames write FExportFrames default True;
    property ExportImageFormat: TRMEFImageFormat read FExportImageFormat write FExportImageFormat;
{$IFDEF JPEG}
    property JPEGQuality: TJPEGQualityRange read FJPEGQuality write FJPEGQuality default High(TJPEGQualityRange);
{$ENDIF}
  end;

const
  ImageFormats: array[TRMEFImageFormat] of string = ('GIF', 'JPG', 'BMP');

function RMColorToHtmlColor(aColor: TColor): string;

implementation

uses RM_Utils;

type
  THackRMView = class(TRMReportView)
  end;

  THackMemoView = class(TRMCustomMemoView)
  end;

function RMColorToHtmlColor(aColor: TColor): string;
begin
  Result := IntToHex(ColorToRGB(AColor), 6);
  Result := '#' + Copy(Result, 5, 2) + Copy(Result, 3, 2) + Copy(Result, 1, 2);
end;

function RMGetTextSize(aFont: TFont; const aText: string): TSize;
var
  lDC: HDC;
  lSaveFont: HFont;
begin
  lDC := GetDC(0);
  lSaveFont := SelectObject(lDC, aFont.Handle);
  Result.cX := 0;
  Result.cY := 0;
  GetTextExtentPoint32(lDC, PChar(aText), Length(aText), Result);
  SelectObject(lDC, lSaveFont);
  ReleaseDC(0, lDC);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMIEMCellStyle }

constructor TRMIEMCellStyle.Create;
begin
  inherited;

  FFont := TFont.Create;
  FLeftFrame := TRMFrameLine.CreateComp(nil);
  FTopFrame := TRMFrameLine.CreateComp(nil);
  FRightFrame := TRMFrameLine.CreateComp(nil);
  FBottomFrame := TRMFrameLine.CreateComp(nil);
end;

destructor TRMIEMCellStyle.Destroy;
begin
  FFont.Free;
  FLeftFrame.Free;
  FTopFrame.Free;
  FRightFrame.Free;
  FBottomFrame.Free;

  inherited;
end;

function TRMIEMCellStyle.IsEqual(aSource: TRMIEMCellStyle): Boolean;
begin
  Result := (HAlign = aSource.HAlign) and (VAlign = aSource.VAlign) and
    (FillColor = aSource.FillColor) and
    (Font.Name = aSource.Font.Name) and (Font.Size = aSource.Font.Size) and
    (Font.Color = aSource.Font.Color) and (Font.Charset = aSource.Font.Charset) and
    (Font.Style = aSource.Font.Style) and
    LeftFrame.IsEqual(aSource.LeftFrame) and
    TopFrame.IsEqual(aSource.TopFrame) and
    RightFrame.IsEqual(aSource.RightFrame) and
    BottomFrame.IsEqual(aSource.BottomFrame) and
    (aSource.DisplayFormat.FormatIndex1 = DisplayFormat.FormatIndex1) and
    (aSource.DisplayFormat.FormatIndex2 = DisplayFormat.FormatIndex2) and
    (aSource.DisplayFormat.FormatPercent = DisplayFormat.FormatPercent) and
    (aSource.DisplayFormat.FormatdelimiterChar = DisplayFormat.FormatdelimiterChar);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMIEMData }

constructor TRMIEMData.Create;
begin
  inherited;

  FTextList := nil;
  FMemo := nil;
  FGraphic := nil;
  FCounter := 0;
end;

destructor TRMIEMData.Destroy;
begin
  ClearTextList;
  FreeAndNil(FTextList);
  FreeAndNil(FMemo);
  FreeAndNil(FGraphic);

  inherited;
end;

function TRMIEMData.GetGraphic: TGraphic;
begin
  if FGraphic = nil then
  begin
{$IFDEF JPEG}
    FGraphic := TJPEGImage.Create;
{$ELSE}
    FGraphic := TBitmap.Create;
{$ENDIF}
  end;

  Result := FGraphic;
end;

function TRMIEMData.GetMemo: TWideStringList;
begin
  if FMemo = nil then
    FMemo := TWideStringList.Create;

  Result := FMemo;
end;

function TRMIEMData.GetTextList: TList;
begin
  if FTextList = nil then
    FTextList := TList.Create;

  Result := FTextList;
end;

function TRMIEMData.GetTextListCount: Integer;
begin
  if FTextList = nil then
    Result := 0
  else
    Result := FTextList.Count;
end;

procedure TRMIEMData.ClearTextList;
var
  i: Integer;
begin
  if FTextList = nil then Exit;

  for i := 0 to FTextList.Count - 1 do
  begin
    Dispose(pRMEFTextRec(FTextList[i]));
  end;

  FTextList.Clear;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMIEMList }

type
  TRMIEMValue = class(TObject)
  public