Delphi下一个封装较为完整的DBGrid-Excel类

原作者: [db:作者] 来自: [db:来源] 收藏邀请

unit DBGridEhToExcel;

interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ComCtrls, ExtCtrls, StdCtrls, Gauges, DBGridEh, ShellApi;

type
TTitleCell = array of array of String;

//分解DBGridEh的标题
TDBGridEhTitle = class
private
   FDBGridEh: TDBGridEh;  //对应DBGridEh
   FColumnCount: integer; //DBGridEh列数(指visible为True的列数)
   FRowCount: integer;    //DBGridEh多表头层数(没有多表头则层数为1)
   procedure SetDBGridEh(const Value: TDBGridEh);
   function GetTitleRow: integer;    //获取DBGridEh多表头层数
   function GetTitleColumn: integer; //获取DBGridEh列数
public
   //分解DBGridEh标题，由TitleCell二维动态数组返回
   procedure GetTitleData(var TitleCell: TTitleCell);
published
   property DBGridEh: TDBGridEh read FDBGridEh write SetDBGridEh;
   property ColumnCount: integer read FColumnCount;
   property RowCount: integer read FRowCount;
end;

TDBGridEhToExcel = class(TComponent)
private
   FCol: integer;
   FRow: integer;
   FProgressForm: TForm;                                  {进度窗体}
   FGauge: TGauge;                                        {进度条}
   Stream: TStream;                                       {输出文件流}
   FBookMark: TBookmark;
   FShowProgress: Boolean;                                {是否显示进度窗体}
   FDBGridEh: TDBGridEh;
   FBeginDate: TCaption;                                  {开始日期}
   FTitleName: TCaption;                                  {Excel文件标题}
   FEndDate: TCaption;                                    {结束日期}
   FUserName: TCaption;                                   {制表人}
   FFileName: String;                                     {保存文件名}
   procedure SetShowProgress(const Value: Boolean);
   procedure SetDBGridEh(const Value: TDBGridEh);
   procedure SetBeginDate(const Value: TCaption);
   procedure SetEndDate(const Value: TCaption);
   procedure SetTitleName(const Value: TCaption);
   procedure SetUserName(const Value: TCaption);
   procedure SetFileName(const Value: String);

   procedure IncColRow;
   procedure WriteBlankCell;                              {写空单元格}
   {写数字单元格}
   procedure WriteFloatCell(const AValue: Double; const IncStatus: Boolean=True);
   {写整型单元格}
   procedure WriteIntegerCell(const AValue: Integer; const IncStatus: Boolean=True);
   {写字符单元格}
   procedure WriteStringCell(const AValue: string; const IncStatus: Boolean=True);
   procedure WritePrefix;
   procedure WriteSuffix;
   procedure WriteHeader;                                 {输出Excel标题}
   procedure WriteTitle;                                  {输出Excel列标题}
   procedure WriteDataCell;                               {输出数据集内容}
   procedure WriteFooter;                                 {输出DBGridEh表脚}
   procedure SaveStream(aStream: TStream);
   procedure CreateProcessForm(AOwner: TComponent);       {生成进度窗体}
   {根据表格修改数据集字段顺序及字段中文标题}
   procedure SetDataSetCrossIndexDBGridEh;
public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   procedure ExportToExcel; {输出Excel文件}
published
   property DBGridEh: TDBGridEh read FDBGridEh write SetDBGridEh;
   property ShowProgress: Boolean read FShowProgress write SetShowProgress;
   property TitleName: TCaption read FTitleName write SetTitleName;
   property BeginDate: TCaption read FBeginDate write SetBeginDate;
   property EndDate: TCaption read FEndDate write SetEndDate;
   property UserName: TCaption read FUserName write SetUserName;
   property FileName: String read FFileName write SetFileName;
end;

var
CXlsBof: array[0..5] of Word = (9, 8, 0, , 0, 0);
CXlsEof: array[0..1] of Word = ({post.content}A, 00);
CXlsLabel: array[0..5] of Word = (4, 0, 0, 0, 0, 0);
CXlsNumber: array[0..4] of Word = (3, 14, 0, 0, 0);
CXlsRk: array[0..4] of Word = (E, 10, 0, 0, 0);
CXlsBlank: array[0..4] of Word = (1, 6, 0, 0, );

implementation
{ TDBGridEhTitle }

function TDBGridEhTitle.GetTitleColumn: integer;
var
i, ColumnCount: integer;
begin
ColumnCount := 0;
for i := 0 to DBGridEh.Columns.Count - 1 do
begin
   if DBGridEh.Columns[i].Visible then
     Inc(ColumnCount);
end;

Result := ColumnCount;
end;

procedure TDBGridEhTitle.GetTitleData(var TitleCell: TTitleCell);
var
i, Row, Col: integer;
Caption: String;
begin
FColumnCount := GetTitleColumn;
FRowCount := GetTitleRow;
SetLength(TitleCell,FColumnCount,FRowCount);
Row := 0;
for i := 0 to DBGridEh.Columns.Count - 1 do
begin
   if DBGridEh.Columns[i].Visible then
   begin
     Col := 0;
     Caption := DBGridEh.Columns[i].Title.Caption;
     while POS('|', Caption) > 0 do
     begin
       TitleCell[Row,Col] := Copy(Caption, 1, Pos('|',Caption)-1);
       Caption := Copy(Caption,Pos('|', Caption)+1, Length(Caption));
       Inc(Col);
     end;
     TitleCell[Row, Col] := Caption;
     Inc(Row);
   end;
end;
end;

function TDBGridEhTitle.GetTitleRow: integer;
var
i, j: integer;
MaxRow, Row: integer;
begin
MaxRow := 1;
for i := 0 to DBGridEh.Columns.Count - 1 do
begin
   Row := 1;
   for j := 0 to Length(DBGridEh.Columns[i].Title.Caption) do
   begin
     if DBGridEh.Columns[i].Title.Caption[j] = '|' then
       Inc(Row);
   end;

   if MaxRow < Row then
     MaxRow :=  Row;
end;

Result := MaxRow;
end;

procedure TDBGridEhTitle.SetDBGridEh(const Value: TDBGridEh);
begin
FDBGridEh := Value;
end;

{ TDBGridEhToExcel }

constructor TDBGridEhToExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FShowProgress := True;
end;

procedure TDBGridEhToExcel.SetShowProgress(const Value: Boolean);
begin
FShowProgress := Value;
end;

procedure TDBGridEhToExcel.SetDBGridEh(const Value: TDBGridEh);
begin
FDBGridEh := Value;
end;

procedure TDBGridEhToExcel.SetBeginDate(const Value: TCaption);
begin
FBeginDate := Value;
end;

procedure TDBGridEhToExcel.SetEndDate(const Value: TCaption);
begin
FEndDate := Value;
end;

procedure TDBGridEhToExcel.SetTitleName(const Value: TCaption);
begin
FTitleName := Value;
end;

procedure TDBGridEhToExcel.SetUserName(const Value: TCaption);
begin
FUserName := Value;
end;

procedure TDBGridEhToExcel.SetFileName(const Value: String);
begin
FFileName := Value;
end;

procedure TDBGridEhToExcel.IncColRow;
begin
if FCol = DBGridEh.DataSource.DataSet.FieldCount - 1 then
begin
   Inc(FRow);
   FCol := 0;
end
else
   Inc(FCol);
end;

procedure TDBGridEhToExcel.WriteBlankCell;
begin
CXlsBlank[2] := FRow;
CXlsBlank[3] := FCol;
Stream.WriteBuffer(CXlsBlank, SizeOf(CXlsBlank));
IncColRow;
end;

procedure TDBGridEhToExcel.WriteFloatCell(const AValue: Double; const IncStatus: Boolean=True);
begin
CXlsNumber[2] := FRow;
CXlsNumber[3] := FCol;
Stream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
Stream.WriteBuffer(AValue, 8);

if IncStatus then
   IncColRow;
end;

procedure TDBGridEhToExcel.WriteIntegerCell(const AValue: Integer; const IncStatus: Boolean=True);
var
V: Integer;
begin
CXlsRk[2] := FRow;
CXlsRk[3] := FCol;
Stream.WriteBuffer(CXlsRk, SizeOf(CXlsRk));
V := (AValue Shl 2) Or 2;
Stream.WriteBuffer(V, 4);

if IncStatus then
   IncColRow;
end;

procedure TDBGridEhToExcel.WriteStringCell(const AValue: string; const IncStatus: Boolean=True);
var
L: integer;
begin
L := Length(AValue);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := FRow;
CXlsLabel[3] := FCol;
CXlsLabel[5] := L;
Stream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
Stream.WriteBuffer(Pointer(AValue)^, L);

if IncStatus then
   IncColRow;
end;

procedure TDBGridEhToExcel.WritePrefix;
begin
Stream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
end;

procedure TDBGridEhToExcel.WriteSuffix;
begin
Stream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
end;

procedure TDBGridEhToExcel.WriteHeader;
var
OpName, OpDate: String;
begin
//标题
FCol := 3;
WriteStringCell(TitleName,False);
FCol := 0;

Inc(FRow);

if Trim(BeginDate) <> '' then
begin
   //开始日期
   FCol := 0;
   WriteStringCell(BeginDate,False);
   FCol := 0
end;

if Trim(EndDate) <> '' then
begin
   //结束日期
   FCol := 5;
   WriteStringCell(EndDate,False);
   FCol := 0;
end;

if (Trim(BeginDate) <> '') or (Trim(EndDate) <> '') then
   Inc(FRow);

//制表人
OpName := '制表人：' + UserName;
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;
         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) 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(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;

end.

/*****************************************************************/

调用的例子

var
DBGridEhToExcel: TDBGridEhToExcel;
begin
DBGridEhToExcel := TDBGridEhToExcel.Create(nil);
try
   DBGridEhToExcel.TitleName := '测试测试测试测试测试测试测试';
   DBGridEhToExcel.BeginDate := '开始日期：2005-07-01';
   DBGridEhToExcel.EndDate := '结束日期：2005-07-18';
   DBGridEhToExcel.UserName := '系统管理员';
   DBGridEhToExcel.DBGridEh := DBGridEh1;
   DBGridEhToExcel.ShowProgress := True;
   DBGridEhToExcel.FileName := 'c:3.xls';
   DBGridEhToExcel.ExportToExcel;
finally
   DBGridEhToExcel.Free;
end;
end;

鲜花

握手

雷人

路过

鸡蛋

该文章已有0人参与评论

请发表评论

全部评论

专题导读

More+

10-27 六六分期app的软件客服如何联系？(六六分期

11-06 可心卡盟:win10系统火狐flash插件崩溃怎么

11-06 亲亲特价:怎么删除回收站图标

11-06 济南大学虚拟社区:鲁大师节能降温的具体办

11-06 xlueops.exe:无线网络安装向导

11-06 女斗合众国:win7系统cf与主机连接不稳定怎

11-06 0xc000022-[cf烟雾头]cf怎么调烟雾头

11-06 qizideyouhuo:应用程序无法正常启动0xc0000

11-06 ipz-185:win7系统vcf文件怎么打开

11-06 傻哥蹦迪:win10系统s4怎么打开usb调试

11-06 八神浩树gtaste:回收站清空了怎么恢复

11-06 妖尾之黑色守护:win10系统电脑没有1440x900

11-06 校园至尊魔王小说:win7系统浏览网页时字体

11-06 女斗合众国:win10系统访问共享文件夹提示请

11-06 tokyo hot n0654:恢复win7系统默认字体一招

11-06 雨酷仙境:设置win7系统转移临时文件夹腾出

11-06 阿穆纳伊之杖:win7系统开始菜单在右边还原

11-06 tunespotting:win10系统火狐flash插件总是

11-06 甘尔葛分析师：计谋网站seo关键词暴涨有什

11-06 蔡贵霖: 计谋网站seo关键词暴涨有什么秘密

11-06 博益网首页:ao3网页版进入不了解决方法

11-06 漏斗子专栏: 网站数据分析小白易懂精华篇

11-06 见证双虹怎么做:win7系统开启telnet命令的

11-06 颾狐蝶蜋:系统资源不足无法完成请求的服务

11-06 国光中学校歌:提交网站到alexa查询详细步骤

11-06 西安有情天:静态网页和动态网页的区别

11-06 红木雅尚斋:外部链接构造对网站的好处

11-06 前官礼遇：防止域名劫持–增强域安全性的10

11-06 密传二转答案: 中文分词算法有哪些

11-06 金泉家园邮编:百度快照劫持的表现及应对方

MATLAB使用入门 - 岚之山发布时间：2022-07-18

DelphiAndroid程序启动过程发布时间：2022-07-18

剪的笔顺,诠释剪的笔画,认识剪的部首

1 六六分期app的软件客服如何联系？(六六分期

六六分期app的软件客服如何联系？不知道吗？加qq群【895510560】即可！标题：六六分期

阅读：19099|2023-10-27

2 可心卡盟:win10系统火狐flash插件崩溃怎么

今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题，可能很多用户都不知

阅读：9966|2022-11-06

3 亲亲特价:怎么删除回收站图标

今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置，可能很多用户都不知道

阅读：8313|2022-11-06

4 济南大学虚拟社区:鲁大师节能降温的具体办

今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法，想必大家都遇到过需要

阅读：8684|2022-11-06

5 xlueops.exe:无线网络安装向导

我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置，可能很多

阅读：8624|2022-11-06

6 女斗合众国:win7系统cf与主机连接不稳定怎

今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题，可能很多用户都不

阅读：9639|2022-11-06

7 0xc000022-[cf烟雾头]cf怎么调烟雾头

电脑对日常生活的重要性小编就不多说了，可是一旦碰到win7系统设置cf烟雾头的问题，很

阅读：8609|2022-11-06

8 qizideyouhuo:应用程序无法正常启动0xc0000

我们在日常使用电脑的时候，有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法

阅读：7989|2022-11-06

9 ipz-185:win7系统vcf文件怎么打开

今天小编告诉大家如何对win7系统打开vcf文件进行设置，可能很多用户都不知道怎么对win

阅读：8635|2022-11-06

10 傻哥蹦迪:win10系统s4怎么打开usb调试

今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置，可能很多用户都不知道怎

阅读：7526|2022-11-06

客服电话

电子邮件

Delphi下一个封装较为完整的DBGrid-Excel类

请发表评论

全部评论

上一篇：

下一篇：

librespeed/speedtest: Self-hosted Speedt

CVE-2022-22999

avehtari/BDA_m_demos: Bayesian Data Anal

四维彩超怎么看性别？四维看男孩女孩诀窍

十部经典的抗战小说推荐

剪的笔顺,诠释剪的笔画,认识剪的部首

六六分期app的软件客服如何联系？(六六分期

florent37/ViewAnimator: A fluent Android

florent37/Shrine-MaterialDesign2: implem

CVE-2020-36276

SimpleSoftwareIO/simple-sms: Send and re

关于我们

产品与服务

解决方案

139-2527-9053