unit DataSetToExcelUnt;interfaceuses Classes, SysUtils, DB, DBGrids;type
{1 将数据源倒出 }
TExports = class(TObject)
private
FBookMark: TBookMark;
FCaption: string;
FCol: Word;
FDataSet: TDataSet;
FDBGrid: TDBGrid;
FFileStream: TFileStream;
FRow: Word;
protected
procedure incColRow;
procedure WriteFloatCell(AValue: double);
procedure WriteIntegerCell(AValue: integer);
procedure WriteStringCell(AValue: string);
public
procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean = True;
aDataSet: TDataSet = nil); overload;
procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean = True;
aDBgrid: TDBGrid = nil); overload;
procedure WriteCaption;
{1 标题 }
property Caption: string read FCaption write FCaption;
end;
var
DataSetExportExcel: TExports; arXlsBegin : array[0..5] of Word = ($809, 8, 0, $10, 0, 0); arXlsEnd : array[0..1] of Word = ($0A, 00); arXlsString : array[0..5] of Word = ($204, 0, 0, 0, 0, 0); arXlsNumber : array[0..4] of Word = ($203, 14, 0, 0, 0); arXlsInteger : array[0..4] of Word = ($27E, 10, 0, 0, 0); arXlsBlank : array[0..4] of Word = ($201, 6, 0, 0, $17);implementation
{1 将数据源倒出 }
{1 将数据源倒出 }
{1 将数据源倒出 }
{1 将数据源倒出 }
{1 将数据源倒出 }
{1 将数据源倒出 }
{1 将数据源倒出 }
{
*********************************** TExports ***********************************
}
procedure TExports.ExportExcelFile(FileName: string; bWriteTitle: Boolean =
True; aDataSet: TDataSet = nil);
var
i: Integer;
begin
if Assigned(aDataSet) then
begin
FDataSet := aDataSet;
end;
if FileExists(FileName) then
DeleteFile(FileName); //文件存在,先删除
FFileStream := TFileStream.Create(FileName, fmCreate);
try
//写文件头
FFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin));
//写列头
FCol := 0;
FRow := 0;
WriteCaption();
if bWriteTitle then
begin
for i := 0 to FDataSet.FieldCount - 1 do
WriteStringCell(FDataSet.Fields[i].FieldName);
end;
//写数据集中的数据
FDataSet.DisableControls;
FBookMark := FDataSet.GetBook;
FDataSet.First;
while not FDataSet.Eof do
begin
for i := 0 to FDataSet.FieldCount - 1 do
begin
case FDataSet.Fields[i].DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
WriteIntegerCell(FDataSet.Fields[i].AsInteger);
ftFloat, ftCurrency, ftBCD:
WriteFloatCell(FDataSet.Fields[i].AsFloat)
else
WriteStringCell(FDataSet.Fields[i].AsString);
end;
end;
FDataSet.Next;
end;
//写文件尾
FFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));
if FDataSet.BookValid(FBookMark) then
begin
FDataSet.GotoBook(FBookMark);
end;
finally
FFileStream.Free;
FDataSet.EnableControls;
FDataSet := nil;
end;
end;procedure TExports.ExportExcelFile(FileName: string; bWriteTitle: Boolean =
True; aDBgrid: TDBGrid = nil);
var
i: Integer;
begin
if Assigned(aDBgrid) then
begin
FDBGrid := aDBgrid;
end;
if FileExists(FileName) then
DeleteFile(FileName); //文件存在,先删除
FFileStream := TFileStream.Create(FileName, fmCreate);
try
//写文件头
FFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin));
//写列头
FCol := 0;
FRow := 0;
WriteCaption();
if bWriteTitle then
begin
for i := 0 to FDBGrid.FieldCount - 1 do
WriteStringCell(FDBGrid.Columns[i].Title.Caption);
end;
//写数据集中的数据
FDBGrid.DataSource.DataSet.DisableControls;
FBookMark := FDBGrid.DataSource.DataSet.GetBook;
FDBGrid.DataSource.DataSet.First;
while not FDBGrid.DataSource.DataSet.Eof do
begin
for i := 0 to FDBGrid.FieldCount - 1 do
begin
case FDBGrid.Fields[i].DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
WriteIntegerCell(FDBGrid.Fields[i].AsInteger);
ftFloat, ftCurrency, ftBCD:
WriteFloatCell(FDBGrid.Fields[i].AsFloat)
else
WriteStringCell(FDBGrid.Fields[i].AsString);
end;
end;
FDBGrid.DataSource.DataSet.Next;
end;
//写文件尾
FFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));
if FDBGrid.DataSource.DataSet.BookValid(FBookMark) then
begin
FDBGrid.DataSource.DataSet.GotoBook(FBookMark);
end;
finally
FFileStream.Free;
FDBGrid.DataSource.DataSet.EnableControls;
FDBGrid := nil;
end;
end;{1 增加行列号 }
procedure TExports.incColRow;
var
FieldCount: Integer;
begin
if Assigned(FDataSet) then
begin
FieldCount := FDataSet.FieldCount - 1;
end;
if Assigned(FDBGrid) then
begin
FieldCount := FDBGrid.FieldCount - 1;
end;
if FCol = FieldCount then
begin
Inc(FRow);
FCol := 0;
end else
begin
Inc(FCol);
end;
end;procedure TExports.WriteCaption;
begin
WriteStringCell(FCaption);
Inc(FRow);
FCol := 0;
end;{1 写浮点数 }
procedure TExports.WriteFloatCell(AValue: double);
begin
arXlsNumber[2] := FRow;
arXlsNumber[3] := FCol;
FFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber));
FFileStream.WriteBuffer(AValue, 8);
IncColRow;
end;{1 写整数 }
procedure TExports.WriteIntegerCell(AValue: integer);
var
V: Integer;
begin
arXlsInteger[2] := FRow;
arXlsInteger[3] := FCol;
FFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));
V := (AValue shl 2) or 2;
FFileStream.WriteBuffer(V, 4);
IncColRow;
end;{1 写字符串数据 }
procedure TExports.WriteStringCell(AValue: string);
var
L: Word;
begin
L := Length(AValue);
arXlsString[1] := 8 + L;
arXlsString[2] := FRow;
arXlsString[3] := FCol;
arXlsString[5] := L;
FFileStream.WriteBuffer(arXlsString, SizeOf(arXlsString));
FFileStream.WriteBuffer(Pointer(AValue)^, L);
IncColRow;
end;initialization
if not Assigned(DataSetExportExcel) then
begin
DataSetExportExcel := TExports.Create;
end;finalization
if Assigned(DataSetExportExcel) then
begin
DataSetExportExcel.Free;
end;end.
{1 将数据源倒出 }
TExports = class(TObject)
private
FBookMark: TBookMark;
FCaption: string;
FCol: Word;
FDataSet: TDataSet;
FDBGrid: TDBGrid;
FFileStream: TFileStream;
FRow: Word;
protected
procedure incColRow;
procedure WriteFloatCell(AValue: double);
procedure WriteIntegerCell(AValue: integer);
procedure WriteStringCell(AValue: string);
public
procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean = True;
aDataSet: TDataSet = nil); overload;
procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean = True;
aDBgrid: TDBGrid = nil); overload;
procedure WriteCaption;
{1 标题 }
property Caption: string read FCaption write FCaption;
end;
var
DataSetExportExcel: TExports; arXlsBegin : array[0..5] of Word = ($809, 8, 0, $10, 0, 0); arXlsEnd : array[0..1] of Word = ($0A, 00); arXlsString : array[0..5] of Word = ($204, 0, 0, 0, 0, 0); arXlsNumber : array[0..4] of Word = ($203, 14, 0, 0, 0); arXlsInteger : array[0..4] of Word = ($27E, 10, 0, 0, 0); arXlsBlank : array[0..4] of Word = ($201, 6, 0, 0, $17);implementation
{1 将数据源倒出 }
{1 将数据源倒出 }
{1 将数据源倒出 }
{1 将数据源倒出 }
{1 将数据源倒出 }
{1 将数据源倒出 }
{1 将数据源倒出 }
{
*********************************** TExports ***********************************
}
procedure TExports.ExportExcelFile(FileName: string; bWriteTitle: Boolean =
True; aDataSet: TDataSet = nil);
var
i: Integer;
begin
if Assigned(aDataSet) then
begin
FDataSet := aDataSet;
end;
if FileExists(FileName) then
DeleteFile(FileName); //文件存在,先删除
FFileStream := TFileStream.Create(FileName, fmCreate);
try
//写文件头
FFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin));
//写列头
FCol := 0;
FRow := 0;
WriteCaption();
if bWriteTitle then
begin
for i := 0 to FDataSet.FieldCount - 1 do
WriteStringCell(FDataSet.Fields[i].FieldName);
end;
//写数据集中的数据
FDataSet.DisableControls;
FBookMark := FDataSet.GetBook;
FDataSet.First;
while not FDataSet.Eof do
begin
for i := 0 to FDataSet.FieldCount - 1 do
begin
case FDataSet.Fields[i].DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
WriteIntegerCell(FDataSet.Fields[i].AsInteger);
ftFloat, ftCurrency, ftBCD:
WriteFloatCell(FDataSet.Fields[i].AsFloat)
else
WriteStringCell(FDataSet.Fields[i].AsString);
end;
end;
FDataSet.Next;
end;
//写文件尾
FFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));
if FDataSet.BookValid(FBookMark) then
begin
FDataSet.GotoBook(FBookMark);
end;
finally
FFileStream.Free;
FDataSet.EnableControls;
FDataSet := nil;
end;
end;procedure TExports.ExportExcelFile(FileName: string; bWriteTitle: Boolean =
True; aDBgrid: TDBGrid = nil);
var
i: Integer;
begin
if Assigned(aDBgrid) then
begin
FDBGrid := aDBgrid;
end;
if FileExists(FileName) then
DeleteFile(FileName); //文件存在,先删除
FFileStream := TFileStream.Create(FileName, fmCreate);
try
//写文件头
FFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin));
//写列头
FCol := 0;
FRow := 0;
WriteCaption();
if bWriteTitle then
begin
for i := 0 to FDBGrid.FieldCount - 1 do
WriteStringCell(FDBGrid.Columns[i].Title.Caption);
end;
//写数据集中的数据
FDBGrid.DataSource.DataSet.DisableControls;
FBookMark := FDBGrid.DataSource.DataSet.GetBook;
FDBGrid.DataSource.DataSet.First;
while not FDBGrid.DataSource.DataSet.Eof do
begin
for i := 0 to FDBGrid.FieldCount - 1 do
begin
case FDBGrid.Fields[i].DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
WriteIntegerCell(FDBGrid.Fields[i].AsInteger);
ftFloat, ftCurrency, ftBCD:
WriteFloatCell(FDBGrid.Fields[i].AsFloat)
else
WriteStringCell(FDBGrid.Fields[i].AsString);
end;
end;
FDBGrid.DataSource.DataSet.Next;
end;
//写文件尾
FFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));
if FDBGrid.DataSource.DataSet.BookValid(FBookMark) then
begin
FDBGrid.DataSource.DataSet.GotoBook(FBookMark);
end;
finally
FFileStream.Free;
FDBGrid.DataSource.DataSet.EnableControls;
FDBGrid := nil;
end;
end;{1 增加行列号 }
procedure TExports.incColRow;
var
FieldCount: Integer;
begin
if Assigned(FDataSet) then
begin
FieldCount := FDataSet.FieldCount - 1;
end;
if Assigned(FDBGrid) then
begin
FieldCount := FDBGrid.FieldCount - 1;
end;
if FCol = FieldCount then
begin
Inc(FRow);
FCol := 0;
end else
begin
Inc(FCol);
end;
end;procedure TExports.WriteCaption;
begin
WriteStringCell(FCaption);
Inc(FRow);
FCol := 0;
end;{1 写浮点数 }
procedure TExports.WriteFloatCell(AValue: double);
begin
arXlsNumber[2] := FRow;
arXlsNumber[3] := FCol;
FFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber));
FFileStream.WriteBuffer(AValue, 8);
IncColRow;
end;{1 写整数 }
procedure TExports.WriteIntegerCell(AValue: integer);
var
V: Integer;
begin
arXlsInteger[2] := FRow;
arXlsInteger[3] := FCol;
FFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));
V := (AValue shl 2) or 2;
FFileStream.WriteBuffer(V, 4);
IncColRow;
end;{1 写字符串数据 }
procedure TExports.WriteStringCell(AValue: string);
var
L: Word;
begin
L := Length(AValue);
arXlsString[1] := 8 + L;
arXlsString[2] := FRow;
arXlsString[3] := FCol;
arXlsString[5] := L;
FFileStream.WriteBuffer(arXlsString, SizeOf(arXlsString));
FFileStream.WriteBuffer(Pointer(AValue)^, L);
IncColRow;
end;initialization
if not Assigned(DataSetExportExcel) then
begin
DataSetExportExcel := TExports.Create;
end;finalization
if Assigned(DataSetExportExcel) then
begin
DataSetExportExcel.Free;
end;end.
uses DataSetToExcelUnt;然后,再需要用的地方,用如下:
DataSetExportExcel.ExportExcelFile('你要导出的文件名',rue, adoDataset1 as TDataSet);或者
DataSetExportExcel.ExportExcelFile('你要导出的文件名',rue, dbgrid1);那个adodataset1 或者 dbgrid1就是你自己要导出的
来设置标题