untreporttextadd.pas

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

unit untReportTextAdd;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, untBaseDialog, StdCtrls, Buttons, ExtCtrls, Grids, DBGrids, DB,
  ADODB, DBCtrls, jpeg, fcButton, fcImgBtn;

type
  TfrmReportTextAdd = class(TfrmBaseDialog)
    Panel1: TPanel;
    DBGrid1: TDBGrid;
    DBLookupComboBox1: TDBLookupComboBox;
    Label1: TLabel;
    adsText: TADODataSet;
    dsText: TDataSource;
    adsMeasure: TADODataSet;
    dsMeasure: TDataSource;
    adsTextiAutoID: TAutoIncField;
    adsTextMeasureCode: TStringField;
    adsTextItemCode: TStringField;
    adsTextLvl: TIntegerField;
    adsTextDiscript: TStringField;
    adsTextMethod: TStringField;
    adsLookMeasure: TADODataSet;
    adsLookMeasureItem: TADODataSet;
    adsTextMeasureName: TStringField;
    adsTextItemName: TStringField;
    btnAdd: TfcImageBtn;
    procedure FormShow(Sender: TObject);
    procedure adsTextLvlGetText(Sender: TField; var Text: String;
      DisplayText: Boolean);
    procedure adsTextLvlSetText(Sender: TField; const Text: String);
    procedure btnAddClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmReportTextAdd: TfrmReportTextAdd;

implementation

uses untDM, untGlobalFun;

{$R *.dfm}

procedure TfrmReportTextAdd.FormShow(Sender: TObject);
begin
  inherited;
  with adsMeasure do begin
    if Active then Active := False;
    Active := true;
  end;
  with adsText do begin
    if Active then Active := False;
    Active := True;
  end;
end;

procedure TfrmReportTextAdd.adsTextLvlGetText(Sender: TField;
  var Text: String; DisplayText: Boolean);
begin
  inherited;
  if Varisnull(sender.Value) then Exit;
  case sender.Value of
    -2 : Text := '较低';
    -1 : Text := '低';
     0 : Text := '中';
     1 : Text := '高';
     2 : Text := '较高';
     5 : Text := '正常';
     6 : Text := '异常';
  end;
end;

procedure TfrmReportTextAdd.adsTextLvlSetText(Sender: TField;
  const Text: String);
begin
  inherited;
  if Text = '较低' then Sender.Value := -2;
  if Text = '低'   then Sender.Value := -1;
  if Text = '中'   then Sender.Value := 0;
  if Text = '高'   then Sender.Value := 1;
  if Text = '较高' then Sender.Value := 2;
  if Text = '正常' then Sender.Value := 5;
  if Text = '异常' then Sender.Value := 6;
end;

procedure TfrmReportTextAdd.btnAddClick(Sender: TObject);
var
  adsTmp: TADODataSet;
  i, itype: Integer;
  strSql:string;
  BM: TBookmark;
begin
  inherited;
  BM := adsText.GetBookmark;
  if VarIsNull(DBLookupComboBox1.KeyValue) then Exit;
  strSql:='select typeid=isnull(typeid,0) from tMeasure where code='+QuotedStr(DBLookupComboBox1.KeyValue);
  itype:=GetDBValue(DM.cnn,strSql);
  adsTmp := GetDataSet(DM.cnn, 'select m.code,ItemCode=i.Code '
      + ' from tMeasure m inner join tMeasure_Item i on m.code=i.MeasureCode '
      + ' where m.code='+QuotedStr(DBLookupComboBox1.KeyValue));
  with adsTmp do begin
    if IsEmpty then begin
      MsgOK('该量表未设置因子');
      Exit;
    end;
    if itype=1 then
    begin
      while not Eof do
      begin
        adsText.Append;
        adsText['MeasureCode'] := FieldByName('code').Value;
        adsText['ItemCode'] := FieldbyName('Itemcode').Value;
        adsText['lvl'] := -3;
        adsText.Post;
        Next;
      end;
    end
    else if itype=3 then
    begin
      while not Eof do
      begin
        for i:=5 to 6 do
        begin
          adsText.Append;
          adsText['MeasureCode'] := FieldByName('code').Value;
          adsText['ItemCode'] := FieldbyName('Itemcode').Value;
          adsText['lvl'] := i;
          adsText.Post;
        end;
        Next;
      end;
    end
    else
    while not Eof do begin
      for i:=-2 to 2 do begin
        adsText.Append;
        adsText['MeasureCode'] := FieldByName('code').Value;
        adsText['ItemCode'] := FieldbyName('Itemcode').Value;
        adsText['lvl'] := i;
        adsText.Post;
      end;
      Next;
    end;
  end;
  adsText.GotoBookmark(BM);
end;

procedure TfrmReportTextAdd.btnOKClick(Sender: TObject);
var
  bFinished: Boolean;
begin
  inherited;
  with adsText do begin
    if IsEmpty then begin
      MsgOK('没有任何记录,无法保存!');
      Exit;
    end;
    DisableControls;
    First;
    bFinished := true;
    {while not Eof do begin
      if FieldByName('discript').IsNull
        or (Trim(FieldByName('discript').AsString)='')
        or FieldByName('method').IsNull
        or (Trim(FieldByName('method').AsString)='') then
        MsgOK('数据未输入完整!');
        bFinished := false;
        Break;
      Next;
    end;}
    EnableControls;
    if bFinished then begin
      adsText.UpdateBatch();
      ModalResult := mrOk;
    end;
  end;
end;

end.