untexportexecl.pas

简要说明:对医院幼儿心理情况做的一个调查,统计系统.

unit untExportExecl;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, untBaseDialog, StdCtrls, Buttons, ExtCtrls, Mask, DBCtrlsEh,
  DBLookupEh, DBCtrls, DB, ADODB, jpeg, fcButton, fcImgBtn, OleServer,
  Excel2000,ComObj;

type
  TfrmExportExecl = class(TfrmBaseDialog)
    adsSchool: TADODataSet;
    adsClass: TADODataSet;
    dsSchool: TDataSource;
    dsClass: TDataSource;
    chkSchool: TCheckBox;
    chkClass: TCheckBox;
    cboSchool: TDBLookupComboBox;
    cboClass: TDBLookupComboboxEh;
    Label1: TLabel;
    rgType: TRadioGroup;
    adsData: TADODataSet;
    SaveDialog1: TSaveDialog;
    procedure chkSchoolClick(Sender: TObject);
    procedure chkClassClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure adsSchoolAfterScroll(DataSet: TDataSet);
    procedure btnOKClick(Sender: TObject);
  private
    FSchoolID: Integer;
    FClassID: Integer;
    FDataType: Integer;
    { Private declarations }
    Procedure LoadData;
    Procedure TransData;
  public
    { Public declarations }
    property SchoolID: Integer read FSchoolID write FSchoolID;
    property ClassID:  Integer read FClassID  write FClassID;
    property DataType: Integer read FDataType write FDataType;
  end;

var
  frmExportExecl: TfrmExportExecl;

implementation

uses untDM, untMessage;

{$R *.dfm}
Procedure TfrmExportExecl.TransData;
var
   Ole:variant;
   Ac,Ar,a,b:integer;
begin
   if not adsData.Active then
   begin
      ShowMessage('数据集没有打开');
      Exit;
   end;
Try
   Ole:=createoleobject('Excel.Application'); //创建OLE对象
Except
   Showmessage('Excel没有安装或不正确');
   Exit;
end;

begin
   Ole.workbooks.add;    //添加工作薄
   adsData.First; //将数据集中的数据导入Excel表格
   adsData.DisableControls;
   Ac:=adsData.FieldCount;
   Ar:=adsData.RecordCount;

  frmMessage := TfrmMessage.Create(Application);
  frmMessage.lblMessage.Caption := '正在导入数据，请稍侯...';
  frmMessage.Show;
  Application.ProcessMessages;
   for a:=1 to Ac do //将数据表中的数据导入表格
   Ole.Cells[1,a]:=adsData.Fields[a-1].FieldName;
   for a:=2 to Ar+1 do
   begin
       for b:=0 to Ac-1 do
       Ole.cells[a,b+1]:=adsData.Fields[b].AsString;
       adsData.Next;
    end;

   application.MessageBox('数据导出完成!','提示',mb_ok+mb_iconinformation);
   Ole.visible := true;

   frmMessage.Free;
end;
end;

Procedure TfrmExportExecl.LoadData;
var
  strSQL, MeasureCode: string;
  i: Integer;
begin
  case FDataType of
    0 : MeasureCode := '0000000002';
    1 : MeasureCode := '0000000001';
    2 : MeasureCode := '0000000003';
    3 : MeasureCode := '0000000004';
  end;
  strSQL :=
'declare @sql varchar(8000) '+
'set @SQl='''' '+
'Select @sql=@sql+'',max(case when ItemCode=''''''+Code+'''''' then ItemValue end) As [''+[Name]+'']'' '+
'from tMeasure_Item '+
'where MeasureCode='+QuotedStr(MeasureCode) +

'select @sql=''select [学校]=s.Name,[班级]=cl.Name,[检查号]=c.Code,[姓名]=c.Name, '+
'     [岁]=c.BirthYear,[月]=c.BirthMonth''+@sql '+
'	+'' from (select cr.ChildrenID,crm.ItemCode,crm.ItemValue '+
'		 from tChildrenResult cr '+
'			inner join tChildrenResult_Mx crm on cr.iAutoID=crm.CheckResultID '+
'		 where cr.MeasureCode='''''+MeasureCode+''''') a '+
'		inner join tChildren c on a.ChildrenID=c.iAutoID '+
'   inner join tClass cl on c.ClassID=cl.iAutoID '+
'   inner join tSchool s on cl.SchoolID=s.iAutoID '+
'where 1=1 ';
  if SchoolID <> -1 then
    strSQL := strSQL+' and s.iAutoID='+InttoStr(SchoolID);
  if ClassID <> -1 then
    strSQL := strSQL + ' and cl.iAutoID='+IntToStr(ClassID);
strSQL := strSQL +
' group by s.Name, cl.Name, c.Code, c.Name, c.birthYear, c.BirthMonth '+
' order by s.Name,cl.Name,c.Code '' '+

'exec(@sql)';
  with adsData do begin
    if Active then Active := false;
    CommandText := strSQL;
    Active := true;
    for i:=0 to Fields.Count-1 do begin
      Fields[i].DisplayWidth := 10;
      if Pos('_LVL', Fields[i].FieldName)>0 then
        Fields[i].Visible := false;
    end;
  end;

end;

procedure TfrmExportExecl.chkSchoolClick(Sender: TObject);
begin
  inherited;
  cboschool.Enabled := TCheckBox(Sender).Checked;
end;

procedure TfrmExportExecl.chkClassClick(Sender: TObject);
begin
  inherited;
  cboClass.Enabled := TCheckBox(Sender).Checked;
end;

procedure TfrmExportExecl.FormShow(Sender: TObject);
begin
  inherited;
  with adsSchool do begin
    if Active then Active := False;
    Active := true;
  end;
end;

procedure TfrmExportExecl.adsSchoolAfterScroll(DataSet: TDataSet);
begin
  inherited;
  with adsClass do begin
    if Active then Active := false;
    Active := true;
    if Filtered then Filtered := false;
    Filter := 'SchoolID='+DataSet.FieldByName('iAutoID').AsString;
    Filtered := true;
  end;
end;

procedure TfrmExportExecl.btnOKClick(Sender: TObject);
begin
  inherited;
  if chkSchool.Checked then
  begin if cboSchool.Text<>'' then  FSchoolID := cboSchool.KeyValue  else FSchoolID := -1; end
  else FSchoolID := -1;
  if chkClass.Checked then
  begin  if  cboClass.Text<>'' then  FClassID := cboClass.KeyValue  else FClassID := -1; end
  else FClassID := -1;
  FDataType := rgType.ItemIndex;
  LoadData;
  TransData;
  ModalResult := mrOk;
end;

end.