Курсовая ( Тест Томоса и узнавание фигур ) / Data

unit Data;

interface

uses
  System.SysUtils, System.Classes, Data.DB, Data.Win.ADODB, frxClass, frxDBSet,
  frxExportImage, frxExportRTF, frxExportPDF;

type
  TDM = class(TDataModule)
    ADOQRespondent: TADOQuery;
    ADOQRespondentID_Respondent: TAutoIncField;
    ADOQRespondentFamily: TWideStringField;
    ADOQRespondentName: TWideStringField;
    ADOQRespondentSurname: TWideStringField;
    ADOQRespondentSex: TWideStringField;
    ADOQRespondentBorn: TDateTimeField;
    DSRespondent: TDataSource;
    DSTesting: TDataSource;
    ADOQTesting: TADOQuery;
    ADOQTestingID_Testing: TAutoIncField;
    ADOQTestingID_Respondent: TIntegerField;
    ADOQTestingID_Test: TIntegerField;
    ADOQTestingTesting_Date: TDateTimeField;
    ADOQTestingTesting_Time: TDateTimeField;
    ADOQTestingNameTest: TStringField;
    DSResult: TDataSource;
    ADOQTest: TADOQuery;
    ADOQTestID_Test: TAutoIncField;
    ADOQTestNameTest: TWideStringField;
    ADOQTestCode: TWideStringField;
    ADOQTestRunFile: TWideStringField;
    ADOQTestInstruction: TWideStringField;
    ADOQTestHelp: TWideStringField;
    ADOQTestDeveloper: TWideStringField;
    ADOQTestPsycologist: TWideStringField;
    ADOQTestVersion: TWideStringField;
    ADOQResult: TADOQuery;
    ADOQResultID_Result: TAutoIncField;
    ADOQResultID_Testing: TIntegerField;
    ADOQResultID_ParamResult: TIntegerField;
    ADOQResultValue_Result: TWideStringField;
    ADOQResultParametr: TStringField;
    ADOQResultMinValue: TStringField;
    ADOQResultMaxValue: TStringField;
    ADOQParamResult: TADOQuery;
    ADOQParamResultID: TAutoIncField;
    ADOQParamResultID_ParamResult: TIntegerField;
    ADOQParamResultID_Test: TIntegerField;
    ADOQParamResultParametr: TWideStringField;
    ADOQParamResultMin_Value: TWideStringField;
    ADOQParamResultMax_Value: TWideStringField;
    ADOQQuestion: TADOQuery;
    ADOQQuestionID_Question: TAutoIncField;
    ADOQQuestionID_Test: TIntegerField;
    ADOQQuestionNum_Question: TIntegerField;
    ADOQQuestionQuestion: TWideStringField;
    ADOQQuestionQuestion_Type: TWideStringField;
    ADOQQuestionQuestion_File: TWideStringField;
    ADOQAnswer: TADOQuery;
    ADOQAnswerID_Answer: TAutoIncField;
    ADOQAnswerNum_Answer: TIntegerField;
    ADOQAnswerID_Test: TIntegerField;
    ADOQAnswerNum_Question: TIntegerField;
    ADOQAnswerAnswer: TWideStringField;
    ADOQAnswerAnswer_Type: TWideStringField;
    ADOQAnswerAnswer_File: TWideStringField;
    ADOQProtocol: TADOQuery;
    AutoIncField1: TAutoIncField;
    IntegerField1: TIntegerField;
    DateTimeField1: TDateTimeField;
    ADOQProtocolNum_Question: TIntegerField;
    ADOQProtocolNum_Answer: TIntegerField;
    ADOQProtocolQuestion: TStringField;
    ADOQProtocolAnswer: TStringField;
    DSProtocol: TDataSource;
    ADOQTesting2: TADOQuery;
    AutoIncField2: TAutoIncField;
    IntegerField4: TIntegerField;
    IntegerField5: TIntegerField;
    DateTimeField2: TDateTimeField;
    DateTimeField3: TDateTimeField;
    StringField1: TStringField;
    ADOQPassword: TADOQuery;
    ADOQPasswordКод: TAutoIncField;
    ADOQPasswordParol: TWideStringField;
    frxReport: TfrxReport;
    frxDBDatasetR: TfrxDBDataset;
    ADOQTemp: TADOQuery;
    frxDBDatasetP: TfrxDBDataset;
    frxPDFExport1: TfrxPDFExport;
    frxRTFExport1: TfrxRTFExport;
    frxBMPExport1: TfrxBMPExport;
    ADOConnection: TADOConnection;
    procedure ADOQRespondentAfterScroll(DataSet: TDataSet);
    procedure ADOQTestingAfterScroll(DataSet: TDataSet);
    procedure ADOQProtocolCalcFields(DataSet: TDataSet);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DM: TDM;

implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}

uses Main;

{$R *.dfm}

procedure TDM.ADOQProtocolCalcFields(DataSet: TDataSet);
// расчиать значения расчётных полей базы данных  протокола: текст вопроса и
// текст ответа по соответсвующим номерам
var
  ID_Test, ID_Testing, Num_Answer, Num_Question : String;
  SQ, SA : String;
begin
  with DM do
  begin
    // получить номер эксперимента
    ID_Testing := ADOQProtocol.FieldByName('ID_Testing').AsString;
    // подготовить запрос
    with ADOQTesting2 do
    begin
      // если запрос был активный, сделать его неактивным
      active := false;
      // скорректировать запрос эксперимента
      with SQL do
      begin
        // очистить "старый" запрос
        Clear;
        // ввыбрать номер теста из записи эксперимента
        Add('SELECT * FROM Testing WHERE ID_Testing = '+ID_Testing);
      end;
      // сделать запрос активным
      Active := True;
      // считать номер теста
      ID_Test := FieldByName('ID_Test').AsString;
    end;
    // считать номер вопроса протокола
    Num_Question := ADOQProtocol.FieldByName('Num_Question').AsString;
    with ADOQQuestion do
    begin
      // сменить запрос вопроса для выбранного теста и номера вопроса
      with SQL do
      begin
        // очистить запрос
        Clear;
        // считать текст вопроса по номерам теста и вопроса
        Add('SELECT * FROM Question WHERE (ID_Test = '+ID_Test+
            ')AND(Num_Question = '+Num_Question+')');
      end;
      // активировать запрос
      Active := True;
      // считать текст вопроса
      SQ := FieldByName('Question').AsString;
    end;
    // методика с номером один имеет только один вариант ответов как на вопрос один
    if ID_Test = '1' then Num_Question := '1';
    // считать номер ответа протокола
    Num_Answer := ADOQProtocol.FieldByName('Num_Answer').AsString;
    // скорректировать запрос для выбранного теста, вопроса и ответа
    with ADOQAnswer do
    begin
      // изменить запрос
      with SQL do
      begin
        // очистить старый запрос
        Clear;
        // считать текст ответа по номерам теста, вопроса и ответа
        Add('SELECT * FROM Answer WHERE (ID_Test = '+ID_Test+
            ')AND(Num_Question = '+Num_Question+
            ')AND(Num_Answer = '+Num_Answer+')');
      end;
      // активировать запрос
      Active := True;
      // считать текст ответа
      SA := FieldByName('Answer').AsString;
    end;
    // присвоить полям таблицы считанные тексты вопроса и ответа
    ADOQProtocol.FieldByName('Question').AsString := SQ;
    ADOQProtocol.FieldByName('Answer').AsString := SA;
  end;
end;

procedure TDM.ADOQRespondentAfterScroll(DataSet: TDataSet);
begin
  // скорректировать список экспериментов в соответсвии с выбранным респондентом
  if ADOQRespondent.RecordCount>0 then
  begin
    ADOQTesting.Filtered:=False;
    ADOQTesting.Filter:='ID_Respondent='+
      ADOQRespondent.FieldByName('ID_Respondent').AsString;
    ADOQTesting.Filtered:=True;
  end;
end;

procedure TDM.ADOQTestingAfterScroll(DataSet: TDataSet);
begin
  with FMain do
  begin
    // при выборе нового эксперимента сделать окна результатов и протокола не видимыми
    DBGProtocol.Visible := False;
    DBGResult.Visible := False;
  end;
end;

end.