unit ltreu_marks;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,  ltrapi,  ltrapitypes, ltrapidefine, StdCtrls;

   //массив кодов режимов синхрометок. порядок должен совпадать с порядком
   //элементов в списке выбора в cbbSecondMarkMode и cbbStartMarkMode
const     mark_modes: array[0..4] of en_LTR_MarkMode = (LTR_MARK_INTERNAL,
                                                   LTR_MARK_EXT_DIGIN1_RISE,
                                                   LTR_MARK_EXT_DIGIN1_FALL,
                                                   LTR_MARK_EXT_DIGIN2_RISE,
                                                   LTR_MARK_EXT_DIGIN2_FALL);
type
  TMainForm = class(TForm)
    btnStartSecondMarsk: TButton;
    cbbSecondMarkMode: TComboBox;
    btnStopSecondMarks: TButton;
    lstCrates: TListBox;
    lbl1: TLabel;
    lbl2: TLabel;
    btnRefreshCratesList: TButton;
    lbl3: TLabel;
    cbbStartMarkMode: TComboBox;
    btnMakeStartMark: TButton;
    procedure btnStartSecondMarskClick(Sender: TObject);
    procedure btnStopSecondMarksClick(Sender: TObject);
    procedure btnRefreshCratesListClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnMakeStartMarkClick(Sender: TObject);
  private
    { Private declarations }
    crate_serials : array of string;

    function openCurrentCrate(var hcrate : TLTR) : Integer;
    procedure refreshCrateList();
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

function TMainForm.openCurrentCrate(var hcrate: TLTR) : Integer;
var
  err : Integer;
  idx : Integer;
  serial : string;
begin
  LTR_Init(hcrate);
  hcrate.cc := LTR_CC_CHNUM_CONTROL;
  // Если выбран крейт в списке, то используем его серийный номер для
  // запуска меток именно для него. Если крейт не выбран, то не заполняем
  // серийный номер и связь будет установлена с первым найденным крейтом
  idx:= lstCrates.ItemIndex;
  if (idx >= 0) and (idx < Length(crate_serials)) then
     serial:= crate_serials[idx]
  else
     serial:='';


  err := LTR_OpenCrate(hcrate, LTRD_ADDR_DEFAULT, LTRD_PORT_DEFAULT,
                       LTR_CRATE_IFACE_UNKNOWN, serial);
  if err <> LTR_OK then
     MessageDlg('Не удалось установить связь с крейтом: ' + LTR_GetErrorString(err), mtError, [mbOK], 0);
  openCurrentCrate:=err;
end;

// получение списка крейтов
procedure TMainForm.refreshCrateList();
var
  hsrv : TLTR;
  hcrate : TLTR;
  crate_info : TLTR_CRATE_INFO;
  err : Integer;
  crates_cnt, crate_ind, crate_append_cnt : Integer;
  current_serial_list : array [0..LTR_CRATES_MAX-1] of string; //список номеров керйтов
  crate_type_name : string;
  idx : Integer;
begin
  //запоминаем выбранный элемент до зачистки, чтобы потом восстановить
  idx := lstCrates.ItemIndex;
  lstCrates.Items.Clear;
  SetLength(crate_serials, 0);
  crate_append_cnt := 0;


  // устанавливаем соединение с ltrd или LTR Server
  LTR_Init(hsrv);
  LTR_OpenSvcControl(hsrv, LTRD_ADDR_DEFAULT, LTRD_PORT_DEFAULT);
  err:=LTR_Open(hsrv);
  if err <> LTR_OK then
  begin
    MessageDlg('Не удалось установить связь с сервером: ' + LTR_GetErrorString(err), mtError, [mbOK], 0);
  end
  else
  begin
    //получаем список серийных номеров всех подключенных крейтов
    err:=LTR_GetCrates(hsrv, current_serial_list, crates_cnt);
    if (err <> LTR_OK) then
      MessageDlg('Не удалось получить список крейтов: ' + LTR_GetErrorString(err), mtError, [mbOK], 0)
    else
    begin
      for crate_ind:=0 to crates_cnt-1 do
      begin
        // для получения информации о крейте (выводим тип крейта) необходимо
        // установить соединение с каждым крейтом
        LTR_Init(hcrate);
        err:=LTR_OpenCrate(hcrate, LTRD_ADDR_DEFAULT, LTRD_PORT_DEFAULT,
                           LTR_CRATE_IFACE_UNKNOWN, current_serial_list[crate_ind]);
        if err=LTR_OK then
        begin
          // получаем информацию
          err:=LTR_GetCrateInfo(hcrate, crate_info);
          if err = LTR_OK then
          begin
            // по коду типа устанавливаем соответствующее имя крейта для вывода
            case crate_info.CrateType of
              LTR_CRATE_TYPE_LTR010:    crate_type_name := 'LTR-U-8/16';
              LTR_CRATE_TYPE_LTR021:    crate_type_name := 'LTR-U-1';
              LTR_CRATE_TYPE_LTR030:    crate_type_name := 'LTR-EU-8/16';
              LTR_CRATE_TYPE_LTR031:    crate_type_name := 'LTR-EU-2';
              LTR_CRATE_TYPE_LTR_CU_1:  crate_type_name := 'LTR-CU-1';
              LTR_CRATE_TYPE_LTR_CEU_1: crate_type_name := 'LTR-CEU-1';
            else
              crate_type_name := 'Неизвестный крейт';
            end;
            // добавляем в отображаемый список
            lstCrates.Items.Add(crate_type_name + ': ' + current_serial_list[crate_ind]);

            SetLength(crate_serials, crate_append_cnt + 1);
            crate_serials[crate_append_cnt] := current_serial_list[crate_ind];
            crate_append_cnt := crate_append_cnt + 1;
          end;
          LTR_Close(hcrate);
        end;
      end;

      LTR_Close(hsrv);
    end;
  end;


  //восстанавливаем выбранный элемент по индексу
  if (idx >= 0)  and (lstCrates.Items.Count > 0) then
  begin
    //если элементов стало меньше, чем номер выбранного, то выбираем последний
    if idx <  lstCrates.Items.Count then
      lstCrates.ItemIndex := idx
    else
      lstCrates.ItemIndex := lstCrates.Items.Count - 1;
  end;
end;  

procedure TMainForm.btnStartSecondMarskClick(Sender: TObject);
var
  hcrate : TLTR;
  err : Integer;
begin
  err := openCurrentCrate(hcrate);
  if err = LTR_OK then
  begin
    err := LTR_StartSecondMark(hcrate, mark_modes[cbbSecondMarkMode.ItemIndex]);
    if err <> LTR_OK then
      MessageDlg('Не удалось запустить синхрометки: ' + LTR_GetErrorString(err), mtError, [mbOK], 0);
  end;

  LTR_Close(hcrate);
end;

procedure TMainForm.btnStopSecondMarksClick(Sender: TObject);
var
  hcrate : TLTR;
  err : Integer;
begin
  err := openCurrentCrate(hcrate);
  if err = LTR_OK then
  begin
    err := LTR_StopSecondMark(hcrate);
    if err <> LTR_OK then
      MessageDlg('Не удалось остановить синхрометки: ' + LTR_GetErrorString(err), mtError, [mbOK], 0);
  end;
  LTR_Close(hcrate);
end;

procedure TMainForm.btnRefreshCratesListClick(Sender: TObject);
begin
  refreshCrateList;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  refreshCrateList;
end;

procedure TMainForm.btnMakeStartMarkClick(Sender: TObject);
var
  hcrate : TLTR;
  err : Integer;
begin
  err := openCurrentCrate(hcrate);
  if err = LTR_OK then
  begin
    err := LTR_MakeStartMark(hcrate, mark_modes[cbbStartMarkMode.ItemIndex]);
    if err <> LTR_OK then
      MessageDlg('Не удалось сгенерировать метку СТАРТ: ' + LTR_GetErrorString(err), mtError, [mbOK], 0);
  end;
  LTR_Close(hcrate);
end;

end.
