2024年2月20日发(作者：)
unit U_func;
interface
uses
forms,SysUtils,ComCtrls,DBGrids,DB,Dialogs,Messages,Windows,ComObj,Controls,ADODB,StdCtrls,Graphics;
function ProgressBarform(max:integer):tProgressBar;
function ExportToExcel(dbgrid:tdbgrid):boolean;
function queryExportToExcel(queryexport:tadoquery):boolean;
implementation
//生成一个显示进度条的窗体
function ProgressBarform(max:integer):tProgressBar;
var
ProgressBar1:TProgressBar;
form:tform;
begin
Form(tform,form);
on:=poScreenCenter;
Style:=bsnone;
:=30;
:=260;
ProgressBar1:=(form);
e:=true;
:=true;
:=max;
Window:=;
:=20;
:=250;
:=+5;
:=+5;
:=1;
;
result:=ProgressBar1;
end;
//将DBGRID中的内容导入到EXCEL中
function ExportToExcel(dbgrid:tdbgrid):boolean;
const
xlNormal=-4143;
var
i,j,k:integer;
str,filename:string;
excel:OleVariant;
SavePlace: TBookmark;
savedialog:tsavedialog;
ProgressBar1:TProgressBar;
begin
result:=false;
filename:='';
if Count>65536 then
begin
if ebox('需要导出的数据过大，Excel最大只能容纳65536行,是否还要继续？','询问',mb_yesno+mb_iconquestion)=idno then
exit;
end;
:=crHourGlass;
try
excel:=CreateOleObject('ation');
;
except
:=crDefault;
showmessage('无法调用Excel！');
exit;
end;
savedialog:=(nil);
:='Excel文件(*.xls)|*.xls';
if e then
begin
if FileExists(me) then
try
if ebox('该文件已经存在，要覆盖吗？','询问',mb_yesno+mb_iconquestion)=idyes then
DeleteFile(PChar(me))
else
begin
;
;
:=crDefault;
Exit;
end;
except
;
;
:=crDefault;
Exit;
end;
filename:=me;
end;
;
sMessages;
if filename='' then
begin
result:=false;
;
:=crDefault;
exit;
end;
k:=0;
for i:=0 to -1 do
begin
if [i].Visible then
begin
//s[k+1].ColumnWidth:=[i].;
[1,k+1]:=[i].n;
inc(k);
end;
end;
eControls;
saveplace:=kmark;
;
i:=2;
if count>65536 then
ProgressBar1:=ProgressBarform(65536)
else
ProgressBar1:=ProgressBarform(count);
while not do
begin
k:=0;
for j:=0 to -1 do
begin
if [j].Visible then
begin
[i,k+1].NumberFormat:='@';
if not yname([j].FieldName).isnull then
begin
str :=
yname([j].FieldName).valu
e;
[i, k + 1] := Str;
end;
inc(k);
end
else
continue;
end;
if i=65536 then
break;
inc(i);
(1);
;
end;
;
sMessages;
okmark(SavePlace);
Controls;
try
if copy(FileName,length(FileName)-3,4)<>'.xls' then
FileName:=FileName+'.xls';
(FileName,xlNormal,'', '',False,False);
except
;
:=crDefault;
exit;
end;
//e := true;
;
:=crDefault;
Result:= true;
end;
//将ADOQUERY的数据集导入到EXCEL中
function queryExportToExcel(queryexport:tadoquery):boolean;
const
xlNormal=-4143;
var
i,j,k:integer;
str,filename:string;
excel:OleVariant;
savedialog:tsavedialog;
ProgressBar1:TProgressBar;
begin
result:=false;
filename:='';
if Count>65536 then
begin
if ebox('需要导出的数据过大，Excel最大只能容纳65536行,是否还要继续？','询问',mb_yesno+mb_iconquestion)=idno then
exit;
end;
:=crHourGlass;
try
excel:=CreateOleObject('ation');
;
except
:=crDefault;
showmessage('无法调用Excel！');
exit;
end;
savedialog:=(nil);
:='Excel文件(*.xls)|*.xls';
if e then
begin
if FileExists(me) then
try
if ebox('该文件已经存在，要覆盖吗？','询问',mb_yesno+mb_iconquestion)=idyes then
DeleteFile(PChar(me))
else
begin
;
;
:=crDefault;
Exit;
end;
except
;
;
:=crDefault;
Exit;
end;
filename:=me;
end;
;
sMessages;
if filename='' then
begin
result:=false;
;
:=crDefault;
exit;
end;
k:=0;
for i:=0 to ount-1 do
begin
[1,k+1]:=[i].FieldName;
inc(k);
end;
;
i:=2;
if count>65536 then
ProgressBar1:=ProgressBarform(65536)
else
ProgressBar1:=ProgressBarform(count);
while not do
begin
k:=0;
for j:=0 to ount-1 do
begin
[i,k+1].NumberFormat:='@';
if not
yname([j].FieldName).isnull then
begin
str:=yname([j].FieldName).AsString;
[i, k + 1] := Str;
end;
inc(k);
end;
if i=65536 then
break;
inc(i);
(1);
;
end;
;
sMessages;
try
if copy(FileName,length(FileName)-3,4)<>'.xls' then
FileName:=FileName+'.xls';
(FileName,xlNormal,'', '',False,False);
except
;
:=crDefault;
exit;
end;
//e := true;
;
:=crDefault;
Result := true;
end;
end.
Qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq
delphi执行查询语句时的进度条怎么做
procedure eate(Sender: TObject);
begin
eOptions := [eoAsyncFetch];//设为异步读取
end;
//ADOQuery的OnFetchProgress事件
procedure ry1FetchProgress(DataSet: TCustomADODataSet;
Progress, MaxProgress: Integer; var EventStatus: TEventStatus);
begin
on := Progress;
:= MaxProgress;
end;
//ADOQuery的OnFetchComplete事件
procedure ry1FetchComplete(DataSet: TCustomADODataSet;
const Error: Error; var EventStatus: TEventStatus);
begin
on := ;
ShowMessage('OK');
发布评论