dbgridexport.pas

是 delphi6的函数库

unit DBGridExport;

interface
uses
  SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Db, DBGrids, Comobj, extctrls, comctrls, ActiveX;
type
  TSpaceMark = (csComma, csSemicolon, csTab, csBlank, csEnter);
  TDBGridExport = class(TComponent)
  private
    FDB_Grid: TDBGrid;                                      { 读取 DBGrid 的源 }
    FTxtFileName: string;                                   { 文本文件名 }
    FSpaceMark: TSpaceMark;                                 { 间隔符号 }
    FSpace_Ord: Integer;                                    { 间隔符号的 Asc 数值 }
    FTitle: string;                                         { 显示的标题 }
    FSheetName: string;                                     { 工作表标题 }
    FExcel_Handle: OleVariant;                              {Excel 的句柄 }
    FWorkbook_Handle: OleVariant;                           { 书签的句柄 }
    FShow_Progress: Boolean;                                { 是否显示插入进度 }
    FProgress_Form: TForm;                                  { 进度窗体 }
    FRun_Excel_Form: TForm;                                 { 启动 Excel 提示窗口 }
    FProgressBar: TProgressBar;                             { 进度条 }
    function Connect_Excel: Boolean;                        { 启动 Excel}
    function New_Workbook: Boolean;                         { 插入新的工作博 }
    function InsertData_To_Excel: Boolean;                  { 插入数据 }
    procedure Create_ProgressForm(AOwner: TComponent);      { 创建进度显示窗口 }
    procedure Create_Run_Excel_Form(AOwner: TComponent);    { 创建启动 Excel 窗口 }
    procedure SetSpaceMark(Value: TSpaceMark);              { 设置导出时的间隔符号 }

  protected

  public
    constructor Create(AOwner: TComponent); override;       { 新建 }
    destructor Destroy; override;                           { 销毁 }
    function Export_To_Excel: Boolean; overload;            { 导出到 Excel 中 }
    function Export_To_Excel(DB_Grid: TDBGrid): Boolean; overload;
    function Export_To_Txt(NewFile: Boolean = True): Boolean; overload; { 导出到文本文件中 }
    function Export_To_Txt(FileName: string; NewFile: Boolean = True): Boolean; overload;
    function Export_To_Txt(DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean; overload;
    function Export_To_Txt(FileName: string; DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean; overload;
  published
    property DB_Grid: TDBGrid read FDB_Grid write FDB_Grid;
    property Show_Progress: Boolean read FShow_Progress write FShow_Progress;
    property TxtFileName: string read FTxtFileName write FTxtFileName;
    property SpaceMark: TSpaceMark read FSpaceMark write SetSpaceMark;
    property Title: string read FTitle write FTitle;
    property SheetName: string read FSheetName write FSheetName;
  end;
procedure Register;

implementation
procedure Register;

begin
  RegisterComponents('uReport', [TDBGridExport]);
end;
{ 新建 }
constructor TDBGridExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FShow_Progress := True;
  FSpaceMark := csTab;
end;
{ 销毁 }
destructor TDBGridExport.Destroy;
begin
  varClear(FExcel_Handle);
  varClear(FWorkbook_Handle);
  inherited Destroy;
end;
{===============================================================================}
{ 导出到文本文件中 }
function TDBGridExport.Export_To_Txt(NewFile: Boolean = True): Boolean;
var
  Txt: TStrings;
  Tmp_Str: string;
  data_Str: string;
  i, j: Integer;
  Column_name: string;
  Data_Set: TDataSet;
  bookmark: pointer;
  Before_Scroll, Afrer_Scroll: TDataSetNotifyEvent;
begin
  Result := False;
  if NewFile = True then
    FTxtFileName := '';
  if FTxtFileName = '' then
  begin
    with TSaveDialog.Create(nil) do
    begin
      Title := ' 请选择输出文件名 ';
      DefaultExt := 'txt';
      Filter := ' 文本文件 (*.Txt)|*.txt';
      Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofNoReadOnlyReturn, ofEnableSizing];
      if Execute then
        FTxtFileName := FileName;
      Free;
      if FTxtFileName = '' then                             { 如果没有选中文件 ,则直接推出 }
         exit;
     end;
     if FTxtFileName = '' then
      begin
        raise exception.Create(' 没有指定输出文件 ');
        Exit;
      end;
    end;

  if FDB_Grid = nil then
      raise exception.Create(' 请输入 DBGrid 名称 ');
    Txt := TStringList.Create;
    try
      { 显示插入进度 }
      if FShow_Progress = True then
      begin
        Create_ProgressForm(nil);
        FProgress_Form.Show;
      end;
      { 第一行 ,插入标题 }
      Tmp_Str := '';                                          //FDB_Grid.Columns[0].Title.Caption;
      for i := 1 to FDB_Grid.Columns.Count do
        if FDB_Grid.Columns[i - 1].Visible = True then
          Tmp_Str := Tmp_Str + FDB_Grid.Columns[i - 1].Title.Caption + Chr(FSpace_Ord);
      Tmp_Str := Copy(Tmp_Str, 1, Length(Tmp_Str) - 1);
      Txt.Add(Tmp_Str);
     { 插入 DBGrid 中的数据 }
      Data_Set := FDB_Grid.DataSource.DataSet;
     { 记忆当前位置并取消任何事件 }
  //  new(bookmark);
      bookmark := Data_Set.GetBookmark;
    Data_Set.DisableControls;
    Before_Scroll := Data_Set.BeforeScroll;
    Afrer_Scroll := Data_Set.AfterScroll;
    Data_Set.BeforeScroll := nil;
    Data_Set.AfterScroll := nil;
    if FShow_Progress = True then
    begin
      Data_Set.Last;
      FProgress_Form.Refresh;
      FProgressBar.Max := Data_Set.RecordCount;
    end;
    { 插入 DBGrid 中的所有字段 }
    Data_Set.First;
    j := 2;
     while not Data_Set.Eof do
     begin
       if FShow_Progress = True then
         FProgressBar.Position := j - 2;
       Column_name := FDB_Grid.Columns[0].FieldName;
       Tmp_Str := '';                                        //Data_Set.FieldByName(Column_name).AsString;
       for i := 1 to FDB_Grid.Columns.Count do
         if FDB_Grid.Columns[i - 1].Visible = True then
         begin
           data_Str := FDB_Grid.Fields[i - 1].DisplayText;
           Tmp_Str := Tmp_Str + data_Str + Chr(FSpace_Ord);
         end;
       Tmp_Str := Copy(Tmp_Str, 1, Length(Tmp_Str) - 1);
       Txt.Add(Tmp_Str);
       j := j + 1;
       Data_Set.Next;
     end;
     { 恢复原始事件以及标志位置 }
     Data_Set.GotoBookmark(bookmark);
     Data_Set.FreeBookmark(bookmark);
 //  dispose(bookmark);
     Data_Set.EnableControls;
     Data_Set.BeforeScroll := Before_Scroll;
     Data_Set.AfterScroll := Afrer_Scroll;
     { 写到文件 }
     Txt.SaveToFile(FTxtFileName);
     Result := True;
   finally
     Txt.Free;
     if FShow_Progress = True then
     begin
       FProgress_Form.Free;
       FProgress_Form := nil;
     end;
   end;
 end;
 function TDBGridExport.Export_To_Txt(FileName: string; NewFile: Boolean = True): Boolean;
 begin
   FTxtFileName := FileName;
   Result := Export_To_Txt(NewFile);
 end;

function TDBGridExport.Export_To_Txt(DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean;
 begin
   FDB_Grid := DB_Grid;
   Result := Export_To_Txt(NewFile);
end;

function TDBGridExport.Export_To_Txt(FileName: string; DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean;
begin
  FTxtFileName := FileName;
  FDB_Grid := DB_Grid;
  Result := Export_To_Txt(NewFile);
end;
{-------------------------------------------------------------------------------}
{ 设置导出时的间隔符号 }
procedure TDBGridExport.SetSpaceMark(Value: TSpaceMark);
begin
  FSpaceMark := Value;
  case Value of
    csComma: FSpace_Ord := ord(',');
    csSemicolon: FSpace_Ord := ord(';');
    csTab: FSpace_Ord := 9;
    csBlank: FSpace_Ord := 32;
    csEnter: FSpace_Ord := 13;
  end;
end;
{ 导出到 Excel 中 }
function TDBGridExport.Export_To_Excel: Boolean;
begin
  if FDB_Grid = nil then
    raise exception.Create(' 请输入 DBGrid 名称 ');
  Result := False;
  if Connect_Excel = True then
    if New_Workbook = True then
      if InsertData_To_Excel = True then
        Result := True;
end;
function TDBGridExport.Export_To_Excel(DB_Grid: TDBGrid): Boolean;
begin
  FDB_Grid := DB_Grid;
  Result := Export_To_Excel;
end;
{启动 Excel}
function TDBGridExport.Connect_Excel: Boolean;
  { 连接 Ole 对象 }
  function My_GetActiveOleObject(const ClassName: string; out Ole_Handle: IDispatch): Boolean;
  var                                                       //IDispatch
    ClassID: TCLSID;
    Unknown: IUnknown;
    l_Result: HResult;
  begin
    Result := False;
    l_Result := CLSIDFromProgID(PWideChar(WideString(ClassName)), ClassID);
    if (l_Result and $80000000) = 0 then
    begin
     l_Result := GetActiveObject(ClassID, nil, Unknown);
      if (l_Result and $80000000) = 0 then
      begin
        l_Result := Unknown.QueryInterface(IDispatch, Ole_Handle);
        if (l_Result and $80000000) = 0 then
         Result := True;
      end;
    end;
  end;
  { 创建 OLE 对象 }
  function My_CreateOleObject(const ClassName: string; out Ole_Handle: IDispatch): Boolean;
  var
    ClassID: TCLSID;
    l_Result: HResult;
  begin
     Result := False;
     l_Result := CLSIDFromProgID(PWideChar(WideString(ClassName)), ClassID);
     if (l_Result and $80000000) = 0 then
    begin
      l_Result := CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or
         CLSCTX_LOCAL_SERVER, IDispatch, Ole_Handle);
      if (l_Result and $80000000) = 0 then
        Result := True;
     end;
  end;


var

  l_Excel_Handle: IDispatch;

begin