unit1.pas

DELPHI操作技巧

  
  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.