其实用这些控件是通过Ole来实现的
速度是非常的慢
给你一个不需要Excel/不需要OLE/不需要ADO的程序,速度很快的
unit XLSFile;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Grids, Forms, Dialogs,db,dbctrls,comctrls;
const
{BOF}
CBOF = $0009;
BIT_BIFF5 = $0800;
BOF_BIFF5 = CBOF or BIT_BIFF5;
{EOF}
BIFF_EOF = $000a;
{Document types}
do
CTYPE_XLS = $0010;
{Dimensions}
DIMENSIONS = $0000;
type
TAtributCell = (acHidden,acLocked,acShaded,acBottomBorder,acTopBorder,
acRightBorder,acLeftBorder,acLeft,acCenter,acRight,acFill);
TSetOfAtribut = set of TatributCell;
TXLSWriter = class(Tobject)
private
FStream:TFileStream;
procedure WriteWord(w:word);
protected
procedure WriteBOF;
procedure WriteEOF;
procedure WriteDimension;
public
MaxCols,MaxRows:Word;
procedure CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
procedure CellDouble(vCol,vRow:word;aValue:double;vAtribut:TSetOfAtribut=[]);
procedure CellStr(vCol,vRow:word;aValue:String;vAtribut:TSetOfAtribut=[]);
procedure WriteField(vCol,vRow:word;Field:TField);
constructor Create(vFileName:string);
destructor Destroy;override;
end;
procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
procedure DataSetToXLS(DS:TDataSet;fname:String;PB1:TProgressBar);
procedure StringGridToXLS(grid:TStringGrid;fname:String);
implementation
procedure DataSetToXLS(DS:TDataSet;fname:String;PB1:TProgressBar);
var
c,r,RCount:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
if DS.FieldCount > xls.MaxCols then
xls.MaxCols:=DS.FieldCount+1;
RCount:=DS.RecordCount;
with PB1do
begin
Min:=0;
Max:=RCount;
Step:=1;
end;
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to DS.FieldCount-1do
begin
xls.Cellstr(0,c,DS.Fields[c].FieldName);
end;
r:=1;
DS.DisableControls;
DS.first;
while (not DS.eof) and (r <= xls.MaxRows)do
begin
for c:=0 to DS.FieldCount-1do
begin
xls.WriteField(r,c,DS.Fields[c]);
end;
inc(r);
PB1.StepIt;
Application.ProcessMessages;
DS.next;
end;
xls.writeEOF;
finally
DS.EnableControls;
xls.free;
end;
end;
procedure StringGridToXLS(grid:TStringGrid;fname:String);
var
c,r,rMax:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
rMax:=grid.RowCount;
if grid.ColCount > xls.MaxCols then
xls.MaxCols:=grid.ColCount+1;
if rMax > xls.MaxRows then
rMax:=xls.MaxRows;
// ??Α程???? 65535 Rows
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to grid.ColCount-1do
for r:=0 to rMax-1do
xls.Cellstr(r,c,grid.Cells[c,r]);
xls.writeEOF;
finally
xls.free;
end;
end;
{ TXLSWriter }
constructor TXLSWriter.create(vFileName:string);
begin
inherited create;
if FileExists(vFilename) then
FStream:=TFileStream.Create(vFilename,fmOpenWrite)
else
FStream:=TFileStream.Create(vFilename,fmCreate);
MaxCols:=100;
// Column 莱赣琌ぃ???? 65535, ┮?ぃ?矪瞶
MaxRows:=65535;
// 硂??Α程???硂或??叫猔種??戈?畐?甧?碞??硂??
end;
destructor TXLSWriter.destroy;
begin
if FStream <> nil then
FStream.free;
inherited;
end;
procedure TXLSWriter.WriteBOF;
begin
Writeword(BOF_BIFF5);
Writeword(6);
// count of bytes
Writeword(0);
Writeword(DOCTYPE_XLS);
Writeword(0);
end;
procedure TXLSWriter.WriteDimension;
begin
Writeword(DIMENSIONS);
// dimension OP Code
Writeword(8);
// count of bytes
Writeword(0);
// min cols
Writeword(MaxRows);
// max rows
Writeword(0);
// min rowss
Writeword(MaxCols);
// max cols
end;
procedure TXLSWriter.CellDouble(vCol, vRow: word;
aValue:do
uble;vAtribut: TSetOfAtribut);
var
FAtribut:array [0..2] of byte;
begin
Writeword(3);
// opcode fordo
uble
Writeword(15);
// count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
FStream.Write(fAtribut,3);
FStream.Write(aValue,8);
end;
procedure TXLSWriter.CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
var FAtribut:array [0..2] of byte;
begin
Writeword(2);
// opcode for word
Writeword(9);
// count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
FStream.Write(fAtribut,3);
Writeword(aValue);
end;
procedure TXLSWriter.CellStr(vCol, vRow: word;
aValue: String;
vAtribut: TSetOfAtribut);
var
FAtribut:array [0..2] of byte;
slen:byte;
begin
Writeword(4);
// opcode for string
slen:=length(avalue);
Writeword(slen+8);
// count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
FStream.Write(fAtribut,3);
FStream.Write(slen,1);
if Trim(aValue)='' then
FStream.Write('',Slen)
else
FStream.Write(aValue[1],Slen);
end;
procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
var
i:integer;
begin
//reset
for i:=0 to High(FAtribut)do
FAtribut:=0;
// bit sequence 76543210
if acHidden in value then
FAtribut[0] := FAtribut[0] + 128;
//byte 0 bit 7:
if acLocked in value then
FAtribut[0] := FAtribut[0] + 64 ;
//byte 0 bit 6:
if acShaded in value then
FAtribut[2] := FAtribut[2] + 128;
//byte 2 bit 7:
if acBottomBorder in value then
FAtribut[2] := FAtribut[2] + 64 ;//byte 2 bit 6
if acTopBorder in value then
FAtribut[2] := FAtribut[2] + 32;
//byte 2 bit 5
if acRightBorder in value then
FAtribut[2] := FAtribut[2] + 16;
//byte 2 bit 4
if acLeftBorder in value then
FAtribut[2] := FAtribut[2] + 8;
//byte 2 bit 3
// 程? 3 bit 莱?Τ 1 贺匡拒
if acLeft in value then
FAtribut[2] := FAtribut[2] + 1 //byte 2 bit 1
else
if acCenter in value then
FAtribut[2] := FAtribut[2] + 2 //byte 2 bit 1
else
if acRight in value then
FAtribut[2] := FAtribut[2] + 3 //byte 2, bit 0 dan bit 1
else
if acFill in value then
FAtribut[2] := FAtribut[2] + 4;
//byte 2, bit 0
end;
procedure TXLSWriter.WriteWord(w: word);
begin
FStream.Write(w,2);
end;
procedure TXLSWriter.WriteEOF;
begin
Writeword(BIFF_EOF);
Writeword(0);
end;
procedure TXLSWriter.WriteField(vCol, vRow: word;
Field: TField);
begin
case field.DataType of
ftString,ftWideString,ftBoolean,ftDate,ftDateTime,ftTime:
Cellstr(vcol,vrow,field.asstring);
ftAutoInc,ftSmallint,ftInteger,ftWord:
CellWord(vcol,vRow,field.AsInteger);
ftFloat, ftBCD:
CellDouble(vcol,vrow,field.AsFloat);
else
Cellstr(vcol,vrow,EmptyStr);
// ㄤ??篈糶??フ?﹃
end;
end;
end.