⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 untstudent.pas

📁 简要说明:对医院幼儿心理情况做的一个调查,统计系统.
💻 PAS
字号:
unit untStudent;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, untBaseSingle, Menus, ImgList, DB, ADODB, Grids, DBGrids,
  StdCtrls, Buttons, ExtCtrls, jpeg, DBGridEh, untGlobalVar, ComCtrls,
  ToolWin;

type
  TfrmStudent = class(TfrmBaseSingle)
    pnlLeftHand: TPanel;
    Splitter1: TSplitter;
    GroupBox1: TGroupBox;
    DBGridEh2: TDBGridEh;
    GroupBox2: TGroupBox;
    DBGridEh3: TDBGridEh;                         
    dsSchool: TDataSource;
    adsSchool: TADODataSet;
    adsSchooliAutoID: TAutoIncField;
    adsSchoolName: TStringField;
    dsClass: TDataSource;
    adsClass: TADODataSet;
    adsClassiAutoID: TAutoIncField;
    adsClassName: TStringField;
    adsClassSchoolID: TIntegerField;
    DBGridEh1: TDBGridEh;
    adsClassClassYear: TStringField;
    adsSingleiAutoID: TAutoIncField;
    adsSingleCode: TStringField;
    adsSingleName: TStringField;
    adsSingleSex: TIntegerField;
    adsSingleBirth: TDateTimeField;
    adsSingleBirthYear: TStringField;
    adsSingleBirthMonth: TStringField;
    adsSingleClassID: TIntegerField;
    adsLookUpSchool: TADODataSet;
    adsLookUpClass: TADODataSet;
    adsSingleClassName: TStringField;
    adsLookUpClassiAutoID: TAutoIncField;
    adsLookUpClassSchoolID: TIntegerField;
    adsLookUpClassClassYear: TStringField;
    adsLookUpClassName: TStringField;
    adsLookUpClassSchoolName: TStringField;
    adsSingleSchoolName: TStringField;
    adsSingleClassYear: TStringField;
    adsSingleSuggest: TStringField;
    dtmfldSingleCreateDate: TDateTimeField;
    ADODataSet1: TADODataSet;
    AutoIncField1: TAutoIncField;
    IntegerField1: TIntegerField;
    StringField1: TStringField;
    StringField2: TStringField;
    StringField3: TStringField;
    ADODataSet2: TADODataSet;
    smlntfldSingleifloor: TSmallintField;
    adswork: TADODataSet;
    adsedu: TADODataSet;
    smlntfldSinglefatherWork: TSmallintField;
    smlntfldSinglefatherEdu: TSmallintField;
    smlntfldSingleMotherwork: TSmallintField;
    smlntfldSingleMotherEdu: TSmallintField;
    adsSinglefaeduname: TStringField;
    adsSinglemoeduname: TStringField;
    adsSinglefaworkname: TStringField;
    adsSinglemoworkname: TStringField;
    procedure adsClassAfterScroll(DataSet: TDataSet);
    procedure FormDestroy(Sender: TObject);
    procedure adsSingleSexGetText(Sender: TField; var Text: String;
      DisplayText: Boolean);
    procedure adsSingleSexSetText(Sender: TField; const Text: String);
    procedure btnViewClick(Sender: TObject);
    procedure adsSingleBirthChange(Sender: TField);
    procedure DBGridEh1ColEnter(Sender: TObject);
    procedure btnShowDetailClick(Sender: TObject);
    procedure btntestClick(Sender: TObject);
  private
    { Private declarations }
  protected
    procedure InsRecord; override;
    procedure EditRecord; override;
  public
    { Public declarations }
    procedure LoadData; override;
  end;

var
  frmStudent: TfrmStudent;

implementation

uses untStudentSet,untStudentResult,untMeasureCase,
untMessage, untGlobalFun, untDM;

{$R *.dfm}

{ TfrmStudent }

procedure TfrmStudent.LoadData;
begin
  frmMessage := TfrmMessage.Create(Application);
  frmMessage.lblMessage.Caption := '正在加载数据,请稍侯...';
  frmMessage.Show;
  Application.ProcessMessages;
  with adswork do
  begin
    if Active then Active := false;
    Active := true;
  end;
  with adsedu do
  begin
    if Active then Active := false;
    Active := true;
  end;
  with adslookupSchool do begin
    if Active then Active := false;
    Active := true;
  end;
  with adsLookupClass do begin
    if Active then Active := false;
    Active := true;
  end;
  with adsClass do begin
    AfterScroll := nil;
    if Active then Active := false;
    Active := true;
    AfterScroll := adsClassAfterScroll;
  end;
  with adsschool do begin
    if Active then Active := false;
    Active := true;
  end;
  inherited;
  adsSchool.First;
  frmMessage.Free;
end;

procedure TfrmStudent.adsClassAfterScroll(DataSet: TDataSet);
begin
  inherited;
  if not adsSingle.Active then Exit;
  if not DataSet.IsEmpty then begin
    with adsSingle do begin
      if Filtered then Filtered := false;
      Filter := 'ClassID='+DataSet.fieldByName('iAutoID').AsString;
      Filtered := true;
    end;
  end;
end;

procedure TfrmStudent.FormDestroy(Sender: TObject);
begin
  inherited;
  frmStudent := nil;
end;

procedure TfrmStudent.EditRecord;
begin
  inherited;
  if adsSchool.IsEmpty or adsClass.IsEmpty then begin
    MsgOk('请先设置学校和班级资料!');
    Exit;
  end;
  SetStudent(adsSingle, omModi, adsClass['iAutoID']);
end;

procedure TfrmStudent.InsRecord;
var
  i:integer;
begin
  inherited;
  if adsSchool.IsEmpty or adsClass.IsEmpty then begin
    MsgOk('请先设置学校和班级资料!');
    Exit;
  end;
  //adsSingle.Append;
  adsSingle.FieldByName('ClassID').AsInteger:=adsClass['iAutoID'];
  adsSingle.FieldByName('CreateDate').AsDateTime:=Date;
  SetStudent(adsSingle, omNew, adsClass['iAutoID']);
end;

procedure TfrmStudent.adsSingleSexGetText(Sender: TField; var Text: String;
  DisplayText: Boolean);
begin
  inherited;
  if Sender.IsNull then Exit;
  case Sender.Value of
    0: Text := '男';
    1: Text := '女';
    else Text := '';
  end;
end;

procedure TfrmStudent.adsSingleSexSetText(Sender: TField;
  const Text: String);
begin
  inherited;
  if Text = '女' then Sender.Value := 1
  else Sender.Value := 0;
end;

procedure TfrmStudent.btnViewClick(Sender: TObject);
begin
  inherited;
  if adsSchool.IsEmpty or adsClass.IsEmpty then begin
    MsgOk('请先设置学校和班级资料!');
    Exit;
  end;
  SetStudent(adsSingle, omBrowse, adsClass['iAutoID']);
end;

procedure TfrmStudent.adsSingleBirthChange(Sender: TField);
var
  BirthYear, BirthMonth: string;
begin
  inherited;
  GetYearMonth(Sender.Value, BirthYear, BirthMonth);
  adsSingle['BirthYear'] := BirthYear;
  adsSingle['BirthMonth'] := BirthMonth;
end;

procedure TfrmStudent.DBGridEh1ColEnter(Sender: TObject);
begin
  inherited;
  //为了过滤按钮
  grdSingle.SelectedField := DBGridEh1.SelectedField;
end;

procedure TfrmStudent.btnShowDetailClick(Sender: TObject);
begin
  //inherited;
  if adsSchool.IsEmpty or adsClass.IsEmpty then begin
    MsgOk('请先设置学校和班级资料!');
    Exit;
  end;
  SetStudentResult(adsSingle, omModi, adsClass['iAutoID']);
end;


procedure TfrmStudent.btntestClick(Sender: TObject);
begin
  inherited;
  if not adsSingle.Active then exit;
   with TfrmMeasureCase.Create(Application) do
   begin
    Conn := DM.cnn;
    ChildrenID := adsSingle.fieldbyname('iAutoID').AsInteger;
    FromMenu := false;
    if ShowModal=mrOK then
    begin
      MsgOK('资料已经成功导入!','提示');
    end;
    Free;
  end;
end;


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -