untexportdata.pas

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

unit untExportData;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, untBaseDialog, StdCtrls, Buttons, ExtCtrls, DB, ADODB,
  Grids, DBGridEh, jpeg, fcButton, fcImgBtn, FR_DSet, FR_DBSet, FR_Class;

type
  TfrmExportData = class(TfrmBaseDialog)
    DBGridEh1: TDBGridEh;
    adsData: TADODataSet;
    dsData: TDataSource;
    frReport1: TfrReport;
    frdsData: TfrDBDataSet;
    btnDesign: TfcImageBtn;
    procedure FormShow(Sender: TObject);
    procedure DBGridEh1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
    procedure btnOKClick(Sender: TObject);
    procedure btnDesignClick(Sender: TObject);
  private
    FSchoolID: Integer;
    FClassID: Integer;
    FDataType: Integer;
    { Private declarations }
    procedure LoadData;
    procedure PrintData;
  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
  frmExportData: TfrmExportData;

implementation

uses untDM, untGlobalVar, untRepQZ, untRepXW;

{$R *.dfm}

procedure TfrmExportData.FormShow(Sender: TObject);
begin
  inherited;
  LoadData;
end;

procedure TfrmExportData.PrintData;
begin
  frReport1.PrepareReport;
  case  FDataType of
    0: frReport1.LoadFromFile('Report\QZResult.frf');
    1: frReport1.LoadFromFile('Report\XWResult.frf');
    2: frReport1.LoadFromFile('Report\XLResult.frf');
    3: frReport1.LoadFromFile('Report\GJResult.frf');
  end;
  frReport1.ShowReport;
end;

procedure TfrmExportData.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]+'']'' '+
'	 +'', max(case when ItemCode =''''''+Code+'''''' then '+
'		Case when ItemValue=''''.'''' then 0 else dbo.fn_GetLevel(ItemCode, ItemValue, c.Sex, c.BirthYear+Convert(decimal(9,2),c.BirthMonth)/100) end end) As [''+[Name]+''_LVL]'' '+
'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 TfrmExportData.DBGridEh1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumnEh;
  State: TGridDrawState);
var
  i: Integer;
  bFound: Boolean;
  AColor: TColor;
  FieldName, ColorFieldName: string;
  AState: TGridDrawState;
begin
  inherited;
  if adsData.IsEmpty then Exit;
  AState := State;
  if FDataType = 0 then begin
    FieldName := Column.FieldName;
    with adsData do begin
      bFound := false;
      for i:=0 to Fields.Count-1 do begin
        if Fields[i].FieldName = FieldName+'_LVL' then begin
          ColorFieldName := Fields[i].FieldName;
          bFound := true;
          Break;
        end;   //end if
      end;  //end for
      if bFound then begin
        case FieldByName(ColorFieldName).Value of
          1 : AColor := StringToColor(QZ1);
          2 : AColor := StringToColor(QZ2);
          3 : AColor := StringToColor(QZ3);
          4 : AColor := StringToColor(QZ4);
          5 : AColor := StringToColor(QZ5);
          else AColor := clWhite;
        end;
        DBGridEh1.Canvas.Brush.Color := AColor;
          if Column.FieldName = FieldName then
            DBGridEh1.DefaultDrawColumnCell(Rect, DataCol, Column, AState);
      end; //end if
    end;  //end with
  end else if FDataType=1 then begin
    FieldName := Column.FieldName;
    with adsData do begin
      bFound := false;
      for i:=0 to Fields.Count-1 do begin
        if Fields[i].FieldName = FieldName+'_LVL' then begin
          ColorFieldName := Fields[i].FieldName;
          bFound := true;
          Break;
        end;   //end if
      end;  //end for
      if bFound then begin
        case FieldByName(ColorFieldName).Value of
          -1 : AColor := StringToColor(XW);
          0 : AColor := clWhite;
          else AColor := clWhite;
        end;
        DBGridEh1.Canvas.Brush.Color := AColor;
          if Column.FieldName = FieldName then
            DBGridEh1.DefaultDrawColumnCell(Rect, DataCol, Column, AState);
      end; //end if
    end;  //end with
  end;
end;

procedure TfrmExportData.btnOKClick(Sender: TObject);
begin
  inherited;
  {if FDataType = 0 then begin
    repQZ := TrepQZ.Create(Application);
    repQZ.Preview;
    FreeAndNil(repQZ);
  end else begin
    repXW := TrepXW.Create(Application);
    repXW.Preview;
    FreeAndNil(repXW);
  end; }
  PrintData;
end;

procedure TfrmExportData.btnDesignClick(Sender: TObject);
begin
  inherited;
  frReport1.ModifyPrepared := true;
  case  FDataType of  //气质/行为/心理/感官
    0: frReport1.LoadFromFile('Report\QZResult.frf');
    1: frReport1.LoadFromFile('Report\XWResult.frf');
    2: frReport1.LoadFromFile('Report\XLResult.frf');
    3: frReport1.LoadFromFile('Report\GJResult.frf');
  end;
  frReport1.DesignReport;
end;

end.