rm_e_xls.pas

这是一个功能强大

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

unit RM_e_Xls;

interface

{$I RM.inc}
{$IFDEF COMPILER4_UP}
//{$DEFINE XLSReadWriteII}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Forms, StdCtrls, Controls,
  Dialogs, ExtCtrls, Buttons, ComCtrls, ShellApi, ComObj,
  RM_Common, RM_Class, RM_e_main
{$IFDEF XLSReadWriteII}
	, XLSReadWriteII, BIFFRecsII, Picture
{$ELSE}
  , RM_wawExcel
{$ENDIF}
{$IFDEF RXGIF}, JvGIF{$ENDIF}
{$IFDEF JPEG}, JPeg{$ENDIF}
{$IFDEF COMPILER6_UP}, Variants{$ENDIF};

type
  { TRMXLSExport }
  TRMXLSExport = class(TRMExportFilter)
  private
    FScaleX, FScaleY: Double;
    FExportPrecision: Integer;
    FShowAfterExport: Boolean;
    FExportImages: Boolean;
    FExportFrames: Boolean;
    FPixelFormat: TPixelFormat;
    FExportImageFormat: TRMEFImageFormat;
{$IFDEF JPEG}
    FJPEGQuality: TJPEGQualityRange;
{$ENDIF}

    FSheetCount: Integer;
    FPagesOfSheet: Integer; //waw
    FTotalPage: Integer;
{$IFDEF XLSReadWriteII}
    FXlsReadWrite: TXLSReadWriteII;
		FXlsPageNo: Integer;
{$ELSE}
    FWorkBook: TwawXLSWorkbook; //waw
{$ENDIF}
    FMatrixList: TRMIEMList;
    FLeftMargin, FTopMargin, FRightMargin, FBottomMargin: Integer;
    FPageOr: TRMPrinterOrientation;
    FPageSize: Integer;
    FCompressFile: Boolean;

    procedure DoAfterExport(const aFileName: string);
    procedure ExportPages;
  protected
    procedure OnBeginDoc; override;
    procedure OnEndDoc; override;
    procedure OnBeginPage; override;
    procedure OnEndPage; override;
    procedure OnExportPage(const aPage: TRMEndPage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ShowModal: Word; override;
  published
    property ShowAfterExport: Boolean read FShowAfterExport write FShowAfterExport;
    property ExportPrecision: Integer read FExportPrecision write FExportPrecision;
    property PagesOfSheet: Integer read FPagesOfSheet write FPagesOfSheet;
    property ExportImages: Boolean read FExportImages write FExportImages;
    property ExportFrames: Boolean read FExportFrames write FExportFrames;
    property ExportImageFormat: TRMEFImageFormat read FExportImageFormat write FExportImageFormat;
{$IFDEF JPEG}
    property JPEGQuality: TJPEGQualityRange read FJPEGQuality write FJPEGQuality default High(TJPEGQualityRange);
{$ENDIF}
    property PixelFormat: TPixelFormat read FPixelFormat write FPixelFormat default pf24bit;
    property ScaleX: Double read FScaleX write FScaleX;
    property ScaleY: Double read FScaleY write FScaleY;
    property CompressFile: Boolean read FCompressFile write FCompressFile;
  end;

  { TRMCSVExportForm }
  TRMXLSExportForm = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    edtExportFileName: TEdit;
    btnFileName: TSpeedButton;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    SaveDialog: TSaveDialog;
    rdbPrintAll: TRadioButton;
    rbdPrintCurPage: TRadioButton;
    rbdPrintPages: TRadioButton;
    edtPages: TEdit;
    Label2: TLabel;
    GroupBox2: TGroupBox;
    chkShowAfterGenerate: TCheckBox;
    chkExportFrames: TCheckBox;
    gbExportImages: TGroupBox;
    lblExportImageFormat: TLabel;
    lblJPEGQuality: TLabel;
    Label4: TLabel;
    cmbImageFormat: TComboBox;
    edJPEGQuality: TEdit;
    UpDown1: TUpDown;
    cmbPixelFormat: TComboBox;
    chkExportImages: TCheckBox;
    edPages: TEdit;
    UpDown2: TUpDown;
    Label3: TLabel;
    chkWYB: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure btnFileNameClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure rbdPrintPagesClick(Sender: TObject);
    procedure edtPagesEnter(Sender: TObject);
    procedure chkExportFramesClick(Sender: TObject);
    procedure edJPEGQualityKeyPress(Sender: TObject; var Key: Char);
    procedure cmbImageFormatChange(Sender: TObject);
  private
    { Private declarations }
    procedure Localize;
  public
    { Public declarations }
  end;

{$ENDIF}
implementation

{$IFDEF COMPILER4_UP}
uses Math, RM_wawWriters, RM_wawExcelFmt, RM_Const, RM_Const1, RM_Utils;

{$R *.DFM}

const
  xlEdgeBottom = $00000009;
  xlEdgeLeft = $00000007;
  xlEdgeRight = $0000000A;
  xlEdgeTop = $00000008;

type
  THackRMIEMData = class(TRMIEMData);

{------------------------------------------------------------------------------}
{TRMXLSExport}

constructor TRMXLSExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  RMRegisterExportFilter(Self, RMLoadStr(SCSVFile) + ' (*.xls)', '*.xls');

  ShowDialog := True;
  CreateFile := False;
  FIsXLSExport := True;

  FScaleX := 1;
  FScaleY := 1;
  FExportPrecision := 1;
  FPagesOfSheet := 1; //waw
  FExportImages := True;
  FExportFrames := True;
  FShowAfterExport := True;
  FExportImageFormat := ifBMP;
  FPixelFormat := pf24bit;
  FCompressFile := False;

  FMatrixList := nil;
end;

destructor TRMXLSExport.Destroy;
begin
  FreeAndNil(FMatrixList);
  RMUnRegisterExportFilter(Self);

  inherited Destroy;
end;

function TRMXLSExport.ShowModal: Word;
var
  tmp: TRMXLSExportForm;
begin
  ExportPageList.Clear;
  if not ShowDialog then
  begin
    Result := mrOk;
    Exit;
  end;

  tmp := TRMXLSExportForm.Create(nil);
  try
    tmp.edtExportFileName.Text := FileName;
    tmp.btnFileName.Enabled := tmp.edtExportFileName.Enabled;

    tmp.chkExportFrames.Checked := ExportFrames;
    tmp.chkShowAfterGenerate.Checked := ShowAfterExport;
    tmp.UpDown2.Position := FPagesOfSheet; //waw

    tmp.cmbPixelFormat.ItemIndex := Integer(PixelFormat);
    tmp.chkExportImages.Checked := ExportImages;
    tmp.cmbImageFormat.ItemIndex := tmp.cmbImageFormat.Items.IndexOfObject(TObject(Ord(ExportImageFormat)));
{$IFDEF JPEG}
    tmp.UpDown1.Position := JPEGQuality;
{$ENDIF}
    tmp.chkExportFramesClick(Self);
    tmp.chkWYB.Checked := ExportPrecision <= 1;

    Result := tmp.ShowModal;
    if Result = mrOK then
    begin
      if tmp.rdbPrintAll.Checked then
        ParsePageNumbers(1, '')
      else if tmp.rbdPrintCurPage.Checked then
        ParsePageNumbers(2, '')
      else
        ParsePageNumbers(3, tmp.edtPages.Text);

      FileName := tmp.edtExportFileName.Text;
      ExportFrames := tmp.chkExportFrames.Checked;
      ShowAfterExport := tmp.chkShowAfterGenerate.Checked;
      FPagesOfSheet := tmp.UpDown2.Position;
      ExportImages := tmp.chkExportImages.Checked;
      if tmp.chkWYB.Checked then
        ExportPrecision := 1
      else
        ExportPrecision := 10;
      if ExportImages then
      begin
        PixelFormat := TPixelFormat(tmp.cmbPixelFormat.ItemIndex);
        ExportImageFormat := TRMEFImageFormat
          (tmp.cmbImageFormat.Items.Objects[tmp.cmbImageFormat.ItemIndex]);
{$IFDEF JPEG}
        JPEGQuality := StrToInt(tmp.edJPEGQuality.Text);
{$ENDIF}
      end;
    end;
  finally
    tmp.Free;
  end;
end;

procedure TRMXLSExport.DoAfterExport(const aFileName: string);

{$IFDEF XLSReadWriteII}
  procedure _SaveToFile(const aFileName: string);
  begin
  	try
	  	FXlsReadWrite.Filename := aFileName;
  		FXlsReadWrite.Write;
    finally
    	FreeAndNil(FXlsReadWrite);
    end;
  end;
{$ELSE}
  procedure _SaveToFile(const aFileName: string);
  var
    lWriter: TwawCustomWriter; //By waw
    lExcel: Variant;
    lWorkBook: Variant;
  begin
    if FWorkBook = nil then Exit;

    if RMCmp(ExtractFileExt(aFileName), '.xls') then
      lWriter := TwawExcelWriter.Create //By waw
    else
      lWriter := TwawHTMLWriter.Create; //By waw

    try
      lWriter.Save(FWorkBook, aFileName); //By waw
    finally
      lWriter.Free; //By waw
    end;

    FreeAndNil(FWorkBook);
    if FCompressFile and RMCmp(ExtractFileExt(aFileName), '.xls') and FileExists(aFileName) then
    begin
      lExcel := CreateOLEObject('Excel.Application');
      lExcel.Application.EnableEvents := False;
      lExcel.Application.EnableAutoComplete := False;
      lExcel.Application.EnableAnimations := False;
      lExcel.Application.ScreenUpdating := False;
      lExcel.Application.Interactive := False;
      lExcel.Application.DisplayAlerts := False;

      lWorkBook := lExcel.WorkBooks.Open(aFileName);
      lWorkBook.SaveAs(aFileName, $FFFFEFD1 {xlNormal});

      lExcel.Quit;
      lExcel := null;
      lExcel := Unassigned;
    end;
  end;
{$ENDIF}

begin //by waw
  try
    if FTotalPage > 0 then
    begin
      FTotalPage := 0;
      ExportPages;
    end;

    _SaveToFile(aFileName);
    if FShowAfterExport then //by waw
      ShellExecute(0, 'open', PChar(aFileName), '', '', SW_SHOWNORMAL);
  finally
    FreeAndNil(FMatrixList);
  end;
end;

{$IFDEF XLSReadWriteII}
const
  sDefaultFontName = 'Arial';
  wawDefFontSize = 10;
  wawPointPerInch14 = 1440;

function GetCharacterWidth: Integer;
var
  F: TFont;
  SaveFont: HFont;
  DC: HDC;
  TM: TEXTMETRIC;
begin
  SaveFont := HFont(nil);
  DC := GetDC(0);
  F := TFont.Create;
  try
    F.Name := sDefaultFontName;
    F.Size := wawDefFontSize;
    SaveFont := SelectObject(DC, F.Handle);
    GetTextMetrics(DC, TM);
    result := TM.tmAveCharWidth + TM.tmOverhang + 1;
  finally
    if SaveFont <> HFont(nil) then
      SelectObject(DC, SaveFont);
    F.Free;
  end;
  ReleaseDC(0, DC);
end;

function GetPixelPerInch: Integer;
var
  DC: HDC;
begin
  DC := GetDC(0);
  Result := GetDeviceCaps(DC, LOGPIXELSX); // LOGPIXELSX = $58
  ReleaseDC(0, DC);
end;

procedure TRMXLSExport.ExportPages;
var
  lRow, lCol: Integer;
  lCell: TRMIEMData;
  lCellStyle: TRMIEMCellStyle;
  lSheetIndex: Integer;

  procedure _ExportAsText;
  begin
  end;

  procedure _ExportAsGraphic;
	var
		lTmpFileName: string;
    lXlsPicture: TXLSPicture;
  begin
		lTmpFileName := RM_Utils.RMGetTmpFileName('.jpg');
    try
    	lCell.Graphic.SaveToFile(lTmpFileName);
      lXlsPicture := FXlsReadWrite.Pictures.Add;
      with lXlsPicture do
      begin
      	IsTempFile := True;
				FileName := lTmpFileName;
        Width := 0;
        Height := 0;
        //for i := lCell.StartCol to lCell.EndCol do
        //	Width := Width + FMatrixList.ColWidth[i - 1];

      end;

      with FXlsReadWrite.Sheets[lSheetIndex].SheetPictures.Add do
      begin
        Col := lCell.StartCol;
        Row := lCell.StartRow;
        PictureName := lTmpFileName;
      end;
    finally
    end;
  end;

begin
  FMatrixList.Prepare;

	if FXlsPageNo > 1 then
	  FXlsReadWrite.Sheets.Add;

  lSheetIndex := FXlsReadWrite.Sheets.Count - 1;
  FXlsReadWrite.Sheets[lSheetIndex].Name := 'Sheet' + IntToStr(lSheetIndex + 1);

  SetProgress(FMatrixList.RowCount * FMatrixList.ColCount, 'Exporting Row Height');
  lCol := 0;
  for lRow := 0 to FMatrixList.RowCount - 1 do
  begin
    AddProgress;
    if ParentReport.Terminated then Break;

    FXlsReadWrite.Sheets[lSheetIndex].RowHeights[lRow + 1] := MulDiv(FMatrixList.RowHeight[lRow], wawPointPerInch14, GetPixelPerInch);
    if FMatrixList.GetCellRowPos(lRow) >= FMatrixList.PageBreak[lCol] then
    begin
      //lSheet.AddPageBreakAfterRow(lRow + 1);
      Inc(lCol);
    end;
  end;

  SetProgress(FMatrixList.RowCount * FMatrixList.ColCount, 'Exporting Column Width');
  for lCol := 0 to FMatrixList.ColCount - 1 do