rm_e_oldxls.pas

这是一个功能强大

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

unit RM_e_OldXls;

interface

{$I RM.inc}
{$IFDEF COMPILER4_UP}

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

type
  { TRMOldXLSExport }
  TRMOldXLSExport = class(TRMMainExportFilter)
  private
    FFirstPage: Boolean;
    FExportPrecision: Integer;
    FExportPages: string;
    FShowAfterExport: Boolean;
    FMultiSheet: Boolean;

    FOldAfterExport: TRMAfterExportEvent;
    FCols, FRows: TList;
    FrStart: Integer;
    FpgList: TStringList;
    FWorkBook: TwawXLSWorkbook; //waw

    procedure _ClearColsAndRows;
    procedure DoAfterExport(const FileName: string);
    procedure SaveToFile(const FileName: string);
  protected
    procedure InternalOnePage(aPage: TRMEndPage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ShowModal: Word; override;
    procedure OnBeginDoc; override;
    procedure OnEndDoc; override;
    procedure OnBeginPage; override;
//    procedure OnEndPage; override;
  published
    property ExportPages: string read FExportPages write FExportPages;
    property PixelFormat;
    property ShowAfterExport: Boolean read FShowAfterExport write FShowAfterExport;
    property MultiSheet: Boolean read FMultiSheet write FMultiSheet;
    property ExportPrecision: Integer read FExportPrecision write FExportPrecision;
  end;

  { TRMCSVExportForm }
  TRMOldXLSExportForm = 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;
    chkMultiSheet: TCheckBox;
    chkExportFrames: TCheckBox;
    gbExportImages: TGroupBox;
    lblExportImageFormat: TLabel;
    lblJPEGQuality: TLabel;
    Label4: TLabel;
    cmbImageFormat: TComboBox;
    edJPEGQuality: TEdit;
    UpDown1: TUpDown;
    cmbPixelFormat: TComboBox;
    chkExportImages: 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;
    function GetExportPages: string;
  public
    { Public declarations }
  end;

{$ENDIF}
implementation

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

{$R *.DFM}

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

{------------------------------------------------------------------------------}
{TRMOldXLSExport}

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

  ShowDialog := True;
  CreateFile := False;
  FExportPrecision := 1;
  ExportImages := True;
  ExportFrames := True;
  FShowAfterExport := True;
  FExportImageFormat := ifBMP;
  FIsXLSExport := True;
  CanMangeRotationText := True;
end;

destructor TRMOldXLSExport.Destroy;
begin
  RMUnRegisterExportFilter(Self);
  inherited Destroy;
end;

procedure TRMOldXLSExport.DoAfterExport(const FileName: string);
begin //by waw
  SaveToFile(FileName);
  if FShowAfterExport then //by waw
    ShellExecute(0, 'open', PChar(FileName), '', '', SW_SHOWNORMAL);

  if Assigned(FOldAfterExport) then FOldAfterExport(FileName);
  OnAfterExport := FOldAfterExport;
end;

function TRMOldXLSExport.ShowModal: Word;
begin
  if not ShowDialog then
    Result := mrOk
  else
  begin
    with TRMOldXLSExportForm.Create(nil) do
    begin
      edtExportFileName.Text := Self.FileName;
      btnFileName.Enabled := edtExportFileName.Enabled;

      chkExportFrames.Checked := ExportFrames;
      chkShowAfterGenerate.Checked := Self.ShowAfterExport;
      chkMultiSheet.Checked := Self.MultiSheet;

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

      Result := ShowModal;
      if Result = mrOK then
      begin
        Self.FileName := edtExportFileName.Text;
        Self.ExportFrames := chkExportFrames.Checked;
        Self.ExportPages := GetExportPages;
        Self.ShowAfterExport := chkShowAfterGenerate.Checked;
        Self.MultiSheet := chkMultiSheet.Checked;

        ExportImages := chkExportImages.Checked;
        if ExportImages then
        begin
          Self.PixelFormat := TPixelFormat(cmbPixelFormat.ItemIndex);
          ExportImageFormat := TRMEFImageFormat
            (cmbImageFormat.Items.Objects[cmbImageFormat.ItemIndex]);
{$IFDEF JPEG}
          JPEGQuality := StrToInt(edJPEGQuality.Text);
{$ENDIF}
        end;
      end;
      Free;
    end;
  end;
end;

type
  TCol = class(TObject)
  public
    Index: integer;
    X: integer;
    constructor CreateCol(_X: integer);
  end;

constructor TCol.CreateCol;
begin
  inherited Create;
  X := _X;
end;

type
  TRow = class(TObject)
  private
    Index: integer;
    Y: integer;
    PageIndex: integer;
  public
    constructor CreateRow(_Y: integer; _PageIndex: integer);
  end;

constructor TRow.CreateRow;
begin
  inherited Create;
  Y := _Y;
  PageIndex := _PageIndex;
end;

procedure TRMOldXLSExport._ClearColsAndRows;
begin
  while FCols.Count > 0 do
  begin
    TCol(FCols[0]).Free;
    FCols.Delete(0);
  end;
  while FRows.Count > 0 do
  begin
    TRow(FRows[0]).Free;
    FRows.Delete(0);
  end;
end;

type
  rXLSExport = record
    LeftCol: TCol;
    RightCol: TCol;
    TopRow: TRow;
    BottomRow: TRow;
  end;
  pXLSExport = ^rXLSExport;

  THackMemoView = class(TRMCustomMemoView)
  end;

  THackRMIEMData = class(TRMIEMData);

function SortCols(Item1, Item2: pointer): integer;
begin
  Result := TCol(Item1).X - TCol(Item2).X;
end;

function SortRows(Item1, Item2: pointer): integer;
begin
  if TRow(Item1).PageIndex = TRow(Item2).PageIndex then
    Result := TRow(Item1).Y - TRow(Item2).Y
  else
    Result := TRow(Item1).PageIndex - TRow(Item2).PageIndex;
end;

procedure TRMOldXLSExport.OnBeginDoc;

  procedure _ParsePageNumbers; //确定需要打印的页
  var
    i, j, n1, n2: Integer;
    s: string;
    IsRange: Boolean;
  begin
    s := ExportPages;
    if s = 'CURPAGE' then
    begin
      FpgList.Add(IntToStr(TRMEndPages(TRMReport(ParentReport).EndPages).CurPageNo));
      Exit;
    end;
    while Pos(' ', s) <> 0 do
      Delete(s, Pos(' ', s), 1);
    if s = '' then
      Exit;

    if s[Length(s)] = '-' then
      s := s + IntToStr(ParentReport.EndPages.Count);
    s := s + ',';
    i := 1; j := 1; n1 := 1;
    IsRange := False;
    while i <= Length(s) do
    begin
      if s[i] = ',' then
      begin
        n2 := StrToInt(Copy(s, j, i - j));
        j := i + 1;
        if IsRange then
        begin
          while n1 <= n2 do
          begin
            FpgList.Add(IntToStr(n1));
            Inc(n1);
          end;
        end
        else
          FpgList.Add(IntToStr(n2));
        IsRange := False;
      end
      else if s[i] = '-' then
      begin
        IsRange := True;
        n1 := StrToInt(Copy(s, j, i - j));
        j := i + 1;
      end;
      Inc(i);
    end;
  end;

begin
  ParentReport.Terminated := False;
  FOldAfterExport := OnAfterExport;
  OnAfterExport := DoAfterExport;
  inherited OnBeginDoc;
  FrStart := 0;
  FFirstPage := True;
  try
    FpgList := TStringList.Create;
    _ParsePageNumbers;

    FCols := TList.Create;
    FRows := TList.Create;

    FWorkBook := TwawXLSWorkbook.Create; //By waw
    FWorkBook.Clear;
  except
  end;
end;

procedure TRMOldXLSExport.OnEndDoc;
begin
  _ClearColsAndRows;
  FCols.Free;
  FRows.Free;
  FpgList.Free;
  inherited OnEndDoc;
end;

procedure TRMOldXLSExport.OnBeginPage;
begin
  inherited OnBeginPage;
end;

const
  KoefX = 0.935;

procedure TRMOldXLSExport.InternalOnePage(aPage: TRMEndPage);
var
  i, k: Integer;
  lDataRec, lDataRec1: TRMIEMData;
  lItem: pXLSExport;
  pe: TList;
  pr, r: TRow;
  lRange: TwawXLSRange; //by waw
  lSheet: TwawXLSWorkSheet; //waw
  lFlag: Boolean;

  function _CEP(v1, v2: integer): boolean;
  begin
    Result := Abs(v1 - v2) <= FExportPrecision;
  end;

  procedure _ExportPicture; //by Waw
  var
    lPicture: TPicture;
  begin
    if not ExportImages then Exit;

    lPicture := TPicture.Create;
    try
      SaveBitmapToPicture(TBitmap(lDataRec.Graphic), ExportImageFormat{$IFDEF JPEG}, JPEGQuality{$ENDIF}, lPicture);
      lSheet.AddImage(lItem^.LeftCol.Index + 1, lItem^.TopRow.Index + 1,
        lItem^.RightCol.Index + 1, lItem^.BottomRow.Index + 1, lPicture, true);

      FreeAndNil(THackRMIEMData(lDataRec).FGraphic)
    finally
      lPicture.Free;
    end;
  end;

  procedure _ExportText; //by waw
  var
    lText: string;

    procedure _SetXLSBorders;

      procedure _SetXLSBorder(bi: cardinal; b: TRMFrameLine);
      var