?? unit1.pas
字號:
with Tblsystem do
begin
edttitle.Text:=trim(fieldbyname('Ftitle').AsString);
edtman.Text:=trim(fieldbyname('Fman').AsString)
end;
//edit1.Text:=Gobdatapath;
end;
procedure TFrmExcel.Button1Click(Sender: TObject);
begin
if TblsourceField.RecordCount>0 then
begin
displaylist(lbxgroupall,'ffieldname','Tsourcefield','fgroup=''0'' and ftotal=''0'' and favg=''0'' ',' 編號');
displaylist(lbxtotalall,'ffieldname','Tsourcefield','fgroup=''0'' and ftotal=''0'' and favg=''0'' ',' 編號');
displaylist(lbxshowall,'ffieldname','Tsourcefield','fgroup=''0'' and ftotal=''0'' and favg=''0'' ',' 編號');
displaylist(lbxgroupsele,'ffieldname','Tsourcefield','fgroup=''1'' ',' 編號');
displaylist(lbxtotalsele,'ffieldname','Tsourcefield','ftotal=''1'' ',' 編號');
displaylist(lbxshowsele,'ffieldname','Tsourcefield','favg=''1'' ',' 編號');
showdatafield();
end;
end;
procedure TFrmExcel.LBxgroupallDblClick(Sender: TObject);
begin
with adocomm do
begin
commandText:='';
commandText:='update TsourceField set fgroup=''1'' where ffieldname='''+Getlbxsele(lbxgroupall)+''' ';
Execute;
Button1Click(nil);
end;
end;
procedure TFrmExcel.LBxgroupseleDblClick(Sender: TObject);
begin
with adocomm do
begin
commandText:='';
commandText:='update TsourceField set fgroup=''0'' where ffieldname='''+Getlbxsele(lbxgroupsele)+''' ';
Execute;
Button1Click(nil);
end;
end;
procedure TFrmExcel.LBxtotalallDblClick(Sender: TObject);
begin
with adocomm do
begin
commandText:='';
commandText:='update TsourceField set ftotal=''1'' where ffieldname='''+Getlbxsele(lbxtotalall)+''' ';
Execute;
Button1Click(nil);
end;
end;
procedure TFrmExcel.LBxtotalseleDblClick(Sender: TObject);
begin
with adocomm do
begin
commandText:='';
commandText:='update TsourceField set ftotal=''0'' where ffieldname='''+Getlbxsele(lbxtotalsele)+''' ';
Execute;
Button1Click(nil);
end;
end;
procedure TFrmExcel.LBxshowallDblClick(Sender: TObject);
begin
with adocomm do
begin
commandText:='';
commandText:='update TsourceField set favg=''1'' where ffieldname='''+Getlbxsele(lbxshowall)+''' ';
Execute;
Button1Click(nil);
end;
end;
procedure TFrmExcel.LBxshowseleDblClick(Sender: TObject);
begin
with adocomm do
begin
commandText:='';
commandText:='update TsourceField set favg=''0'' where ffieldname='''+Getlbxsele(lbxshowsele)+''' ';
Execute;
Button1Click(nil);
end;
end;
procedure TFrmExcel.btngroupClick(Sender: TObject);
begin
pangroup.Left:=8;
pangroup.Top:=128;
pangroup.Visible:=True;
try
lbxgroupall.SetFocus;
except
end;
pangroup.Visible:=true;
pantotal.Visible:=false;
panshow.Visible:=false;
end;
procedure TFrmExcel.BitBtn5Click(Sender: TObject);
begin
pangroup.Visible:=false;
try
btntotal.SetFocus;
except
end;
end;
procedure TFrmExcel.btntotalClick(Sender: TObject);
begin
pantotal.Left:=8;
pantotal.Top:=128;
pantotal.Visible:=true;
try
lbxtotalall.SetFocus;
except
end;
pangroup.Visible:=false;
pantotal.Visible:=true;
panshow.Visible:=false;
end;
procedure TFrmExcel.BitBtn6Click(Sender: TObject);
begin
pantotal.Visible:=false;
try
btnshow.SetFocus;
except
end;
end;
procedure TFrmExcel.btnshowClick(Sender: TObject);
begin
panshow.Left:=8;
panshow.Top:=128;
panshow.Visible:=true;
try
lbxshowall.SetFocus;
except
end;
pangroup.Visible:=false;
pantotal.Visible:=false;
panshow.Visible:=true;
end;
procedure TFrmExcel.BitBtn7Click(Sender: TObject);
begin
panshow.Visible:=false;
try
btnexectotal.SetFocus;
except
end;
end;
procedure TFrmExcel.btnexectotalClick(Sender: TObject);
var
groupsql,showsql,fieldsql,sqlstring:string;
checkdata:string;
Tmpdata:real;
i:integer;
begin
Tbltotal.Active:=False;
btnoutyes.Enabled:=false;
btnout.Enabled:=false;
button1Click(nil);
{if length(Trim(labgroup.Caption))=0 then
begin
showmessage('未設定分組條件');
Exit;
end;}
if (length(Trim(labtotal.Caption))=0) and (length(Trim(labavg.Caption))=0) then
begin
showmessage('未設定統計、平均條件');
Exit;
end;
//進行有效性檢查
Tblsource.Close;
with TblsourceField do
begin
close;
open;
first;
while not eof do
begin
fieldsql:=trim(fieldbyname('ffieldname').AsString);
if (trim(fieldbyname('ftotal').AsString)='1') or (trim(fieldbyname('favg').AsString)='1') then
begin
with qrytmp do
begin
close;
sql.Text:='';
sql.Text:='select '+fieldsql+' from Tsource';
open;
checkdata:=trim(fieldbyname(fieldsql).AsString);
try
Tmpdata:=strtofloat(checkdata);
adocomm.CommandText:='';
adocomm.CommandText:='ALTER TABLE Tsource ALTER column '+fieldsql+' numeric(12,2) null';
adocomm.Execute;
except
showmessage( fieldsql+' 該字段 不能進行統計');
exit;
end;
end;
end;
next;
end;
end;
Tblsource.Open;
//生成統計SQL語句
groupsql:=trim(labgroup.Caption);
showsql:='';
with TblsourceField do
begin
close;
open;
first;
while not eof do
begin
fieldsql:=trim(fieldbyname('ffieldname').AsString);
if trim(fieldbyname('ftotal').AsString)='1' then
begin
if showsql='' then
showsql:='sum('+fieldsql+') as '+fieldsql
else
showsql:=showsql+',sum('+fieldsql+') as '+fieldsql;
end;
if trim(fieldbyname('favg').AsString)='1' then
begin
if showsql='' then
showsql:='avg('+fieldsql+') as '+fieldsql
else
showsql:=showsql+',avg('+fieldsql+') as '+fieldsql;
end;
if trim(fieldbyname('fgroup').AsString)='1' then
begin
if showsql='' then
showsql:=fieldsql
else
showsql:=showsql+','+fieldsql;
end;
next;
end;
end;
//刪除Ttotal表
With Tblsystem do
begin
Active:=True;
if trim(fieldbyname('Ftotal').AsString)='是' then
begin
Tbltotal.Active:=False;
adocomm.CommandText:='';
adocomm.CommandText:='Drop Table Ttotal';
adocomm.Execute;
edit;
fieldbyname('Ftotal').AsString:='否';
post;
end;
end;
//合成SQL語句,生成統計數據
if showsql<>'' then
begin
sqlstring:='select '+showsql+' into Ttotal from Tsource';
if length(groupsql)<>0 then
sqlstring:=sqlstring+' group by '+groupsql;
adocomm.CommandText:='';
adocomm.CommandText:=sqlstring;
try
adocomm.Execute;
except
showmessage('指定的統計條件有問題,請重新設定');
exit;
end;
With Tblsystem do
begin
Active:=True;
edit;
fieldbyname('Ftotal').AsString:='是';
post;
end;
Tbltotal.Active:=True;
with grdtotal.Columns do
begin
for i:=0 to (Count-1) do
begin
items[i].Width:=60;
end;
end;
with grdlist.Columns do
begin
for i:=0 to (Count-1) do
begin
items[i].Width:=60;
end;
items[0].Visible:=false;
end;
btnoutyes.Enabled:=True;
end;
end;
procedure TFrmExcel.btnExitClick(Sender: TObject);
begin
if application.MessageBox('是否要退出?','信息窗口',mb_yesno+mb_defbutton2)=idyes then
begin
FrmExcel.Close;
application.Terminate;
end;
end;
procedure TFrmExcel.btnoutyesClick(Sender: TObject);
begin
with tblsystem do
begin
edit;
fieldbyname('ftitle').AsString:=trim(edttitle.Text);
fieldbyname('fman').AsString:=trim(edtman.Text);
post;
end;
btnout.Enabled:=True;
btnout.SetFocus;
end;
procedure TFrmExcel.btnoutClick(Sender: TObject);
var
xlsFilename:string;
eclApp,WorkBook,sheet:Variant; //聲明為OLE Automation 對象
outdata:string;
i,j,k:integer;
begin
try
Tbltotal.Open;
with grdtotal.Columns do
begin
for i:=0 to (Count-1) do
begin
items[i].Width:=60;
end;
end;
except
showmessage('未生成統計數據,無法導出');
exit;
end;
try
eclApp:=CreateOleObject('Excel.Application');
except
ShowMessage('您的機器里未安裝Microsoft Excel。');
Exit;
end;
with Tblsystem do
begin
xlsFileName:=trim(fieldbyname('ffilepath').AsString);
end;
if length(xlsFileName)=0 then exit;
frmExcel.Cursor:=crHourGlass;
try
WorkBook:=eclApp.workBooks.Open(xlsFileName);
eclapp.ActiveWorkbook.Worksheets.add;
sheet:=eclapp.ActiveSheet;
//插入標題
outdata:=tblsystem.fieldbyname('ftitle').AsString;
sheet.cells[1,3].value:=outdata;
//導入字段名
with grdtotal.Columns do
begin
for i:=0 to (Count-1) do
begin
j:=2+i;
sheet.cells[3,j].value:=items[i].FieldName;
end;
end;
//導入數據
with Tbltotal do
begin
first;
j:=4;
while not Eof do
begin
for i:=0 to FieldCount-1 do
begin
k:=2+i;
sheet.cells[j,k].value:=Fields[I].AsString;
end;
next;
j:=j+1;
end;
j:=j+1;
sheet.cells[j,2].value:='制表日期:'+datetimetostr(date())+' 制表人:'+Trim(Tblsystem.FieldByName('fman').AsString);
end;
eclapp.ActiveWorkbook.Save;
showmessage('數據成功導出!!!');
finally
frmExcel.Cursor:=crDefault;
WorkBook.Close;
eclApp.Quit;
eclApp:=Unassigned;
end;
end;
procedure TFrmExcel.btnClick(Sender: TObject);
var
xlsFilename:string;
begin
with openDialog1 do
begin
Title := '請選擇輸入文件名';
DefaultExt := 'xls';
Filter := 'Excel文件(*.xls)|*.xls';
Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofNoReadOnlyReturn, ofEnableSizing];
if Execute then
xlsFileName := FileName;
Edtexcelname.Text:=xlsFileName;
if xlsFileName = '' then exit; {如果沒有選中文件,則直接退出}
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -