Курсовая ( Тест Томоса и узнавание фигур ) / 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.