怎样把数据库的查询结果保存到电子表格文件中
解决方案 »
- FindResource中的Hinstance如何获得?
- 请问如何关闭一个ACCESS数据库文件?
- 关于动态库的问题,哪位哥哥能出面救救我?--------UP有礼!
- 高分、在线等待 收邮件的时候出现错误提示:connection closed gracefully
- DELPHI里怎么定义日期类型??99/05/01-99/06/01怎么做??
- 如何在程序运行过程中随时在popupmenu对象中增加一个item
- com+完成后的分装问题
- 用adoquery建立的查询在执行时出错!
- 急救!!!出现“类型的实际和正式-增值转卖商参数必须是相同的(英文是: Types of actual and formal var parameters must be identical)”的错误,怎么解决?
- 我有一个问题大家帮我UP一下
- 如何隐藏程序窗口?
- Tstringgrid中如何使某些编辑框显示灰色无法操作
Windows,Graphics,DB,Grids, DBGrids,StdCtrls,forms,Sysutils,classes,
Controls,comobj,comctrls,Dialogs,Variants;
function ExportToExcel(dbgrid:tdbgrid):boolean;
const
xlNormal=-4143;
var
i,j,k:integer;
str,filename:string;
excel:OleVariant;
SavePlace: TBook;
savedialog:tsavedialog;
ProgressBar1:TProgressBar;
begin
result:=false;
filename:='';
if not dbgrid.DataSource.DataSet.Active then
begin
application.MessageBox('数据集尚未打开!','错误',0);
exit;
end;
screen.Cursor:=crHourGlass;
try
excel:=CreateOleObject('Excel.Application');
excel.workbooks.add;
except
screen.cursor:=crDefault;
showmessage('无法调用Excel!');
exit;
end;
savedialog:=tsavedialog.Create(nil);
savedialog.Filter:='Excel文件(*.xls)|*.xls';
if savedialog.Execute then
begin
if FileExists(savedialog.FileName) then
try
if application.messagebox('该文件已经存在,要覆盖吗?','询问',mb_yesno+mb_iconquestion)=idyes then
DeleteFile(PChar(savedialog.FileName))
else
begin
Excel.Quit;
savedialog.free;
screen.cursor:=crDefault;
Exit;
end;
except
Excel.Quit;
savedialog.free;
screen.cursor:=crDefault;
Exit;
end;
filename:=savedialog.FileName;
end;
savedialog.free;
if filename='' then
begin
result:=true;
Excel.Quit;
screen.cursor:=crDefault;
exit;
end;
k:=0;
for i:=0 to dbgrid.Columns.count-1 do
begin
if dbgrid.Columns.Items[i].Visible then
begin
//Excel.Columns[k+1].ColumnWidth:=dbgrid.Columns.Items[i].Title.Column.Width;
excel.cells[1,k+1]:=dbgrid.Columns.Items[i].Title.Caption;
inc(k);
end;
end;
dbgrid.DataSource.DataSet.DisableControls;
saveplace:=dbgrid.DataSource.DataSet.GetBook;
dbgrid.DataSource.dataset.First;
i:=2;
ProgressBar1:=ProgressBarform(dbgrid.DataSource.DataSet.RecordCount);
while not dbgrid.DataSource.dataset.Eof do
begin
k:=0;
for j:=0 to dbgrid.Columns.count-1 do
begin
if dbgrid.Columns.Items[j].Visible then
begin
excel.cells[i,k+1].NumberFormat:='@';
if not dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).isnull then
begin
str:=dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).value;
Excel.Cells[i, k + 1] := Str;
end;
inc(k);
end
else
continue;
end;
inc(i);
ProgressBar1.StepBy(1);
dbgrid.DataSource.dataset.next;
end;
progressbar1.Parent.Free;
dbgrid.DataSource.dataset.GotoBook(SavePlace);
dbgrid.DataSource.dataset.EnableControls;
try
if copy(FileName,length(FileName)-3,4)<>'.xls' then
FileName:=FileName+'.xls';
Excel.ActiveWorkbook.SaveAs(FileName, xlNormal, '', '', False, False);
except
Excel.Quit;
screen.cursor:=crDefault;
exit;
end;
Excel.Visible := true;
screen.cursor:=crDefault;
Result := true;
end;
function ProgressBarform(max:integer):tProgressBar;
var
ProgressBar1:tProgressBar;
form:tform;
begin
application.CreateForm(tform,form);
form.Position:=poScreenCenter;
form.BorderStyle:=bsnone;
form.Height:=30;
form.Width:=260;
ProgressBar1:=tProgressBar.Create(form);
ProgressBar1.Smooth:=true;
ProgressBar1.Max:=max;
ProgressBar1.Parent:=form;
ProgressBar1.Height:=20;
ProgressBar1.Width:=250;
ProgressBar1.Left:=5;
ProgressBar1.Top:=5;
ProgressBar1.Step:=1;
form.Show;
result:=ProgressBar1;
end;
interface
uses
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, Db, DBGrids, Comobj, extctrls, comctrls, ActiveX;
type
TSpaceMark = (csComma, csSemicolon, csTab, csBlank, csEnter);
TDBGridExport = class(TComponent)
private
FDB_Grid: TDBGrid; {读取DBGrid的源}
FTxtFileName: string; {文本文件名}
FSpaceMark: TSpaceMark; {间隔符号}
FSpace_Ord: Integer; {间隔符号的Asc数值}
FTitle: string; {显示的标题}
FSheetName: string; {工作表标题}
FExcel_Handle: OleVariant; {Excel的句柄}
FWorkbook_Handle: OleVariant; {书签的句柄}
FShow_Progress: Boolean; {是否显示插入进度}
FProgress_Form: TForm; {进度窗体}
FRun_Excel_Form: TForm; {启动Excel提示窗口}
FProgressBar: TProgressBar; {进度条}
function Connect_Excel: Boolean; {启动Excel}
function New_Workbook: Boolean; {插入新的工作博}
function InsertData_To_Excel: Boolean; {插入数据}
procedure Create_ProgressForm(AOwner: TComponent); {创建进度显示窗口}
procedure Create_Run_Excel_Form(AOwner: TComponent); {创建启动Excel窗口}
procedure SetSpaceMark(Value: TSpaceMark); {设置导出时的间隔符号}
protected
public
constructor Create(AOwner: TComponent); override; {新建}
destructor Destroy; override; {销毁}
function Export_To_Excel: Boolean; overload; {导出到Excel中}
function Export_To_Excel(DB_Grid: TDBGrid): Boolean; overload;
function Export_To_Txt(NewFile: Boolean = True): Boolean; overload; {导出到文本文件中}
function Export_To_Txt(FileName: string; NewFile: Boolean = True): Boolean; overload;
function Export_To_Txt(DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean; overload;
function Export_To_Txt(FileName: string; DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean; overload;
published
property DB_Grid: TDBGrid read FDB_Grid write FDB_Grid;
property Show_Progress: Boolean read FShow_Progress write FShow_Progress;
property TxtFileName: string read FTxtFileName write FTxtFileName;
property SpaceMark: TSpaceMark read FSpaceMark write SetSpaceMark;
property Title: string read FTitle write FTitle;
property SheetName: string read FSheetName write FSheetName;
end;procedure Register;implementationprocedure Register;begin
RegisterComponents('Stone', [TDBGridExport]);
end;
{-------------------------------------------------------------------------------}
{新建}
constructor TDBGridExport.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FShow_Progress := True;
FSpaceMark := csTab;
end;{销毁}
destructor TDBGridExport.Destroy;
begin
varClear(FExcel_Handle);
varClear(FWorkbook_Handle);
inherited Destroy;
end;
{===============================================================================}
{导出到文本文件中}
function TDBGridExport.Export_To_Txt(NewFile: Boolean = True): Boolean;
var
Txt: TStrings;
Tmp_Str,data_Str,Column_name: string;
i, j: Integer;
Data_Set: TDataSet;
book: pointer;
Before_Scroll, Afrer_Scroll: TDataSetNotifyEvent;
begin
Result := False;
if NewFile = True then
FTxtFileName := '';
if FTxtFileName = '' then
begin
with TSaveDialog.Create(nil) do
begin
Title := '请选择输出文件名';
DefaultExt := 'txt';
Filter := '文本文件(*.Txt)|*.txt';
Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofNoReadOnlyReturn, ofEnableSizing];
if Execute then
FTxtFileName := FileName;
Free;
if FTxtFileName = '' then {如果没有选中文件,则直接推出}
exit;
end; if FTxtFileName = '' then
begin
raise exception.Create('没有指定输出文件');
Exit;
end;
end;
if FDB_Grid = nil then
raise exception.Create('请输入DBGrid名称');
Txt := TStringList.Create;
try{显示插入进度}
if FShow_Progress = True then
begin
Create_ProgressForm(nil);
FProgress_Form.Show;
end;
{第一行,插入标题}
Tmp_Str := ''; //FDB_Grid.Columns[0].Title.Caption;
for i := 1 to FDB_Grid.Columns.Count do
if FDB_Grid.Columns[i - 1].Visible = True then
Tmp_Str := Tmp_Str + FDB_Grid.Columns[i - 1].Title.Caption + Chr(FSpace_Ord);
Tmp_Str := Copy(Tmp_Str, 1, Length(Tmp_Str) - 1);
Txt.Add(Tmp_Str);
{插入DBGrid中的数据}
Data_Set := FDB_Grid.DataSource.DataSet;
{记忆当前位置并取消任何事件}
// new(book);
book := Data_Set.GetBook;
Data_Set.DisableControls;
Before_Scroll := Data_Set.BeforeScroll;
Afrer_Scroll := Data_Set.AfterScroll;
Data_Set.BeforeScroll := nil;
Data_Set.AfterScroll := nil;
if FShow_Progress = True then
begin
Data_Set.Last;
FProgress_Form.Refresh;
FProgressBar.Max := Data_Set.RecordCount;
end;
{插入DBGrid中的所有字段}
Data_Set.First;
j := 2;
while not Data_Set.Eof do
begin
if FShow_Progress = True then
FProgressBar.Position := j - 2;
Column_name := FDB_Grid.Columns[0].FieldName;
Tmp_Str := ''; //Data_Set.FieldByName(Column_name).AsString;
for i := 1 to FDB_Grid.Columns.Count do
if FDB_Grid.Columns[i - 1].Visible = True then
begin
data_Str := FDB_Grid.Fields[i - 1].DisplayText;
Tmp_Str := Tmp_Str + data_Str + Chr(FSpace_Ord);
end;
Tmp_Str := Copy(Tmp_Str, 1, Length(Tmp_Str) - 1);
Txt.Add(Tmp_Str);
j := j + 1;
Data_Set.Next;
end;
{恢复原始事件以及标志位置}
Data_Set.GotoBook(book);
Data_Set.FreeBook(book);
// dispose(book);
Data_Set.EnableControls;
Data_Set.BeforeScroll := Before_Scroll;
Data_Set.AfterScroll := Afrer_Scroll;
{写到文件}
Txt.SaveToFile(FTxtFileName);
Result := True;
finally
Txt.Free;
if FShow_Progress = True then
begin
FProgress_Form.Free;
FProgress_Form := nil;
end;
end;
end;
begin
FTxtFileName := FileName;
Result := Export_To_Txt(NewFile);
end;function TDBGridExport.Export_To_Txt(DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean;
begin
FDB_Grid := DB_Grid;
Result := Export_To_Txt(NewFile);
end;function TDBGridExport.Export_To_Txt(FileName: string; DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean;
begin
FTxtFileName := FileName;
FDB_Grid := DB_Grid;
Result := Export_To_Txt(NewFile);
end;
{-------------------------------------------------------------------------------}
{设置导出时的间隔符号}
procedure TDBGridExport.SetSpaceMark(Value: TSpaceMark);
begin
FSpaceMark := Value;
case Value of
csComma: FSpace_Ord := ord(',');
csSemicolon: FSpace_Ord := ord(';');
csTab: FSpace_Ord := 9;
csBlank: FSpace_Ord := 32;
csEnter: FSpace_Ord := 13;
end;
end;
{===============================================================================}
{导出到Excel中}
function TDBGridExport.Export_To_Excel: Boolean;
begin
if FDB_Grid = nil then
raise exception.Create('请输入DBGrid名称');
Result := False;
if Connect_Excel = True then
if New_Workbook = True then
if InsertData_To_Excel = True then
Result := True;
end;function TDBGridExport.Export_To_Excel(DB_Grid: TDBGrid): Boolean;
begin
FDB_Grid := DB_Grid;
Result := Export_To_Excel;
end;
{-------------------------------------------------------------------------------}
{启动Excel}
function TDBGridExport.Connect_Excel: Boolean;
{连接Ole对象}
function My_GetActiveOleObject(const ClassName: string; out Ole_Handle: IDispatch): Boolean;
var //IDispatch
ClassID: TCLSID;
Unknown: IUnknown;
l_Result: HResult;
begin
Result := False;
l_Result := CLSIDFromProgID(PWideChar(WideString(ClassName)), ClassID);
if (l_Result and $80000000) = 0 then
begin
l_Result := GetActiveObject(ClassID, nil, Unknown);
if (l_Result and $80000000) = 0 then
begin
l_Result := Unknown.QueryInterface(IDispatch, Ole_Handle);
if (l_Result and $80000000) = 0 then
Result := True;
end;
end;
end;
{创建OLE对象}
function My_CreateOleObject(const ClassName: string; out Ole_Handle: IDispatch): Boolean;
var
ClassID: TCLSID;
l_Result: HResult;
begin
Result := False;
l_Result := CLSIDFromProgID(PWideChar(WideString(ClassName)), ClassID);
if (l_Result and $80000000) = 0 then
begin
l_Result := CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or
CLSCTX_LOCAL_SERVER, IDispatch, Ole_Handle);
if (l_Result and $80000000) = 0 then
Result := True;
end;
end;
var
l_Excel_Handle: IDispatch;
begin
if FShow_Progress = True then
begin
Create_Run_Excel_Form(nil);
FRun_Excel_Form.Show;
end;
if My_GetActiveOleObject('Excel.Application', l_Excel_Handle) = False then
if My_CreateOleObject('Excel.Application', l_Excel_Handle) = False then
begin
FRun_Excel_Form.Free;
FRun_Excel_Form := nil;
raise exception.Create('启动Excel失败,可能没有安装Excel!');
Result := False;
Exit;
end;
FExcel_Handle := l_Excel_Handle;
if FShow_Progress = True then
begin
FRun_Excel_Form.Free;
FRun_Excel_Form := nil;
end;
Result := True;
end;
{插入新的工作博}
function TDBGridExport.New_Workbook: Boolean;
var
i: Integer;
begin
Result := True;
try
FWorkbook_Handle := FExcel_Handle.Workbooks.Add;
except
raise exception.Create('新建Excel工作表出错!');
Result := False;
Exit;
end;
if FTitle <> '' then
FWorkbook_Handle.Application.ActiveWindow.Caption := FTitle;
if FSheetName <> '' then
begin
for i := 2 to FWorkbook_Handle.Sheets.Count do
if FSheetName = FWorkbook_Handle.Sheets[i].Name then
begin
raise exception.Create('工作表命名重复!');
Result := False;
exit;
end;
try
FWorkbook_Handle.Sheets[1].Name := FSheetName;
except
raise exception.Create('工作表命名错误!');
Result := False;
exit;
end;
end;
end;
{插入数据}
function TDBGridExport.InsertData_To_Excel: Boolean;
var
i, j, k: Integer;
data_Str: string;
Column_name: string;
Data_Set: TDataSet;
book: pointer;
Before_Scroll, Afrer_Scroll: TDataSetNotifyEvent;
begin
try
{显示插入进度}
if FShow_Progress = True then
begin
Create_ProgressForm(nil);
FProgress_Form.Show;
end;
{第一行,插入标题}{仅仅插入可见数据}
j := 1;
for i := 1 to FDB_Grid.Columns.Count do
if FDB_Grid.Columns[i - 1].Visible = True then
begin
FWorkbook_Handle.WorkSheets[1].Cells[1, j].Value := FDB_Grid.Columns[i - 1].Title.Caption;
FWorkbook_Handle.WorkSheets[1].Columns[j].ColumnWidth := FDB_Grid.Columns[i - 1].Width div 6;
j := j + 1
end;
{插入DBGrid中的数据}
Data_Set := FDB_Grid.DataSource.DataSet;
{记忆当前位置并取消任何事件}
// new(book);
book := Data_Set.GetBook;
Data_Set.DisableControls;
Before_Scroll := Data_Set.BeforeScroll;
Afrer_Scroll := Data_Set.AfterScroll;
Data_Set.BeforeScroll := nil;
Data_Set.AfterScroll := nil;
if FShow_Progress = True then
begin
Data_Set.Last;
FProgress_Form.Refresh;
FProgressBar.Max := Data_Set.RecordCount;
end;
Data_Set.First;
k := 2;
while not Data_Set.Eof do
begin
if FShow_Progress = True then
FProgressBar.Position := k;
j := 1;
for i := 1 to FDB_Grid.Columns.Count do
begin
if FDB_Grid.Columns[i - 1].Visible = True then
begin
Column_name := FDB_Grid.Columns[i - 1].FieldName;
data_Str := FDB_Grid.Fields[i - 1].DisplayText;
FWorkbook_Handle.WorkSheets[1].Cells[k, j].Value := data_Str;
j := j + 1;
end;
end;
k := k + 1;
Data_Set.Next;
end;
{恢复原始事件以及标志位置}
Data_Set.GotoBook(book);
Data_Set.FreeBook(book);
// dispose(book);
Data_Set.EnableControls;
Data_Set.BeforeScroll := Before_Scroll;
Data_Set.AfterScroll := Afrer_Scroll;
Result := True;
finally
FExcel_Handle.Visible := True;
FExcel_Handle.Application.ScreenUpdating := True;
if FShow_Progress = True then
begin
FProgress_Form.Free;
FProgress_Form := nil;
end;
end;
end;
{启动Excel时给出进度显示}
procedure TDBGridExport.Create_Run_Excel_Form(AOwner: TComponent);
var
Panel: TPanel;
Prompt: TLabel; {提示的标签}
begin
if assigned(FRun_Excel_Form) then exit;
FRun_Excel_Form := TForm.Create(AOwner);
with FRun_Excel_Form do
begin
try
Font.Name := '宋体'; {设置字体}
Font.Size := 9;
BorderStyle := bsNone;
Width := 300;
Height := 100;
BorderWidth := 2;
Color := clBlue;
Position := poScreenCenter;
Panel := TPanel.Create(FRun_Excel_Form);
with Panel do
begin
Parent := FRun_Excel_Form;
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 := '正在导出数据,请稍候……';
end;
except
end;
end;
end;
{===============================================================================}
{创建进度显示窗口}
procedure TDBGridExport.Create_ProgressForm(AOwner: TComponent);
var
Panel: TPanel;
Prompt: TLabel; {提示的标签}
begin
if assigned(FProgress_Form) then exit;
FProgress_Form := TForm.Create(AOwner);
with FProgress_Form do
begin
try
Font.Name := '宋体'; {设置字体}
Font.Size := 9;
BorderStyle := bsNone;
Width := 300;
Height := 100;
BorderWidth := 2;
Color := clBlue;
Position := poScreenCenter;
Panel := TPanel.Create(FProgress_Form);
with Panel do
begin
Parent := FProgress_Form;
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 := '正在导出数据,请稍候……';
end;
FProgressBar := TProgressBar.Create(panel);
with FProgressBar do
begin
Parent := panel;
Left := 20;
Top := 50;
Height := 18;
Width := 260;
end;
except
end;
end;
end;
end.