unit Osc_DLL;

interface

uses
  Classes, windows, dialogs, Modules, Graphics;

type

  TArrDbl  = Array [0..2] of Double;
  PTArrDbl = ^TArrDbl;

  TScopes = class
  private
    FScopes :  integer;
//    FStarted : boolean;
  protected

  public
    { Public declarations }

    DllInst     : Longint; // DLL handle.

    // DLL functions begin
     ScopeAfterOpenLib  : function (Prm : Integer)  : Integer; cdecl;
     ScopeCreate        : function (Prm : Integer; P_IniName : Pointer; P_IniSuffix : Pointer) : Integer; cdecl;
     ScopeDestroy       : function (Prm : Integer) : Integer; cdecl;
     ScopeShow          : function (Prm : Integer) : Integer; cdecl;
     ScopeHide          : function (Prm : Integer) : Integer; cdecl;
     ScopeCleanBuffers  : function (ScopeHandle : Integer) : Integer; cdecl;
     ScopeShowNext      : function (Prm : Integer; PrmD : PTArrDbl) : Integer; cdecl;
     ScopeQuickUpDate   : function (Prm : Integer) : Integer; cdecl;
     ScopeExtNext       : function (ScopeHandle : Integer; PDbl : Pointer) : Integer; cdecl;
    // DLL functions end

     constructor Create; virtual;
     destructor Destroy; override;
     procedure Show;
     procedure Hide;
     procedure Clear;
     procedure Values(PrmD : PTArrDbl);
     procedure Update;
//     function GetProcess: boolean;
  published
//     property isProcess: boolean read GetProcess;
  end;


  TProcess = class(TThread)
  private
    FCriticalSection : TRTLCriticalSection; // Секция для безопасного выполнения команд
    t : string;
    Values : TArrayValues;
    States : TArrayStates;
    Gains  : TArrayGains;

    FLineCount : integer;
    FPause     : boolean;
    FStream    : TStream;
    Freq       : Int64;
    StartTime  : Int64;
    hrT1       : Int64;
    FTab       : Char;
    procedure SetPause(Index : boolean);
    procedure UpdateMain;
  protected
    ActiveModule : TModule;
    procedure DoTerminate; override;
    procedure Execute; override;
      // заблокировать секцию
    procedure Lock;

    // разблокировать секцию
    procedure UnLock;

  public
    constructor Create;virtual;
    destructor Destroy;override;
  published
    property isPause: boolean read FPause;
    property Pause: boolean write SetPause;

  end;



Var
  Process : TProcess;
  Scopes : TScopes;

implementation

uses
  Main, SysUtils, Forms, Config, NxColumns, NxColumnClasses;

Const
  DllName : String = 'Osc_DLL.dll' + Char(0);
  
{ TTstTrd }

constructor TProcess.Create;
begin
  inherited Create(true);
  InitializeCriticalSection(FCriticalSection);
  FreeOnTerminate := true;
  Priority := tpHighest; //tpHigher;
  Scopes.Clear;
  ActiveModule := ModuleList.ActiveModule;
  Resume;
end;

destructor TProcess.Destroy;
begin
  DeleteCriticalSection(FCriticalSection);
  inherited Destroy;
end;

procedure TProcess.Lock;
begin
  EnterCriticalSection(FCriticalSection);
end;

procedure TProcess.Unlock;
begin
  LeaveCriticalSection(FCriticalSection);
end;

procedure TProcess.SetPause;
begin
  Lock;
  try
    FPause := Index;
  finally
    UnLock;
  end;
end;

procedure TProcess.Execute;
var
  s        : string;
  i, j, k  : integer;
  D        : TArrDbl;
  Interval : Cardinal;

  function PerformanceDelay(Ms: Cardinal): boolean;
  var
    dif, hrT2: Int64;
//    hHandle : THandle;
  begin
      result := true;
      dif := 0;
      repeat
        if Terminated or Application.Terminated or FPause then
        begin
          result := false;
          break;
        end;
        if (dif<>0) and ((ms - dif) > 40) then
            SleepEx(1, false);
        QueryPerformanceCounter(hrT2);
        dif := ((hrT2 - hrT1) * 1000 div Freq);
      until dif > Ms;

{      QueryPerformanceCounter(hrT2);
      dif :=  ((hrT2 - hrT1) * 1000 div Freq);
      if dif < Ms then
      begin
        hHandle := CreateEvent(nil, true, false,'');
        WaitForSingleObject(hHandle, Ms - dif);
        CloseHandle(hHandle);
      end;
}

  end;

begin

  Interval := Trunc(Configuration.MainItem.TimeInterval * 1000);

  if Configuration.MainItem.SaveToFile then
  begin
    if SameText(ExtractFileExt(Configuration.MainItem.FileName), '.csv') then
        FTab := ';'
    else
        FTab := #09;
    FileClose(FileCreate(Configuration.MainItem.FileName));
    FStream := TFileStream.Create(Configuration.MainItem.FileName, fmOpenReadWrite or fmShareDenyWrite);
    FStream.Seek(soFromBeginning, 0);
    FStream.Size := 0;
  end;

  QueryPerformanceFrequency(Freq);
  QueryPerformanceCounter(StartTime);

  FLineCount := 0;
  k:=0;
  repeat
    if not FPause then
    begin
      try // mod - берет очень много ресурсов
        if ((k > 2){(FLineCount mod 2 = 0)} and (Interval > 20) and (Interval <= 60))or
           ((k > 20){(FLineCount mod 5 = 0)} and (Interval > 5) and (Interval <= 20))or
           ((k > 50){(FLineCount mod 20 = 0)} and (Interval > 0) and (Interval <= 5))or
           ((k > 100){(FLineCount mod 100 = 0)} and (Interval = 0))
        then
        begin
          sleep(1);
          k := 0;
//        Application.ProcessMessages;
        end
        else
            inc(k);

        if (Interval <> 0) and (FLineCount <> 0) then
        begin
//          SleepEx(Interval, False);
          if not PerformanceDelay(Interval) then continue;
        end;

        QueryPerformanceCounter(hrT1);
        t := Format('%.3f сек.', [(hrT1 - StartTime) / Freq]);
       //t := Format('%.0f мс.', [(hrT1 - StartTime) * 1000 / Freq]);

        s := t + ':' + FTab;

        ActiveModule.GetValues(Values, States, Gains);

        D[0] := 0;
        D[1] := 0;
        D[2] := 0;

        j := 0;
        for i := 0 to ActiveModule.GetCount -1 do
        begin

          if States[i] then
          begin
            s := s + FloatToStr(Values[i]) + FTab;
            case j of
              0 : D[0] := Values[i];
              1 : D[1] := Values[i];
              2 : D[2] := Values[i];
            end;
            inc(j);
           end;

        end;

        if Configuration.MainItem.OnScreen and ( Configuration.MainItem.TimeInterval <> 0 )then
            Synchronize(UpdateMain);

        Scopes.Values(@D);

        if FLineCount mod 10 = 0 then
            Scopes.Update;

        if Assigned(FStream) and Configuration.MainItem.SaveToFile then
        begin
          s := s + #13#10;
          FStream.Write(s[1], length(s));
        end;

        Inc(FLineCount);
        if FLineCount = Trunc(Configuration.MainItem.Count) then
        begin
          MessageBox(Application.Handle, PChar('Успешно завершено.'), '', MB_OK or MB_ICONINFORMATION);
          Terminate;
        end;

      except
        on E: Exception do
        begin
          Application.ShowException(E);
          Terminate;
        end;
      end;
    end
    else
        Sleep(10);
  until Terminated or Application.Terminated;

  if Assigned(FStream) then
      FreeAndNil(FStream);

end;


procedure TProcess.UpdateMain;
var
  i, j : integer;
  nxCustomColum : TNxCustomColumn;
begin
//  try
  with MainForm do
  begin
    j := 0;
    if NextGrid.Columns.Count = 0 then
    begin
      nxCustomColum := NextGrid.Columns.Add(TNxTextColumn, 'Время');
      nxCustomColum.Options :=[coCanClick,coCanInput,coPublicUsing,coShowTextFitHint];
    end;
    NextGrid.AddRow();
    NextGrid.Cell[0, FLineCount].AsString := t;
    for i := 0 to ActiveModule.GetCount -1 do
    begin
      if States[i] then
      begin
        inc(j);
        if NextGrid.Columns.Count <= j then
        begin
          nxCustomColum := NextGrid.Columns.Add(TNxTextColumn, Format('Канал №%d', [i +1]));
          nxCustomColum.Options :=[coCanClick,coCanInput,coPublicUsing,coShowTextFitHint];
          case nxCustomColum.Index of
            1 : nxCustomColum.Font.Color := clgreen;
            2 : nxCustomColum.Font.Color := clPurple;
            3 : nxCustomColum.Font.Color := clOlive;
          end;

        end;
        NextGrid.Cell[j, FLineCount].AsString := FloatToStr(Values[i]);
       end;

    end;
    NextGrid.SelectLastRow;
  end;
//  except
//    Terminate;
//  end;
end;

procedure TProcess.DoTerminate;
begin
  Process := nil;
//  MainForm.acStopExecute(nil);
end;

constructor TScopes.Create;
begin
  inherited Create;
  ScopeAfterOpenLib := NIL;
  DllInst := LoadLibrary(PChar(DllName));
   if (DllInst = 0) then  begin ShowMessage('Error DLL loading 1'); Exit; end;

   ScopeAfterOpenLib  := GetProcAddress(DllInst, 'AtOpenLib');
   if (@ScopeAfterOpenLib = Nil) then
   begin FreeLibrary(DllInst); ShowMessage('Error DLL loading 2'); Exit; end;

   ScopeAfterOpenLib(0);

   ScopeShowNext := Nil;
   ScopeShowNext := GetProcAddress(DllInst, 'ShowNext');
   if (@ScopeShowNext = Nil) then
   begin FreeLibrary(DllInst); ShowMessage('Error DLL loading 3'); Exit; end;

   ScopeCreate := Nil;
   ScopeCreate := GetProcAddress(DllInst, 'ScopeCreate');
   if (@ScopeCreate = Nil) then
   begin FreeLibrary(DllInst); ShowMessage('Error DLL loading 4'); Exit; end;

   ScopeDestroy := Nil;
   ScopeDestroy := GetProcAddress(DllInst, 'ScopeDestroy');
   if (@ScopeDestroy = Nil) then
   begin FreeLibrary(DllInst); ShowMessage('Error DLL loading 5'); Exit; end;

   ScopeShow := Nil;
   ScopeShow := GetProcAddress(DllInst, 'ScopeShow');
   if (@ScopeShow = Nil) then
   begin FreeLibrary(DllInst); ShowMessage('Error DLL loading 6'); Exit; end;

   ScopeHide := Nil;
   ScopeHide := GetProcAddress(DllInst, 'ScopeHide');
   if (@ScopeHide = Nil) then
   begin FreeLibrary(DllInst); ShowMessage('Error DLL loading 7'); Exit; end;

   ScopeCleanBuffers := Nil;
   ScopeCleanBuffers := GetProcAddress(DllInst, 'ScopeCleanBuffers');
   if (@ScopeCleanBuffers = Nil) then
   begin FreeLibrary(DllInst); ShowMessage('Error DLL loading 8');  end;

   ScopeQuickUpDate := Nil;
   ScopeQuickUpDate := GetProcAddress(DllInst, 'QuickUpDate');
   if (@ScopeQuickUpDate = Nil) then
   begin FreeLibrary(DllInst); ShowMessage('Error DLL loading 9'); Exit; end;


   ScopeExtNext := Nil;
   ScopeExtNext := GetProcAddress(DllInst, 'ExternalNext');
   if (@ScopeExtNext = Nil) then
   begin FreeLibrary(DllInst); ShowMessage('Error DLL loading 10'); Exit; end;

   FScopes := ScopeCreate(0, Nil, Nil);

end;

destructor TScopes.Destroy;
begin
  try
    ScopeDestroy(FScopes);
  except
  end;

  FreeLibrary(DllInst);

  ScopeAfterOpenLib := NIL;
  ScopeShowNext     := Nil;
  ScopeCreate       := Nil;
  ScopeQuickUpDate  := Nil;
  ScopeHide         := Nil;
  ScopeCleanBuffers := Nil;
  ScopeShow         := Nil;
  ScopeDestroy      := Nil;
  ScopeExtNext      := Nil;

  inherited Destroy;
end;

{function TScopes.GetProcess: boolean;
begin
  Result := assigned(TstTrd);
end;
}
procedure TScopes.Show;
begin
  ScopeShow(FScopes);
end;

procedure TScopes.Hide;
begin
  ScopeHide(FScopes);
end;

procedure TScopes.Clear;
begin
  ScopeCleanBuffers(FScopes);
end;

{
procedure TScopes.Stop;
begin
// if assigned(TstTrd) then
// begin
//   TstTrd.Terminate;
//   TstTrd := nil;
//   TstTrd.WaitFor;
//   FreeAndNil(TstTrd);
// end;
end;

procedure TScopes.Pause;
begin
  TstTrd.Pause := not TstTrd.isPause;
end;
}
procedure TScopes.Values(PrmD : PTArrDbl);
begin
  Scopes.ScopeShowNext(FScopes, PrmD);
end;

procedure TScopes.Update;
begin
  Scopes.ScopeQuickUpDate(FScopes);
end;

end.

