untquestionsset.pas

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

unit untQuestionsSet;

interface

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

type
  PAnswer=^TAnswer;
  TAnswer=record
     selectTag:string[8];
     content:string[20];
     Value:Integer;
end;

type
  TfrmQuestionSet = class(TfrmBaseMDEdit)
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    DBEdit1: TDBEdit;
    DBLookupComboBox1: TDBLookupComboBox;
    DBEdit3: TDBEdit;
    DBMemo1: TDBMemo;
    adsDetailcode: TStringField;
    adsDetailquestioncode: TStringField;
    adsDetailselectTag: TStringField;
    adsDetailcontent: TStringField;
    adsDetailvalue: TIntegerField;
    adsQuestionGrp: TADODataSet;
    dsQuestionGrp: TDataSource;
    adsQuestionGrpcode: TStringField;
    adsQuestionGrpname: TStringField;
    Label6: TLabel;
    DBEdit4: TDBEdit;
    Label2: TLabel;
    DBEdit2: TDBEdit;
    pmsingle: TPopupMenu;
    C1: TMenuItem;
    V1: TMenuItem;
    procedure C1Click(Sender: TObject);
    procedure V1Click(Sender: TObject);
  private
    FList:TList;
    { Private declarations }
  protected
    procedure CheckAvoild; override;
    procedure DoBeforePost; override;
    procedure AfterFormShow; override;
    procedure InitComponents; override;
  public
    { Public declarations }
  end;

function SetQuestions(ADataSet: TADODataSet; AOpMode: TOperatorMode): Boolean;

implementation

uses untGlobalFun;

function SetQuestions(ADataSet: TADODataSet; AOpMode: TOperatorMode): Boolean;
begin
  with TfrmQuestionSet.Create(Application) do
    try
      DataSet := ADataSet;
      Title := '心理量表问题';
      OpMode := AOpMode;
      ContinueAppend := true;
      FList:=TList.Create;
      Result := ShowModal=mrOK;
    finally
      FList.Free;
      Free;
    end;
end;

{$R *.dfm}

{ TfrmQuestionSet }

procedure TfrmQuestionSet.AfterFormShow;
begin
  inherited;
  if OpMode = omModi then
    DBEdit1.Enabled := false;
  with adsDetail do begin
    if Active then Active := false;
    Connection := DataSet.Connection;
    CommandText := 'select * from tSelectItem where questioncode='
      +QuotedStr(DataSet.FieldByName('code').AsString);
    Active := true;
  end;
end;

procedure TfrmQuestionSet.CheckAvoild;
var
  strSQL: string;
begin
  inherited;
  if OpMode = omNew then begin
    strSQL := 'select count(*) from tQuestion where code='+QuotedStr(Trim(DBEdit1.Text));
    if GetDBValue(DataSet.Connection, strSQL) > 0 then
    begin
      if DBEdit1.CanFocus then DBEdit1.SetFocus;
      raise Exception.Create('编号重复，请重输！');
    end;
    strSQL := 'select count(*) from tQuestion '
      +' where grpcode='+QuotedStr(DataSet.fieldbyname('grpcode').AsString)
      +' and xh='+QuotedStr(DataSet.fieldbyname('xh').AsString);
    if GetDBValue(DataSet.Connection, strSQL) > 0 then
    begin
      if DBEdit4.CanFocus then DBEdit4.SetFocus;
      raise Exception.Create('所选问题分组中，该序号已存在，请修改后再保存！');
    end;
  end;
  if OpMode = omModi then begin
    strSQL := 'select count(*) from tQuestion '
      +' where grpcode='+QuotedStr(DataSet.fieldbyname('grpcode').AsString)
      +' and xh='+QuotedStr(DataSet.fieldbyname('xh').AsString)
      +' and code<>'+QuotedStr(DataSet.fieldbyname('code').AsString);
    if GetDBValue(DataSet.Connection, strSQL) > 0 then
    begin
      if DBEdit4.CanFocus then DBEdit4.SetFocus;
      raise Exception.Create('所选问题分组中，该序号已存在，请修改后再保存！');
    end;
  end;
end;

procedure TfrmQuestionSet.DoBeforePost;
var
  ABookStr: TBookmarkStr;
  MaxID: Integer;
  sltDomain: TStringList;
begin
  inherited;
  sltDomain := TStringList.Create;
  sltDomain.Delimiter := ';';
  with adsDetail do begin
    if State in [dsInsert, dsEdit] then Post;
    DisableControls;
    ABookStr := Bookmark;
    First;
    MaxID := GetMaxID(DataSet.Connection, 'tSelectItem','code');
    while not Eof do begin
      Edit;
      if adsDetailquestioncode.Value <> DataSet.FieldByName('code').AsString then
        adsDetailquestioncode.Value := DataSet.FieldByName('code').AsString;
      sltDomain.Add(adsDetailselectTag.Value);
      if adsDetailcode.IsNull then begin
        adsDetailcode.Value := StringOfChar('0',10-Length(IntToStr(MaxID)))+IntToStr(MaxID);
        Inc(MaxID);
      end;
      Post;
      Next;
    end;
    if not (DataSet.State in [dsInsert, dsEdit]) then DataSet.Edit;
    DataSet.FieldByName('ItemDomain').Value := sltDomain.DelimitedText;
    EnableControls;
  end;
  sltDomain.Free;
end;

procedure TfrmQuestionSet.InitComponents;
begin
  inherited;
  with adsQuestionGrp do begin
    if Active then Active := false;
    Active := true;
  end;
  if OpMode = omNew then
    DataSet.FieldByName('code').Value := GetMaxID('tQuestion', 'code', DataSet.Connection);
end;

procedure TfrmQuestionSet.C1Click(Sender: TObject);
var
  answer:PAnswer;
begin
  inherited;
  FList.Clear;
  with  adsDetail do
  begin
    First;
    while not  Eof do
    begin
       New(answer);
       answer^.selectTag:=FieldByName('selectTag').AsString;
       answer^.content:=FieldByName('content').AsString;
       answer^.Value:=FieldByName('Value').AsInteger;
       FList.Add(answer);
       Next;
    end;
    V1.Enabled:=True;
  end;
end;

procedure TfrmQuestionSet.V1Click(Sender: TObject);
var
  answer:PAnswer;
  i:Integer;
begin
  inherited;
  for i:=0 to FList.Count-1 do
  with  adsDetail do
  begin
     Append;
     FieldByName('selectTag').AsString:=PAnswer(FList[i])^.selectTag;
     FieldByName('content').AsString:=PAnswer(FList[i])^.content;
     FieldByName('Value').AsInteger:=PAnswer(FList[i])^.Value;
     Post;
  end;
end;

end.