uexportdlg.pas

简单易用的按件按时计工资管理系统

unit uExportDlg;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, ActnList, IniFiles, DB,
  dxExEdtr, dxCntner, dxTL, dxDBCtrl, dxDBGrid, uGlobal, ShellApi, uMain;

type
  TExportDlg = class(TForm)
    lblFileName: TLabel;
    SpeedButton1: TSpeedButton;
    lblFileFormat: TLabel;
    lblFileNotes: TLabel;
    Bevel1: TBevel;
    btnOK: TButton;
    btnCancel: TButton;
    edtFileName: TEdit;
    Remark: TStaticText;
    cbFileType: TComboBox;
    chkOpenFile: TCheckBox;
    SaveDlg: TSaveDialog;
    Actions: TActionList;
    actSave: TAction;
    actOK: TAction;
    actCancel: TAction;
    procedure cbFileTypeChange(Sender: TObject);
    procedure actSaveExecute(Sender: TObject);
    procedure actOKExecute(Sender: TObject);
    procedure actCancelExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FMR_OK: Boolean;
    FFileName: string;
    FExtension: string;
    FCurGrid: TdxDBGrid ;
    FExportType: TExportType;
    FMasterGrid: TdxDBGrid;
    function  FormatFileName(FileName, ExtName: string): string;
    procedure SetMasterGrid(const Value: TdxDBGrid);
    function Export2Htm: Boolean;
    function Export2Txt: Boolean;
    function Export2Xls: Boolean;
    function Export2Xml: Boolean;
    function GetExportType(FileName: string): TExportType;
  protected
    procedure OK_Close;
    procedure Cancel;
    procedure IniVars;
    function InteralExport:boolean;
  public
    property MasterGrid: TdxDBGrid read FMasterGrid write SetMasterGrid;

  end;

const
  //文件格式的说明文字数组
  FILE_NOTES : array[0..3] of string = (
   'Microsoft Excel 所使用的文件格式, 但系统必须安装有Microsoft Excel软件方可进行导出。',
   'HTML（超文本标记语言）(*.htm)。',
   '文本（Tab 分隔文件）(*.txt)，数据列以制表符 (Tab) 分隔，每一行数据都以回车符结束。',
   'XML （可扩展标记语言）(*.xml)。');

  //对应的SaveDialog控件中的Filter属性设置数组
  //注意：与上列数组定义要对应
  DIALOG_FILTERS : array[0..3] of string = (
    'Microsoft Excel 文件(*.xls)|*.xls',
    'HTML（超文本标记语言）(*.htm)|*.htm',
    '文本（Tab 分隔文件）(*.txt)|*.txt',
    'XML （可扩展标记语言）(*.xml)|*.xml');

  //对应的缺省的扩展名数组
  DefaultExts : array[0..3] of string = ('.xls', '.htm', '.txt', '.xml');

var
  Pub_ExportDlg: TExportDlg;
implementation

{$R *.dfm}

function TExportDlg.Export2Htm: Boolean;
begin
  inherited;
  Result := True;
  try
    FCurGrid.SaveToHTML(FFileName, True);
  except
    Result := False;
  end;
end;

function TExportDlg.Export2Txt: Boolean;
begin
  inherited;
  Result := True;
  try
    FCurGrid.SaveToText(FFileName, True, #9, '|', '|');
  except
    Result := False;
  end;
end;

function TExportDlg.Export2Xls: Boolean;
begin
  inherited;
  Result := True;
  try
    FCurGrid.SaveToXLS(FFileName, True);
  except
    Result := False;
  end;
end;

function TExportDlg.Export2Xml: Boolean;
begin
  inherited;
  Result := True;
  try
    FCurGrid.SaveToXML(FFileName, True);
  except
    Result := False;
  end;
end;


procedure TExportDlg.cbFileTypeChange(Sender: TObject);
begin
  inherited;
  Remark.Caption := FILE_NOTES[(Sender as TCombobox).ItemIndex];
  SaveDlg.Filter := DIALOG_FILTERS[(Sender as TCombobox).ItemIndex];
  SaveDlg.DefaultExt := DefaultExts[(Sender as TCombobox).ItemIndex];
  if FFileName<>'' then
  begin
    FFileName := FormatFileName(FFileName, SaveDlg.DefaultExt);
    edtFileName.Text := FFileName;
  end;
end;

function TExportDlg.FormatFileName(FileName, ExtName: string): string;
begin
  FileName := edtFileName.Text;   //ken040706 修补没有选择Dlg设置文件名的时候,fileName失效的BUG.
  Result := FileName;
  if FileName = '' then Exit;
  Result := ChangeFileExt(FileName, ExtName);
end;

procedure TExportDlg.IniVars;
begin
  inherited;
  FFileName := '';
  FExtension := '.xls';
  FMR_OK := False;
  cbFileType.ItemIndex:=0;
  cbFileTypeChange(cbFileType);
end;

procedure TExportDlg.actSaveExecute(Sender: TObject);
begin
  inherited;
  SaveDlg.FileName := edtFileName.Text;
  if SaveDlg.Execute then
  begin
    edtFileName.Text := SaveDlg.FileName;
  end;
end;

procedure TExportDlg.actOKExecute(Sender: TObject);
begin
  OK_Close;
end;

procedure TExportDlg.actCancelExecute(Sender: TObject);
begin
  Cancel;
end;

procedure TExportDlg.Cancel;
begin
  FMR_OK := False;
  ModalResult := MRCancel;
  Close;
end;

procedure TExportDlg.OK_Close;
begin
  FMR_OK := True;
  FFileName := edtFileName.Text;
  if FFileName='' then
  begin
    Application.MessageBox (pchar('文件名称不能为空！'), pchar(Caption), MB_ICONINFORMATION + MB_OK);
    exit;
  end;
  edtFileName.Text:=ChangeFileExt(edtFileName.Text, FExtension);
  FFileName := edtFileName.Text;
  ModalResult := MROK;
  InteralExport;
end;

procedure TExportDlg.FormCreate(Sender: TObject);
begin
  IniVars; 
end;


procedure TExportDlg.SetMasterGrid(const Value: TdxDBGrid);
begin
  FMasterGrid := Value;
  FCurGrid:= FMasterGrid;
  if FMasterGrid=nil then exit;
end;

function TExportDlg.GetExportType(FileName: string): TExportType;
var
  s: string;
begin
  Result := etXls;
  s := lowercase(ExtractFileExt(FileName));
  if s = '.xls' then Result := etXls;
  if s = '.htm' then Result := etHtm;
  if s = '.txt' then Result := etTxt;
  if s = '.xml' then Result := etXml;
end;

function TExportDlg.InteralExport: boolean;
var eAfterScroll: TDataSetNotifyEvent;
begin
  Result := False;
    FFileName := edtFileName.Text;
    FExportType := GetExportType(FFileName);

    eAfterScroll := FCurGrid.DataSource.DataSet.AfterScroll;
    FCurGrid.DataSource.DataSet.AfterScroll := nil;

  {根据导出类型进行导出}
  try
    try
      case FExportType of
        etXls: Result := Export2Xls;
        etXml: Result := Export2Xml;
        etHtm: Result := Export2Htm;
        etTxt: Result := Export2Txt
      else Exit;
      end;

    {如果选中了立即打开该文件,则调用ShellAPI打开该文件}
      if chkOpenFile.Checked  then
        ShellExecute(0, 'open', pChar(FFileName), '', '', SW_SHOWNORMAL);
    except
      Application.MessageBox (pchar('数据导出时发生错误，请检验！'), pchar(Application.Title),MB_ICONINFORMATION + mrOK);
      Result := false;
    end;
  finally
    FCurGrid.DataSource.DataSet.AfterScroll := eAfterScroll;  //强制恢复以前的事件~
  end;
end;

end.