dbgridexport.pas

是 delphi6的函数库

  if FShow_Progress = True then

  begin

    Create_Run_Excel_Form(nil);

    FRun_Excel_Form.Show;

  end;

  if My_GetActiveOleObject('Excel.Application', l_Excel_Handle) = False then
    if My_CreateOleObject('Excel.Application', l_Excel_Handle) = False then
    begin
       FRun_Excel_Form.Free;
       FRun_Excel_Form := nil;
      raise exception.Create(' 启动 Excel 失败 ,可能没有安装 Excel ！ ');
      Result := False;
      Exit;
    end;
  FExcel_Handle := l_Excel_Handle;
  if FShow_Progress = True then
  begin
    FRun_Excel_Form.Free;
    FRun_Excel_Form := nil;
  end;
   Result := True;
end;

{ 插入新的工作博 }
function TDBGridExport.New_Workbook: Boolean;
var
  i: Integer;
begin
  Result := True;
  try
    FWorkbook_Handle := FExcel_Handle.Workbooks.Add;
  except
    raise exception.Create(' 新建 Excel 工作表出错！ ');
    Result := False;
    Exit;
   end;

  if FTitle <> '' then

    FWorkbook_Handle.Application.ActiveWindow.Caption := FTitle;
  if FSheetName <> '' then
  begin
    for i := 2 to FWorkbook_Handle.Sheets.Count do
      if FSheetName = FWorkbook_Handle.Sheets[i].Name then
      begin

        raise exception.Create(' 工作表命名重复！ ');

        Result := False;

        exit;

      end;

    try

      FWorkbook_Handle.Sheets[1].Name := FSheetName;

    except

      raise exception.Create(' 工作表命名错误！ ');

      Result := False;

      exit;

    end;

  end;

end;


{ 插入数据 }

function TDBGridExport.InsertData_To_Excel: Boolean;

var

  i, j, k: Integer;

  data_Str: string;

  Column_name: string;

  Data_Set: TDataSet;


  bookmark: pointer;

  Before_Scroll, Afrer_Scroll: TDataSetNotifyEvent;

begin

  try

    { 显示插入进度 }

    if FShow_Progress = True then

    begin

      Create_ProgressForm(nil);

      FProgress_Form.Show;

    end;
    { 第一行 ,插入标题 }{ 仅仅插入可见数据 }
    j := 1;
    for i := 1 to FDB_Grid.Columns.Count do
      if FDB_Grid.Columns[i - 1].Visible = True then
      begin
        FWorkbook_Handle.WorkSheets[1].Cells[1, j].Value := FDB_Grid.Columns[i - 1].Title.Caption;
        FWorkbook_Handle.WorkSheets[1].Columns[j].ColumnWidth := FDB_Grid.Columns[i - 1].Width div 6;
        j := j + 1
      end;


   { 插入 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;
    Data_Set.First;
    k := 2;
    while not Data_Set.Eof do
    begin
      if FShow_Progress = True then
        FProgressBar.Position := k;
      j := 1;
      for i := 1 to FDB_Grid.Columns.Count do
      begin
        if FDB_Grid.Columns[i - 1].Visible = True then
        begin
          Column_name := FDB_Grid.Columns[i - 1].FieldName;
          data_Str := FDB_Grid.Fields[i - 1].DisplayText;
          FWorkbook_Handle.WorkSheets[1].Cells[k, j].Value := data_Str;
          j := j + 1;
         end;
       end;
       k := k + 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;
    Result := True;
   finally
     FExcel_Handle.Visible := True;
     FExcel_Handle.Application.ScreenUpdating := True;
     if FShow_Progress = True then
     begin
       FProgress_Form.Free;
       FProgress_Form := nil;
     end;
   end;
end;
{ 启动 Excel 时给出进度显示 }
procedure TDBGridExport.Create_Run_Excel_Form(AOwner: TComponent);
var
  Panel: TPanel;
  Prompt: TLabel;                                           { 提示的标签 }
begin
  if assigned(FRun_Excel_Form) then exit;
  FRun_Excel_Form := TForm.Create(AOwner);
  with FRun_Excel_Form do
  begin
    try
      Font.Name := ' 宋体 ';                                  { 设置字体 }
      Font.Size := 9;
      BorderStyle := bsNone;
      Width := 300;
      Height := 100;
      BorderWidth := 2;
      Color := clbtnFace;
      Position := poScreenCenter;
      Panel := TPanel.Create(FRun_Excel_Form);
      with Panel do
      begin
        Parent := FRun_Excel_Form;
        Align := alClient;
        BevelInner := bvNone;
        BevelOuter := bvRaised;
        Caption := '';
      end;
      Prompt := TLabel.Create(Panel);
      with Prompt do
      begin
        Parent := panel;
        AutoSize := True;
        Left := 25;
        Top := 25;
        Caption := ' 正在导出数据 ,请稍候…… ';
      end;
    except
    end;
  end;
end;
{ 创建进度显示窗口 }
procedure TDBGridExport.Create_ProgressForm(AOwner: TComponent);
var
  Panel: TPanel;
  Prompt: TLabel;                                           { 提示的标签 }
begin
  if assigned(FProgress_Form) then exit;
  FProgress_Form := TForm.Create(AOwner);
  with FProgress_Form do
  begin
    try
      Font.Name := ' 宋体 ';                                  { 设置字体 }
      Font.Size := 9;
      BorderStyle := bsNone;
      Width := 300;
      Height := 100;
      BorderWidth := 2;
      Color := clBlue;
      Position := poScreenCenter;
      Panel := TPanel.Create(FProgress_Form);
      with Panel do
      begin
        Parent := FProgress_Form;
        Align := alClient;
        BevelInner := bvNone;
        BevelOuter := bvRaised;
        Caption := '';
      end;
      Prompt := TLabel.Create(Panel);
      with Prompt do
      begin
        Parent := panel;
        AutoSize := True;
        Left := 25;
        Top := 25;
        Caption := ' 正在导出数据 ,请稍候…… ';
      end;
      FProgressBar := TProgressBar.Create(panel);
      with FProgressBar do
      begin
        Parent := panel;
        Left := 20;
        Top := 50;
        Height := 18;
        Width := 260;
      end;
    except
    end;
  end;
end;
end.