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

📄 untselectstudent.pas

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

interface

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

type
  TfrmSelectStudent = class(TfrmBaseDialog)
    grdStudent: TDBGridEh;
    adsStudent: TADODataSet;
    dsStudent: TDataSource;
    chkSelectAll: TCheckBox;
    adsStudentiAutoID: TIntegerField;
    adsStudentSelected: TBooleanField;
    adsStudentCode: TStringField;
    adsStudentName: TStringField;
    adsStudentSex: TIntegerField;
    adsStudentBirthYear: TStringField;
    adsStudentBirthMonth: TStringField;
    adsStudentClassID: TIntegerField;
    adsStudentSuggest: TStringField;
    adsClass: TADODataSet;
    adsClassiAutoID: TAutoIncField;
    adsClassSchoolID: TIntegerField;
    adsClassClassYear: TStringField;
    adsClassName: TStringField;
    adsSchool: TADODataSet;
    adsClassSchoolName: TStringField;
    adsStudentSchoolName: TStringField;
    adsStudentClassYear: TStringField;
    adsStudentClassName: TStringField;
    Label1: TLabel;
    lblRecCnt: TLabel;
    frReport1: TfrReport;
    frdsMain: TfrDBDataSet;
    adsData1: TADODataSet;
    adsData2: TADODataSet;
    adsData3: TADODataSet;
    frdsXL: TfrDBDataSet;
    frdsQZ: TfrDBDataSet;
    frdsXW: TfrDBDataSet;
    adsMainData: TADODataSet;
    dsMainData: TDataSource;
    adsData1ChildrenID: TIntegerField;
    adsMainDataiAutoID: TIntegerField;
    adsMainDataSelected: TBooleanField;
    adsMainDataCode: TStringField;
    adsMainDataName: TStringField;
    adsMainDataSex: TIntegerField;
    adsMainDataBirthYear: TStringField;
    adsMainDataBirthMonth: TStringField;
    adsMainDataClassID: TIntegerField;
    adsMainDataSuggest: TStringField;
    adsMainDataSchoolName: TStringField;
    adsMainDataClassYear: TStringField;
    adsMainDataClassName: TStringField;
    adsData2ChildrenID: TIntegerField;
    adsData2Table: TADODataSet;
    frdsQZTable: TfrDBDataSet;
    adsData2TableChildrenID: TIntegerField;
    adsData2TableName: TStringField;
    adsData2TableContent: TStringField;
    adsData2TablesResult: TStringField;
    adsData3ChildrenID: TIntegerField;
    adsData3Name: TStringField;
    adsData3NormalValue: TStringField;
    adsData3CalcValue: TStringField;
    adsData3FlagText: TStringField;
    adsWord: TADODataSet;
    frdsWord: TfrDBDataSet;
    adsGJData: TADODataSet;
    IntegerField1: TIntegerField;
    StringField1: TStringField;
    StringField2: TStringField;
    StringField3: TStringField;
    frdsGJ: TfrDBDataSet;
    adsData3sSuggest: TStringField;
    adsData1sResult: TStringField;
    adsData2sResult: TStringField;
    adsData2ssuggest: TStringField;
    btnPrint: TfcImageBtn;
    btnDesign: TfcImageBtn;
    adsData3content: TStringField;
    adsData1sSuggest: TStringField;
    procedure adsStudentSexGetText(Sender: TField; var Text: String;
      DisplayText: Boolean);
    procedure FormShow(Sender: TObject);
    procedure adsStudentAfterPost(DataSet: TDataSet);
    procedure chkSelectAllClick(Sender: TObject);
    procedure btnPrintClick(Sender: TObject);
    procedure btnDesignClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    FFilter: string;
    { Private declarations }
    procedure ClearData;
    procedure GetData;
    procedure GetMainData;
    procedure RelationData;
    procedure PrintData;
    procedure GetXLData;
    procedure GetQZData;
    procedure GetXWData;
  public
    { Public declarations }
    property FilterString: string read FFilter write FFilter;
  end;

var
  frmSelectStudent: TfrmSelectStudent;

implementation

uses untDM, untGlobalFun;

{$R *.dfm}

procedure TfrmSelectStudent.adsStudentSexGetText(Sender: TField;
  var Text: String; DisplayText: Boolean);
begin
  inherited;
  if VarIsNull(Sender.Value) then Exit;
  case sender.Value of
    0: Text := '男';
    1: Text := '女';
  end;
end;

procedure TfrmSelectStudent.FormShow(Sender: TObject);
var
  adsTmp: TADODataSet;
  i: Integer;
begin
  inherited;
  with adsSchool do begin
    if Active then Active := false;
    Active := true;
  end;
  with adsClass do begin
    if Active then Active := false;
    Active := true;
  end;
  adsTmp := GetDataSet(DM.cnn, 'select * from tChildren where 1=1 '+FilterString);

  with adsStudent do begin
    CreateDataSet;
    if adsTmp.IsEmpty then begin
      MsgOK('未找到任何记录!');
      Exit;
    end;
    adsTmp.First;
    while not adsTmp.Eof do begin
      Append;
      FieldByName('Selected').Value := False;
      FieldByName('code').Value := adsTmp['code'];
      FieldByName('Name').Value := adsTmp['name'];
      FieldByName('sex').Value := adsTmp['sex'];
      FieldByName('birthyear').Value := adsTmp['birthyear'];
      FieldByName('birthmonth').Value := adsTmp['birthmonth'];
      FieldByName('iAutoID').Value := adsTmp['iAutoID'];
      FieldByName('classID').Value := adsTmp['ClassID'];
      adsTmp.Next;
      Post;
    end;
  end;
  adsTmp.Free;

  for i:=0 to adsStudent.Fields.Count-1 do
    adsMainData.FieldDefs.Add(adsStudent.Fields[i].FieldName,
                              adsStudent.Fields[i].DataType,
                              adsStudent.Fields[i].Size,
                              adsStudent.Fields[i].Required);
  adsMainData.FieldDefs.Add('XLData', ftString, 800);
  adsMainData.CreateDataSet;
end;

procedure TfrmSelectStudent.adsStudentAfterPost(DataSet: TDataSet);
begin
  inherited;
  lblRecCnt.Caption := IntToStr(DataSet.RecordCount);
end;

procedure TfrmSelectStudent.chkSelectAllClick(Sender: TObject);
begin
  inherited;
  with adsStudent do begin
    if IsEmpty then Exit;
    DisableControls;
    first;
    while not Eof do begin
      edit;
      FieldByName('Selected').Value := TCheckBox(Sender).Checked;
      Post;
      Next;
    end;
    EnableControls;
  end;
end;

procedure TfrmSelectStudent.btnPrintClick(Sender: TObject);
begin
  inherited;
  ClearData;
  GetMainData;
  if adsMainData.IsEmpty then begin
    MsgOK('您没有选择任何学生!');
    Exit;
  end;
  with adsMainData do begin
    first;
    while not eof do begin
      GetData;
      Next;
    end;
    RelationData;
    PrintData;
  end;
end;

procedure TfrmSelectStudent.ClearData;
begin
  while not adsMainData.IsEmpty do
    adsMainData.Delete;
  while not adsData1.IsEmpty do
    adsData1.Delete;
  while not adsData2.IsEmpty do
    adsData2.Delete;
  while not adsData3.IsEmpty do
    adsData3.Delete;
end;

procedure TfrmSelectStudent.GetMainData;
var
  i: Integer;
begin
  with adsStudent do begin
    DisableControls;
    first;
    while not eof do begin
      if FieldByName('Selected').Value then begin
        adsMainData.Append;
        for i:=0 to Fields.Count-1 do
          adsMainData.Fields[i].Value := Fields[i].Value;
        adsMainData.Post;
      end;
      Next;
    end;
    EnableControls;
  end;
end;

procedure TfrmSelectStudent.GetData;
begin
  GetXLData;
  GetQZData;
  GetXWData;
end;

procedure TfrmSelectStudent.PrintData;
begin
  frReport1.PrepareReport;
  frReport1.LoadFromFile('Report\BaseReport.frf');
  frReport1.ShowReport;
end;

procedure TfrmSelectStudent.GetQZData;
begin
  if adsData2.Active then adsData2.Active := false;
  adsData2.Active := true;
end;

procedure TfrmSelectStudent.GetXLData;
begin
  if adsData1.Active then adsData1.Active := false;
  adsData1.Active := true;
end;

procedure TfrmSelectStudent.GetXWData;
begin
  if adsData3.Active then adsData3.Active := false;
  adsData3.Active := true;
end;

procedure TfrmSelectStudent.btnDesignClick(Sender: TObject);
begin
  inherited;
  frReport1.ModifyPrepared := true;
  frReport1.LoadFromFile('Report\BaseReport.frf');
  frReport1.DesignReport;
end;

procedure TfrmSelectStudent.RelationData;
begin
  with adsData1 do begin
    IndexFieldNames := 'ChildrenID';
    MasterFields := 'iAutoID';
  end;
end;

procedure TfrmSelectStudent.Button1Click(Sender: TObject);
begin
  inherited;
  ClearData;
  GetMainData;
  GetXLData;
  RelationData;
end;

end.

⌨️ 快捷键说明

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