unit utExcelClass;
{
此种方法通过写磁盘文件方式导出EXCEL比较快,
但是在导出来的OPENOFFICE打开时 中文为乱码,MS、WPS中文正常,
暂时没有找到解决方法。
待用 2013-09-27
}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,GridsEh, DBGridEh,
Dialogs, StdCtrls, Grids, DBGrids, DB, ADODB,ComCtrls;
var
CXlsBof: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
CXlsEof: array[0..1] of Word = ($0A, 00);
CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0);
CXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);
type
ExportXls = class(TObject)
private
FCol: word;
FRow: word;
FDbgrid:TDBGrid;
FDbgridEh:TDBGridEh;
FStrGrid:TStringGrid;
Stream: TStream;
FWillWriteHead: boolean;
FBookMark: TBookmark;
procedure IncColRow;
procedure WriteBlankCell;
procedure WriteFloatCell(const AValue: Double);
procedure WriteIntegerCell(const AValue: Integer);
procedure WriteStringCell(const AValue: string);
procedure WritePrefix;
procedure WriteSuffix;
procedure WriteTitle;
procedure WriteDataCell;
procedure Save2Stream(aStream: TStream);
public
procedure Save2File(FileName: string; WillWriteHead: Boolean);
constructor Create(aDbgrid:TDBGrid=nil;
aDbgridEh:TDBGridEh=nil;
aStrGrid:TStringGrid=nil);
end;
function ExportToXLS( sFileName: string='';
dbGrid: TDBGrid=nil;
dbgridEh:TDBGridEh=nil;
strGrid:TStringGrid=nil): Boolean;
function ShowProgressBarForm(maxCount:Integer):TProgressBar;
var tempSaveFile:string;
implementation
function ShowProgressBarForm(maxCount:Integer):TProgressBar;
var tempProgressBar:TProgressBar;
tempForm:TForm;
templabel:TLabel;
begin
Application.CreateForm(TForm,tempForm);
tempForm.Position:=poScreenCenter;
tempForm.BorderStyle:=bsNone;
tempForm.Height:=50;
tempForm.Width:=300;
tempProgressBar:=TProgressBar.Create(tempForm);
tempProgressBar.ParentWindow:=tempForm.Handle;
tempProgressBar.Align:=alTop;
tempProgressBar.Height:=30;
tempProgressBar.Width:=300;
tempProgressBar.Visible:=True;
tempProgressBar.Smooth:=True;
tempProgressBar.Max:=maxCount;
tempProgressBar.Step:=1;
templabel:=TLabel.Create(tempForm);
templabel.Align:=alBottom;
templabel.Parent:=tempForm;
templabel.Height:=15;
templabel.Width:=300;
templabel.Visible:=True;
templabel.Caption:='正在导出,请等待.......';
templabel.Name:='Label1';
tempForm.Show;
templabel.Update;
tempProgressBar.Update;
Application.ProcessMessages;
Result:=tempProgressBar;
end;
function ExportToXLS( sFileName: string='';
dbGrid: TDBGrid=nil;
dbgridEh:TDBGridEh=nil;
strGrid:TStringGrid=nil): Boolean;
var savedialog: TSaveDialog;
strsavefile: string;
begin
tempSaveFile:='';
Result := False;
try
savedialog := TSaveDialog.Create(nil);
begin
savedialog.Filter := '*.xls|*.xls|*.ods|*.ods|*.xlsx|*.xlsx|*.et|*.et';
savedialog.FileName:=sFileName;
if not savedialog.Execute then Exit;
strsavefile:=savedialog.FileName;
end;
finally
savedialog.Free;
end;
Application.ProcessMessages;
if Length(strsavefile) = 0 then
begin
Result:=False;
Exit;
end;
if Pos('.xls', strsavefile) <= 0 then
strsavefile := strsavefile + '.xls';
tempSaveFile:=strsavefile;
with ExportXls.Create(dbGrid,dbgridEh,strGrid) do
try
Save2File(strsavefile, True);
Result := True;
finally
Free;
end;
end;
constructor ExportXls.Create(aDbgrid:TDBGrid=nil;
aDbgridEh:TDBGridEh=nil;
aStrGrid:TStringGrid=nil);
begin
inherited Create;
if aDbgrid<>nil then FDbgrid:=aDbgrid;
if aDbgridEh<>nil then FDbgridEh:=aDbgridEh;
if aStrGrid<>nil then FStrGrid:=aStrGrid;
end;
procedure ExportXls.IncColRow;
var GridFieldCount:Integer;
i:Integer;
begin
GridFieldCount:=0;
if FDbgrid<>nil then
begin
for I := 0 to FDbgrid.Columns.Count-1 do
begin
if FDbgrid.Columns[i].Visible=False then
Continue;
Inc(GridFieldCount);
end;
end;
if FDbgridEh<>nil then
begin
for I := 0 to FDbgridEh.Columns.Count-1 do
begin
if FDbgridEh.Columns[i].Visible=False then
Continue;
Inc(GridFieldCount);
end;
end;
if FStrGrid<>nil then
GridFieldCount:=FStrGrid.ColCount;
if FCol = GridFieldCount - 1 then
begin
Inc(FRow);
FCol := 0;
end
else
Inc(FCol);
end;
procedure ExportXls.WriteBlankCell;
begin
CXlsBlank[2] := FRow;
CXlsBlank[3] := FCol;
Stream.WriteBuffer(CXlsBlank, SizeOf(CXlsBlank));
IncColRow;
end;
procedure ExportXls.WriteFloatCell(const AValue: Double);
begin
CXlsNumber[2] := FRow;
CXlsNumber[3] := FCol;
Stream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
Stream.WriteBuffer(AValue, 8);
IncColRow;
end;
procedure ExportXls.WriteIntegerCell(const AValue: Integer);
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);
IncColRow;
end;