rm_e_comxls.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 812 行 · 第 1/2 页

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

unit RM_e_ComXls;

interface

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

uses
  SysUtils, Windows, Messages, Classes, Graphics, Forms, StdCtrls, Controls,
  Dialogs, ExtCtrls, Buttons, ComCtrls, ComObj, activex,
  RM_Class, RM_e_main, Excel2000
{$IFDEF RXGIF}, JvGIF{$ENDIF}
{$IFDEF JPEG}, JPeg{$ENDIF}
{$IFDEF Delphi6}, Variants{$ENDIF};

type

  TRMExcelApplication = TExcelApplication;
  TRMExcelWorkbook = TExcelWorkbook;
  TRMExcelWorksheet = TExcelWorksheet;
  TRMExcelRange = Range;

  { TRMComXLSExport }
  TRMComXLSExport = class(TRMMainExportFilter)
  private
    FFirstPage: Boolean;
    FExportPrecision: Integer;
    FExportPages: string;
    FShowAfterExport: Boolean;
    FMultiSheet: Boolean;
    LCID: Integer;
    KoefX, KoefY: double;

    FOldAfterExport: TRMAfterExportEvent;
    FCols, FRows: TList;
    FrStart: Integer;
    FpgList: TStringList;

    FExcelApplication: TRMExcelApplication;
    FExcelWorkbook: TRMExcelWorkbook;
    FExcelWorksheet: TRMExcelWorksheet;

    procedure _ClearColsAndRows;
    procedure DoAfterExport(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 }
  TRMComXLSExportForm = 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 Delphi4}
uses Math, RM_Common, RM_Const, RM_Const1, RM_Utils;

{$R *.DFM}

const
  MAX_EXCEL_ROW_HEIGHT = 409;
  MAX_EXCEL_COLUMN_WIDTH = 255;

  XLS_EXPORT_LOGPIXELSX = 108;
  XLS_EXPORT_LOGPIXELSY = 96;

{------------------------------------------------------------------------------}
{TRMComXLSExport}

constructor TRMComXLSExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  RMRegisterExportFilter(Self, 'Export To xls use Com' + ' (*.xls)', '*.xls');

  ShowDialog := True;
  CreateFile := False;
  FExportPrecision := 1;
  ExportImages := True;
  ExportFrames := True;
  MultiSheet := True; //waw 03-07-26
  FShowAfterExport := True;
  FExportImageFormat := ifBMP;
  FIsXLSExport := True;
  CanMangeRotationText := True;
end;

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

procedure TRMComXLSExport.DoAfterExport(const FileName: string);
begin //by waw
  if Assigned(FOldAfterExport) then FOldAfterExport(FileName);
  OnAfterExport := FOldAfterExport;
end;

function TRMComXLSExport.ShowModal: Word;
begin
  if not ShowDialog then
    Result := mrOk
  else
  begin
    with TRMComXLSExportForm.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 TRMComXLSExport._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;

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 TRMComXLSExport.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;

    FExcelApplication := TRMExcelApplication.Create(nil);
    FExcelWorkbook := TRMExcelWorkbook.Create(nil);
    FExcelWorkSheet := TRMExcelWorksheet.Create(nil);

    FExcelApplication.Visible[0] := True;
    FExcelApplication.DisplayAlerts[0] := False;
    FExcelApplication.Connect;

    LCID := LOCALE_USER_DEFAULT;
    LCID := GetUserDefaultLCID();

    FExcelApplication.WorkBooks.Add(EmptyParam, LCID);
    FExcelWorkbook.ConnectTo(FExcelApplication.Workbooks[1]);

    while FExcelWorkbook.Sheets.Count > 1 do
    begin
      FExcelWorkSheet.ConnectTo(FExcelWorkBook.Sheets[FExcelWorkbook.Sheets.Count] as _WorkSheet);
      FExcelWorkSheet.Delete;
    end;
    FExcelWorkSheet.ConnectTo(FExcelWorkBook.Sheets[1] as _WorkSheet);

    KoefX := 1;
    KoefY := 1;
//    KoefX := FExcelApplication.InchesToPoints(1) * FExcelWorksheet.Columns[1].ColumnWidth / XLS_EXPORT_LOGPIXELSX / FExcelWorksheet.Columns[1].Width;
//    KoefY := FExcelApplication.InchesToPoints(1) * FExcelWorksheet.Rows[1].RowHeight / XLS_EXPORT_LOGPIXELSY / FExcelWorksheet.Rows[1].Height;
  except
  end;
end;

procedure TRMComXLSExport.OnEndDoc;
begin
  try
    FExcelWorkBook.SaveCopyAs(Self.FileName); // 关闭并保存
//    FExcelWorkbook.Close(True, Self.FileName, EmptyParam, lCID); // 关闭并保存

    FExcelWorksheet.Disconnect;
    FExcelWorkbook.Disconnect;
    FExcelApplication.Disconnect;
//    FExcelApplication.Quit;
  finally
    _ClearColsAndRows;
    FCols.Free;
    FRows.Free;
    FpgList.Free;

    FreeAndNil(FExcelWorkSheet);
    FreeAndNil(FExcelWorkBook);
    FreeAndNil(FExcelApplication);

    inherited OnEndDoc;
  end;
end;

procedure TRMComXLSExport.OnBeginPage;
begin
  inherited OnBeginPage;
end;

procedure TRMComXLSExport.InternalOnePage(aPage: TRMEndPage);
var
  i, k: Integer;