unit UnitFormFromDll;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.MPlayer, Vcl.StdCtrls,
  Vcl.Samples.Gauges, Vcl.Buttons, Vcl.ExtCtrls, Vcl.Samples.Spin, System.DateUtils;

type TMyStartRecord = record
  iCurSecForTO: integer;
  myLessonType: integer;
  idtSLYear: integer;
  idtSLMonth: integer;
  idtSLDay: integer;
  idtSLHour: integer;
  idtSLMin: integer;
  idtSLSec: integer;
  idtSLmSec: integer;
end;

//type TRecMyScriptFields = record
//  FormWidth, FormHeight: integer;//размеры формы отображения теста
//  PanelTopHeight: integer;//высота вержней панели (на ней мемо с текстом вопроса) формы отображения теста
//  ScrollBoxImageWidth: integer;//ширина скролл-бокса с картинкой
//end;

Type TRecTestPChar = record //Запись описания теста для передачи в DLL
  ID : Integer; //Идентификатор теста
  MyTestType : Integer; //Тип теста
  Text : PChar; //Текст теста
  TestImageFN : PChar; //Имя файла изображения
  TestSoundFN : PChar; //Имя файла звука
  TestMovieFN : PChar; //Имя видеофайла
  AnswersType : Integer; //Тип ответов
  WeightTest : Integer; //Баллов за правильный ответ
  SecondsTO : Integer; //Время на ответ в секундах
  MyScript : PChar; //Имя файла DLL ()
  iidw1,iidw2:integer;
end;

Type TRecTest = record //Запись описания теста
  ID : Integer; //Идентификатор теста
  MyTestType : Integer; //Тип теста
  Text : String; //Текст теста
  TestImageFN : TFileName; //Имя файла изображения
  TestSoundFN : TFileName; //Имя файла звука
  TestMovieFN : TFileName; //Имя видеофайла
  AnswersType : Integer; //Тип ответов
  WeightTest : Integer; //Баллов за правильный ответ
  SecondsTO : Integer; //Время на ответ в секундах
  MyScript : AnsiString; //Скрипт
  iidw1,iidw2:integer;
end;

type
  TFormFromDLL = class(TForm)
    PanelBottom: TPanel;
    SBStop: TSpeedButton;
    SBPlay: TSpeedButton;
    BBCancel: TBitBtn;
    BBOk: TBitBtn;
    PanelTimeOut: TPanel;
    GaugeTO: TGauge;
    Label5: TLabel;
    MediaPlayerTest: TMediaPlayer;
    BBOut: TBitBtn;
    TimerMain: TTimer;
    procedure TimerMainTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    bufRMyTest: TRecTest;
    //переменные для автоостановки
//    iCurSecForTO: integer;
//    dtStartLesson: TDateTime;
//    dtBeginWork: TDateTime;
    function PrepareAndShowModal(r: TRecTest): TModalResult;
  end;

function PrepareStartT(sr: TMyStartRecord):integer; stdcall;//функция установки стартовых параметров, относящихся ко всему уроку
function PrepareAndShowModal(rpch: TRecTestPChar): integer; stdcall;//функция установки параметров задания и запуска формы
function DestroyMyDLGForm: Integer; stdcall;

function GetMyScriptForReturn: PChar; stdcall;
function GetMyReturnIntValue1: integer; stdcall;
function GetMyReturnIntValue2: integer; stdcall;

function GetMyEntAnswer: PChar; stdcall;
function GetMyCorrectAnswer: PChar; stdcall;
function GetMyQuestion: PChar; stdcall;

function GetMyResult: integer; stdcall;


procedure TRecTestPCharToTRecTest(source: TRecTestPChar; var dest: TRecTest);
procedure TRecTestToTRecTestPChar(source: TRecTest; var dest: TRecTestPChar);
procedure CopyTRecTest(source:TRecTest; var dest:TRecTest);

var
  FormFromDLL: TFormFromDLL;

  myScriptForReturn: string;
  iReturnIntValue1: integer;
  iReturnIntValue2: integer;
  MyEntAnswer: string;
  MyCorrectAnswer: string;
  MyQuestion: string;

  iCurSecForTO: integer;
  myLessonType: integer;
  dtStartLesson: TDateTime;
  dtBeginWork: TDateTime;


implementation

function GetMyQuestion: PChar; stdcall;
var bufret: PChar; sss: string;
begin
  try
    sss := MyQuestion;
    bufret := PChar(sss);
  finally
    result := bufret;
  end;
end;

function GetMyResult: integer;
var bufret: integer;
begin
  bufret := 0;
  //тут вычисление результата выполнения задания: 0 - не правильно; 1 - правильно
  result := bufret;
end;

function DecodeScriptToRecMyScriptFields(smsc: string; var r: TRecMyScriptFields):boolean;
var bufres: boolean;  bufs, sval: string; inum: integer;
begin
 bufres:= false;
 try
  if Length(Trim(smsc))>0 then
    begin
       bufs := Trim(smsc);
        {
       inum := Pos('|', bufs);
       sval := Copy(bufs, 1, inum-1);
       r.FormWidth := StrToIntDef(sval, 0);

       bufs := Copy(bufs, inum + 1, Length(bufs) - inum);
       inum := Pos('|', bufs);
       sval := Copy(bufs, 1, inum-1);
       r.FormHeight := StrToIntDef(sval, 0);

       bufs := Copy(bufs, inum + 1, Length(bufs) - inum);
       inum := Pos('|', bufs);
       sval := Copy(bufs, 1, inum-1);
       r.PanelTopHeight := StrToIntDef(sval, 0);

       bufs := Copy(bufs, inum + 1, Length(bufs) - inum);
       r.ScrollBoxImageWidth := StrToIntDef(bufs, 0);


       bufres:= (r.FormWidth > 0) and (r.FormHeight > 0);
       }


    end//if Length(Trim(smsc))>0 then
  else bufres:= false;
 finally
  result :=  bufres;
 end;


end;

function GetMyScriptForReturn: PChar;
var bufret: PChar; sss: string;
begin
  try
    sss := myScriptForReturn;
    bufret := PChar(sss);
  finally
    result := bufret;
  end;
end;

function GetMyEntAnswer: PChar;
var bufret: PChar; sss: string;
begin
  try
    sss := MyEntAnswer;
    bufret := PChar(sss);
  finally
    result := bufret;
  end;
end;

function GetMyCorrectAnswer: PChar;
var bufret: PChar; sss: string;
begin
  try
    sss := MyCorrectAnswer;
    bufret := PChar(sss);
  finally
    result := bufret;
  end;
end;

function GetMyReturnIntValue1: integer;
var bufret: integer;
begin
  try
    bufret := iReturnIntValue1;
  finally
    result := bufret;
  end;
end;

function GetMyReturnIntValue2: integer;
var bufret: integer;
begin
  try
    bufret := iReturnIntValue2;
  finally
    result := bufret;
  end;
end;

procedure TRecTestPCharToTRecTest(source: TRecTestPChar; var dest: TRecTest);
begin
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//ВНИМАНИЕ!!!
//В описании теста TRecTest поле имени файла изображения TestImageFN
//используется для хранения имени DLL
  dest.ID := source.ID;
  dest.MyTestType := source.MyTestType;
  dest.Text := StrPas(source.Text);
  dest.TestImageFN := StrPas(source.TestImageFN);
  dest.TestSoundFN := StrPas(source.TestSoundFN);
  dest.TestMovieFN := StrPas(source.TestMovieFN);
  dest.AnswersType := source.AnswersType;
  dest.WeightTest := source.WeightTest;
  dest.SecondsTO := source.SecondsTO;
  dest.MyScript := StrPas(source.MyScript);
  dest.iidw1 := source.iidw1;
  dest.iidw2 := source.iidw2;
end;

procedure TRecTestToTRecTestPChar(source: TRecTest; var dest: TRecTestPChar);
var s, ss: String;
begin
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//ВНИМАНИЕ!!!
//В описании теста TRecTest поле имени файла изображения TestImageFN
//используется для хранения имени DLL
  dest.ID := source.ID;
  dest.MyTestType := source.MyTestType;
  s := source.Text;
  dest.Text := PChar(s);
  dest.TestImageFN := PChar(source.TestImageFN);
  dest.TestSoundFN := PChar(source.TestSoundFN);
  dest.TestMovieFN := PChar(source.TestMovieFN);
  dest.AnswersType := source.AnswersType;
  dest.WeightTest := source.WeightTest;
  dest.SecondsTO := source.SecondsTO;
  ss := source.MyScript;
  dest.MyScript := PChar(ss);
  dest.iidw1 := source.iidw1;
  dest.iidw2 := source.iidw2;
end;

procedure CopyTRecTest(source:TRecTest; var dest:TRecTest);
begin
 dest.ID := source.ID;
 dest.MyTestType := source.MyTestType;
 dest.Text := source.Text;
 dest.TestImageFN := source.TestImageFN;
 dest.TestSoundFN := source.TestSoundFN;
 dest.TestMovieFN := source.TestMovieFN;
 dest.AnswersType := source.AnswersType;
 dest.WeightTest := source.WeightTest;
 dest.SecondsTO := source.SecondsTO;
 dest.MyScript := source.MyScript;
 dest.iidw1 := source.iidw1;
 dest.iidw2 := source.iidw2;
end;

function PrepareStartT(sr: TMyStartRecord):integer;
begin
  try
    iCurSecForTO := sr.iCurSecForTO;
    myLessonType := sr.myLessonType;
    dtStartLesson :=
     EncodeDateTime(Word(sr.idtSLYear), Word(sr.idtSLMonth), Word(sr.idtSLDay),
                    Word(sr.idtSLHour), Word(sr.idtSLMin), Word(sr.idtSLSec),
                    Word(sr.idtSLmSec));

  finally
    result := 0;
  end;
end;

function PrepareAndShowModal(rpch: TRecTestPChar): integer;
var bufres: integer;  sss: AnsiString; r: TRecTest;
begin
  bufres := 0;
  FormFromDLL := TFormFromDLL.Create(nil);
  try
    myScriptForReturn :=  '';
    iReturnIntValue1 := 0;
    iReturnIntValue2 := 0;
    MyEntAnswer := '';
    MyCorrectAnswer := '';
    MyQuestion := '';
    TRecTestPCharToTRecTest(rpch, r);
    bufres := FormFromDLL.PrepareAndShowModal(r);


  finally
   Result := bufres;
  end;
end;

function DestroyMyDLGForm: integer;
begin
  FormFromDLL.Free;
  result:= 0;
end;


{$R *.dfm}

{ TFormFromDLL }

function TFormFromDLL.PrepareAndShowModal(r: TRecTest): TModalResult;
var bufret: TModalResult;   rf: TRecMyScriptFields;
begin
 bufret := 0;
 try
   CopyTRecTest(r, bufRMyTest);
   {//декодирование скрипта - для дальнейшего развития
   if DecodeScriptToRecMyScriptFields(bufRMyTest.MyScript, rf) then
     begin
      Width := rf.FormWidth;
      Height := rf.FormHeight;
     end;//if DecodeScriptToRecMyScriptFields(bufRMyTest.MyScript, rf) then}

   dtBeginWork := Now;
   TimerMain.Enabled := (bufRMyTest.SecondsTO > 0) or (iCurSecForTO > 0);
   PanelTimeOut.Visible := (bufRMyTest.SecondsTO > 0) or (iCurSecForTO > 0);
   if (iCurSecForTO > 0)and(bufRMyTest.SecondsTO = 0) then  GaugeTO.Progress :=  MilliSecondsBetween(Now, dtStartLesson) div (iCurSecForTO*10);
   if bufRMyTest.SecondsTO > 0 then  GaugeTO.Progress :=  0;

   BBOut.Enabled := myLessonType in [0, 1];

   ShowModal;
   bufret := ModalResult;
 finally
   result := bufret;
 end;
end;

procedure TFormFromDLL.TimerMainTimer(Sender: TObject);
var iMSbuf: integer;
begin
   if (bufRMyTest.SecondsTO > 0) or (iCurSecForTO > 0) then
    begin

     if iCurSecForTO > 0 then
      begin
       iMSbuf := MilliSecondsBetween(Now, dtStartLesson);
       if iMSbuf >= iCurSecForTO*1000 then
         begin
           TimerMain.Enabled := false;
           ModalResult := mrOK;
         end;

       if bufRMyTest.SecondsTO = 0 then
         GaugeTO.Progress :=  iMSbuf div (iCurSecForTO*10);

      end;//if iCurSecForTO > 0 then

     if bufRMyTest.SecondsTO > 0 then
       begin
        iMSbuf := MilliSecondsBetween(Now, dtBeginWork);
        if iMSbuf >= bufRMyTest.SecondsTO*1000 then
          begin
             TimerMain.Enabled := false;
             ModalResult := mrOK;
          end;//if MilliSecondsBetween(Now, dtBeginWork) >= bufRMyTest.SecondsTO*1000 then

         GaugeTO.Progress :=  iMSbuf div (bufRMyTest.SecondsTO*10);
       end;//if bufRMyTest.SecondsTO > 0 then

    end//if bufRMyTest.SecondsTO > 0 then
  else  TimerMain.Enabled := false;
end;

end.
