dbgridehtoexcel.pas

将DBGRIDEH多表头装换到EXCEL中

  FCol := 0;
  WriteStringCell(OpName,False);
  FCol := 0;

  //制表时间
  OpDate := '制表时间：' + DateTimeToStr(Now);
  FCol := 5;
  WriteStringCell(OpDate,False);
  FCol := 0;

  Inc(FRow); }
end;

procedure TDBGridEhToExcel.WriteTitle;
var

  i, j: integer;
  DBGridEhTitle: TDBGridEhTitle;
  TitleCell: TTitleCell;
begin
  DBGridEhTitle := TDBGridEhTitle.Create;
  try
    DBGridEhTitle.DBGridEh := FDBGridEh;
    DBGridEhTitle.GetTitleData(TitleCell);

    try
      for i := 0 to DBGridEhTitle.RowCount - 1 do
      begin
        for j := 0 to DBGridEhTitle.ColumnCount - 1 do
        begin
          FCol := j;
           if j>=1 then
           begin
            if (TitleCell[j,i]=TitleCell[j-1,i]) and(TitleCell[j,i]<>'') then
            mergecell:=true;
           end;
          WriteStringCell(TitleCell[j,i],False);
        end;
        Inc(FRow);
      end;
      FCol := 0;
    except

    end;
  finally
    DBGridEhTitle.Free;
  end;
end;


procedure TDBGridEhToExcel.WriteDataCell;
var
  i: integer;
begin
  DBGridEh.DataSource.DataSet.DisableControls;
  FBookMark := DBGridEh.DataSource.DataSet.GetBookmark;
  try
    DBGridEh.DataSource.DataSet.First;
    while not DBGridEh.DataSource.DataSet.Eof do
    begin
      for i := 0 to DBGridEh.DataSource.DataSet.FieldCount - 1 do
      begin
        if DBGridEh.DataSource.DataSet.Fields[i].IsNull or (not DBGridEh.DataSource.DataSet.Fields[i].Visible) or (I >visablecount-1) then

          WriteBlankCell

        else
        begin
          case DBGridEh.DataSource.DataSet.Fields[i].DataType of
            ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
              WriteIntegerCell(DBGridEh.DataSource.DataSet.Fields[i].AsInteger);
            ftFloat, ftCurrency, ftBCD:
              WriteFloatCell(DBGridEh.DataSource.DataSet.Fields[i].AsFloat);
          else
            if DBGridEh.DataSource.DataSet.Fields[i] Is TBlobfield then  // 此类型的字段(图像等)暂无法读取显示
              WriteStringCell('')
            else
              WriteStringCell(trim(DBGridEh.DataSource.DataSet.Fields[i].AsString));
          end;
        end;
      end;

      //显示进度条进度过程
      if ShowProgress then
      begin
        FGauge.Progress := DBGridEh.DataSource.DataSet.RecNo;
        FGauge.Refresh;
      end;

      DBGridEh.DataSource.DataSet.Next;
    end;

  finally
    if DBGridEh.DataSource.DataSet.BookmarkValid(FBookMark) then
    DBGridEh.DataSource.DataSet.GotoBookmark(FBookMark);

    DBGridEh.DataSource.DataSet.EnableControls;
  end;
end;

procedure TDBGridEhToExcel.WriteFooter;
var
  i, j: integer;
begin
  if DBGridEh.FooterRowCount = 0 then exit;

  FCol := 0;
  if DBGridEh.FooterRowCount = 1 then
  begin
    for i := 0 to DBGridEh.Columns.Count - 1 do
    begin
      if DBGridEh.Columns[i].Visible then
      begin
        WriteStringCell(DBGridEh.Columns[i].Footer.Value,False);
        Inc(FCol);
      end;
    end;
  end
  else if DBGridEh.FooterRowCount > 1 then
  begin
    for i := 0 to DBGridEh.Columns.Count - 1 do
    begin
      if DBGridEh.Columns[i].Visible then
      begin
        for j := 0 to DBGridEh.Columns[i].Footers.Count - 1 do
        begin
          WriteStringCell(DBGridEh.Columns[i].Footers[j].Value ,False);
          Inc(FRow);
        end;
        Inc(FCol);
        FRow := FRow - DBGridEh.Columns[i].Footers.Count;
      end;
    end;
  end;
  FCol := 0;
end;

procedure TDBGridEhToExcel.SaveStream(aStream: TStream);
begin
  FCol := 0;
  FRow := 0;
  Stream := aStream;

  //输出前缀
  WritePrefix;

  //输出表格标题
  WriteHeader;

  //输出列标题
  WriteTitle;

  //输出数据集内容
  WriteDataCell;

  //输出DBGridEh表脚
  WriteFooter;

  //输出后缀
  WriteSuffix;
end;

procedure TDBGridEhToExcel.ExportToExcel;
var
  FileStream: TFileStream;
  Msg: String;
begin
  //如果数据集为空或没有打开则退出
  if (DBGridEh.DataSource.DataSet.IsEmpty) or (not DBGridEh.DataSource.DataSet.Active) then
    exit;

  //如果保存的文件名为空则退出 
  if Trim(FileName) = '' then
    exit;
    
  //根据表格修改数据集字段顺序及字段中文标题
  SetDataSetCrossIndexDBGridEh;

  Screen.Cursor := crHourGlass;
  try
    try
      if FileExists(FileName) then
      begin
        Msg := '已存在文件（' + FileName + '），是否覆盖？';
        if Application.MessageBox(PChar(Msg),'提示',MB_YESNO+MB_ICONQUESTION+MB_DEFBUTTON2) = IDYES then
        begin
          //删除文件
          DeleteFile(FileName)
        end
        else
          exit;
      end;

      //显示进度窗体
      if ShowProgress then
        CreateProcessForm(nil);
        
      FileStream := TFileStream.Create(FileName, fmCreate);
      try
        //输出文件
        SaveStream(FileStream);
      finally
        FileStream.Free;
      end;
      
      //打开Excel文件
      ShellExecute(0, 'Open', PChar(FileName), nil, nil, SW_SHOW);
    except

    end;
  finally
    if ShowProgress then
      FreeAndNil(FProgressForm);
    Screen.Cursor := crDefault;
  end;
end;

destructor TDBGridEhToExcel.Destroy;
begin
  inherited Destroy;
end;

procedure TDBGridEhToExcel.CreateProcessForm(AOwner: TComponent);
var
  Panel: TPanel;
  Prompt: TLabel;                                           {提示的标签}
begin
  if Assigned(FProgressForm) then
    exit;

  FProgressForm := TForm.Create(AOwner);
  with FProgressForm do
  begin
    try
      Font.Name := '宋体';                                  {设置字体}
      Font.Size := 9;
      BorderStyle := bsNone;
      Width := 300;
      Height := 100;
      BorderWidth := 1;
      Color := clBlack;
      Position := poScreenCenter;

      Panel := TPanel.Create(FProgressForm);
      with Panel do
      begin
        Parent := FProgressForm;
        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 := '正在导出数据，请稍候......';
        Font.Style := [fsBold];
      end;

      FGauge := TGauge.Create(Panel);
      with FGauge do
      begin
        Parent := Panel;
        ForeColor := clBlue;
        Left := 20;
        Top := 50;
        Height := 13;
        Width := 260;
        MinValue := 0;
        MaxValue := DBGridEh.DataSource.DataSet.RecordCount;
      end;
    except

    end;
  end;

  FProgressForm.Show;
  FProgressForm.Update;
end;

procedure TDBGridEhToExcel.SetDataSetCrossIndexDBGridEh;
var
  i: integer;
begin
  for i := 0 to DBGridEh.Columns.Count - 1 do
  begin
    DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[i].FieldName).Index := i;
    DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[i].FieldName).DisplayLabel
      := DBGridEh.Columns.Items[i].Title.Caption;
    DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[i].FieldName).Visible :=
      DBGridEh.Columns.Items[i].Visible;
  end;

  for i := 0 to DBGridEh.DataSource.DataSet.FieldCount - 1 do
  begin
    if POS('*****',DBGridEh.DataSource.DataSet.Fields[i].DisplayLabel) > 0 then
      DBGridEh.DataSource.DataSet.Fields[i].Visible := False;
  end;  
end;
{procedure Register;
begin
     RegisterComponents('System', [TDBGridEhToExcel])
end; }

end.